try-purescript sprites (flare backend)

Main.purs

module Main where

import Prelude
import Data.Array
import Data.Foldable
import Data.Int (toNumber)
import Data.Maybe
import Signal.DOM (animationFrame)
import Flare
import Flare.Drawing

chameleonBitmap :: Array Int
chameleonBitmap =
  [ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,1,1,1,0,0,0
  , 0,1,1,1,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,0,0
  , 1,1,0,0,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,0
  , 1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
  , 1,1,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,0,0,0,1
  , 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1
  , 0,0,0,0,0,0,1,1,1,0,1,1,1,1,0,1,1,1,0,1,1,1,0,0
  , 0,0,0,0,0,1,1,0,0,1,0,0,0,0,1,0,0,1,0,0,0,0,0,0
  , 0,0,0,0,1,1,0,0,0,0,1,0,0,0,1,0,0,0,1,1,1,0,0,0
  , 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  ]

chameleonGreen :: Array Color
chameleonGreen = colorize green <$> chameleonBitmap

colorize :: Color -> Int -> Color 
colorize c 1 = c
colorize _ _ = black

indexToXY :: X -> Int -> XY
indexToXY width i = { x: i `mod` width, y: i/width }

spriteAnimation :: Number -> Drawing
spriteAnimation time = do
  fold (mapWithIndex (pixy <<< indexToXY width) chameleonGreen)
  where
    width = 3*8

main = runFlareDrawing "controls" "canvas" ui
  where ui = spriteAnimation <$> lift animationFrame

----------------------------------------------------------------------------

red   = rgb 255   0   0
green = rgb   0 255   0

----------------------------------------------------------------------------

pixy :: XY -> Color -> Pixel
pixy { x, y } color = pix x y color

pix x y col = filled (fillColor col) (rectangle (toNumber (20*x)) (toNumber (20*y)) 20.0 20.0)

type Pixel = Drawing

type X = Int
type Y = Int
type XY = { x :: X, y :: Y }