refactor stairs example to allow interactive execution

Stairs.fr

@@ -1,50 +1,43 @@
 module Stairs where
 
-import org.frege.JavaFX
-import org.frege.AllNodes
-
-import fregefx.javafx.application.Platform
+import org.frege.SketchBook
 import fregefx.javafx.scene.canvas.GraphicsContext
-import fregefx.javafx.scene.canvas.Canvas
-import fregefx.javafx.scene.Group
-import fregefx.javafx.stage.Stage
-import fregefx.javafx.scene.Scene
-
-withUI f = Platform.runLater =<< Runnable.new f
-
-paint :: (GraphicsContext -> IO()) -> IO ()
-paint drawing = withUI do
-    grp    <- Group.new ()
-    kids   <- grp.getChildren
-    canvas <- Canvas.new 600 600
-    ctx    <- canvas.getGraphicsContext2D
-    kids.add canvas
-    scene <- Scene.new grp 600d 600d
-    stage <- Stage.new ()
-    stage.setScene scene
-    stage.show
-    ctx.translate 300 300 -- center 0,0
-    ctx.scale 1  (-1)     -- mirror y axis
-    drawing ctx
+import Data.List
 
+--- A point on the canvas.
 data Point = P {x, y :: Double}
+
+--- The last four points that we have drawn a line to, latest first.
 type Trail = (Point, Point, Point, Point)
 
+--- The initial trail.
+--- Note that the starting point is tugged in a little to make the first bearing landing at the right point.
 start = ( P (-10) 10, P (-10) (-10), P 10 (-10), P 9.5 9.5 )
 
+--- Return the point that we reach when drawing a line from _start_ to _over_ and extend by 5%.
 bearing:: Point -> Point -> Point
 bearing start over = P ((over.x - start.x) * 1.05 + start.x ) ((over.y - start.y) * 1.05 + start.y)
 
+--- How to move the trails one step forward.
 step :: Trail -> Trail
 step (first, second, third, last) = (bearing first last, first, second, third)
 
-stairs = iterate step start
+--- The infinite production of trails.
+trails :: [Trail]
+trails = iterate step start
 
+--- Given a trail with a new head, paint the line that connects it to its body (= old head).
 connect :: GraphicsContext -> Trail -> IO ()
-connect ctx (nextHead,head,_,_) = ctx.strokeLine head.x head.y nextHead.x nextHead.y
+connect ctx (nextHead,head,_,_) = withUI $ ctx.strokeLine head.x head.y nextHead.x nextHead.y
+
+--- A doodle contains all actions that when applied in sequence make up the picture.
+doodle :: GraphicsContext -> [IO ()]
+doodle ctx = map (connect ctx) trails
+
+--- Sample usage: paint the doodle at once.
+fast = paint $ sequence_ . take 300 . doodle
 
---- a doodle contains all actions that when applied in sequence make up the picture
-doodle ctx = map (connect ctx) stairs
+--- Sample usage: make every second action a sleep.
+slow = paint $ sequence_ . intersperse (Thread.sleep 100) . take 300 . doodle
 
---paint (\ctx -> sequence_ $ take 500 $ doodle ctx)
 

client/src/main/frege/org/frege/Application.fr

@@ -55,8 +55,8 @@ showUI mConsole stage = do
     items.add "mapM println [1..100]"
     items.add "fib = 1n : 1n : zipWith (+) fib (tail fib)"
     items.add ":l https://raw.githubusercontent.com/Dierk/frepl-gui/master/Stairs.fr"
-    items.add "import Stairs"
-    items.add "paint (\\ctx -> sequence_ $ take 500 $ doodle ctx)"
+    items.add "import Stairs;import org.frege.SketchBook;import Data.List"
+    items.add "paint $ sequence_ . take 300 . doodle"
 
     sm  <- historyLV.getSelectionModel
     sip <- sm.selectedItemProperty

client/src/main/frege/org/frege/SketchBook.fr

@@ -0,0 +1,59 @@
+{--
+    The SketchBook provides painting surfaces on which code in the REPL can draw.
+
+    Use it like in the _sampleUse_ function:
+
+    > sampleUse = paint crosshair where
+    >     crosshair ctx = withUI do
+    >         ctx.strokeLine (-100d) 0d 100d 0d  -- horizontal line
+    >         ctx.strokeLine 0d (-100d) 0d 100d  -- vertical line
+-}
+
+module org.frege.SketchBook where
+
+import fregefx.javafx.application.Platform
+import fregefx.javafx.scene.canvas.GraphicsContext
+import fregefx.javafx.scene.canvas.Canvas
+import fregefx.javafx.scene.Group
+import fregefx.javafx.stage.Stage
+import fregefx.javafx.scene.Scene
+
+import Control.Concurrent
+
+--- Call the _draw_ function with the graphical context of a newly created canvas.
+--- The logic inside _draw_ is itself responsible for using _withUI_ when appropriate.
+paint :: (GraphicsContext->IO α) -> IO α
+paint draw = do
+    ctxHolder <- MVar.newEmpty
+    canvas 600 600 ctxHolder   -- runs in UI thread
+    ctx <- ctxHolder.take      -- wait until UI thread is ready
+    draw ctx
+
+--- Run any function _f_ in the JavaFX Application Thread to ensure proper painting.
+--- Any code that touches a JavaFX UI component must run in this thread.
+withUI :: IO () -> IO ()
+withUI f = Platform.runLater =<< Runnable.new f
+
+--- Make a frame (stage) with a canvas of the given _width_ and _height_.
+--- Set the graphicsContext into the _ctxHolder_ once it is available such that other threads that wait for it can proceed.
+--- The (0,0) origin is centered and y coordinates point upwards like it is conventional in mathematics.
+canvas :: Double -> Double -> MVar GraphicsContext -> IO ()
+canvas width height ctxHolder = withUI do  -- UI construction must happen inside the UI thread
+    grp    <- Group.new ()
+    kids   <- grp.getChildren
+    canvas <- Canvas.new width height
+    ctx    <- canvas.getGraphicsContext2D
+    kids.add canvas
+    scene <- Scene.new grp width height
+    stage <- Stage.new ()
+    stage.setScene scene
+    stage.show
+    ctx.translate (width / 2) (height / 2)  -- center 0,0
+    ctx.scale 1  (-1)                       -- mirror y axis
+    ctxHolder.put ctx
+
+--- Example on how to use the sketchbook API that draws a crosshair.
+sampleUse = paint crosshair where
+    crosshair ctx = withUI do
+        ctx.strokeLine (-100d) 0d 100d 0d
+        ctx.strokeLine 0d (-100d) 0d 100d