RMCA/GUI/Board.hs

   1 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
   2
   3 module RMCA.GUI.Board where
   4
   5 import Data.Array
   6 import Game.Board.BasicTurnGame
   7 import Graphics.UI.Gtk
   8 import RMCA.Semantics           hiding (Action)
   9
  10 newtype GUIBoard = GUIBoard (GameState Int Cell () Action)
  11
  12 boardToList :: Board -> [(Int,Int,Cell)]
  13 boardToList = map (\((x,y),z) -> (x,y,z)) . assocs
  14
  15 initGUIBoard :: GUIBoard
  16 initGUIBoard = GUIBoard $ GameState
  17   { curPlayer'   = ()
  18   , boardPos     = boardToList $ makeBoard []
  19   , boardPieces' = []
  20   }
  21
  22 instance Show GUIBoard where
  23   show _ = "lol"
  24
  25 instance PlayableGame GUIBoard Int Cell () Action where
  26   curPlayer _               = ()
  27   allPos (GUIBoard game)    = boardPos game
  28   allPieces (GUIBoard game) = boardPieces' game
  29   moveEnabled _             = True
  30   canMove _ _ _             = True
  31   canMoveTo _ _ _ _         = True
  32
  33 pixbufFrom :: (Int, Int) -> Cell -> IO Pixbuf
  34 pixbufFrom (hexW,hexH) (a,_) = do
  35   let pixbufScaleSimple' p = pixbufScaleSimple p hexW hexH InterpBilinear
  36       actionToFile = case a of
  37                        Inert -> "img/hexOff.png"
  38                        Absorb -> "img/stop.svg"
  39                        Stop _ -> "img/stop.svg"
  40                        ChDir True _ _ -> "img/start.svg"
  41                        ChDir False _ _ -> "img/ric.svg"
  42                        Split _ -> "img/split.svg"
  43       pixbufComposeAct p pa =
  44         pixbufComposite p pa 0 0 hexW hexH 0 0 1 1 InterpBilinear 255
  45   pixbufOn <- pixbufScaleSimple' =<< pixbufNewFromFile "img/hexOff.png"
  46   pixbufAct <- pixbufScaleSimple' =<< pixbufNewFromFile actionToFile
  47   pixbufComposeAct pixbufOn pixbufAct
  48   return pixbufAct