diff --git a/ai/src/Card.hs b/ai/src/Card.hs index 1e041fc..6c16a48 100644 --- a/ai/src/Card.hs +++ b/ai/src/Card.hs @@ -95,7 +95,7 @@ creatureUI2CreatureCore Creature {creatureId, hp, attack, moral, victoryPoints, card2Creature :: Card p -> Maybe (Creature p) card2Creature = \case - CreatureCard creature -> Just $ creature + CreatureCard creature -> Just creature NeutralCard _ -> Nothing ItemCard _ -> Nothing diff --git a/ai/ui/MainUi.hs b/ai/ui/MainUi.hs index 5f5915d..12c6524 100644 --- a/ai/ui/MainUi.hs +++ b/ai/ui/MainUi.hs @@ -71,7 +71,8 @@ pictureSize picture = data Assets = Assets { backgroundPics :: NE.NonEmpty Picture, - creaturePics :: Map.Map CreatureID Picture + creaturePics :: Map.Map CreatureID Picture, + cardOverlay :: Picture } getOrThrow :: @@ -84,30 +85,25 @@ getOrThrow ma e = Nothing -> throw e Just a -> return a +loadOrThrowJuicyPNG :: (MonadIO m, MonadThrow m) => FilePath -> m Picture +loadOrThrowJuicyPNG filepath = do + maybePic <- liftIO $ loadJuicyPNG filepath + pic :: Picture <- getOrThrow maybePic $ LoadException filepath + return pic + loadBackgrounds :: (MonadIO m, MonadThrow m) => m (NE.NonEmpty Picture) loadBackgrounds = do - let pics = NE.map loadBackground backgrounds + let pics = NE.map loadOrThrowJuicyPNG backgrounds traverse Prelude.id pics - where - loadBackground :: (MonadIO m, MonadThrow m) => FilePath -> m Picture - loadBackground filepath = do - maybePic <- liftIO $ loadJuicyPNG filepath - pic :: Picture <- getOrThrow maybePic $ LoadException filepath - return pic loadCreature :: (MonadIO m, MonadThrow m) => CreatureID -> m Picture -loadCreature creatureID = do - maybePic <- liftIO $ loadJuicyPNG path - case maybePic of - Nothing -> throw $ CreatureLoadException path creatureID - Just pic -> return pic - where - path = creatureID2FilePath creatureID +loadCreature creatureID = + loadOrThrowJuicyPNG $ creatureID2FilePath creatureID -- | Loads backgrounds and creatures assets from disk loadAssets :: @@ -117,7 +113,12 @@ loadAssets :: loadAssets uiData = do bgs <- loadBackgrounds assocList <- liftIO $ traverse entryMaker uiData - return $ Assets bgs $ Map.fromListWith handleDuplicate assocList + cardOverlay <- loadOrThrowJuicyPNG $ assetsGenPath ++ "/" ++ "card-overlay.png" + return $ + Assets + bgs + (Map.fromListWith handleDuplicate assocList) + cardOverlay where entryMaker :: CreatureID -> IO (CreatureID, Picture) entryMaker id = do @@ -129,9 +130,9 @@ loadAssets uiData = do pictureBoard :: HasCallStack => Assets -> - Board -> + (Board, Maybe Event) -> Picture -pictureBoard assets board = +pictureBoard assets (board, maybeEvent) = mconcat (bg : cards') where bg :: Picture = NE.head $ backgroundPics assets @@ -202,7 +203,7 @@ mainPlay assets cards = liftIO $ play display' white fps world drawer eventHandler stepper where board = exampleBoard cards - boardPicture = pictureBoard assets board + boardPicture = pictureBoard assets (board, Nothing) world = World board (framex, framey) = pictureSize boardPicture display' = InWindow gameName (round framex, round framey) (0, 0) @@ -217,7 +218,7 @@ mainUI :: [Card UI] -> m () mainUI assets cards = do - let pic = pictureBoard assets board + let pic = pictureBoard assets (board, Nothing) pic' = Scale 0.66 0.66 pic picSize = pictureSize pic' liftIO $ display (InWindow gameName (both ceiling picSize) (0, 0)) white pic' diff --git a/assets/card-overlay.xcf b/assets/card-overlay.xcf new file mode 100644 index 0000000..8f42bf4 Binary files /dev/null and b/assets/card-overlay.xcf differ