weekly25.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where

import Lens.Micro ((^.), (&), (.~), (%~))
import Lens.Micro.TH (makeLenses)
import Control.Monad (void, forever)
import Control.Concurrent (newChan, writeChan, threadDelay, forkIO)
import Data.Default
import Data.Monoid
import qualified Graphics.Vty as V

import Brick.Main
  ( App(..)
  , showFirstCursor
  , customMain
  , continue
  , halt
  )
import Brick.Types
  ( Widget
  , Next
  , EventM
  , BrickEvent(..)
  )
import Brick.Widgets.Core
  ( (<=>)
  , str
  )

data CustomEvent = Counter deriving Show

data St =
    St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent)
       , _stCounter :: Int
       , _maze :: [String]
       , _actionCounter :: Int
       , _charPos :: Coord
       , _charDirection :: Direction
       }

class Position a where
  toCoord :: a -> Coord

data Direction = North | South | West | East deriving (Show, Eq)

instance Position Direction where
  toCoord North = Coord (-1) 0
  toCoord South = Coord 1 0
  toCoord West  = Coord 0 (-1)
  toCoord East  = Coord 0 1

dirToChar :: Direction -> Char
dirToChar North = '^'
dirToChar South = 'v'
dirToChar West  = '<'
dirToChar East  = '>'

getFromMaze :: [String] -> Coord -> Char
getFromMaze maze (Coord x y) = maze !! x !! y

data Coord = Coord Int Int deriving (Show, Eq)

instance Position Coord where
  toCoord x = x

instance Num Coord where
  (+) (Coord a b) (Coord x y) = Coord (a + x) (b + y)
  (*) (Coord a b) (Coord x y) = Coord (a*x) (b*y)
  abs    (Coord x y) = Coord (abs x) (abs y)
  negate (Coord x y) = Coord (negate x) (negate y)
  signum _ = error "undefined"
  fromInteger x = Coord (fromInteger x) (fromInteger x)

makeLenses ''St

defaultMaze = 
  ["#####################################"
  ,"# #       #       #     #         # #"
  ,"# # ##### # ### ##### ### ### ### # #"
  ,"#       #   # #     #     # # #   # #"
  ,"##### # ##### ##### ### # # # ##### #"
  ,"#   # #       #     # # # # #     # #"
  ,"# # ####### # # ##### ### # ##### # #"
  ,"# #       # # #   #     #     #   # #"
  ,"# ####### ### ### # ### ##### # ### #"
  ,"#     #   # #   ##   #     #  #     #"
  ,"# ### ### # ### # ##### # # # #######"
  ,"#   #   # # #   #   #   # # #   #   #"
  ,"####### # # # ##### # ### # ### ### #"
  ,"#     # #     #   # #   # #   #     #"
  ,"# ### # ##### ### # ### ### ####### #"
  ,"# #   #     #     #   # # #       # #"
  ,"# # ##### # ### ##### # # ####### # #"
  ,"# #     # # # # #     #       # #   #"
  ,"# ##### # # # ### ##### ##### # #####"
  ,"# #   # # #     #     # #   #       #"
  ,"# # ### ### ### ##### ### # ##### # #"
  ,"# #         #     #       #       # #"
  ,"#X###################################"]

unwidget :: [Widget a] -> Widget a
unwidget widgets = foldr1 (\x y -> x <=> y) widgets

updateWith :: Int -> (a -> a) -> [a] -> [a]
updateWith 0 f (x:xs) = f x:xs
updateWith n f (x:xs) = x:updateWith (n-1) f xs

updateMaze :: Coord -> (Char -> Char) -> [String] -> [String]
updateMaze (Coord x y) f xs = updateWith x (updateWith y f) xs

drawUI :: St -> [Widget ()]
drawUI st@(St {_maze = maze, _actionCounter = actionCounter, _charPos = Coord x y, _charDirection = d}) = [a]
  where
    charToken = dirToChar d
    a = unwidget $ map str $ (updateWith x (updateWith y (\_ -> charToken)) maze) ++ 
      [ show actionCounter
      , ("Last event: " <> (show $ st^.stLastBrickEvent))
      ]
          {-, (str $ "Counter value is: " <> (show $ st^.stCounter))-}
          

appEvent :: St -> BrickEvent () CustomEvent -> EventM () (Next St)
appEvent st e =
  case e of
    VtyEvent (V.EvKey (V.KChar 'c') [V.MCtrl]) -> halt st
    VtyEvent (V.EvKey (V.KChar 'q') []) -> halt st
    VtyEvent (V.EvKey (V.KUp      ) []) -> continue $ st & actionCounter %~ (+1)
                                                         & mMove North
    VtyEvent (V.EvKey (V.KDown    ) []) -> continue $ st & actionCounter %~ (+1)
                                                         & mMove South
    VtyEvent (V.EvKey (V.KLeft    ) []) -> continue $ st & actionCounter %~ (+1)
                                                         & mMove West
    VtyEvent (V.EvKey (V.KRight   ) []) -> continue $ st & actionCounter %~ (+1)
                                                         & mMove East
    VtyEvent _ -> continue $ st & stLastBrickEvent .~ (Just e)
    AppEvent Counter -> continue $ st & stCounter %~ (+1)
                                      & stLastBrickEvent .~ (Just e)
    _ -> continue st

mMove :: Direction -> St -> St
mMove d st@(St {_charPos = _charPos, _maze = _maze, _charDirection = charD}) 
  | d /= charD                      = st & charDirection .~ d
  | _maze `getFromMaze` (_charPos + (toCoord d)) /= '#' = moveAction
  | _maze `getFromMaze` (_charPos + (toCoord d * 2)) /= '#' = pushAction
  | otherwise = st
  where
    Coord dx dy = toCoord d
    moveAction  = st & charPos %~ (toCoord d +)
    pushAction  = moveAction 
      & maze %~ (updateMaze (_charPos + (toCoord d * 2)) (\_ -> '#'))
      & maze %~ (updateMaze (_charPos + (toCoord d))     (\_ -> ' '))

initialState :: St
initialState =
    St { _stLastBrickEvent = Nothing
       , _stCounter = 0
       , _maze = defaultMaze
       , _actionCounter = 0
       , _charPos = Coord 1 1
       , _charDirection = South
       }

theApp :: App St CustomEvent ()
theApp =
    App { appDraw = drawUI
        , appChooseCursor = showFirstCursor
        , appHandleEvent = appEvent
        , appStartEvent = return
        , appAttrMap = def
        }

main :: IO ()
main = do
    chan <- newChan

    forkIO $ forever $ do
        writeChan chan Counter
        threadDelay 1000000

    void $ customMain (V.mkVty def) (Just chan) theApp initialState