-- GPLv3, this and all the repo {-# Language TemplateHaskell #-} {-# Language LambdaCase #-} module Venzone where import Menu import Story import Paths import Input import Terminal.Game import Lens.Micro.Platform ---------- -- GAME -- ---------- -- main Game State data Venzone = Venzone { _quit :: Bool, _menu :: Menu, -- Nothing; we are in menu _story :: Maybe Story } deriving (Eq, Show) makeLenses ''Venzone defaultVenzone :: Venzone defaultVenzone = Venzone False defaultMenu Nothing prepareVenzone :: IO (Game Venzone) prepareVenzone = bundleStories <$> findStories bundleStories :: [Story] -> Game Venzone bundleStories ss = let m = menuStories ss gs = defaultVenzone & menu .~ m in makeVenzone gs where logicWrapper :: Venzone -> Event -> Venzone logicWrapper s e = logicFun s (eventInput e) makeVenzone :: Venzone -> Game Venzone makeVenzone gs = Game 80 24 13 gs logicWrapper drawFun (^. quit) ----------- -- LOGIC -- ----------- logicFun :: Venzone -> Input -> Venzone logicFun gs KExit | gs ^. story == Nothing || gs ^. story . non defaultStory . name == "Gymnasium" -- debug = gs & quit .~ True logicFun gs _ | (Just s) <- gs ^. menu . selected = gs & menu . selected .~ Nothing & story ?~ s -- ?~ = wraps in maybe logicFun gs e = menuCase gs (gs & menu %~ flip menuLogic e) (if gs ^. story . non (error "menuCase non-story") . status . to fsb then gs & story .~ Nothing else gs & story . mapped %~ flip storyLogic e) where fsb :: Status -> Bool fsb SQuit = True fsb (SWon a) = isExpired a fsb _ = False ---------- -- DRAW -- ---------- drawFun :: Venzone -> Plane drawFun gs = menuCase gs (drawMenu (gs ^. menu)) (drawStory (gs ^?! story . _Just)) ----------------- -- ANCILLARIES -- ----------------- menuCase :: Venzone -> a -> a -> a menuCase gs ca cb = if has (story . _Nothing) gs then ca else cb