Y6H3FAPFS4BGTCZG2SXZ5ELEWVMFK6VF46OI24JFGC4WIASPK63QC NMV4GGIJSHARTJRLUHX7GTDBOKRYIPFGFAA77F2CAL4HAOIKAMDQC 7QP2V7ZBVZ7SKQ3SYV6NYA7V77G3Y7GF5V6EPIXLIYFSMFRWR4VAC K7KUOYE2VONTDGZ6BIAGA3F7RYQEBNTY3LQOYQM4FH3MOUTLBL6AC Y2N6GDITBJID3Q4Z2Y7KEDY46F7R3SU4DRK3ST6ZMA4CNLXWSFDAC NQEZG66FQWQQOOYXN2GK7MHIQH25QBBNKE37GGDJBCHCSKWJZABQC RTM5VGIPTRMJMKLJER4543HXDRMGUZ7TI5VJBOV4ZFGUCILNQ62QC LDXV64JUWYYYPCV6CWMGS3EFX4ZSO7TQ6X327EOQWC5Z6W75UMXQC CHFKQM47XREZBR5LKV6J4G7FYXQD3SA5XGDAY7P4JF6IBCMUGG3QC F3QBAH24YMFWMCA3KJBBUWQTCVTCZW7ZWMSCNWJVQVSLK7BG7TGQC EDJU6E3O44JB425LUX6H5IDTRUSXPUGUNYF2NJBP6VW2GZKCWG6QC VHUL3O55RPR6QD7IXPMJFWI5EOXHQYAMHCLP2FYAULPAOAWUVQ7QC JDI62ZLKN7J4572C7E2WL2HPGAMFU5YEIDOERVGIOBPOOV3DRF5AC 3AFV4YVYLZGHZDSMO3I3DCZE2BZKA2SOBQ6DI2GZILOUGHLVRCQAC 6QAAR2VPKVD3II6SKKLQBHRYOFX4NHA6HGJMBMFRPQCVE5OLKWJQC DPKNMYAABC2UGZ2VAU2GKRDWZSRHFG24VOJ3X57MMPFY76YXJWHAC VMPZ6XVHIWAVIWHZ6WEXEZRZLDPQN7NWJIW3YHG5YRH4I2BXXMBAC CWLOBLWQJDZL5EMPWBHK3XRT2TZZ5U5M4WGMHC65MU5YHAAUJPHAC module Main whereimport Noveimport Nove.Verseimport Nove.Draw.Ansiimport Data.Wordimport Data.Bifunctor ( bimap )import Control.Monad ( join )import Terminal.Game hiding ( Cell )import Terminal.Game qualified as ATG ( Cell )-- Game IO loopmain :: IO ()main = io 20 State{ play = True, center = 0, focus = 0, time = 0} (verse 19 :: Verse (Maybe Train))data State = State{ play :: Bool, center :: Int, focus :: Int, time :: Int}data Track = Trackdata Train = Train { movement :: Maybe Dir }instance Atom (Maybe Train) wherevoid = Nothingmass a| Nothing <- a = False| Just _ <- a = Truemove a| Nothing <- a = Nothing| Just t <- a = movement ttrack :: Automaton State (Maybe Track)track = Automaton fwheref :: Cell State (Maybe Track)f s ns a = atrain :: Automaton State (Maybe Train)train = Automaton fwheref :: Cell State (Maybe Train)f s ns a = ainstance Interface State (Maybe Train) wherelogic :: GEnv -> (State,Verse (Maybe Train)) -> Event -> Either () (State,Verse (Maybe Train))logic g (s,v) e| KeyPress 'Q' <- e = Left ()| KeyPress 'H' <- e = Right (s { center = shift v 1 H $ center s } , v)| KeyPress 'J' <- e = Right (s { center = shift v 1 N $ center s } , v)| KeyPress 'K' <- e = Right (s { center = shift v 1 I $ center s } , v)| KeyPress 'L' <- e = Right (s { center = shift v 1 L $ center s } , v)| KeyPress 'h' <- e = Right (s { focus = shift v 1 H $ focus s } , v)| KeyPress 'j' <- e = Right (s { focus = shift v 1 N $ focus s } , v)| KeyPress 'k' <- e = Right (s { focus = shift v 1 I $ focus s } , v)| KeyPress 'l' <- e = Right (s { focus = shift v 1 L $ focus s } , v)| KeyPress 'p' <- e = Right (s { play = not $ play s } , v)| KeyPress '.' <- e = Right (s { play = False } , v')| KeyPress 'q' <- e , Nothing <- get v (focus s) = Right (s , set (Just $ Train { movement = Nothing }) (focus s) v')| KeyPress 'q' <- e = Right (s , set Nothing (focus s) v')| play s , Tick <- e , mod (time s) (div (fromInteger $ eFPS g) 2) == 0 = Right (s { time = time s + 1 } , v')| otherwise = Right (s , v)wherev' = sim mempty s vdraw :: GEnv -> (State,Verse (Maybe Train)) -> Planedraw e (s,v) = hexwheresize :: Intsize = radius v(widthFull,heightFull) = eTermDims ehex :: Planehex = cellsPlane (succ $ 2 * size * 2) (succ $ 2 * size) [ write (x,y) | x <- [-size..size] , y <- [-size..size] , abs (x + y) <= size ]wherewrite :: (Int,Int) -> (Coords,ATG.Cell)write (x,y)| n == focus s = (c , paletteColorCell k $ creaCell $ grapheme a)| otherwise = (c , paletteColorCell k $ creaCell $ grapheme a)wherea :: Maybe Traina = get v n-- get index of node taking scroll into accountn :: Intn = shift v mx L . shift v my I $ coordToIndex v (mod (x - div y size * size) (3 * size) , mod y size)(mx,my) = indexToCoord v $ center s-- stretch, tilt, margin, translate to library coordinate system (1-based (y,x))c :: (Int,Int)c = join bimap succ (size - y , 2 * (x + size) + y)grapheme :: Maybe Train -> Chargrapheme a| Just _ <- a = 'o'| n == focus s = '.'| otherwise = ' 'k :: Word8| n == focus s = xterm6LevelRGB 4 2 5| otherwise = xterm24LevelGray 9ui :: Planeui = blankPlane 2 2
hex = ATGP.updatePlane (blankPlane (succ $ 2 * size * 2) (succ $ 2 * size)) [ write (x,y) | x <- [-size..size] , y <- [-size..size] , abs (x + y) <= size ]
hex = cellsPlane (succ $ 2 * size * 2) (succ $ 2 * size) [ write (x,y) | x <- [-size..size] , y <- [-size..size] , abs (x + y) <= size ]
| Just _ <- look h = (c , ATGP.colorCell White Dull $ ATGP.creaCell '*')| 0 < i h = (c , ATGP.rgbColorCell (spectrum $ i h + rand s) $ ATGP.creaCell 'o')| otherwise = (c , ATGP.creaCell ' ')
| Just _ <- look h = (c , colorCell White Dull $ creaCell '*')| 0 < i h = (c , rgbColorCell (spectrum $ i h + rand s) $ creaCell 'o')| otherwise = (c , creaCell ' ')
| n == focus s , odd $ frame s = (c,ATGP.creaCell ' ')| Just n == hand s , odd $ frame s = (c,ATGP.creaCell ' ')
| Just n == hand s , odd $ frame s = (c,colorCell White Dull $ atgpcell $ showing $ get v n)| n == focus s , odd $ frame s = (c,creaCell ' ')
atgpcell :: Maybe Piece -> ATGP.Cellatgpcell Nothing = ATGP.colorCell Black Vivid $ ATGP.creaCell '.'atgpcell (Just p) = uncurry ATGP.colorCell (colors !! team p) $ ATGP.creaCell (['▂','▄','▇'] !! size p)
atgpcell :: Maybe Piece -> ATG.Cellatgpcell Nothing = colorCell Black Vivid $ creaCell '.'atgpcell (Just p) = uncurry colorCell (colors !! team p) $ creaCell (['▂','▄','▇'] !! size p)
import Terminal.Gameimport Terminal.Game.Plane qualified as ATGP ( Cell, creaCell, colorCell, rgbColorCell, mapPlane, updatePlane )
import Terminal.Game qualified as ATG ( Cell )import Terminal.Game hiding ( Cell )
| Just n <- mn , ns <- neighbour v (ix n) = foldl (&) (blankPlane 5 3)[ (1,2) % let a = get v $ ns U in cell (grapheme a) # cellDraw a, (1,4) % let a = get v $ ns I in cell (grapheme a) # cellDraw a, (2,1) % let a = get v $ ns H in cell (grapheme a) # cellDraw a, (2,3) % let a = atom n in cell (grapheme a), (2,5) % let a = get v $ ns L in cell (grapheme a) # cellDraw a, (3,2) % let a = get v $ ns N in cell (grapheme a) # cellDraw a, (3,4) % let a = get v $ ns M in cell (grapheme a) # cellDraw a
| Just n <- mn , ns <- neighbour v (ix n) = cellsPlane 5 3[ ((1,2) , let a = get v $ ns U in cellStyle a $ creaCell (grapheme a)), ((1,4) , let a = get v $ ns I in cellStyle a $ creaCell (grapheme a)), ((2,1) , let a = get v $ ns H in cellStyle a $ creaCell (grapheme a)), ((2,3) , let a = atom n in creaCell (grapheme a)), ((2,5) , let a = get v $ ns L in cellStyle a $ creaCell (grapheme a)), ((3,2) , let a = get v $ ns N in cellStyle a $ creaCell (grapheme a)), ((3,4) , let a = get v $ ns M in cellStyle a $ creaCell (grapheme a))
| Dumb <- mode s , me a = ATGP.colorCell White Dull| Dumb <- mode s , not (mass a) = ATGP.colorCell Black Vivid| Dumb <- mode s , Robot {} <- a , "t0" <- name a = ATGP.colorCell Blue Dull| Dumb <- mode s , Robot {} <- a , "t1" <- name a = ATGP.colorCell Magenta Dull| Dumb <- mode s , Robot {} <- a , "t2" <- name a = ATGP.colorCell Red Dull| Dumb <- mode s , Robot {} <- a , "d0" <- name a = ATGP.colorCell Yellow Dull| Dumb <- mode s , Robot {} <- a , "d1" <- name a = ATGP.colorCell Green Dull| Dumb <- mode s , Robot {} <- a , 'L':_ <- name a = ATGP.colorCell Cyan Dull| Dumb <- mode s , Robot {} <- a , "r0" <- name a = ATGP.colorCell White Vivid| Dumb <- mode s , Robot {} <- a , "r1" <- name a = ATGP.colorCell Black Vivid| Dumb <- mode s , Robot {} <- a , "m0" <- name a = ATGP.colorCell Green Vivid| Dumb <- mode s , Robot {} <- a , "m1" <- name a = ATGP.colorCell Green Vivid| Dumb <- mode s , Robot {} <- a , "p0" <- name a = ATGP.colorCell White Dull| Dumb <- mode s , Robot {} <- a , "Tp" <- name a = ATGP.colorCell White Dull| Dumb <- mode s , Robot {} <- a , "T0" <- name a = ATGP.colorCell Blue Dull| Dumb <- mode s , Robot {} <- a , "T1" <- name a = ATGP.colorCell Magenta Dull| Dumb <- mode s , Robot {} <- a , "T2" <- name a = ATGP.colorCell Red Dull| Dumb <- mode s = ATGP.colorCell White Vivid
| Dumb <- mode s , me a = colorCell White Dull| Dumb <- mode s , not (mass a) = colorCell Black Vivid| Dumb <- mode s , Robot {} <- a , "t0" <- name a = colorCell Blue Dull| Dumb <- mode s , Robot {} <- a , "t1" <- name a = colorCell Magenta Dull| Dumb <- mode s , Robot {} <- a , "t2" <- name a = colorCell Red Dull| Dumb <- mode s , Robot {} <- a , "d0" <- name a = colorCell Yellow Dull| Dumb <- mode s , Robot {} <- a , "d1" <- name a = colorCell Green Dull| Dumb <- mode s , Robot {} <- a , 'L':_ <- name a = colorCell Cyan Dull| Dumb <- mode s , Robot {} <- a , "r0" <- name a = colorCell White Vivid| Dumb <- mode s , Robot {} <- a , "r1" <- name a = colorCell Black Vivid| Dumb <- mode s , Robot {} <- a , "m0" <- name a = colorCell Green Vivid| Dumb <- mode s , Robot {} <- a , "m1" <- name a = colorCell Green Vivid| Dumb <- mode s , Robot {} <- a , "p0" <- name a = colorCell White Dull| Dumb <- mode s , Robot {} <- a , "Tp" <- name a = colorCell White Dull| Dumb <- mode s , Robot {} <- a , "T0" <- name a = colorCell Blue Dull| Dumb <- mode s , Robot {} <- a , "T1" <- name a = colorCell Magenta Dull| Dumb <- mode s , Robot {} <- a , "T2" <- name a = colorCell Red Dull| Dumb <- mode s = colorCell White Vivid
| Full <- mode s , me a = ATGP.rgbColorCell $ sRGB24 0x21 0xb2 0x8e -- #21b28e| Full <- mode s , not (mass a) = ATGP.rgbColorCell $ sRGB24 0x66 0x66 0x66 -- #666666| Full <- mode s , Robot {} <- a , "t0" <- name a = ATGP.rgbColorCell $ sRGB24 0x66 0x66 0x99 -- #666699| Full <- mode s , Robot {} <- a , "t1" <- name a = ATGP.rgbColorCell $ sRGB24 0x99 0x66 0x99 -- #996699| Full <- mode s , Robot {} <- a , "t2" <- name a = ATGP.rgbColorCell $ sRGB24 0x99 0x66 0x66 -- #996666| Full <- mode s , Robot {} <- a , "d0" <- name a = ATGP.rgbColorCell $ sRGB24 0x99 0x99 0x66 -- #999966| Full <- mode s , Robot {} <- a , "d1" <- name a = ATGP.rgbColorCell $ sRGB24 0x66 0x99 0x66 -- #669966| Full <- mode s , Robot {} <- a , 'L':_ <- name a = ATGP.rgbColorCell $ sRGB24 0x66 0x99 0x99 -- #669999| Full <- mode s , Robot {} <- a , "r0" <- name a = ATGP.rgbColorCell $ sRGB24 0x99 0x99 0x99 -- #999999| Full <- mode s , Robot {} <- a , "r1" <- name a = ATGP.rgbColorCell $ sRGB24 0x66 0x66 0x66 -- #666666| Full <- mode s , Robot {} <- a , "m0" <- name a = ATGP.rgbColorCell $ sRGB24 0x93 0xe9 0xbe -- #93e9be| Full <- mode s , Robot {} <- a , "m1" <- name a = ATGP.rgbColorCell $ sRGB24 0x93 0xe9 0xbe -- #93e9be| Full <- mode s , Robot {} <- a , "p0" <- name a = ATGP.rgbColorCell $ sRGB24 0xff 0xff 0xff -- #ffffff| Full <- mode s , Robot {} <- a , "Tp" <- name a = ATGP.rgbColorCell $ sRGB24 0xff 0xff 0xff -- #ffffff| Full <- mode s , Robot {} <- a , "T0" <- name a = ATGP.rgbColorCell $ sRGB24 0x66 0x66 0x99 -- #666699| Full <- mode s , Robot {} <- a , "T1" <- name a = ATGP.rgbColorCell $ sRGB24 0x99 0x66 0x99 -- #996699| Full <- mode s , Robot {} <- a , "T2" <- name a = ATGP.rgbColorCell $ sRGB24 0x99 0x66 0x66 -- #996666| Full <- mode s = ATGP.rgbColorCell $ sRGB24 0x99 0x99 0x99 -- #999999
| Full <- mode s , me a = rgbColorCell $ sRGB24 0x21 0xb2 0x8e -- #21b28e| Full <- mode s , not (mass a) = rgbColorCell $ sRGB24 0x66 0x66 0x66 -- #666666| Full <- mode s , Robot {} <- a , "t0" <- name a = rgbColorCell $ sRGB24 0x66 0x66 0x99 -- #666699| Full <- mode s , Robot {} <- a , "t1" <- name a = rgbColorCell $ sRGB24 0x99 0x66 0x99 -- #996699| Full <- mode s , Robot {} <- a , "t2" <- name a = rgbColorCell $ sRGB24 0x99 0x66 0x66 -- #996666| Full <- mode s , Robot {} <- a , "d0" <- name a = rgbColorCell $ sRGB24 0x99 0x99 0x66 -- #999966| Full <- mode s , Robot {} <- a , "d1" <- name a = rgbColorCell $ sRGB24 0x66 0x99 0x66 -- #669966| Full <- mode s , Robot {} <- a , 'L':_ <- name a = rgbColorCell $ sRGB24 0x66 0x99 0x99 -- #669999| Full <- mode s , Robot {} <- a , "r0" <- name a = rgbColorCell $ sRGB24 0x99 0x99 0x99 -- #999999| Full <- mode s , Robot {} <- a , "r1" <- name a = rgbColorCell $ sRGB24 0x66 0x66 0x66 -- #666666| Full <- mode s , Robot {} <- a , "m0" <- name a = rgbColorCell $ sRGB24 0x93 0xe9 0xbe -- #93e9be| Full <- mode s , Robot {} <- a , "m1" <- name a = rgbColorCell $ sRGB24 0x93 0xe9 0xbe -- #93e9be| Full <- mode s , Robot {} <- a , "p0" <- name a = rgbColorCell $ sRGB24 0xff 0xff 0xff -- #ffffff| Full <- mode s , Robot {} <- a , "Tp" <- name a = rgbColorCell $ sRGB24 0xff 0xff 0xff -- #ffffff| Full <- mode s , Robot {} <- a , "T0" <- name a = rgbColorCell $ sRGB24 0x66 0x66 0x99 -- #666699| Full <- mode s , Robot {} <- a , "T1" <- name a = rgbColorCell $ sRGB24 0x99 0x66 0x99 -- #996699| Full <- mode s , Robot {} <- a , "T2" <- name a = rgbColorCell $ sRGB24 0x99 0x66 0x66 -- #996666| Full <- mode s = rgbColorCell $ sRGB24 0x99 0x99 0x99 -- #999999