diff --git a/codeworld-api.cabal b/codeworld-api.cabal
--- a/codeworld-api.cabal
+++ b/codeworld-api.cabal
@@ -1,5 +1,5 @@
 Name:                codeworld-api
-Version:             0.2.3
+Version:             0.2.4
 Synopsis:            Graphics library for CodeWorld
 License:             Apache
 License-file:        LICENSE
@@ -54,4 +54,4 @@
 
   Exposed:             True
   Ghc-options:         -O2
-                       -Werror=incomplete-patterns
+                       -Wincomplete-patterns
diff --git a/src/CodeWorld.hs b/src/CodeWorld.hs
--- a/src/CodeWorld.hs
+++ b/src/CodeWorld.hs
@@ -19,6 +19,9 @@
     -- * Entry points
       drawingOf
     , animationOf
+    , activityOf
+    , groupActivityOf
+    , unsafeGroupActivityOf
     , simulationOf
     , interactionOf
     , collaborationOf
@@ -38,11 +41,8 @@
     , curve
     , thickCurve
     , closedCurve
-    , loop
     , thickClosedCurve
-    , thickLoop
     , solidClosedCurve
-    , solidLoop
     , rectangle
     , solidRectangle
     , thickRectangle
@@ -53,7 +53,9 @@
     , sector
     , thickArc
     , text
+    , lettering
     , styledText
+    , styledLettering
     , colored
     , coloured
     , translated
@@ -66,6 +68,10 @@
     , coordinatePlane
     , codeWorldLogo
     , Point
+    , translatedPoint
+    , rotatedPoint
+    , scaledPoint
+    , dilatedPoint
     , Vector
     , vectorLength
     , vectorDirection
@@ -113,7 +119,6 @@
     , saturation
     , luminosity
     , alpha
-    , fromHSL
     -- * Events
     , Event(..)
     , MouseButton(..)
diff --git a/src/CodeWorld/CanvasM.hs b/src/CodeWorld/CanvasM.hs
--- a/src/CodeWorld/CanvasM.hs
+++ b/src/CodeWorld/CanvasM.hs
@@ -22,7 +22,7 @@
 
 import Control.Monad
 import Control.Monad.Reader
-import Control.Monad.Trans (liftIO)
+import Control.Monad.Trans (MonadIO)
 import Data.Text (Text, pack)
 
 #ifdef ghcjs_HOST_OS
@@ -50,7 +50,7 @@
            Double -> Double -> Double -> Double -> Double -> Double -> m ()
     translate :: Double -> Double -> m ()
     scale :: Double -> Double -> m ()
-    newImage :: Int -> Int -> m () -> m (Image m)
+    newImage :: Int -> Int -> m a -> m (Image m, a)
     drawImage :: Image m -> Int -> Int -> Int -> Int -> m ()
     globalCompositeOperation :: Text -> m ()
     lineWidth :: Double -> m ()
@@ -89,6 +89,9 @@
     { unCanvasM :: Canvas.Context -> IO a
     } deriving (Functor)
 
+runCanvasM :: Canvas.Context -> CanvasM a -> IO a
+runCanvasM = flip unCanvasM
+
 instance Applicative CanvasM where
     pure x = CanvasM (const (return x))
     f <*> x = CanvasM (\ctx -> unCanvasM f ctx <*> unCanvasM x ctx)
@@ -106,6 +109,9 @@
 foreign import javascript "$r = $3.isPointInStroke($1, $2);"
                js_isPointInStroke :: Double -> Double -> Canvas.Context -> IO Bool
 
+instance MonadIO CanvasM where
+    liftIO = CanvasM . const
+
 instance MonadCanvas CanvasM where
     type Image CanvasM = Canvas.Canvas
     save = CanvasM Canvas.save
@@ -118,8 +124,8 @@
         const $ do
             buf <- Canvas.create w h
             ctx <- Canvas.getContext buf
-            unCanvasM m ctx
-            return buf
+            a <- unCanvasM m ctx
+            return (buf, a)
     drawImage (Canvas.Canvas c) x y w h =
         CanvasM (Canvas.drawImage (Canvas.Image c) x y w h)
     globalCompositeOperation op =
@@ -159,8 +165,8 @@
     scale x y = Canvas.scale (x, y)
     newImage w h m = do
         ctx <- Canvas.newCanvas (w, h)
-        Canvas.with ctx m
-        return ctx
+        a <- Canvas.with ctx m
+        return (ctx, a)
     drawImage img x y w h =
         Canvas.drawImageSize
             ( img
diff --git a/src/CodeWorld/CollaborationUI.hs b/src/CodeWorld/CollaborationUI.hs
--- a/src/CodeWorld/CollaborationUI.hs
+++ b/src/CodeWorld/CollaborationUI.hs
@@ -124,7 +124,7 @@
 
 -- | Handling a UI event. May change the phase.
 event :: Event -> UIState s -> Step UIState s
-event (MouseMovement p) s = continueUIState (setMousePos p s)
+event (PointerMovement p) s = continueUIState (setMousePos p s)
 event CreateClick (MainMenu t p) = Create (Connecting t p)
 event JoinClick (MainMenu t p) = ContinueMain (Joining t p "")
 event (LetterPress k) (Joining t p code)
@@ -139,13 +139,13 @@
 event _ s = continueUIState s
 
 pattern CreateClick <-
-        MousePress LeftButton (inButton 0 1.5 8 2 -> True)
+        PointerPress (inButton 0 1.5 8 2 -> True)
 
 pattern JoinClick <-
-        MousePress LeftButton (inButton 0 (-1.5) 8 2 -> True)
+        PointerPress (inButton 0 (-1.5) 8 2 -> True)
 
 pattern ConnectClick <-
-        MousePress LeftButton (inButton 0 (-3.0) 8 2 -> True)
+        PointerPress (inButton 0 (-3.0) 8 2 -> True)
 
 pattern LetterPress c <- (isLetterPress -> Just c)
 
@@ -161,7 +161,7 @@
 
 isCancelClick :: Event -> Bool
 isCancelClick (KeyPress "Esc") = True
-isCancelClick (MousePress LeftButton point) = inButton 0 (-3) 8 2 point
+isCancelClick (PointerPress point) = inButton 0 (-3) 8 2 point
 isCancelClick _ = False
 
 picture :: UIState s -> Picture
@@ -242,13 +242,14 @@
     size = 1
 
 connectScreen :: Text -> Double -> Picture
-connectScreen hdr t =
-    translated 0 7 connectBox & translated 0 (-7) codeWorldLogo &
-    colored (RGBA 0.85 0.86 0.9 1) (solidRectangle 20 20)
+connectScreen hdr t = translated 0 (-7) connectBox
+        & translated 0 2.5 (colored background (solidRectangle 20 3.5))
+        & translated 0 5 codeWorldLogo
+        & colored background (solidRectangle 20 20)
   where
-    connectBox =
-        scaled 2 2 (text hdr) & rectangle 14 3 &
-        colored connectColor (solidRectangle 14 3)
-    connectColor =
-        let k = (1 + sin (3 * t)) / 5
-        in HSL (k + 0.5) 0.8 0.7
+    connectBox = scaled 2 2 (text hdr)
+               & rectangle 14 3
+               & colored connectColor (solidRectangle 14 3)
+    connectColor = let k = (1 + sin (3 * t)) / 5
+                   in  HSL (k + 0.5) 0.8 0.7
+    background = RGBA 0.85 0.86 0.9 1
diff --git a/src/CodeWorld/Color.hs b/src/CodeWorld/Color.hs
--- a/src/CodeWorld/Color.hs
+++ b/src/CodeWorld/Color.hs
@@ -71,10 +71,6 @@
         | h * 3 < 2 = m1 + (m2 - m1) * (2 / 3 - h) * 6
         | otherwise = m1
 
-{-# WARNING
-fromHSL "Please use HSL instead of fromHSL."
- #-}
-
 toHSL :: Color -> Maybe (Double, Double, Double)
 toHSL c@(RGBA _ _ _ 1) = Just (hue c, saturation c, luminosity c)
 toHSL _ = Nothing
@@ -86,34 +82,34 @@
 
 -- Primary and secondary colors
 red, green, blue, cyan, magenta, yellow :: Color
-red = fromHSL (0 / 3 * pi) 0.75 0.5
+red = HSL (0 / 3 * pi) 0.75 0.5
 
-yellow = fromHSL (1 / 3 * pi) 0.75 0.5
+yellow = HSL (1 / 3 * pi) 0.75 0.5
 
-green = fromHSL (2 / 3 * pi) 0.75 0.5
+green = HSL (2 / 3 * pi) 0.75 0.5
 
-cyan = fromHSL (3 / 3 * pi) 0.75 0.5
+cyan = HSL (3 / 3 * pi) 0.75 0.5
 
-blue = fromHSL (4 / 3 * pi) 0.75 0.5
+blue = HSL (4 / 3 * pi) 0.75 0.5
 
-magenta = fromHSL (5 / 3 * pi) 0.75 0.5
+magenta = HSL (5 / 3 * pi) 0.75 0.5
 
 -- Tertiary colors
 orange, rose, chartreuse, aquamarine, violet, azure :: Color
-orange = fromHSL (1 / 6 * pi) 0.75 0.5
+orange = HSL (1 / 6 * pi) 0.75 0.5
 
-chartreuse = fromHSL (3 / 6 * pi) 0.75 0.5
+chartreuse = HSL (3 / 6 * pi) 0.75 0.5
 
-aquamarine = fromHSL (5 / 6 * pi) 0.75 0.5
+aquamarine = HSL (5 / 6 * pi) 0.75 0.5
 
-azure = fromHSL (7 / 6 * pi) 0.75 0.5
+azure = HSL (7 / 6 * pi) 0.75 0.5
 
-violet = fromHSL (9 / 6 * pi) 0.75 0.5
+violet = HSL (9 / 6 * pi) 0.75 0.5
 
-rose = fromHSL (11 / 6 * pi) 0.75 0.5
+rose = HSL (11 / 6 * pi) 0.75 0.5
 
 -- Other common colors and color names
-brown = fromHSL (1 / 6 * pi) 0.5 0.5
+brown = HSL (1 / 6 * pi) 0.5 0.5
 
 purple = violet
 
@@ -137,7 +133,7 @@
 
 lighter :: Double -> Color -> Color
 lighter d c =
-    sameAlpha c $ fromHSL (hue c) (saturation c) (fence (luminosity c + d))
+    sameAlpha c $ HSL (hue c) (saturation c) (fence (luminosity c + d))
 
 light :: Color -> Color
 light = lighter 0.15
@@ -150,7 +146,7 @@
 
 brighter :: Double -> Color -> Color
 brighter d c =
-    sameAlpha c $ fromHSL (hue c) (fence (saturation c + d)) (luminosity c)
+    sameAlpha c $ HSL (hue c) (fence (saturation c + d)) (luminosity c)
 
 bright :: Color -> Color
 bright = brighter 0.25
@@ -171,16 +167,23 @@
 
 -- | An infinite list of colors.
 assortedColors :: [Color]
-assortedColors = red : green : blue : more
+assortedColors = [ HSL (adjusted h) 0.75 0.5 | h <- [0, 2 * pi / phi ..] ]
   where
-    more =
-        [ fromHSL hue 0.75 0.5
-        | denom <- doublesOf 6
-        , numer <- shuffleSeed denom [1,3 .. denom]
-        , let hue = fromIntegral numer * 2 * pi / fromIntegral denom
-        ]
-    doublesOf n = n : doublesOf (2 * n)
-    shuffleSeed k xs = shuffle' xs (length xs) (mkStdGen k)
+    phi = (1 + sqrt 5) / 2
+    adjusted x = x + a0
+               + a1 * sin (1*x) + b1 * cos (1*x)
+               + a2 * sin (2*x) + b2 * cos (2*x)
+               + a3 * sin (3*x) + b3 * cos (3*x)
+               + a4 * sin (4*x) + b4 * cos (4*x)
+    a0 = -8.6870353473225553e-02
+    a1 =  8.6485747604766350e-02
+    b1 = -9.6564816819163041e-02
+    a2 = -3.0072759267059756e-03
+    b2 =  1.5048456422494966e-01
+    a3 =  9.3179137558373148e-02
+    b3 =  2.9002513227535595e-03
+    a4 = -6.6275768228887290e-03
+    b4 = -1.0451841243520298e-02
 
 hue :: Color -> Double
 hue (fenceColor -> RGBA r g b a)
diff --git a/src/CodeWorld/Driver.hs b/src/CodeWorld/Driver.hs
--- a/src/CodeWorld/Driver.hs
+++ b/src/CodeWorld/Driver.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE StaticPointers #-}
 {-# LANGUAGE DataKinds #-}
 
 {-
@@ -30,6 +31,9 @@
 module CodeWorld.Driver
     ( drawingOf
     , animationOf
+    , activityOf
+    , groupActivityOf
+    , unsafeGroupActivityOf
     , simulationOf
     , interactionOf
     , collaborationOf
@@ -39,6 +43,7 @@
 
 import CodeWorld.CollaborationUI (SetupPhase(..), Step(..), UIState)
 import qualified CodeWorld.CollaborationUI as CUI
+import qualified CodeWorld.CanvasM as CM
 import CodeWorld.Color
 import CodeWorld.Event
 import CodeWorld.Picture
@@ -49,7 +54,7 @@
 import Control.Monad
 import Control.Monad.Trans (liftIO)
 import Data.Char (chr)
-import Data.List (find, zip4)
+import Data.List (find, zip4, intercalate)
 import Data.Maybe (fromMaybe, isNothing, mapMaybe)
 import Data.Monoid
 import Data.Serialize
@@ -67,8 +72,10 @@
 import System.IO.Unsafe
 import System.Mem.StableName
 import System.Random
+import Text.Printf
 import Text.Read
 #ifdef ghcjs_HOST_OS
+import CodeWorld.CanvasM (CanvasM, runCanvasM)
 import CodeWorld.Message
 import CodeWorld.Prediction
 import qualified Control.Monad.Trans.State as State
@@ -87,7 +94,7 @@
 import GHCJS.DOM.MouseEvent
 import GHCJS.DOM.NonElementParentNode
 import GHCJS.DOM.Types (Element, unElement)
-import GHCJS.DOM.Window as Window
+import qualified GHCJS.DOM.Window as Window
 import GHCJS.Foreign
 import GHCJS.Foreign.Callback
 import GHCJS.Marshal
@@ -120,6 +127,47 @@
                                     --   frames, given the time in seconds.
             -> IO ()
 
+-- | Runs an interactive CodeWorld program that responds to events.  Activities
+-- can interact with the user, change over time, and remember information about
+-- the past.
+activityOf
+  :: world                       -- ^ The initial state of the interaction.
+  -> (Event -> world -> world)   -- ^ The event handling function, which updates
+                                 --   the state given an event.
+  -> (world -> Picture)          -- ^ The visualization function, which converts
+                                 --   the state into a picture to display.
+  -> IO ()
+
+-- | Runs an interactive multi-user CodeWorld program that is joined by several
+-- participants over the internet.
+groupActivityOf
+  :: Int  -- ^ The number of participants to expect.  The participants will be
+          -- ^ numbered starting at 0.
+  -> StaticPtr (StdGen -> world)
+          -- ^ The initial state of the activity.
+  -> StaticPtr (Int -> Event -> world -> world)
+          -- ^ The event handling function, which updates the state given a
+          --   participant number and user interface event.
+  -> StaticPtr (Int -> world -> Picture)
+          -- ^ The visualization function, which converts a participant number
+          --   and the state into a picture to display.
+  -> IO ()
+
+-- | A version of 'groupActivityOf' that avoids static pointers, and does not
+-- check for consistency.
+unsafeGroupActivityOf
+  :: Int  -- ^ The number of participants to expect.  The participants will be
+          -- ^ numbered starting at 0.
+  -> (StdGen -> world)
+          -- ^ The initial state of the activity.
+  -> (Int -> Event -> world -> world)
+          -- ^ The event handling function, which updates the state given a
+          --   participant number and user interface event.
+  -> (Int -> world -> Picture)
+          -- ^ The visualization function, which converts a participant number
+          --   and the state into a picture to display.
+  -> IO ()
+
 -- | Shows a simulation, which is essentially a continuous-time dynamical
 -- system described by an initial value and step function.
 simulationOf
@@ -194,6 +242,14 @@
                      Drawing
     | Drawings [Drawing]
 
+#if MIN_VERSION_base(4,11,0)
+
+instance Semigroup Drawing where
+    a <> Drawings bs = Drawings (a : bs)
+    a <> b           = Drawings [a, b]
+
+#endif
+
 instance Monoid Drawing where
     mempty = Drawings []
     mappend a (Drawings bs) = Drawings (a : bs)
@@ -221,7 +277,7 @@
 pictureToDrawing (ThickClosedCurve _ pts w) = Shape $ pathDrawer pts w True True
 pictureToDrawing (Circle _ r) = Shape $ arcDrawer 0 (2 * pi) r 0
 pictureToDrawing (SolidCircle _ r) = Shape $ sectorDrawer 0 (2 * pi) r 
-pictureToDrawing (ThickCircle _ r lw) = Shape $ arcDrawer 0 (2 * pi) r lw
+pictureToDrawing (ThickCircle _ lw r) = Shape $ arcDrawer 0 (2 * pi) r lw
 pictureToDrawing (Polyline _ pts) = Shape $ pathDrawer pts 0 False False
 pictureToDrawing (ThickPolyline _ pts w) = Shape $ pathDrawer pts w False False
 pictureToDrawing (Curve _ pts) = Shape $ pathDrawer pts 0 False True
@@ -229,9 +285,9 @@
 pictureToDrawing (Sector _ b e r) = Shape $ sectorDrawer b e r
 pictureToDrawing (Arc _ b e r) = Shape $ arcDrawer b e r 0
 pictureToDrawing (ThickArc _ b e r w) = Shape $ arcDrawer b e r w
-pictureToDrawing (Text _ txt) = Shape $ textDrawer Plain Serif txt
+pictureToDrawing (Lettering _ txt) = Shape $ textDrawer Plain Serif txt
 pictureToDrawing (Blank _) = Drawings $ []
-pictureToDrawing (StyledText _ sty fnt txt) = Shape $ textDrawer sty fnt txt
+pictureToDrawing (StyledLettering _ sty fnt txt) = Shape $ textDrawer sty fnt txt
 pictureToDrawing (Logo _) = Shape $ logoDrawer
 pictureToDrawing (CoordinatePlane _) = Shape $ coordinatePlaneDrawer
 pictureToDrawing (Color _ col p) =
@@ -240,6 +296,8 @@
     Transformation (translateDS x y) $ pictureToDrawing p
 pictureToDrawing (Scale _ x y p) =
     Transformation (scaleDS x y) $ pictureToDrawing p
+pictureToDrawing (Dilate _ k p) =
+    Transformation (scaleDS k k) $ pictureToDrawing p
 pictureToDrawing (Rotate _ r p) =
     Transformation (rotateDS r) $ pictureToDrawing p
 pictureToDrawing (Pictures ps) = Drawings $ pictureToDrawing <$> ps
@@ -307,6 +365,7 @@
             | k <- [-9,-8 .. 9]
             , k /= 0
             ]
+
 --------------------------------------------------------------------------------
 -- GHCJS implementation of drawing
 #ifdef ghcjs_HOST_OS
@@ -333,56 +392,47 @@
 nextFrame :: IO Double
 nextFrame = waitForAnimationFrame >> getTime
 
-withDS :: Canvas.Context -> DrawState -> IO () -> IO ()
-withDS ctx (ta, tb, tc, td, te, tf, col) action = do
-    Canvas.save ctx
-    Canvas.transform ta tb tc td te tf ctx
-    Canvas.beginPath ctx
+withDS :: DrawState -> CanvasM a -> CanvasM a
+withDS (ta, tb, tc, td, te, tf, col) action = CM.saveRestore $ do
+    CM.transform ta tb tc td te tf
+    CM.beginPath
     action
-    Canvas.restore ctx
 
-applyColor :: Canvas.Context -> DrawState -> IO ()
-applyColor ctx ds =
+applyColor :: DrawState -> CanvasM ()
+applyColor ds =
     case getColorDS ds of
         Nothing -> do
-            Canvas.strokeStyle 0 0 0 1 ctx
-            Canvas.fillStyle 0 0 0 1 ctx
+            CM.strokeColor 0 0 0 1
+            CM.fillColor 0 0 0 1
         Just (RGBA r g b a) -> do
-            Canvas.strokeStyle
+            CM.strokeColor
                 (round $ r * 255)
                 (round $ g * 255)
                 (round $ b * 255)
                 a
-                ctx
-            Canvas.fillStyle
+            CM.fillColor
                 (round $ r * 255)
                 (round $ g * 255)
                 (round $ b * 255)
                 a
-                ctx
 
-foreign import javascript unsafe "$1.globalCompositeOperation = $2"
-               js_setGlobalCompositeOperation ::
-               Canvas.Context -> JSString -> IO ()
-
 drawCodeWorldLogo ::
-       Canvas.Context -> DrawState -> Int -> Int -> Int -> Int -> IO ()
-drawCodeWorldLogo ctx ds x y w h = do
-    Just doc <- currentDocument
-    Just canvas <- getElementById doc ("cwlogo" :: JSString)
+       DrawState -> Int -> Int -> Int -> Int -> CanvasM ()
+drawCodeWorldLogo ds x y w h = do
+    Just doc <- liftIO $ currentDocument
+    Just canvas <- liftIO $ getElementById doc ("cwlogo" :: JSString)
     case getColorDS ds of
-        Nothing -> js_canvasDrawImage ctx canvas x y w h
+        Nothing -> CM.drawImage (canvasFromElement canvas) x y w h
         Just (RGBA r g b a)
             -- This is a tough case.  The best we can do is to allocate an
             -- offscreen buffer as a temporary.
          -> do
-            buf <- Canvas.create w h
-            bufctx <- js_getCodeWorldContext buf
-            applyColor bufctx ds
-            Canvas.fillRect 0 0 (fromIntegral w) (fromIntegral h) bufctx
-            js_setGlobalCompositeOperation bufctx "destination-in"
-            js_canvasDrawImage bufctx canvas 0 0 w h
-            js_canvasDrawImage ctx (elementFromCanvas buf) x y w h
+            (img, _) <- CM.newImage w h $ do
+                applyColor ds
+                CM.fillRect 0 0 (fromIntegral w) (fromIntegral h)
+                CM.globalCompositeOperation "destination-in"
+                CM.drawImage (canvasFromElement canvas) 0 0 w h
+            CM.drawImage img x y w h
 
 -- Debug Mode logic
 inspectStatic :: Picture -> IO ()
@@ -426,17 +476,14 @@
             let canvas = unsafeCoerce c :: Element
                 nodeId = pFromJSVal n
             drawing <- pictureToDrawing <$> getpicture
-            let node =
-                    fromMaybe (Drawings []) $ fst <$> getDrawNode nodeId drawing
+            let node = fromMaybe (Drawings []) $ fst <$> getDrawNode nodeId drawing
             offscreenCanvas <- Canvas.create 500 500
             setCanvasSize canvas canvas
             setCanvasSize (elementFromCanvas offscreenCanvas) canvas
             screen <- js_getCodeWorldContext (canvasFromElement canvas)
             rect <- getBoundingClientRect canvas
-            buffer <-
-                setupScreenContext (elementFromCanvas offscreenCanvas) rect
-            drawFrame buffer (node <> coordinatePlaneDrawing)
-            Canvas.restore buffer
+            withScreen (elementFromCanvas offscreenCanvas) rect $
+                drawFrame (node <> coordinatePlaneDrawing)
             rect <- getBoundingClientRect canvas
             cw <- ClientRect.getWidth rect
             ch <- ClientRect.getHeight rect
@@ -558,7 +605,7 @@
                 ]
                 obj
             retVal obj
-        ThickCircle cs r lw -> do
+        ThickCircle cs lw r -> do
             obj <- init "thickCircle"
             setProps
                 [ ("radius", pToJSVal r)
@@ -641,16 +688,16 @@
                 ]
                 obj
             retVal obj
-        Text cs txt -> do
-            obj <- init "text"
+        Lettering cs txt -> do
+            obj <- init "lettering"
             setProps
                 [ ("font", pToJSVal $ fontString Plain Serif)
                 , ("text", pToJSVal txt)
                 ]
                 obj
             retVal obj
-        StyledText cs style font txt -> do
-            obj <- init "styledText"
+        StyledLettering cs style font txt -> do
+            obj <- init "styledLettering"
             setProps
                 [ ("font", pToJSVal $ fontString style font)
                 , ("text", pToJSVal txt)
@@ -683,6 +730,13 @@
                 [("picture", picJS), ("x", pToJSVal x), ("y", pToJSVal y)]
                 obj
             retVal obj
+        Dilate cs k p -> do
+            obj <- init "scale"
+            picJS <- picToObj' p
+            setProps
+                [("picture", picJS), ("k", pToJSVal k)]
+                obj
+            retVal obj
         Rotate cs angle p -> do
             obj <- init "rotate"
             picJS <- picToObj' p
@@ -728,217 +782,251 @@
             return $ (unsafeCoerce arr :: JSVal)
     setProps xs obj = liftIO $ void $ mapM (\(s, v) -> setProp s v obj) xs
 
+trim :: Int -> String -> String
+trim x y = let mid = (x - 2) `div` 2
+    in case x >= (length y) of
+                True -> y :: String
+                False -> take mid y ++ ".." ++ (reverse $ take mid $ reverse y)
+
+showShortFloat :: Double -> String
+showShortFloat x = stripZeros (showFFloatAlt (Just 4) x "")
+  where stripZeros = reverse . dropWhile (== '.') . dropWhile (== '0') . reverse
+
+describePicture :: Picture -> String
+describePicture (Rectangle _ w h) = "rectangle { width = " ++ showShortFloat w ++ ", height = " ++ showShortFloat h ++ " }"
+describePicture (SolidPolygon _ pts) = "solidPolygon { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ " }"
+describePicture (SolidClosedCurve _ pts) = "solidClosedCurve { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ " }"
+describePicture (Polygon _ pts) = "polygon { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ " }"
+describePicture (ThickPolygon _ pts w) = "thickPolygon { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ ", width = " ++ showShortFloat w ++ " }"
+describePicture (SolidRectangle _ w h) = "solidRectangle { width = " ++ showShortFloat w ++ ", height = " ++ showShortFloat h ++ " }"
+describePicture (ThickRectangle _ lw w h) = "thickRectangle { linewidth = " ++ showShortFloat lw ++ ", width = " ++ showShortFloat w ++ ", height = " ++ showShortFloat h ++ " }"
+describePicture (ClosedCurve _ pts) = "closedCurve { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ " }"
+describePicture (ThickClosedCurve _ pts w) = "thickClosedCurve { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ ", width = " ++ showShortFloat w ++ " }"
+describePicture (Circle _ r) = "circle { radius = " ++ showShortFloat r ++ " }"
+describePicture (SolidCircle _ r) = "solidCircle { radius = " ++ showShortFloat r ++ " }"
+describePicture (ThickCircle _ lw r) =  "thickCircle { linewidth = " ++ showShortFloat lw ++ ", radius = " ++ showShortFloat r ++ " }"
+describePicture (Polyline _ pts) = "polyline { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ " }"
+describePicture (ThickPolyline _ pts w) = "thickPolyline { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ ", width = " ++ showShortFloat w ++ " }"
+describePicture (Curve _ pts) = "curve { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ " }"
+describePicture (ThickCurve _ pts w) = "thickCurve { points = " ++ intercalate ", " [ "(" ++ showShortFloat x ++ ", " ++ showShortFloat y ++ ")" | (x, y) <- pts ] ++ ", width = " ++ showShortFloat w ++ " }"
+describePicture (Sector _ b e r) =  "sector { startAngle = " ++ showShortFloat (180 * b / pi) ++ "° (" ++ showShortFloat b ++ " radians)" ++ ", endAngle = " ++ showShortFloat (180 * e / pi) ++ "°" ++ " (" ++ showShortFloat e ++ " radias )," ++ " radius = " ++ showShortFloat r ++ " }"
+describePicture (Arc _ b e r) = "arc { startAngle = " ++ showShortFloat (180 * b / pi) ++ "° (" ++ showShortFloat b ++ " radians)" ++ ", endAngle = " ++ showShortFloat (180 * e / pi) ++ "°" ++ " (" ++ showShortFloat e ++ " radias )," ++ " radius = " ++ showShortFloat r ++ " }"
+describePicture (ThickArc _ b e r w) =  "thickArc { startAngle = " ++ showShortFloat (180 * b / pi) ++ "° (" ++ showShortFloat b ++ " radians)" ++ ", endAngle = " ++ showShortFloat (180 * e / pi) ++ "°" ++ " (" ++ showShortFloat e ++ " radias )," ++ " radius = " ++ showShortFloat r ++ ", width = " ++ showShortFloat w ++ " }"
+describePicture (Lettering _ txt) = printf "lettering { text = '%s' }" txt
+describePicture (Blank _) = "blank"
+describePicture (StyledLettering _ style font txt) = printf " styledLettering { style = %s , font = %s, text = '%s' }" (show style) (show font) txt
+describePicture (Color _ (RGBA r g b a) _) = "colored { color = RGBA(" ++ showShortFloat r ++ ", " ++ showShortFloat g ++ ", " ++ showShortFloat b ++ ", " ++ showShortFloat a ++ ") }"
+describePicture (Translate _ x y _) = "translated { x = " ++ showShortFloat x ++ ", y = " ++ showShortFloat y ++ " }"
+describePicture (Scale _ x y _) = "scaled { x = " ++ showShortFloat x ++ ", y = " ++ showShortFloat y ++ " }"
+describePicture (Rotate _ angle _) = "rotated { angle = " ++ showShortFloat angle ++ "° }"
+describePicture (Dilate _ k _) = "dilated { factor = " ++ showShortFloat k ++  " }"
+describePicture (Logo _) = "codeWorldLogo"
+describePicture (CoordinatePlane _) = "coordinatePlane"
+describePicture (Pictures _) = "pictures"
+
 setCallInfo :: Picture -> Object -> IO ()
-setCallInfo pic obj =
-    case findCSMain (getPictureCS pic) of
-        Just (callName, src) -> do
-            setProp "name" (pToJSVal $ callName) obj
-            setProp "startLine" (pToJSVal $ srcLocStartLine src) obj
-            setProp "startCol" (pToJSVal $ srcLocStartCol src) obj
-            setProp "endLine" (pToJSVal $ srcLocEndLine src) obj
-            setProp "endCol" (pToJSVal $ srcLocEndCol src) obj
+setCallInfo pic obj = do
+    case getPictureSrcLoc pic of
+        Just loc -> do
+            setProp "name" (pToJSVal $ (trim 80 . describePicture) pic) obj
+            setProp "startLine" (pToJSVal $ srcLocStartLine loc) obj
+            setProp "startCol" (pToJSVal $ srcLocStartCol loc) obj
+            setProp "endLine" (pToJSVal $ srcLocEndLine loc) obj
+            setProp "endCol" (pToJSVal $ srcLocEndCol loc) obj
         Nothing -> return ()
 
-findCSMain :: CallStack -> Maybe (String, SrcLoc)
-findCSMain cs =
-    Data.List.find ((== "main") . srcLocPackage . snd) (getCallStack cs)
-
-getPictureCS :: Picture -> CallStack
-getPictureCS (SolidPolygon cs _) = cs
-getPictureCS (SolidClosedCurve cs _) = cs
-getPictureCS (Polygon cs _) = cs
-getPictureCS (ThickPolygon cs _ _) = cs
-getPictureCS (Rectangle cs _ _) = cs
-getPictureCS (SolidRectangle cs _ _) = cs
-getPictureCS (ThickRectangle cs _ _ _) = cs
-getPictureCS (ClosedCurve cs _) = cs
-getPictureCS (ThickClosedCurve cs _ _) = cs
-getPictureCS (Circle cs _) = cs
-getPictureCS (SolidCircle cs _) = cs
-getPictureCS (ThickCircle cs _ _) = cs
-getPictureCS (Polyline cs _) = cs
-getPictureCS (ThickPolyline cs _ _) = cs
-getPictureCS (Curve cs _) = cs
-getPictureCS (ThickCurve cs _ _) = cs
-getPictureCS (Sector cs _ _ _) = cs
-getPictureCS (Arc cs _ _ _) = cs
-getPictureCS (ThickArc cs _ _ _ _) = cs
-getPictureCS (Text cs _) = cs
-getPictureCS (Blank cs) = cs
-getPictureCS (StyledText cs _ _ _) = cs
-getPictureCS (Color cs _ _) = cs
-getPictureCS (Translate cs _ _ _) = cs
-getPictureCS (Scale cs _ _ _) = cs
-getPictureCS (Rotate cs _ _) = cs
-getPictureCS (Logo cs) = cs
-getPictureCS (CoordinatePlane cs) = cs
-getPictureCS (Pictures _) = emptyCallStack
+getPictureSrcLoc :: Picture -> Maybe SrcLoc
+getPictureSrcLoc (SolidPolygon loc _) = Just loc
+getPictureSrcLoc (SolidClosedCurve loc _) = Just loc
+getPictureSrcLoc (Polygon loc _) = Just loc
+getPictureSrcLoc (ThickPolygon loc _ _) = Just loc
+getPictureSrcLoc (Rectangle loc _ _) = Just loc
+getPictureSrcLoc (SolidRectangle loc _ _) = Just loc
+getPictureSrcLoc (ThickRectangle loc _ _ _) = Just loc
+getPictureSrcLoc (ClosedCurve loc _) = Just loc
+getPictureSrcLoc (ThickClosedCurve loc _ _) = Just loc
+getPictureSrcLoc (Circle loc _) = Just loc
+getPictureSrcLoc (SolidCircle loc _) = Just loc
+getPictureSrcLoc (ThickCircle loc _ _) = Just loc
+getPictureSrcLoc (Polyline loc _) = Just loc
+getPictureSrcLoc (ThickPolyline loc _ _) = Just loc
+getPictureSrcLoc (Curve loc _) = Just loc
+getPictureSrcLoc (ThickCurve loc _ _) = Just loc
+getPictureSrcLoc (Sector loc _ _ _) = Just loc
+getPictureSrcLoc (Arc loc _ _ _) = Just loc
+getPictureSrcLoc (ThickArc loc _ _ _ _) = Just loc
+getPictureSrcLoc (Lettering loc _) = Just loc
+getPictureSrcLoc (Blank loc) = Just loc
+getPictureSrcLoc (StyledLettering loc _ _ _) = Just loc
+getPictureSrcLoc (Color loc _ _) = Just loc
+getPictureSrcLoc (Translate loc _ _ _) = Just loc
+getPictureSrcLoc (Scale loc _ _ _) = Just loc
+getPictureSrcLoc (Dilate loc _ _) = Just loc
+getPictureSrcLoc (Rotate loc _ _) = Just loc
+getPictureSrcLoc (Logo loc) = Just loc
+getPictureSrcLoc (CoordinatePlane loc) = Just loc
+getPictureSrcLoc (Pictures _) = Nothing
 
 -- If a picture is found, the result will include an array of the base picture
 -- and all transformations.
 findTopShapeFromPoint :: Point -> Drawing -> IO (Maybe NodeId)
 findTopShapeFromPoint (x, y) pic = do
-    offscreen <- Canvas.create 500 500
-    context <- Canvas.getContext offscreen
-    (found, node) <-
-        findTopShape
-            context
-            (translateDS (10 - x / 25) (y / 25 - 10) initialDS)
-            pic
+    buf <- Canvas.create 500 500
+    ctx <- Canvas.getContext buf
+    (found, node) <- runCanvasM ctx $
+        findTopShape (translateDS (10 - x / 25) (y / 25 - 10) initialDS)
+                     pic
     case found of
         True -> return $ Just node
         False -> return Nothing
 
-findTopShape :: Canvas.Context -> DrawState -> Drawing -> IO (Bool, Int)
-findTopShape ctx ds (Shape drawer) = do
-    contained <- shapeContains $ drawer ctx ds
+findTopShape :: DrawState -> Drawing -> CanvasM (Bool, Int)
+findTopShape ds (Shape drawer) = do
+    contained <- shapeContains $ drawer ds
     case contained of
         True -> return (True, 0)
         False -> return (False, 1)
-findTopShape ctx ds (Transformation f d) =
-    map2 (+ 1) $ findTopShape ctx (f ds) d
-findTopShape ctx ds (Drawings []) = return (False, 1)
-findTopShape ctx ds (Drawings (dr:drs)) = do
-    (found, count) <- findTopShape ctx ds dr
+findTopShape ds (Transformation f d) =
+    map2 (+ 1) $ findTopShape (f ds) d
+findTopShape ds (Drawings []) = return (False, 1)
+findTopShape ds (Drawings (dr:drs)) = do
+    (found, count) <- findTopShape ds dr
     case found of
         True -> return (True, count + 1)
-        False -> map2 (+ count) $ findTopShape ctx ds (Drawings drs)
+        False -> map2 (+ count) $ findTopShape ds (Drawings drs)
 
 map2 :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
 map2 = fmap . fmap
 
-isPointInPath :: Canvas.Context -> IO Bool
-isPointInPath = js_isPointInPath 0 0
-
-isPointInStroke :: Canvas.Context -> IO Bool
-isPointInStroke = js_isPointInStroke 0 0
-
--- Canvas.isPointInPath does not provide a way to get the return value
--- https://github.com/ghcjs/ghcjs-base/blob/master/JavaScript/Web/Canvas.hs#L212
-foreign import javascript unsafe "$3.isPointInPath($1,$2)"
-               js_isPointInPath :: Double -> Double -> Canvas.Context -> IO Bool
-
-foreign import javascript unsafe "$3.isPointInStroke($1,$2)"
-               js_isPointInStroke :: Double -> Double -> Canvas.Context -> IO Bool
-
 foreign import javascript unsafe "initDebugMode($1,$2,$3,$4,$5)"
-               js_initDebugMode ::
-               Callback (JSVal -> IO JSVal) ->
-                 Callback (JSVal -> IO ()) ->
-                   Callback (IO JSVal) ->
-                     Callback (JSVal -> JSVal -> IO ()) ->
-                       Callback (JSVal -> JSVal -> IO ()) -> IO ()
+               js_initDebugMode :: Callback (JSVal -> IO JSVal)
+                                -> Callback (JSVal -> IO ())
+                                -> Callback (IO JSVal)
+                                -> Callback (JSVal -> JSVal -> IO ())
+                                -> Callback (JSVal -> JSVal -> IO ())
+                                -> IO ()
 
 -----------------------------------------------------------------------------------
 -- GHCJS Drawing
-type Drawer = Canvas.Context -> DrawState -> DrawMethods
+type Drawer = DrawState -> DrawMethods
 
 data DrawMethods = DrawMethods
-    { drawShape :: IO ()
-    , shapeContains :: IO Bool
+    { drawShape :: CanvasM ()
+    , shapeContains :: CanvasM Bool
     }
 
-polygonDrawer ps smooth ctx ds =
+polygonDrawer ps smooth ds =
     DrawMethods
-    { drawShape = trace >> applyColor ctx ds >> Canvas.fill ctx
-    , shapeContains = trace >> isPointInPath ctx
+    { drawShape = do
+          trace
+          applyColor ds
+          CM.fill
+    , shapeContains = do
+          trace
+          CM.isPointInPath (0, 0)
     }
   where
-    trace = withDS ctx ds $ followPath ctx ps True smooth
+    trace = withDS ds $ followPath ps True smooth
 
-pathDrawer ps w closed smooth ctx ds =
+pathDrawer ps w closed smooth ds =
     DrawMethods
-    { drawShape = drawFigure ctx ds w $ followPath ctx ps closed smooth
+    { drawShape = drawFigure ds w $ followPath ps closed smooth
     , shapeContains =
           do let width =
                      if w == 0
                          then 0.3
                          else w
-             drawFigure ctx ds width $ followPath ctx ps closed smooth
-             isPointInStroke ctx
+             drawFigure ds width $ followPath ps closed smooth
+             CM.isPointInStroke (0, 0)
     }
 
-sectorDrawer b e r ctx ds =
+sectorDrawer b e r ds =
     DrawMethods
-    { drawShape = trace >> applyColor ctx ds >> Canvas.fill ctx
-    , shapeContains = trace >> isPointInPath ctx
+    { drawShape = do
+          trace
+          applyColor ds
+          CM.fill
+    , shapeContains = do
+          trace
+          CM.isPointInPath (0, 0)
     }
   where
     trace =
-        withDS ctx ds $ do
-            Canvas.arc 0 0 (25 * abs r) b e (b > e) ctx
-            Canvas.lineTo 0 0 ctx
+        withDS ds $ do
+            CM.arc 0 0 (25 * abs r) b e (b > e)
+            CM.lineTo (0, 0)
 
-arcDrawer b e r w ctx ds =
+arcDrawer b e r w ds =
     DrawMethods
     { drawShape =
-          drawFigure ctx ds w $ Canvas.arc 0 0 (25 * abs r) b e (b > e) ctx
+          drawFigure ds w $ CM.arc 0 0 (25 * abs r) b e (b > e)
     , shapeContains =
           do let width =
                      if w == 0
                          then 0.3
                          else w
-             Canvas.lineWidth (width * 25) ctx
-             drawFigure ctx ds width $
-                 Canvas.arc 0 0 (25 * abs r) b e (b > e) ctx
-             isPointInStroke ctx
+             CM.lineWidth (width * 25)
+             drawFigure ds width $
+                 CM.arc 0 0 (25 * abs r) b e (b > e)
+             CM.isPointInStroke (0, 0)
     }
 
-textDrawer sty fnt txt ctx ds =
+textDrawer sty fnt txt ds =
     DrawMethods
     { drawShape =
-          withDS ctx ds $ do
-              Canvas.scale 1 (-1) ctx
-              applyColor ctx ds
-              Canvas.font (fontString sty fnt) ctx
-              Canvas.fillText (textToJSString txt) 0 0 ctx
+          withDS ds $ do
+              CM.scale 1 (-1)
+              applyColor ds
+              CM.font (fontString sty fnt)
+              CM.fillText txt (0, 0)
     , shapeContains =
-          do Canvas.font (fontString sty fnt) ctx
-             width <- Canvas.measureText (textToJSString txt) ctx
+          do CM.font (fontString sty fnt)
+             width <- CM.measureText txt
              let height = 25 -- constant, defined in fontString
-             withDS ctx ds $
-                 Canvas.rect ((-0.5) * width) ((-0.5) * height) width height ctx
-             isPointInPath ctx
+             withDS ds $
+                 CM.rect ((-0.5) * width) ((-0.5) * height) width height
+             CM.isPointInPath (0, 0)
     }
 
-logoDrawer ctx ds =
+logoDrawer ds =
     DrawMethods
     { drawShape =
-          withDS ctx ds $ do
-              Canvas.scale 1 (-1) ctx
-              drawCodeWorldLogo ctx ds (-225) (-50) 450 100
+          withDS ds $ do
+              CM.scale 1 (-1)
+              drawCodeWorldLogo ds (-221) (-91) 442 182
     , shapeContains =
-          do withDS ctx ds $ Canvas.rect (-225) (-50) 450 100 ctx
-             isPointInPath ctx
+          withDS ds $ do
+              CM.rect (-221) (-91) 442 182
+              CM.isPointInPath (0, 0)
     }
 
-coordinatePlaneDrawer ctx ds =
+coordinatePlaneDrawer ds =
     DrawMethods
-    { drawShape = drawDrawing ctx ds coordinatePlaneDrawing
-    , shapeContains = fst <$> findTopShape ctx ds coordinatePlaneDrawing
+    { drawShape = drawDrawing ds coordinatePlaneDrawing
+    , shapeContains = fst <$> findTopShape ds coordinatePlaneDrawing
     }
 
 foreign import javascript unsafe "showCanvas()" js_showCanvas ::
                IO ()
 
-followPath :: Canvas.Context -> [Point] -> Bool -> Bool -> IO ()
-followPath ctx [] closed _ = return ()
-followPath ctx [p1] closed _ = return ()
-followPath ctx ((sx, sy):ps) closed False = do
-    Canvas.moveTo (25 * sx) (25 * sy) ctx
-    forM_ ps $ \(x, y) -> Canvas.lineTo (25 * x) (25 * y) ctx
-    when closed $ Canvas.closePath ctx
-followPath ctx [p1, p2] False True = followPath ctx [p1, p2] False False
-followPath ctx ps False True = do
+followPath :: [Point] -> Bool -> Bool -> CanvasM ()
+followPath [] closed _ = return ()
+followPath [p1] closed _ = return ()
+followPath ((sx, sy):ps) closed False = do
+    CM.moveTo (25 * sx, 25 * sy)
+    forM_ ps $ \(x, y) -> CM.lineTo (25 * x, 25 * y)
+    when closed $ CM.closePath
+followPath [p1, p2] False True = followPath [p1, p2] False False
+followPath ps False True = do
     let [(x1, y1), (x2, y2), (x3, y3)] = take 3 ps
         dprev = sqrt ((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
         dnext = sqrt ((x3 - x2) ^ 2 + (y3 - y2) ^ 2)
         p = dprev / (dprev + dnext)
         cx = x2 + p * (x1 - x3) / 2
         cy = y2 + p * (y1 - y3) / 2
-    Canvas.moveTo (25 * x1) (25 * y1) ctx
-    Canvas.quadraticCurveTo (25 * cx) (25 * cy) (25 * x2) (25 * y2) ctx
-    forM_ (zip4 ps (tail ps) (tail $ tail ps) (tail $ tail $ tail ps)) $ \((x1, y1), (x2, y2), (x3, y3), (x4, y4)) ->
+    CM.moveTo (25 * x1, 25 * y1)
+    CM.quadraticCurveTo (25 * cx, 25 * cy) (25 * x2, 25 * y2)
+    forM_ (zip4 ps (tail ps) (tail $ tail ps) (tail $ tail $ tail ps)) $ \((x1, y1), (x2, y2), (x3, y3), (x4, y4)) -> do
         let dp = sqrt ((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
             d1 = sqrt ((x3 - x2) ^ 2 + (y3 - y2) ^ 2)
             d2 = sqrt ((x4 - x3) ^ 2 + (y4 - y3) ^ 2)
@@ -948,25 +1036,21 @@
             cy1 = y2 + r * (y3 - y1) / 2
             cx2 = x3 + p * (x2 - x4) / 2
             cy2 = y3 + p * (y2 - y4) / 2
-        in Canvas.bezierCurveTo
-               (25 * cx1)
-               (25 * cy1)
-               (25 * cx2)
-               (25 * cy2)
-               (25 * x3)
-               (25 * y3)
-               ctx
+        CM.bezierCurveTo
+            (25 * cx1, 25 * cy1)
+            (25 * cx2, 25 * cy2)
+            (25 * x3,  25 * y3)
     let [(x1, y1), (x2, y2), (x3, y3)] = reverse $ take 3 $ reverse ps
         dp = sqrt ((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
         d1 = sqrt ((x3 - x2) ^ 2 + (y3 - y2) ^ 2)
         r = d1 / (dp + d1)
         cx = x2 + r * (x3 - x1) / 2
         cy = y2 + r * (y3 - y1) / 2
-    Canvas.quadraticCurveTo (25 * cx) (25 * cy) (25 * x3) (25 * y3) ctx
-followPath ctx ps@(_:(sx, sy):_) True True = do
-    Canvas.moveTo (25 * sx) (25 * sy) ctx
+    CM.quadraticCurveTo (25 * cx, 25 * cy) (25 * x3, 25 * y3)
+followPath ps@(_:(sx, sy):_) True True = do
+    CM.moveTo (25 * sx, 25 * sy)
     let rep = cycle ps
-    forM_ (zip4 ps (tail rep) (tail $ tail rep) (tail $ tail $ tail rep)) $ \((x1, y1), (x2, y2), (x3, y3), (x4, y4)) ->
+    forM_ (zip4 ps (tail rep) (tail $ tail rep) (tail $ tail $ tail rep)) $ \((x1, y1), (x2, y2), (x3, y3), (x4, y4)) -> do
         let dp = sqrt ((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
             d1 = sqrt ((x3 - x2) ^ 2 + (y3 - y2) ^ 2)
             d2 = sqrt ((x4 - x3) ^ 2 + (y4 - y3) ^ 2)
@@ -976,30 +1060,26 @@
             cy1 = y2 + r * (y3 - y1) / 2
             cx2 = x3 + p * (x2 - x4) / 2
             cy2 = y3 + p * (y2 - y4) / 2
-        in Canvas.bezierCurveTo
-               (25 * cx1)
-               (25 * cy1)
-               (25 * cx2)
-               (25 * cy2)
-               (25 * x3)
-               (25 * y3)
-               ctx
-    Canvas.closePath ctx
+        CM.bezierCurveTo
+            (25 * cx1, 25 * cy1)
+            (25 * cx2, 25 * cy2)
+            (25 * x3,  25 * y3)
+    CM.closePath
 
-drawFigure :: Canvas.Context -> DrawState -> Double -> IO () -> IO ()
-drawFigure ctx ds w figure = do
-    withDS ctx ds $ do
+drawFigure :: DrawState -> Double -> CanvasM () -> CanvasM ()
+drawFigure ds w figure = do
+    withDS ds $ do
         figure
         when (w /= 0) $ do
-            Canvas.lineWidth (25 * w) ctx
-            applyColor ctx ds
-            Canvas.stroke ctx
+            CM.lineWidth (25 * w)
+            applyColor ds
+            CM.stroke
     when (w == 0) $ do
-        Canvas.lineWidth 1 ctx
-        applyColor ctx ds
-        Canvas.stroke ctx
+        CM.lineWidth 1
+        applyColor ds
+        CM.stroke
 
-fontString :: TextStyle -> Font -> JSString
+fontString :: TextStyle -> Font -> Text
 fontString style font = stylePrefix style <> "25px " <> fontName font
   where
     stylePrefix Plain = ""
@@ -1011,31 +1091,31 @@
     fontName Handwriting = "cursive"
     fontName Fancy = "fantasy"
     fontName (NamedFont txt) =
-        "\"" <> textToJSString (T.filter (/= '"') txt) <> "\""
+        "\"" <> T.filter (/= '"') txt <> "\""
 
-drawDrawing :: Canvas.Context -> DrawState -> Drawing -> IO ()
-drawDrawing ctx ds (Shape shape) = drawShape $ shape ctx ds
-drawDrawing ctx ds (Transformation f d) = drawDrawing ctx (f ds) d
-drawDrawing ctx ds (Drawings drs) = mapM_ (drawDrawing ctx ds) (reverse drs)
+drawDrawing :: DrawState -> Drawing -> CanvasM ()
+drawDrawing ds (Shape shape) = drawShape $ shape ds
+drawDrawing ds (Transformation f d) = drawDrawing (f ds) d
+drawDrawing ds (Drawings drs) = mapM_ (drawDrawing ds) (reverse drs)
 
-drawFrame :: Canvas.Context -> Drawing -> IO ()
-drawFrame ctx drawing = do
-    Canvas.fillStyle 255 255 255 1 ctx
-    Canvas.fillRect (-250) (-250) 500 500 ctx
-    drawDrawing ctx initialDS drawing
+drawFrame :: Drawing -> CanvasM ()
+drawFrame drawing = do
+    CM.fillColor 255 255 255 1
+    CM.fillRect (-250) (-250) 500 500
+    drawDrawing initialDS drawing
 
-setupScreenContext :: Element -> ClientRect.ClientRect -> IO Canvas.Context
-setupScreenContext canvas rect = do
+withScreen :: Element -> ClientRect.ClientRect -> CanvasM a -> IO a
+withScreen canvas rect action = do
     cw <- ClientRect.getWidth rect
     ch <- ClientRect.getHeight rect
     ctx <- js_getCodeWorldContext (canvasFromElement canvas)
-    Canvas.save ctx
-    Canvas.translate (realToFrac cw / 2) (realToFrac ch / 2) ctx
-    Canvas.scale (realToFrac cw / 500) (-realToFrac ch / 500) ctx
-    Canvas.lineWidth 0 ctx
-    Canvas.textAlign Canvas.Center ctx
-    Canvas.textBaseline Canvas.Middle ctx
-    return ctx
+    runCanvasM ctx $ CM.saveRestore $ do
+        CM.translate (realToFrac cw / 2) (realToFrac ch / 2)
+        CM.scale (realToFrac cw / 500) (-realToFrac ch / 500)
+        CM.lineWidth 0
+        CM.textCenter
+        CM.textMiddle
+        action
 
 setCanvasSize :: Element -> Element -> IO ()
 setCanvasSize target canvas = do
@@ -1335,6 +1415,11 @@
                 , tokenStep :: StaticKey
                 , tokenEvent :: StaticKey
                 , tokenDraw :: StaticKey }
+    | SteplessToken { tokenDeployHash :: Text
+                    , tokenNumPlayers :: Int
+                    , tokenInitial :: StaticKey
+                    , tokenEvent :: StaticKey
+                    , tokenDraw :: StaticKey }
     | PartialToken { tokenDeployHash :: Text }
     | NoToken
     deriving (Generic)
@@ -1636,6 +1721,7 @@
     -> (Int -> s -> Picture)
     -> IO ()
 runGame token numPlayers initial stepHandler eventHandler drawHandler = do
+    let fullStepHandler dt = stepHandler dt . eventHandler (-1) (TimePassing dt)
     js_showCanvas
     Just window <- currentWindow
     Just doc <- currentDocument
@@ -1651,21 +1737,19 @@
         gameHandle
             numPlayers
             initial
-            stepHandler
+            fullStepHandler
             eventHandler
             token
             currentGameState
     screen <- js_getCodeWorldContext (canvasFromElement canvas)
     let go t0 lastFrame = do
             gs <- readMVar currentGameState
-            let pic = gameDraw stepHandler drawHandler gs t0
+            let pic = gameDraw fullStepHandler drawHandler gs t0
             picFrame <- makeStableName $! pic
             when (picFrame /= lastFrame) $ do
                 rect <- getBoundingClientRect canvas
-                buffer <-
-                    setupScreenContext (elementFromCanvas offscreenCanvas) rect
-                drawFrame buffer (pictureToDrawing pic)
-                Canvas.restore buffer
+                withScreen (elementFromCanvas offscreenCanvas) rect $
+                    drawFrame (pictureToDrawing pic)
                 rect <- getBoundingClientRect canvas
                 cw <- ClientRect.getWidth rect
                 ch <- ClientRect.getHeight rect
@@ -1677,7 +1761,7 @@
                     (round cw)
                     (round ch)
             t1 <- nextFrame
-            modifyMVar_ currentGameState $ return . gameStep stepHandler t1
+            modifyMVar_ currentGameState $ return . gameStep fullStepHandler t1
             go t1 picFrame
     t0 <- getTime
     nullFrame <- makeStableName undefined
@@ -1688,8 +1772,10 @@
     -> (Double -> s -> s)
     -> (e -> s -> s)
     -> (s -> Drawing)
+    -> (Double -> e)
     -> IO (e -> IO (), IO s)
-run initial stepHandler eventHandler drawHandler = do
+run initial stepHandler eventHandler drawHandler injectTime = do
+    let fullStepHandler dt = stepHandler dt . eventHandler (injectTime dt)
     js_showCanvas
     Just window <- currentWindow
     Just doc <- currentDocument
@@ -1713,10 +1799,8 @@
             picFrame <- makeStableName $! pic
             when (picFrame /= lastFrame) $ do
                 rect <- getBoundingClientRect canvas
-                buffer <-
-                    setupScreenContext (elementFromCanvas offscreenCanvas) rect
-                drawFrame buffer pic
-                Canvas.restore buffer
+                withScreen (elementFromCanvas offscreenCanvas) rect $
+                    drawFrame pic
                 rect <- getBoundingClientRect canvas
                 cw <- ClientRect.getWidth rect
                 ch <- ClientRect.getHeight rect
@@ -1731,7 +1815,7 @@
                 if | needsTime ->
                        do t1 <- nextFrame
                           let dt = min (t1 - t0) 0.25
-                          modifyMVar_ currentState (return . stepHandler dt)
+                          modifyMVar_ currentState (return . fullStepHandler dt)
                           return t1
                    | otherwise ->
                        do takeMVar eventHappened
@@ -1742,7 +1826,7 @@
                 if | nextStateName /= lastStateName -> return True
                    | not needsTime -> return False
                    | otherwise ->
-                       not <$> isUniversallyConstant stepHandler nextState
+                       not <$> isUniversallyConstant fullStepHandler nextState
             go t1 picFrame nextStateName nextNeedsTime
     t0 <- getTime
     nullFrame <- makeStableName undefined
@@ -1803,10 +1887,8 @@
         drawToScreen = withoutPreemption $ do
             drawing <- draw
             rect <- getBoundingClientRect canvas
-            buffer <-
-                setupScreenContext (elementFromCanvas offscreenCanvas) rect
-            drawFrame buffer drawing
-            Canvas.restore buffer
+            withScreen (elementFromCanvas offscreenCanvas) rect $
+                drawFrame drawing
             rect <- getBoundingClientRect canvas
             cw <- ClientRect.getWidth rect
             ch <- ClientRect.getHeight rect
@@ -1860,6 +1942,7 @@
             stepHandlerWrapper
             eventHandlerWrapper
             drawHandlerWrapper
+            (Right . TimePassing)
     let pauseEvent True = sendEvent $ Left DebugStart
         pauseEvent False = sendEvent $ Left DebugStop
         highlightSelectEvent True n = sendEvent $ Left (HighlightEvent n)
@@ -1905,6 +1988,7 @@
             stepHandlerWrapper
             eventHandlerWrapper
             drawHandlerWrapper
+            (Right . TimePassing)
     let pauseEvent True = sendEvent $ Left DebugStart
         pauseEvent False = sendEvent $ Left DebugStop
         highlightSelectEvent True n = sendEvent $ Left (HighlightEvent n)
@@ -2019,6 +2103,7 @@
 run :: s -> (Double -> s -> s) -> (Event -> s -> s) -> (s -> Picture) -> IO ()
 run initial stepHandler eventHandler drawHandler =
     runBlankCanvas $ \context -> do
+        let fullStepHandler dt = stepHandler dt . eventHandler (TimePassing dt)
         let rect = (Canvas.width context, Canvas.height context)
         offscreenCanvas <- Canvas.send context $ Canvas.newCanvas rect
         currentState <- newMVar initial
@@ -2047,7 +2132,7 @@
                                        round ((tn `diffUTCTime` t0) * 1000000))
                               t1 <- getCurrentTime
                               let dt = realToFrac (t1 `diffUTCTime` t0)
-                              modifyMVar_ currentState (return . stepHandler dt)
+                              modifyMVar_ currentState (return . fullStepHandler dt)
                               return t1
                        | otherwise ->
                            do takeMVar eventHappened
@@ -2056,7 +2141,7 @@
                 nextStateName <- makeStableName $! nextState
                 nextNeedsTime <-
                     if nextStateName == lastStateName
-                        then not <$> isUniversallyConstant stepHandler nextState
+                        then not <$> isUniversallyConstant fullStepHandler nextState
                         else return True
                 go t1 picFrame nextStateName nextNeedsTime
         t0 <- getCurrentTime
@@ -2093,8 +2178,31 @@
     -> IO ()
 runGame = error "game API unimplemented in stand-alone interface mode"
 #endif
+
 --------------------------------------------------------------------------------
 -- Common code for game interface
+
+groupActivityOf numPlayers initial event draw = do
+    dhash <- getDeployHash
+    let token =
+            SteplessToken
+            { tokenDeployHash = dhash
+            , tokenNumPlayers = numPlayers
+            , tokenInitial = staticKey initial
+            , tokenEvent = staticKey event
+            , tokenDraw = staticKey draw
+            }
+    runGame
+        token
+        numPlayers
+        (deRefStaticPtr initial)
+        (const id)
+        (deRefStaticPtr event)
+        (deRefStaticPtr draw)
+
+unsafeGroupActivityOf numPlayers initial event draw =
+    unsafeCollaborationOf numPlayers initial (const id) event draw
+
 unsafeCollaborationOf numPlayers initial step event draw = do
     dhash <- getDeployHash
     let token = PartialToken dhash
@@ -2122,12 +2230,14 @@
         (deRefStaticPtr draw)
 
 --------------------------------------------------------------------------------
--- Common code for interaction, animation and simulation interfaces
+-- Common code for activity, interaction, animation and simulation interfaces
+activityOf initial event draw = interactionOf initial (const id) event draw
+
 interactionOf initial step event draw = runInspect initial step event draw
 
 data Wrapped a = Wrapped
     { state :: a
-    , paused :: Bool
+    , playbackSpeed :: Double
     , mouseMovedTime :: Double
     } deriving (Show)
 
@@ -2138,14 +2248,15 @@
     RestartButton :: Control Double
     BackButton :: Control Double
     TimeLabel :: Control Double
+    SpeedSlider :: Control a
 
 wrappedStep :: (Double -> a -> a) -> Double -> Wrapped a -> Wrapped a
 wrappedStep f dt w =
     w
     { state =
-          if paused w
+          if playbackSpeed w == 0
               then state w
-              else f dt (state w)
+              else f (dt * playbackSpeed w) (state w)
     , mouseMovedTime = mouseMovedTime w + dt
     }
 
@@ -2165,14 +2276,16 @@
 handleControl _ (x, y) RestartButton w
     | -9.4 < x && x < -8.6 && -9.4 < y && y < -8.6 = w {state = 0}
 handleControl _ (x, y) PlayButton w
-    | -8.4 < x && x < -7.6 && -9.4 < y && y < -8.6 = w {paused = False}
+    | -8.4 < x && x < -7.6 && -9.4 < y && y < -8.6 = w {playbackSpeed = 1}
 handleControl _ (x, y) PauseButton w
-    | -8.4 < x && x < -7.6 && -9.4 < y && y < -8.6 = w {paused = True}
+    | -8.4 < x && x < -7.6 && -9.4 < y && y < -8.6 = w {playbackSpeed = 0}
 handleControl _ (x, y) BackButton w
     | -7.4 < x && x < -6.6 && -9.4 < y && y < -8.6 =
         w {state = max 0 (state w - 0.1)}
 handleControl f (x, y) StepButton w
     | -6.4 < x && x < -5.6 && -9.4 < y && y < -8.6 = w {state = f 0.1 (state w)}
+handleControl f (x, y) SpeedSlider w
+    | -5.4 < x && x < -2.6 && -9.4 < y && y < -8.6 = w {playbackSpeed = 5 * (x + 5.4) / 2.8}
 handleControl _ _ _ w = w
 
 wrappedDraw ::
@@ -2242,36 +2355,39 @@
             (scaled 0.5 0.5 $ text (pack (showFFloatAlt (Just 4) (state w) "s"))) <>
         colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 3.0 0.8) <>
         colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 3.0 0.8)
+drawControl w alpha SpeedSlider = translated (-4) (-9) p
+  where
+    p =
+    
+        translated x 0 (solidRectangle 0.2 0.8) <>
+        colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 2.8 0.6) <>
+        colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 2.8 0.6)
+    x = playbackSpeed w / 5 * 2.8 - 1.4
 
 animationControls :: Wrapped Double -> [Control Double]
 animationControls w
     | mouseMovedTime w > 5 = []
-    | paused w && state w > 0 =
-        [RestartButton, PlayButton, StepButton, BackButton, TimeLabel]
-    | paused w = [RestartButton, PlayButton, StepButton, TimeLabel]
-    | otherwise = [RestartButton, PauseButton, TimeLabel]
+    | playbackSpeed w == 0 && state w > 0 =
+        [RestartButton, PlayButton, StepButton, BackButton, TimeLabel, SpeedSlider]
+    | playbackSpeed w == 0 = [RestartButton, PlayButton, StepButton, TimeLabel, SpeedSlider]
+    | otherwise = [RestartButton, PauseButton, TimeLabel, SpeedSlider]
 
 animationOf f = runPauseable initial (+) animationControls f
   where
-    initial = Wrapped {state = 0, paused = False, mouseMovedTime = 1000}
+    initial = Wrapped {state = 0, playbackSpeed = 1, mouseMovedTime = 1000}
 
 simulationControls :: Wrapped w -> [Control w]
 simulationControls w
     | mouseMovedTime w > 5 = []
-    | paused w = [PlayButton, StepButton]
-    | otherwise = [PauseButton]
+    | playbackSpeed w == 0 = [PlayButton, StepButton, SpeedSlider]
+    | otherwise = [PauseButton, SpeedSlider]
 
 simulationOf simInitial simStep simDraw =
     runPauseable initial simStep simulationControls simDraw
   where
     initial =
-        Wrapped {state = simInitial, paused = False, mouseMovedTime = 1000}
+        Wrapped {state = simInitial, playbackSpeed = 1, mouseMovedTime = 1000}
 
 trace msg x = unsafePerformIO $ do
     hPutStrLn stderr (T.unpack msg)
     return x
-
-#ifdef ghcjs_HOST_OS
-
---- GHCJS implementation of tracing and error handling
-#endif
diff --git a/src/CodeWorld/Event.hs b/src/CodeWorld/Event.hs
--- a/src/CodeWorld/Event.hs
+++ b/src/CodeWorld/Event.hs
@@ -23,7 +23,7 @@
 {-| An event initiated by the user.
 
     Values of this type represent events that the user triggers when
-    using an interaction, defined with 'interactionOf'.
+    using an interactive program.
 
     Key events describe the key as 'Text'.  Most keys are represented
     by a single character text string, with the capital letter or other
@@ -63,6 +63,7 @@
     | MouseRelease !MouseButton
                    !Point
     | MouseMovement !Point
+    | TimePassing !Double
     deriving (Eq, Show, Read)
 
 data MouseButton
@@ -72,13 +73,19 @@
     deriving (Eq, Show, Read)
 
 pattern PointerPress :: Point -> Event
-
 pattern PointerPress p = MousePress LeftButton p
 
 pattern PointerRelease :: Point -> Event
-
 pattern PointerRelease p = MouseRelease LeftButton p
 
 pattern PointerMovement :: Point -> Event
-
 pattern PointerMovement p = MouseMovement p
+
+{-# WARNING MousePress    ["Please use PointerPress instead of MousePress.",
+                           "MousePress may be removed July 2019." ] #-}
+{-# WARNING MouseRelease  ["Please use PointerRelease instead of MouseRelease.",
+                           "MouseRelease may be removed July 2019."] #-}
+{-# WARNING MouseMovement ["Please use PointerMovement instead of MouseMovement.",
+                           "MouseMovement may be removed July 2019."] #-}
+{-# WARNING MouseButton   ["Please use pointer events, which don't have buttons.",
+                           "MouseButton may be removed July 2019."] #-}
diff --git a/src/CodeWorld/Picture.hs b/src/CodeWorld/Picture.hs
--- a/src/CodeWorld/Picture.hs
+++ b/src/CodeWorld/Picture.hs
@@ -18,12 +18,25 @@
 module CodeWorld.Picture where
 
 import CodeWorld.Color
+import Data.List
 import Data.Monoid ((<>))
 import Data.Text (Text, pack)
 import GHC.Stack
 
 type Point = (Double, Double)
 
+translatedPoint :: Double -> Double -> Point -> Point
+translatedPoint tx ty (x, y) = (x + tx, y + ty)
+
+rotatedPoint :: Double -> Point -> Point
+rotatedPoint = rotatedVector
+
+scaledPoint :: Double -> Double -> Point -> Point
+scaledPoint kx ky (x, y) = (kx * x, ky * y)
+
+dilatedPoint :: Double -> Point -> Point
+dilatedPoint k (x, y) = (k * x, k * y)
+
 type Vector = (Double, Double)
 
 vectorLength :: Vector -> Double
@@ -49,90 +62,101 @@
 dotProduct :: Vector -> Vector -> Double
 dotProduct (x1, y1) (x2, y2) = x1 * x2 + y1 * y2
 
+getDebugSrcLoc :: CallStack -> SrcLoc
+getDebugSrcLoc cs =
+    case Data.List.find ((== "main") . srcLocPackage) locs of
+        Just loc -> loc
+        Nothing -> error "Cannot find debug source location."
+  where
+    locs = map snd (getCallStack cs)
+
 data Picture
-    = SolidPolygon CallStack
+    = SolidPolygon SrcLoc
               [Point]
-    | SolidClosedCurve CallStack
+    | SolidClosedCurve SrcLoc
               [Point]
-    | Polygon CallStack
+    | Polygon SrcLoc
            [Point]
-    | ThickPolygon CallStack
+    | ThickPolygon SrcLoc
            [Point]
            !Double
-    | Rectangle CallStack
+    | Rectangle SrcLoc
            !Double
            !Double
-    | SolidRectangle CallStack
+    | SolidRectangle SrcLoc
            !Double
            !Double
-    | ThickRectangle CallStack
+    | ThickRectangle SrcLoc
            !Double
            !Double
            !Double
-    | ClosedCurve CallStack
+    | ClosedCurve SrcLoc
            [Point]
-    | ThickClosedCurve CallStack
+    | ThickClosedCurve SrcLoc
            [Point]
            !Double
-    | Polyline CallStack
+    | Polyline SrcLoc
            [Point]
-    | ThickPolyline CallStack
+    | ThickPolyline SrcLoc
            [Point]
            !Double
-    | Curve CallStack
+    | Curve SrcLoc
            [Point]
-    | ThickCurve CallStack
+    | ThickCurve SrcLoc
            [Point]
            !Double
-    | Circle CallStack
+    | Circle SrcLoc
            !Double
-    | SolidCircle CallStack
+    | SolidCircle SrcLoc
            !Double
-    | ThickCircle CallStack
+    | ThickCircle SrcLoc
            !Double
            !Double
-    | Sector CallStack
+    | Sector SrcLoc
              !Double
              !Double
              !Double
-    | Arc CallStack
+    | Arc SrcLoc
           !Double
           !Double
           !Double
-    | ThickArc CallStack
+    | ThickArc SrcLoc
           !Double
           !Double
           !Double
           !Double
-    | StyledText CallStack
+    | StyledLettering SrcLoc
            !TextStyle
            !Font
            !Text
-    | Text CallStack
+    | Lettering SrcLoc
            !Text
-    | Color CallStack
+    | Color SrcLoc
             !Color
             !Picture
-    | Translate CallStack
+    | Translate SrcLoc
                 !Double
                 !Double
                 !Picture
-    | Scale CallStack
+    | Scale SrcLoc
             !Double
             !Double
             !Picture
-    | Rotate CallStack
+    | Dilate SrcLoc
              !Double
              !Picture
-    | CoordinatePlane CallStack
-    | Logo CallStack
+    | Rotate SrcLoc
+             !Double
+             !Picture
+    | CoordinatePlane SrcLoc
+    | Logo SrcLoc
     | Pictures [Picture]
-    | Blank CallStack
+    | Blank SrcLoc
 
 data TextStyle
     = Plain
     | Bold
-    | Italic
+    | Italic deriving (Show)
 
 data Font
     = SansSerif
@@ -140,140 +164,134 @@
     | Monospace
     | Handwriting
     | Fancy
-    | NamedFont !Text
+    | NamedFont !Text deriving (Show)
 
 -- | A blank picture
 blank :: HasCallStack => Picture
-blank = Blank callStack
+blank = Blank (getDebugSrcLoc callStack)
 
 -- | A thin sequence of line segments, with these points as endpoints
 polyline :: HasCallStack => [Point] -> Picture
-polyline ps = Polyline callStack ps
+polyline ps = Polyline (getDebugSrcLoc callStack) ps
 
 -- | A thin sequence of line segments, with these points as endpoints
 path :: HasCallStack => [Point] -> Picture
-path ps = Polyline callStack ps
+path ps = Polyline (getDebugSrcLoc callStack) ps
 
-{-# WARNING path "Please use polyline instead of path." #-}
+{-# WARNING path ["Please use polyline instead of path.",
+                  "path may be removed July 2019."] #-}
 
 -- | A thick sequence of line segments, with given line width and endpoints
 thickPolyline :: HasCallStack => Double -> [Point] -> Picture
-thickPolyline n ps = ThickPolygon callStack ps n
+thickPolyline n ps = ThickPolyline (getDebugSrcLoc callStack) ps n
 
 -- | A thick sequence of line segments, with given line width and endpoints
 thickPath :: HasCallStack => Double -> [Point] -> Picture
-thickPath n ps = ThickPolyline callStack ps n
+thickPath n ps = ThickPolyline (getDebugSrcLoc callStack) ps n
 
-{-# WARNING thickPath "Please used thickPolyline instead of thickPath." #-}
+{-# WARNING thickPath ["Please used thickPolyline instead of thickPath.",
+                       "thickPath may be removed July 2019."] #-}
 
 -- | A thin polygon with these points as vertices
 polygon :: HasCallStack => [Point] -> Picture
-polygon ps = Polygon callStack ps
+polygon ps = Polygon (getDebugSrcLoc callStack) ps
 
 -- | A thick polygon with this line width and these points as
 -- vertices
 thickPolygon :: HasCallStack => Double -> [Point] -> Picture
-thickPolygon n ps = ThickPolygon callStack ps n
+thickPolygon n ps = ThickPolygon (getDebugSrcLoc callStack) ps n
 
 -- | A solid polygon with these points as vertices
 solidPolygon :: HasCallStack => [Point] -> Picture
-solidPolygon ps = SolidPolygon callStack ps
+solidPolygon ps = SolidPolygon (getDebugSrcLoc callStack) ps
 
 -- | A smooth curve passing through these points.
 curve :: HasCallStack => [Point] -> Picture
-curve ps = Curve callStack ps
+curve ps = Curve (getDebugSrcLoc callStack) ps
 
 -- | A thick smooth curve with this line width, passing through these points.
 thickCurve :: HasCallStack => Double -> [Point] -> Picture
-thickCurve n ps = ThickCurve callStack ps n
+thickCurve n ps = ThickCurve (getDebugSrcLoc callStack) ps n
 
 -- | A smooth closed curve passing through these points.
 closedCurve :: HasCallStack => [Point] -> Picture
-closedCurve ps = ClosedCurve callStack ps
-
--- | A smooth closed curve passing through these points.
-loop :: HasCallStack => [Point] -> Picture
-loop ps = ClosedCurve callStack ps
-
-{-# WARNING loop "Please use closedCurve instead of loop." #-}
+closedCurve ps = ClosedCurve (getDebugSrcLoc callStack) ps
 
 -- | A thick smooth closed curve with this line width, passing through these points.
 thickClosedCurve :: HasCallStack => Double -> [Point] -> Picture
-thickClosedCurve n ps = ThickClosedCurve callStack ps n
-
--- | A thick smooth closed curve with this line width, passing through these points.
-thickLoop :: HasCallStack => Double -> [Point] -> Picture
-thickLoop n ps = ThickClosedCurve callStack ps n
-
-{-# WARNING thickLoop "Please use thickClosedCurve instead of thickLoop." #-}
+thickClosedCurve n ps = ThickClosedCurve (getDebugSrcLoc callStack) ps n
 
 -- | A solid smooth closed curve passing through these points.
 solidClosedCurve :: HasCallStack => [Point] -> Picture
-solidClosedCurve ps = SolidClosedCurve callStack ps
-
--- | A solid smooth closed curve passing through these points.
-solidLoop :: HasCallStack => [Point] -> Picture
-solidLoop ps = SolidClosedCurve callStack ps
-
-{-# WARNING solidLoop "Please use solidClosedCurve instead of solidLoop." #-}
+solidClosedCurve ps = SolidClosedCurve (getDebugSrcLoc callStack) ps
 
 rectangleVertices :: Double -> Double -> [Point]
 rectangleVertices w h = [ (w / 2, h / 2), (w / 2, -h / 2), (-w / 2, -h / 2), (-w / 2, h / 2) ]
 
 -- | A thin rectangle, with this width and height
 rectangle :: HasCallStack => Double -> Double -> Picture
-rectangle w h = Rectangle callStack w h
+rectangle w h = Rectangle (getDebugSrcLoc callStack) w h
 
 -- | A solid rectangle, with this width and height
 solidRectangle :: HasCallStack => Double -> Double -> Picture
-solidRectangle w h = SolidRectangle callStack w h
+solidRectangle w h = SolidRectangle (getDebugSrcLoc callStack) w h
 
 -- | A thick rectangle, with this line width, and width and height
 thickRectangle :: HasCallStack => Double -> Double -> Double -> Picture
-thickRectangle lw w h = ThickRectangle callStack lw w h
+thickRectangle lw w h = ThickRectangle (getDebugSrcLoc callStack) lw w h
 
 -- | A thin circle, with this radius
 circle :: HasCallStack => Double -> Picture
-circle = Circle callStack 
+circle = Circle (getDebugSrcLoc callStack) 
 
 -- | A thick circle, with this line width and radius
 thickCircle :: HasCallStack => Double -> Double -> Picture
-thickCircle = ThickCircle callStack
+thickCircle = ThickCircle (getDebugSrcLoc callStack)
 
 -- | A thin arc, starting and ending at these angles, with this radius
 --
 -- Angles are in radians.
 arc :: HasCallStack => Double -> Double -> Double -> Picture
-arc b e r = Arc callStack b e r
+arc b e r = Arc (getDebugSrcLoc callStack) b e r
 
 -- | A thick arc with this line width, starting and ending at these angles,
 -- with this radius.
 --
 -- Angles are in radians.
 thickArc :: HasCallStack => Double -> Double -> Double -> Double -> Picture
-thickArc w b e r = ThickArc callStack b e r w
+thickArc w b e r = ThickArc (getDebugSrcLoc callStack) b e r w
 
 -- | A solid circle, with this radius
 solidCircle :: HasCallStack => Double -> Picture
-solidCircle = SolidCircle callStack 
+solidCircle = SolidCircle (getDebugSrcLoc callStack) 
 
 -- | A solid sector of a circle (i.e., a pie slice) starting and ending at these
 -- angles, with this radius
 --
 -- Angles are in radians.
 sector :: HasCallStack => Double -> Double -> Double -> Picture
-sector = Sector callStack
+sector = Sector (getDebugSrcLoc callStack)
 
--- | A piece of text
+-- | A rendering of text characters.
 text :: HasCallStack => Text -> Picture
-text = Text callStack
+text = Lettering (getDebugSrcLoc callStack)
 
+-- | A rendering of text characters.
+lettering :: HasCallStack => Text -> Picture
+lettering = Lettering (getDebugSrcLoc callStack)
+
+-- | A rendering of text characters, with a specific choice of font and style.
 styledText :: HasCallStack => TextStyle -> Font -> Text -> Picture
-styledText = StyledText callStack
+styledText = StyledLettering (getDebugSrcLoc callStack)
 
+-- | A rendering of text characters onto a Picture, with a specific
+-- choice of font and style.
+styledLettering :: HasCallStack => TextStyle -> Font -> Text -> Picture
+styledLettering = StyledLettering (getDebugSrcLoc callStack)
+
 -- | A picture drawn entirely in this color.
 colored :: HasCallStack => Color -> Picture -> Picture
-colored = Color callStack
+colored = Color (getDebugSrcLoc callStack)
 
 -- | A picture drawn entirely in this colour.
 coloured :: HasCallStack => Color -> Picture -> Picture
@@ -281,21 +299,21 @@
 
 -- | A picture drawn translated in these directions.
 translated :: HasCallStack => Double -> Double -> Picture -> Picture
-translated = Translate callStack
+translated = Translate (getDebugSrcLoc callStack)
 
 -- | A picture scaled by these factors.
 scaled :: HasCallStack => Double -> Double -> Picture -> Picture
-scaled = Scale callStack
+scaled = Scale (getDebugSrcLoc callStack)
 
 -- | A picture scaled by these factors.
 dilated :: HasCallStack => Double -> Picture -> Picture
-dilated k = scaled k k
+dilated = Dilate (getDebugSrcLoc callStack)
 
 -- | A picture rotated by this angle.
 --
 -- Angles are in radians.
 rotated :: HasCallStack => Double -> Picture -> Picture
-rotated = Rotate callStack
+rotated = Rotate (getDebugSrcLoc callStack)
 
 -- A picture made by drawing these pictures, ordered from top to bottom.
 pictures :: [Picture] -> Picture
@@ -329,8 +347,8 @@
 --    main = drawingOf (myPicture <> coordinatePlane)
 --    myPicture = ...
 coordinatePlane :: HasCallStack => Picture
-coordinatePlane = CoordinatePlane callStack
+coordinatePlane = CoordinatePlane (getDebugSrcLoc callStack)
 
 -- | The CodeWorld logo.
 codeWorldLogo :: HasCallStack => Picture
-codeWorldLogo = Logo callStack
+codeWorldLogo = Logo (getDebugSrcLoc callStack)