icyrock.com

Home

PureScript experiments - canvas-smiley

2017-Jul-31 20:51
purescript-experimentspurescript

Here's how purescript can be used to draw on canvas. The code is pretty much self-explanatory:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
module Main where
 
import Prelude
 
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Foldable (for_)
import Data.Maybe (Maybe(..))
import Graphics.Canvas (CANVAS, CanvasElement, Context2D, arc, beginPath, getCanvasElementById, getCanvasHeight, getCanvasWidth, getContext2D, setStrokeStyle, stroke)
import Math (pi)
 
type EffR eff = ( canvas :: CANVAS
                , console :: CONSOLE
                | eff
                )
        
type EffA eff = Eff (EffR eff) Unit
 
drawPath :: forall eff. Context2D -> Eff (EffR eff) Context2D -> EffA eff
drawPath c2d f = void do
  _ <- beginPath c2d
  _ <- f
  stroke c2d
 
drawHead :: forall eff. Context2D -> Number -> Number -> EffA eff
drawHead c2d cw ch = void do
  for_ [3.0, 3.1] \d -> do
    drawPath c2d do
      arc c2d { x: cw / 2.0
              , y: ch / 2.0
              , r: cw / d
              , start: 0.0
              , end: 2.0 * pi
              }
 
drawLip :: forall eff.
  Context2D -> Number -> Number -> Number -> Number -> Number -> EffA eff
drawLip c2d cw ch r sa ea = void do
  drawPath c2d do
    arc c2d { x: cw / 2.0
            , y: ch / 2.0
            , r: r
            , start: sa
            , end: ea
            }
 
drawMouth :: forall eff. Context2D -> Number -> Number -> EffA eff
drawMouth c2d cw ch = void do
  for_ [5.0, 6.0, 7.0] \d -> do
    drawLip c2d cw ch (cw * (0.20 + d / 100.0)) (pi / d) (pi * (d - 1.0) / d)
 
drawEye :: forall eff. Context2D -> Number -> Number -> Number-> Number -> EffA eff
drawEye c2d cw ch x y = void do
  for_ [11.0, 20.0, 22.0, 40.0, 50.0] \d -> do
    drawPath c2d do
      arc c2d { x: x
              , y: y
              , r: cw / d
              , start: 0.0
              , end: 2.0 * pi
              }
 
drawSmiley :: forall eff. CanvasElement -> EffA eff
drawSmiley ce = void do
  cw <- getCanvasWidth ce
  ch <- getCanvasHeight ce
 
  log $ "Canvas dimensions " <> show cw <> "x" <> show ch
 
  c2d <- getContext2D ce
  _ <- setStrokeStyle "#369" c2d
 
  drawHead c2d cw ch
  drawMouth c2d cw ch
  drawEye c2d cw ch (cw * 2.0 / 5.0) (ch * 3.0 / 7.0)
  drawEye c2d cw ch (cw * 3.0 / 5.0) (ch * 3.0 / 7.0)
 
  log "There you go :)"
 
main :: forall eff. EffA eff
main = do
  log "Start"
  cem <- getCanvasElementById "canvas"
  case cem of
    Nothing -> log "Hm... no canvas?"
    Just ce -> drawSmiley ce
  log "Done!"

The html that goes with it:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
<!doctype html>
<html>
  <head>
    <title>purescript-canvas-smiley</title>
 
    <style>
      #canvas {
        border: 2px solid #369;
      }
    </style>
  </head>
 
  <body>
    <canvas id="canvas" width="400" height="400">
    </canvas>
 
    <script src="/app.js">
    </script>
  </body>
 
</html>

Run with the usual pulp server and open the html in the browser. Result: