module Balls where -- library module for `balls` import Terminal.Game import qualified Data.Bool as B import qualified Data.Ix as I import qualified Data.Maybe as M import qualified Data.Tuple as T {- There are three things I will showcase in this example: 1. ** How you can display current FPS. ** This is done using information passed via `GEnv` (eFPS). 2. ** How your game can gracefully handle screen resize. ** Notice how if you resize the terminal, balls will still fill the entire screen. This is again possible using `Game` and the information passed via GEnv (in this case, terminal dimensions). 3. ** That — while FPS can change — game speed does not. ** Check the timer: even when screen is crowded and frames are dropped, it is not slowed down. This game runs at 60 FPS, you will almost surely never need such a high TPS! 15–20 is more than enough in most cases. -} ------------------------------------------------------------------------------- -- Ball data Ball = Ball { pChar :: Plane, pSpeed :: Timed Bool, pDir :: Coords, pPos :: Coords } -- change direction is necessary, then and move modPar :: Dimensions -> Ball -> Maybe Ball modPar ds b@(Ball _ _ d _) = -- tick the ball and check it is time to move let b' = tickBall b in if not (fetchFrame . pSpeed $ b') then Just b' -- no time to move for you else -- check all popssible directions let pd = [d, togR d, togC d, togB d] bs = map (\ld -> b' { pDir = ld }) pd bs' = filter (isIn ds) $ map modPos bs in -- returns a moved ball nor nothing to mark it “to eliminate” case bs' of [] -> Nothing (cp:_) -> Just cp where togR (wr, wc) = (-wr, wc) togC (wr, wc) = ( wr, -wc) togB (wr, wc) = (-wr, -wc) tickBall :: Ball -> Ball tickBall b = b { pSpeed = tick (pSpeed b) } modPos :: Ball -> Ball modPos (Ball p t d@(dr, dc) (r, c)) = Ball p t d (r+dr, c+dc) isIn :: Dimensions -> Ball -> Bool isIn (w, h) (Ball p _ _ (pr, pc)) = let (pw, ph) = planeSize p in pr >= 1 && pr+ph-1 <= h && pc >= 1 && pc+pw-1 <= w dpart :: Ball -> (Coords, Plane) dpart (Ball p _ _ cs) = (cs, p) genBall :: StdGen -> Dimensions -> (Ball, StdGen) genBall g ds = let (c, g1) = pickRandom [minBound..] g (s, g2) = getRandom (1, 3) g1 (v, g3) = pickRandom dirs g2 (p, g4) = ranIx ((1,1), T.swap ds) g3 b = Ball (cell 'o' # color c Vivid) (creaBoolTimerLoop s) v p in (b, g4) where dirs = [(1, 1), (1, -1), (-1, 1), (-1, -1)] -- tuples instances are yet to be added to `random` -- as nov 21; this will do meanwhile. ranIx :: I.Ix a => (a, a) -> StdGen -> (a, StdGen) ranIx r wg = pickRandom (I.range r) wg ------------------------------------------------------------------------------- -- Timer type Timer = (Timed Bool, Integer) ctimer :: TPS -> Timer ctimer tps = (creaBoolTimerLoop tps, 0) ltimer :: Timer -> Timer ltimer (t, i) = let t' = tick t k = B.bool 0 1 (fetchFrame t') in (t', i+k) dtimer :: Timer -> Plane dtimer (_, i) = word . show $ i ------------------------------------------------------------------------------- -- Game data GState = GState { gen :: StdGen, timer :: Timer, balls :: [Ball], bslow :: Bool } -- pSlow is not used in game, it is there just -- for the test suite fireworks :: StdGen -> Game GState Int fireworks g = Game tps istate lfun dfun where tps = 60 istate :: GState istate = GState g (ctimer tps) [] False ------------------------------------------------------------------------------- -- Logic -- The `Int` in `Either Int Gstate` is: number of balls -- on screen at the end of the game. lfun :: GEnv -> GState -> Event -> Either Int GState lfun e s (KeyPress 's') = let g = gen s ds = eTermDims e (b, g1) = genBall g ds s' = s { gen = g1, balls = b : balls s } in Right s' lfun _ s (KeyPress 'q') = Left $ length (balls s) lfun _ s (KeyPress _) = Right s lfun r s Tick = let ds = eTermDims r ps = balls s ps' = M.mapMaybe (modPar ds) ps bs = eFPS r < 30 s' = s { timer = ltimer (timer s), balls = filter (isIn ds) ps', bslow = bs } in Right s' ------------------------------------------------------------------------------- -- Draw dfun :: GEnv -> GState -> Plane dfun r s = mergePlanes (uncurry blankPlane ds) (map dpart $ balls s) & (1, 2) %^> tui # trans & (1, 2) %.< inst # trans # bold where ds = eTermDims r tm = timer s tui :: Plane tui = let fps = eFPS r np = length $ balls s l1 = word "FPS: " ||| word (show fps) l2 = word "Timer: " ||| dtimer tm l3 = word ("Balls: " ++ show np) l4 = word ("Term. dims.: " ++ show ds) in vcat [l1, l2, l3, l4] inst :: Plane inst = word "Press (s) to spawn" === word "Press (q) to quit" === word "Resize terminal to pop balls" trans :: Draw trans = makeTransparent ' '