venzone-1.0.0.0: src/Venzone.hs

-- 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