module Test where import Affection as A import Control.Monad.IO.Class (liftIO) import Data.Matrix (toLists) import NanoVG import Types import Floorplan import Foreign.C.Types (CFloat(..)) loadMap :: Affection UserData () loadMap = do ud <- getAffection let fc = FloorConfig (10, 10) [] (50,50) matrix <- liftIO $ buildHallFloorIO fc putAffection ud { stateData = MenuData { mapMat = matrix , initCoords = (50, 250) } } drawMap :: Affection UserData () drawMap = do ud <- getAffection let matrix = mapMat (stateData ud) mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [1..] ls)) (zip [1..] (toLists matrix)) drawTile :: Int -> Int -> TileState -> Affection UserData () drawTile row col tile = do ctx <- nano <$> getAffection (xinit, yinit) <- initCoords <$> stateData <$> getAffection let tileWidth = 20 :: CFloat tileHeight = 10 :: CFloat liftIO $ do save ctx beginPath ctx let x = fromIntegral xinit + (fromIntegral col * tileWidth / 2) + (fromIntegral row * tileWidth / 2) y = fromIntegral yinit + (fromIntegral row * tileHeight / 2) - (fromIntegral col * tileHeight / 2) fillColor ctx (case tile of Wall -> rgba 128 128 128 255 Door -> rgba 255 128 128 255 Hall -> rgba 255 255 255 255 Offi -> rgba 0 255 0 255 Toil -> rgba 0 0 255 255 Kitc -> rgba 255 0 0 255 Elev -> rgba 0 0 0 255 _ -> rgba 255 255 0 255 ) moveTo ctx x y lineTo ctx (x + tileWidth / 2) (y + tileHeight / 2) lineTo ctx (x + tileWidth) y lineTo ctx (x + tileWidth / 2) (y - tileHeight / 2) closePath ctx fill ctx restore ctx