{-# Language TemplateHaskell #-} module Menu where import Art import Story import Input import Terminal.Game import Lens.Micro.Platform import qualified Data.List as L import qualified NonEmptyZipper as Z data Menu = Menu { _stories :: Z.NonEmptyZipper Story, _selected :: Maybe Story } deriving (Eq, Show) makeLenses ''Menu defaultMenu :: Menu defaultMenu = Menu (Z.wrap defaultStory) Nothing menuStories :: [Story] -> Menu menuStories [] = error "No stories found in story folder!" menuStories (s:ss) = Menu (s Z.|: ss) Nothing ----------- -- LOGIC -- ----------- menuLogic :: Menu -> Input -> Menu menuLogic m KUp = m & stories %~ Z.previousMod menuLogic m KDown = m & stories %~ Z.nextMod menuLogic m KRight = let c = m ^. stories . to Z.current in m & selected ?~ c -- ?~ == .~ (Just ...) menuLogic m _ = m ---------- -- DRAW -- ---------- drawMenu :: Menu -> Plane drawMenu m = menuArt & (11, 6) % drawSelector 25 10 m -- selector -- drawSelector :: Width -> Height -> Menu -> Plane drawSelector w h m = blankPlane w h & (1, 1) % textBox tbt w 3 & (4, 2) % mergePlanes (blankPlane w (h-2)) [((r, 1), p) | (r, p) <- zip [1..] ls] where tbt :: String tbt = "W/S to select story,\nD to play, L leaves." iss :: [(Int, Story)] iss = zip [0..] (m ^. stories . to Z.toList) ls :: [Plane] ls = map (\(i,s) -> drawEntry w s (hi == i)) iss hi :: Int hi = m ^. stories . to Z.getPosition type IsSelected = Bool drawEntry :: Width -> Story -> IsSelected -> Plane drawEntry w s sb | not sb = entry | otherwise = blankPlane (w+2) 1 & (1, 1) % entry # bold & (1, w-2) % textBox " *" 2 1 where entry = makeOpaque $ textBox (L.genericTake w $ s ^. name) w 1