LIVE CODING from BusConf

Main.purs

module Main where

import Control.Apply (lift2)
import Data.Foldable (elem)
import Data.Tuple (Tuple(..))
import FRP.Behavior (Behavior, animate, fixB)
import FRP.Behavior.Keyboard (keys)
import FRP.Event.Keyboard (Keyboard, getKeyboard)
import Color.Scheme.MaterialDesign (deepPurple, lime)
import Data.Maybe (Maybe(..))
import Graphics.Drawing (Drawing, Shape, circle, fillColor, filled, rectangle, render)
import Graphics.Canvas (CanvasElement, getCanvasElementById, getContext2D, setCanvasWidth, setCanvasHeight)
import Effect (Effect)
import Effect.Console (log)
import Prelude

-- These are the possible directions in which we'd like to move.
data Direction = Up | Down | Left | Right

-- `Show` lets us turn a `Direction` into a `String`.
instance showDirection :: Show Direction where
  show Up    = "Up"
  show Down  = "Down"
  show Left  = "Left"
  show Right = "Right"

-- Here, we create a real-time "behavior" to tell us which keys are currently
-- being pressed.
controls :: Keyboard -> Behavior (Maybe Direction)
controls keyboard
  = map convertSetOfStringsToDirection (keys keyboard)
  where
    -- `elem` is a function that tells us
    convertSetOfStringsToDirection set
      | elem "ArrowUp"    set = Just Up
      | elem "ArrowDown"  set = Just Down
      | elem "ArrowLeft"  set = Just Left
      | elem "ArrowRight" set = Just Right
      | otherwise             = Nothing

-- We can then use `fixB` to turn that maybe direction into a real-time
-- position for our cursor. FixB gives us the last position, and we use lift2
-- to combine this with the current keyboard control.
position :: Keyboard -> Behavior (Tuple Number Number)
position keyboard
  = fixB (Tuple 0.0 0.0) \old ->
      lift2 calculateNewPosition old (controls keyboard)
  where
    calculateNewPosition :: Tuple Number Number -> Maybe Direction -> Tuple Number Number
    calculateNewPosition (Tuple x y) = case _ of
      Just Up    -> Tuple x (y - 1.0)
      Just Down  -> Tuple x (y + 1.0)
      Just Left  -> Tuple (x - 1.0) y
      Just Right -> Tuple (x + 1.0) y
      Nothing    -> Tuple x y

-- This is our background. Nothing interesting.
background :: Drawing
background = filled (fillColor deepPurple) shape
  where
    shape :: Shape
    shape = rectangle 0.0 0.0 500.0 500.0

-- Given our cursor position, we now know where to put the lime circle!
renderMyGame :: Tuple Number Number -> Drawing
renderMyGame (Tuple x y) = background <> filled (fillColor lime) cursor
  where cursor = circle x y 20.0

main :: Effect Unit
main = do
  maybeCanvas :: Maybe CanvasElement
    <- getCanvasElementById "my-game"

  case maybeCanvas of
    Just canvas -> do
      context <- getContext2D canvas
      keyboard <- getKeyboard

      setCanvasWidth canvas 500.0
      setCanvasHeight canvas 500.0

      _ <- animate (position keyboard) (render context <<< renderMyGame)
      log "Yay canvas :)"

    Nothing ->
      log "No canvas :("