icyrock.com
HomePureScript experiments - canvas-smiley
2017-Jul-31 20:51
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:
