Skip to content

Commit

Permalink
Eliminate Context2DEff in favour of Effect Context2D.
Browse files Browse the repository at this point in the history
  • Loading branch information
epost committed Oct 1, 2020
1 parent d9c09d1 commit ea2664a
Show file tree
Hide file tree
Showing 3 changed files with 21 additions and 22 deletions.
22 changes: 10 additions & 12 deletions src/Canvas.purs
Original file line number Diff line number Diff line change
Expand Up @@ -7,31 +7,29 @@ import Language (Distance (), Angle (), Color (..))

foreign import data Context2D :: Type

type Context2DEff = Effect Context2D

type CanvasStyleString = String

foreign import get2DContext :: String -> Context2DEff
foreign import get2DContext :: String -> Effect Context2D

foreign import initContext :: CanvasStyleString -> Context2D -> Context2DEff
foreign import initContext :: CanvasStyleString -> Context2D -> Effect Context2D

foreign import beginStroke :: Context2D -> Context2DEff
foreign import beginStroke :: Context2D -> Effect Context2D

foreign import endStroke :: Context2D -> Context2DEff
foreign import endStroke :: Context2D -> Effect Context2D

foreign import lineTo :: Distance -> Distance -> Context2D -> Context2DEff
foreign import lineTo :: Distance -> Distance -> Context2D -> Effect Context2D

drawArc :: Distance -> Distance -> Distance -> Angle -> Angle -> Context2D -> Context2DEff
drawArc :: Distance -> Distance -> Distance -> Angle -> Angle -> Context2D -> Effect Context2D
drawArc = drawFilledArc' "transparent"

drawFilledArc :: Maybe Color -> Distance -> Distance -> Distance -> Angle -> Angle -> Context2D -> Context2DEff
drawFilledArc :: Maybe Color -> Distance -> Distance -> Distance -> Angle -> Angle -> Context2D -> Effect Context2D
drawFilledArc col = drawFilledArc' $ maybe "" colorToCanvasStyle col

foreign import drawFilledArc' :: CanvasStyleString -> Distance -> Distance -> Distance -> Angle -> Angle -> Context2D -> Context2DEff
foreign import drawFilledArc' :: CanvasStyleString -> Distance -> Distance -> Distance -> Angle -> Angle -> Context2D -> Effect Context2D

foreign import moveTo :: Distance -> Distance -> Context2D -> Context2DEff
foreign import moveTo :: Distance -> Distance -> Context2D -> Effect Context2D

foreign import setStrokeStyle :: String -> Context2D -> Context2DEff
foreign import setStrokeStyle :: String -> Context2D -> Effect Context2D

colorToCanvasStyle :: Color -> String
colorToCanvasStyle col = case col of
Expand Down
15 changes: 8 additions & 7 deletions src/CanvasInterpreter.purs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ import Control.Monad.Free (runFreeM)
import Control.Monad.State (State, evalState, get, modify_, put)
import Data.Tuple
import Data.Foldable
import Effect (Effect)
import Math (sin, cos, pi, (%))

-- | x, y, rotation, isPenDown
Expand All @@ -17,11 +18,11 @@ instance turtleShow :: Show Turtle where
show (Turtle x y angle isPenDown) = "(Turtle " <> show x <> " " <> show y <> " " <> show angle <> " " <> show isPenDown <> ")"


interpretTurtleProg :: forall a. TurtleProg a -> Context2D -> Context2DEff
interpretTurtleProg :: forall a. TurtleProg a -> Context2D -> Effect Context2D
interpretTurtleProg turtleProg ctx = foldl (>>=) (pure ctx) (interpretTurtleProg' turtleProg)


interpretTurtleProg' :: forall a. TurtleProg a -> Array (Context2D -> Context2DEff)
interpretTurtleProg' :: forall a. TurtleProg a -> Array (Context2D -> Effect Context2D)
interpretTurtleProg' turtleProg =

evalState turtleProgState (Turtle 0.0 0.0 0.0 true)
Expand All @@ -31,13 +32,13 @@ interpretTurtleProg' turtleProg =


-- | A natural transformation from `TurtleProg` to `State Turtle`.
interpretTurtleProg'' :: TurtleProg (Array (Context2D -> Context2DEff))
-> State Turtle (Array (Context2D -> Context2DEff))
interpretTurtleProg'' :: TurtleProg (Array (Context2D -> Effect Context2D))
-> State Turtle (Array (Context2D -> Effect Context2D))
interpretTurtleProg'' = runFreeM interpret

-- pick off the outermost TurtleCmd from the TurtleProg and process it
where interpret :: TurtleCmd (TurtleProg (Array (Context2D -> Context2DEff)))
-> State Turtle (TurtleProg (Array (Context2D -> Context2DEff)))
where interpret :: TurtleCmd (TurtleProg (Array (Context2D -> Effect Context2D)))
-> State Turtle (TurtleProg (Array (Context2D -> Effect Context2D)))

interpret (Forward r rest) = do
Turtle x y angle p <- get
Expand Down Expand Up @@ -81,7 +82,7 @@ adjacent r angle = r * cos angle
opposite r angle = r * sin angle
rad angleDegrees = (2.0 * pi * (angleDegrees % 360.0)) / 360.0

renderTurtleProgOnCanvas :: String -> TurtleProg Unit -> Context2DEff
renderTurtleProgOnCanvas :: String -> TurtleProg Unit -> Effect Context2D
renderTurtleProgOnCanvas canvasId prog =
get2DContext canvasId >>=
initContext (colorToCanvasStyle Purple) >>=
Expand Down
6 changes: 3 additions & 3 deletions src/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,12 +2,12 @@ module Main where

import Prelude
import Language
import Canvas (Context2D)
import CanvasInterpreter
import Canvas (Context2DEff (..))
import Control.Monad
import Effect (Effect)


main :: Context2DEff
main :: Effect Context2D
main = renderTurtleProgOnCanvas "turtleCanvas" $ do
star
penUp
Expand Down

0 comments on commit ea2664a

Please sign in to comment.