Circles program (9.1.1)

1 files changed, 48 insertions, 0 deletions

diff --git a/tut9_1_1.icl b/tut9_1_1.icl
new file mode 100644
index 0000000..3dc6bbc
--- /dev/null
+++ b/tut9_1_1.icl
@@ -0,0 +1,48 @@
+module tut9_1_1
+
+// ********************************************************************************
+// Clean tutorial example program.
+//
+// This program creates a window that displays growing concentric circles.
+// For this purpose it uses a timer.
+// ********************************************************************************
+
+import StdEnv, StdIO
+
+:: TimerState = { nrCircles     :: Int,
+                  equiDistance  :: Int,
+                  minRadius     :: Int }
+
+Start :: *World -> *World
+Start world = circles (openId world)
+
+circles :: (Id, *World) -> *World
+circles (wid, world) = startIO SDI Void (snd o seqList [openWindow Void wdef, openMenu Void mdef, openTimer initTimerState tdef]) [] world
+where
+    windowEdge = 200
+    viewDomain = { corner1 = {x= ~windowEdge/2, y= ~windowEdge/2},
+                   corner2 = {x=  windowEdge/2, y=  windowEdge/2} }
+
+    wdef = Window "Circles" NilLS [ WindowId wid,
+                                    WindowViewSize (rectangleSize viewDomain),
+                                    WindowViewDomain viewDomain ]
+
+    mdef = Menu "&Circles" (MenuItem "&Quit" [MenuFunction (noLS closeProcess), MenuShortKey 'q']) []
+    
+    tdef = Timer (ticksPerSecond/20) NilLS [TimerFunction timer]
+
+    initTimerState = { nrCircles    = 4,
+                       equiDistance = 2,
+                       minRadius    = 0 }
+
+    timer _ (lst=:{nrCircles,equiDistance,minRadius},pst)
+        | minRadius < windowEdge/2
+            # lst       = {lst & minRadius = minRadius + equiDistance}
+              newRadius = minRadius + nrCircles * equiDistance
+            # pst       = appPIO (appWindowPicture wid (draw     {oval_rx=newRadius, oval_ry=newRadius}
+                                                        o undraw {oval_rx=minRadius, oval_ry=minRadius})) pst
+            = (lst,pst)
+        | otherwise
+            # pst = appPIO (appWindowPicture wid (unfill viewDomain)) pst
+            = (initTimerState, pst)
+