--- type: slide --- # Final Lambda <style> .reveal { font-size: 24px; } </style> ---- # Team Thomas Paul David ---- # Initiale Idee ### Rouge-lite Dorf /Stadt (Händler/Trainer/Quest) Spawnpoint (Story-Start, Quest) Dungeons (Combat) NPC-Gegner Optional: 1 End-Boss Map ---- # FFP Konzepte Databases Graphics Lenses ---- ## Databases - postgresql-simple: Mid-Level PostgreSQL client library - Session-übergreifender State um Fortschritt zu erlauben - Content für Quests ---- ```haskell= insertQuest :: Int -> String -> IO Int64 insertQuest id name = do connection <- getConnection execute connection "insert into quest (id, q_type) values (?,?)" (id,name) getQuest :: Int -> IO [DB.DataStructures.QuestDB] getQuest q_id = do connection <- getConnection query connection "select * from quest where id = (?)" [q_id] questFromDB :: Int -> IO Quest questFromDB questId = do quest <- DB.Database.getQuest questId let qt_id = getQuestType quest questType <- getQuestTypeDB qt_id let qt_desc = getQuestDesc questType progress <- getProgressByQuest questId reward <- getRewardByQuest questId dialogue <- getDialogueByQuest questId let item_id = getRewardItemId reward item_type <- getItemType item_id return $ Quest (createQuestType qt_desc) (createQuestProgress (createQuestType qt_desc) progress) (createQuestReward reward) $ createDialogue dialogue ``` ---- ## Questing - Aufträge für SpielerInnen - Vehikel für Story und Fortschritt - Füllen Spielwelt mit Leben ---- ```haskell= data QuestInfo = QuestInfo { playerId :: Int , index :: Int , contractor :: Int , quest :: Quest , state :: QuestState } data Quest = Quest { qtype :: QuestType , progress :: QuestProgress , reward :: QuestReward , dialogue :: Dialogue } ``` ---- ```haskell= interactWithContractor :: Int -> ActiveQuests -> Int -> Questline -> ActiveQuests interactWithContractor id pq c ql = let action = getAvailableAction c pq currentPlayerQuest = getQuestInfoByContractor pq c otherQuests = filterQuests pq c dialogue = getDialogue currentPlayerQuest isKnown = hasQuestFromContractor pq c in if isJust currentPlayerQuest then case action of KeepGoing -> pq BeginQuestline -> acceptQuest pq id 1 c $ fromJust $ getNextFromQl ql 0 Accept -> progressQuestline id pq c ql MarkAsDone -> setQuestDone (fromJust currentPlayerQuest) : otherQuests else pq ``` ---- ```haskell= getNextFromQl :: Questline -> Int -> Maybe Quest getNextFromQl ql i = let questMap = qlToQlMap ql index = i + 1 in Map.lookup index questMap ``` ---- ## Graphics (GUI) ![](https://i.imgur.com/to35evQ.png) ---- ## Server ![](https://i.imgur.com/2SH3b8K.png) ---- ## Messages ```haskell data Message = Message [Destionation] Payload deriving stock Generic deriving anyclass Binary deriving Show deriving Eq ``` ---- ## Connection Handling ```haskell bufferSize :: Int bufferSize = 10000000 msg <- recv conn bufferSize ``` ---- ## Lenses Viel eingesetzt im KI Part um auf Attribute von Bots zuzugreifen, Funktionen auf sie anzuwenden, etc. ---- ```haskell movementL :: Lens' Entity MovementAttr movementL = lens movementAttrs (\entity newMovementAttrs -> entity { position = fstOf5 newMovementAttrs, direction = sndOf5 newMovementAttrs, homebase = trdOf5 newMovementAttrs, velocity = frtOf5 newMovementAttrs, perimeter = fftOf5 newMovementAttrs }) where movementAttrs :: Entity -> MovementAttr movementAttrs entity = (position entity, direction entity, homebase entity, velocity entity, perimeter entity) movementDirectionL :: Lens' MovementAttr PointF movementDirectionL = lens direction' (\(pos, _, hb, v, p) newDirection -> (pos, newDirection, hb, v, p)) where direction' :: MovementAttr -> PointF direction' (_, dir, _, _, _) = dir -- in action normalizeP :: MovementAttr -> MovementAttr normalizeP mvmnt = over movementDirectionL (normalizeWeighted 1 . (tApp2 (-) `flip`) pos) mvmnt where pos = view movementPositionL mvmnt ``` ---- ## Dungeon Generation - Abstrakte API implementiert - Geseedete Dungeons für Kosistenz - Meta Informationen über Dungeon die der KI und dem Client bereitgestellt werden ---- Seed 21 ![](https://i.imgur.com/aw8W5II.png) ---- Seed 42 ![](https://i.imgur.com/Ki67iOw.png) ---- ```haskell getDungeon :: Int -> IO (PointI, VS.Vector Int, (PointF, Circles)) getDungeon seed = do (pic, entry, botPositions) <- generateDungeon seed sideLen let imagePath = printf "images/dungeon%d.png" seed exportPictureToFormat writePng (round sideLen, round sideLen) black imagePath pic let meta = (entry, botPositions) cluster <- readImageRGB VS imagePath (dims, vector) <- transformToVector cluster return (dims, vector, meta) ``` ---- ## KI - Abstrakte API implementiert um KI zu konsumieren - Eigens modifizierte Variante von Separation Steering als Grundlegenden Verhaltensalgorithmus - Wände werden respektiert ohne echte Kollissionerkennung zu benötigen ---- # Live Demo? ---- ```haskell initKI :: Int -> [(Float, PointF)] -> VS.Vector Int -> KIState initKI seed botSpawns vector = State { dims = (sideLen', sideLen'), substrate = vector, bots = genBots nBots seed botSpawns } updateKI :: [PlayerInfo] -> Float -> KIState -> KIState updateKI players seconds state = moveAgents players seconds state attackKI :: Float -> PlayerInfo -> Int -> KIState -> KIState attackKI damage player botID state = applyDamage damage player botID state ``` ---- ---- # Issues - Scale - Zeitmanagement - Kompatibilität ---- ## Issues: Scale - Projektumfang sehr ambitioniert - zu spät bemerkt, dass nicht realisierbar ---- ## Issues: Zeitmanagement - Zu knapp kalkuliert - äußere Faktoren ---- ## Issues: Kompatibilität - Zusammenspiel verschiedener Libraries mehr Probleme als erwartet - Kleinere Community als andere Sprachen - ---- # Vielen Dank! Thomas | Paul | David