Skip to content

Instantly share code, notes, and snippets.

@soupi
Created December 5, 2015 21:37
Show Gist options
  • Star 6 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save soupi/76103c45fc00a6c1478e to your computer and use it in GitHub Desktop.
Save soupi/76103c45fc00a6c1478e to your computer and use it in GitHub Desktop.
simple purescript-signal + purescript-canvas example
module Main where
import Prelude
import Data.Maybe
import Control.Monad.Eff
import Graphics.Canvas as C
import Signal as S
import Signal.DOM as S
main = do
Just canvas <- C.getCanvasElementById "canvas"
context <- C.getContext2D canvas
frames <- S.animationFrame
let game = S.foldp (const update) initialState frames
S.runSignal (render context <$> game)
type State
= { pos :: Number, step :: Number }
initialState = { pos : 0.0, step : 2.0 }
update state =
if state.pos >= 200.0
then { pos : 199.0, step : -state.step }
else if state.pos <= 0.0
then { pos : 1.0, step : -state.step }
else { pos : state.pos + state.step, step : state.step }
render context state = do
clearCanvas context
drawRect context state
pure unit
clearCanvas ctx = do
C.setFillStyle "#1B1C1B" ctx
C.fillRect ctx { x: 0.0, y: 0.0, w: 800.0, h: 500.0 }
drawRect ctx state = do
C.setFillStyle "#0088DD" ctx
C.fillRect ctx { x: 300.0 + state.pos, y: 100.0, w: 30.0, h: 30.0 }
@gasi
Copy link

gasi commented Aug 27, 2017

Updated version with types and fixed warnings (purs 0.11.6):

module Main where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Timer (TIMER)
import Data.Maybe (Maybe(Just, Nothing))
import DOM (DOM)
import Graphics.Canvas as C
import Signal (foldp, runSignal)
import Signal.DOM (animationFrame)

main :: forall e. Eff (canvas :: C.CANVAS, dom :: DOM, timer :: TIMER | e) Unit
main = do
  mcanvas <- C.getCanvasElementById "scene"
  case mcanvas of
    Just canvas -> do
      context <- C.getContext2D canvas
      frames <- animationFrame
      let game = foldp (const update) initialState frames
      runSignal (render context <$> game)
    Nothing -> pure unit

type State =
  { x :: Number
  , step :: Number
  }

initialState :: State
initialState =
  { x: 0.0
  , step: 10.0
  }

scene ::
  { x :: Number
  , y :: Number
  , width :: Number
  , height :: Number
  , boxSize :: Number
  }
scene =
  { x: 0.0
  , y: 0.0
  , width: 800.0
  , height: 800.0
  , boxSize: 25.0
  }

update :: State -> State
update state =
  if state.x + scene.boxSize > scene.width then
    { x: scene.width - scene.boxSize
    , step: -state.step
    }
  else if state.x < scene.x then
    { x: scene.x
    , step: -state.step
    }
  else
    { x: state.x + state.step
    , step: state.step
    }

render :: forall e. C.Context2D -> State -> Eff (canvas :: C.CANVAS | e) Unit
render context state = do
  clearCanvas context
  drawRect context state
  pure unit

clearCanvas :: forall e. C.Context2D -> Eff (canvas :: C.CANVAS | e) Unit
clearCanvas ctx = do
  _ <- C.setFillStyle "#000000" ctx
  _ <- C.fillRect ctx { x: 0.0, y: 0.0, w: scene.width, h: scene.height }
  pure unit

drawRect :: forall e. C.Context2D -> State -> Eff (canvas :: C.CANVAS | e) Unit
drawRect ctx state = do
  _ <- C.setFillStyle "#0088DD" ctx
  _ <- C.fillRect ctx
        { x: state.x
        , y: scene.height / 2.0
        , w: scene.boxSize
        , h: scene.boxSize
        }
  pure unit

@MDsKumaran
Copy link

--I need to add more than one arc in the program

module Main where

import Prelude

import Control.Monad.Eff #(Eff)
import Data.Maybe (Maybe(..))
import Graphics.Canvas (CANVAS, getCanvasElementById, rotate, getContext2D, arc, setFillStyle, fillPath)
import Partial.Unsafe (unsafePartial)

main :: Eff (canvas :: CANVAS ) Unit
main = void $ unsafePartial do
Just getcanvas <- getCanvasElementById "htmlcanvasid3"
getarc <- getContext2D getcanvas

void $ setFillStyle "#d6e5ff" getarc
fillPath getarc $ arc getarc
{ x : 0.0
, y : 190.0
, r : 80.0
, start : 4.8
, end : 1.5
}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment