initial week 6 commit
authorMart Lubbers <mart@martlubbers.net>
Tue, 26 May 2015 18:17:55 +0000 (20:17 +0200)
committerMart Lubbers <mart@martlubbers.net>
Tue, 26 May 2015 18:17:55 +0000 (20:17 +0200)
fp2/week6/mart/BinSearchTreeImage.icl [new file with mode: 0644]
fp2/week6/mart/GuessWhat.icl [new file with mode: 0644]
fp2/week6/mart/QA.dcl [new file with mode: 0644]
fp2/week6/mart/QA.icl [new file with mode: 0644]
fp2/week6/mart/QA_shapes.dcl [new file with mode: 0644]
fp2/week6/mart/QA_shapes.icl [new file with mode: 0644]
fp2/week6/mart/Reglement-verkeersregels-en-verkeersteke.pdf [new file with mode: 0644]
fp2/week6/mart/SimpleSVG.icl [new file with mode: 0644]
fp2/week6/mart/SimpleSVG.prj [new file with mode: 0644]

diff --git a/fp2/week6/mart/BinSearchTreeImage.icl b/fp2/week6/mart/BinSearchTreeImage.icl
new file mode 100644 (file)
index 0000000..1662608
--- /dev/null
@@ -0,0 +1,57 @@
+module BinSearchTreeImage\r
+\r
+/* Instructions:\r
+\r
+(1) copy BinTree.(i/d)cl and BinSearchTree.(i/d)cl from Practicum to\r
+    {iTasks-SDK}\Experiments\SVG_tests\\r
+    \r
+(2) in these modules change the type\r
+\r
+    :: Tree a = Node a (Tree a) (Tree a) | Leaf\r
+    \r
+    to\r
+    \r
+    :: BTree a = BLeaf | BNode a (BTree a) (BTree a)   // ORDER OF DATACONSTRUCTORS IS ESSENTIAL!!\r
+    \r
+    and adapt the corresponding function definitions.\r
+    \r
+(3) this main file (BinSearchTreeImage.icl) must be in the same folder:\r
+    {iTasks-SDK}\Experiments\SVG_tests\\r
+    \r
+(4) create a new project and set de environment to 'iTasks'\r
+\r
+(5) Bring-Up-To-Date and start generated application\r
+\r
+(6) Open a browser and navigate to localhost.\r
+    The application creates two tasks:\r
+    (a) The task on the left allows you to enter subsequent elements that are inserted in the tree, one after another.\r
+    (b) The task on the right must be finished by you by writing the function treeImage. This function must render the tree structure in such a way\r
+        that Nodes of the same depth have the same y-coordinate, and the root having the smallest y-coordinate.\r
+*/\r
+\r
+import iTasks                                                          // de algemene iTask API\r
+import iTasks.API.Extensions.SVG.SVGlet                // specialiseer task editors\r
+from   StdFunc import flip\r
+\r
+import BinSearchTree                                           // type definition of Tree and sample trees z0 .. z8\r
+derive class iTask BTree\r
+\r
+Start                          :: *World -> *World\r
+Start world                    = startEngine [publish "/" (WebApp []) (\_ -> task)] world\r
+\r
+task                           :: Task [Int]\r
+task                           = withShared [] (\sharedList ->\r
+                                               (  (updateSharedInformation (Title "Edit list") [] sharedList <<@ ArrangeHorizontal)\r
+                                                  -||-\r
+                                                  (viewSharedInformation (Title "Tree view") [imageView treeImage` (\_ _ -> Nothing)] sharedList <<@ ArrangeHorizontal)\r
+                                               ) <<@ ArrangeHorizontal\r
+                                         ) <<@ FullScreen\r
+\r
+font                           = normalFontDef "Courier New" fonthoogte\r
+fonthoogte                     = 14.0\r
+\r
+treeImage`                     :: [Int] *TagSource -> Image m\r
+treeImage` nrs tags    = treeImage (foldl (flip insertTree) BLeaf nrs) tags\r
+\r
+treeImage                      :: (BTree Int) *TagSource -> Image m\r
+treeImage tree ts   = text (normalFontDef "Courier New" 12.0) "I need to draw a tree!"\r
diff --git a/fp2/week6/mart/GuessWhat.icl b/fp2/week6/mart/GuessWhat.icl
new file mode 100644 (file)
index 0000000..8e6284a
--- /dev/null
@@ -0,0 +1,96 @@
+module GuessWhat\r
+\r
+/* Instructions:\r
+\r
+(1) copy this main file (GuessWhat.icl), QA_shapes.(d/i)cl, and QA.(d/i)cl in the folder:\r
+    {iTasks-SDK}\Experiments\SVG_tests\\r
+    \r
+(2) create a new project and set de environment to 'iTasks'\r
+\r
+(3) Bring-Up-To-Date and start generated application\r
+\r
+(4) Open a browser and navigate to localhost.\r
+    The application creates a task that randomly selects a number of image-name pairs and asks the user to \r
+    give the right name to the right image. Once this is done correctly, the task terminates, otherwise the\r
+    user can try again.\r
+\r
+(5) Create a new set of QA-shapes. You can choose one of the following:\r
+    (i)  Dutch traffic signs. See attached document:\r
+         Reglement-verkeersregels-en-verkeersteke.pdf, appendix 1, hoofdstuk A upto L.\r
+         \r
+         Implement **at least 15** traffic signs. In your solution, clearly indicate at each traffic sign \r
+         which one you have implemented (use the numbers in the right-most column in the above document).\r
+    \r
+    \r
+    (ii) European flags. See the following wikipedia page:\r
+         http://nl.wikipedia.org/wiki/Lijst_van_vlaggen_van_Europa\r
+         \r
+         Implement **at least 15** flags. In your solution, clearly indicate at each flag which one you\r
+         have implemented by the name of the nation or organization.\r
+*/\r
+\r
+import iTasks                                                  // de algemene iTask API\r
+import iTasks.API.Extensions.SVG.SVGlet        // specialiseer task editors\r
+from   Data.List import zipWith\r
+\r
+import QA_shapes                                               // the QA elements that have to be guessed\r
+\r
+nr_of_qas :== 10\r
+\r
+Start :: *World -> *World\r
+Start world = startEngine [publish "/" (WebApp []) (\_ -> play queries)] world\r
+\r
+play :: [QA] -> Task String\r
+play []\r
+       = viewInformation "missing queries" [] "No queries are available"\r
+play qas\r
+       =             sequence "throw dice" (repeatn (nr_of_qas + length qas) (get randomInt))\r
+         >>= \nrs -> let (nrs1,nrs2)   = splitAt nr_of_qas nrs\r
+                         shuffled_qas  = shuffle nrs2 qas\r
+                         (qs,as)               = unzip (take nr_of_qas shuffled_qas)\r
+                         sas                   = shuffle nrs1 as\r
+                      in keep_guessing qs as sas\r
+\r
+keep_guessing :: [Image ()] [String] [String] -> Task String\r
+keep_guessing qs as sas\r
+       =             allTasks [guess i q sas \\ q <- qs & i <- [1 ..]]\r
+         >>* [ OnAction (Action "Check" []) (hasValue (check_answers qs as sas))\r
+             , OnAction ActionQuit          (always   (return "Goodbye"))\r
+             ] \r
+\r
+check_answers :: [Image ()] [String] [String] [String] -> Task String\r
+check_answers qs as sas nas\r
+| ok == nr_of_qas\r
+       = viewInformation "Tada!" [] "Congratulations! All correct!"\r
+| otherwise\r
+       = (viewInformation "Ouch!" [] ("Too bad: there are " <+++ nr_of_qas - ok <+++ " mistakes.")\r
+             ||-\r
+          allTasks [  ((show_image i q <<@ ArrangeHorizontal)\r
+                           ||-\r
+                       (viewInformation "isn't" [] a <<@ ArrangeHorizontal)\r
+                      ) <<@ ArrangeHorizontal\r
+                   \\ wrong <- zipWith (<>) as nas\r
+                    & q     <- qs\r
+                    & a     <- nas\r
+                    & i     <- [1 ..]\r
+                    | wrong\r
+                   ]\r
+         ) >>* [ OnAction (Action "Try again" []) (always (keep_guessing qs as sas))\r
+               , OnAction ActionQuit              (always (return "Goodbye"))\r
+               ]\r
+where\r
+       ok = length [() \\ a <- as & b <- nas | a == b]\r
+\r
+show_image :: Int (Image ()) -> Task ()\r
+show_image i q = viewInformation ("image " <+++ i) [imageView (\_ _ -> q) (\_ _ -> Nothing)] ()\r
+\r
+guess :: Int (Image ()) [String] -> Task String\r
+guess i q sas\r
+       = ( (show_image i q <<@ ArrangeHorizontal)\r
+           ||-\r
+        (enterChoice "is:" [ChooseWith (ChooseFromComboBox id)] sas <<@ ArrangeHorizontal)\r
+      ) <<@ ArrangeHorizontal\r
+\r
+shuffle :: [Int] [a] -> [a]\r
+shuffle rnrs as\r
+       = fst (unzip (sortBy (\(_,r1) (_,r2) -> r1 < r2) (zip2 as rnrs)))\r
diff --git a/fp2/week6/mart/QA.dcl b/fp2/week6/mart/QA.dcl
new file mode 100644 (file)
index 0000000..051640d
--- /dev/null
@@ -0,0 +1,5 @@
+definition module QA\r
+\r
+import Graphics.Scalable                                       // de Graphics.Scalable API\r
+\r
+:: QA :== (Image (), String)\r
diff --git a/fp2/week6/mart/QA.icl b/fp2/week6/mart/QA.icl
new file mode 100644 (file)
index 0000000..1f0b13d
--- /dev/null
@@ -0,0 +1,3 @@
+implementation module QA\r
+\r
+import Graphics.Scalable\r
diff --git a/fp2/week6/mart/QA_shapes.dcl b/fp2/week6/mart/QA_shapes.dcl
new file mode 100644 (file)
index 0000000..14664fc
--- /dev/null
@@ -0,0 +1,5 @@
+definition module QA_shapes\r
+\r
+import QA\r
+\r
+queries :: [QA]\r
diff --git a/fp2/week6/mart/QA_shapes.icl b/fp2/week6/mart/QA_shapes.icl
new file mode 100644 (file)
index 0000000..fdb1a54
--- /dev/null
@@ -0,0 +1,27 @@
+implementation module QA_shapes\r
+\r
+import QA, StdReal\r
+\r
+//     deze module definieert een aantal eenvoudige vorm-naam elementen\r
+\r
+d    :== px 40.0\r
+font :== normalFontDef "Times" 40.0\r
+\r
+queries :: [QA]\r
+queries\r
+       = [(rect d d,                                      "square")\r
+         ,(circle d <@< {strokewidth=zero},               "circle")\r
+         ,(ellipse d (d /. 2) <@< {strokewidth=zero},     "ellipse")\r
+         ,(text font "Hello",                             "text")\r
+         ,(margin (d /. 2,px zero) (xline Nothing d),     "xline")\r
+         ,(margin (px zero,d /. 2) (yline Nothing d),     "yline")\r
+         ,(line Nothing Slash d d,                        "slash")\r
+         ,(line Nothing Backslash d d,                    "backslash")\r
+         ,(polygon  Nothing [(d/.2,zero),(d,d),(zero,d)], "triangle")\r
+         ,(polyline Nothing [(d/.2,zero),(d,d),(zero,d),(d/.2,zero)], "polyline")\r
+         ,(fitx (d /. 1.2) \r
+             (overlay [(AtMiddleX,AtMiddleY),(AtMiddleX,AtMiddleY)] \r
+                      [] \r
+                      [rect d d,rotate (deg 45.0) (rect d d)] \r
+                      Nothing),                           "star")\r
+         ]\r
diff --git a/fp2/week6/mart/Reglement-verkeersregels-en-verkeersteke.pdf b/fp2/week6/mart/Reglement-verkeersregels-en-verkeersteke.pdf
new file mode 100644 (file)
index 0000000..a5e6403
Binary files /dev/null and b/fp2/week6/mart/Reglement-verkeersregels-en-verkeersteke.pdf differ
diff --git a/fp2/week6/mart/SimpleSVG.icl b/fp2/week6/mart/SimpleSVG.icl
new file mode 100644 (file)
index 0000000..38544b1
--- /dev/null
@@ -0,0 +1,454 @@
+module SimpleSVG\r
+\r
+/* How to create and test an iTask program:\r
+   1. Install the iTask Clean compiler\r
+   2. Create a new project with this module as main module\r
+   3. Select the 'iTasks' environment\r
+   4. Bring the project Up-Uo-Date\r
+   5. Start the generated exe (this launches a local web server, allow your OS to unblock the exe)\r
+   6. Open a web browser (Google Chrome gives the best results)\r
+   7. Navigate to http://localhost/ activates the root-application (hello world)\r
+   8. Navigate to http://localhost/LABEL activates the application with the corresponding LABEL (e.g. http://localhost/basic)\r
+*/\r
+\r
+import iTasks                                                          // the iTask API\r
+import iTasks.API.Extensions.SVG.SVGlet                // required to embed Image-tasks inside other tasks\r
+import StdArray\r
+\r
+const2 :: .a .b .c -> .a\r
+const2 x _ _ = x\r
+\r
+:: Person = {name :: String, surname :: String, birth :: Date}\r
+derive class iTask Person\r
+\r
+person = {name = "Peter", surname = "Achten", birth = {day=9,mon=1,year=1967}}\r
+\r
+Start :: *World -> *World\r
+Start world\r
+       = startEngine [publish "/"                (WebApp []) (const (viewInformation "Hello" [] "World!"                                                     <<@ FullScreen))\r
+                     ,publish "/basic"           (WebApp []) (const (viewInformation "Basic Images"    [imageView basic_images       (const2 Nothing)] model <<@ FullScreen))\r
+                     ,publish "/transformations" (WebApp []) (const (viewInformation "Transformations" [imageView transformed_images (const2 Nothing)] model <<@ FullScreen))\r
+                     ,publish "/overlays"        (WebApp []) (const (viewInformation "Overlays"        [imageView overlays           (const2 Nothing)] model <<@ FullScreen))\r
+                     ,publish "/linear"          (WebApp []) (const (viewInformation "Linear"          [imageView linear             (const2 Nothing)] model <<@ FullScreen))\r
+                     ,publish "/grid"            (WebApp []) (const (viewInformation "Grid"            [imageView grid_layouts       (const2 Nothing)] model <<@ FullScreen))\r
+                     ,publish "/box"             (WebApp []) (const (viewInformation "Box"             [imageView box2               (const2 Nothing)] model <<@ FullScreen))\r
+                     ,publish "/rose"            (WebApp []) (const (viewInformation "Rose"            [imageView rose               (const2 Nothing)] model <<@ FullScreen))\r
+                     ,publish "/onclick"         (WebApp []) (const (updateInformation "On-Click"    [imageUpdate id count (\_ _ -> Nothing) (\_ n -> n) ] 0 <<@ FullScreen))\r
+                     ,publish "/100percent"      (WebApp []) (const (viewInformation "100% Clean!"     [imageView clean              (const2 Nothing)] model <<@ FullScreen))\r
+                     ] world\r
+where\r
+       model = ()                                                              // for these examples, the model is actually irrelevant\r
+\r
+//     This examples displays the basic Image shapes\r
+basic_images :: m *TagSource -> Image m\r
+basic_images model tags\r
+       = margin (px zero,px 100.0,px zero,px zero) (\r
+           grid (Columns 3) (RowMajor,LeftToRight,TopToBottom) (updateAt 6 (AtLeft,AtMiddleY) (repeat (AtLeft,AtTop))) []\r
+              [ above [] [] [empty (px 200.0) (px 100.0),    txts ["empty (px 200.0) (px 100.0)"]] Nothing\r
+              , above [] [] [margin (px zero,px 5.0,px zero,px 5.0) (rect  (px 200.0) (px 100.0))\r
+                                                           , txts ["rect (px 200.0) (px 100.0)"]] Nothing\r
+              , above [] [] [rect  (px 200.0) (px 100.0) <@< {fill = toSVGColor "none"}\r
+                                                           , txts ["rect (px 200.0) (px 100.0)"\r
+                                                                  ,"<@< {fill = toSVGColor \"none\"}"\r
+                                                                  ]] Nothing\r
+              , above [] [] [circle  (px 100.0),             txts ["circle (px 100.0)"]] Nothing\r
+              , above [] [] [ellipse (px 200.0) (px 100.0),  txts ["ellipse (px 200.0) (px 100.0)"]] Nothing\r
+              , above [] [] [overlay [] [] \r
+                                [text (normalFontDef "Times New Roman" 100.0) "Hey World!"]\r
+                                (Just (empty (px 200.0) (px 100.0)))\r
+                                                           , txts ["text (normalFontDef \"Times New Roman\" 100.0) \"Hey World!\""]] Nothing\r
+              , above [] [] [xline Nothing (px 200.0),       txts ["xline Nothing (px 200.0)"]] Nothing\r
+              , above [AtMiddleX] [] [yline Nothing (px 100.0),       txts ["yline Nothing (px 100.0)"]] Nothing\r
+              , above [] [] [line Nothing Slash (px 200.0) (px 100.0)\r
+                                                           , txts ["line Nothing Slash (px 200.0) (px 100.0)"]] Nothing\r
+              , above [] [] [line Nothing Backslash (px 200.0) (px 100.0)\r
+                                                           , txts ["line Nothing Backslash (px 200.0) (px 100.0)"]] Nothing\r
+              , above [] [] [polygon  Nothing [(zero,zero),(px 200.0,px 100.0),(px 200.0,zero),(zero,px 100.0)]\r
+                                                           , txts ["polygon Nothing"\r
+                                                                  ,"        [(zero,    zero    )"\r
+                                                                  ,"        ,(px 200.0,px 100.0)"\r
+                                                                  ,"        ,(px 200.0,zero    )"\r
+                                                                  ,"        ,(zero,    px 100.0)]"]] Nothing\r
+              , above [] [] [polyline Nothing [(zero,zero),(px 200.0,px 100.0),(px 200.0,zero),(zero,px 100.0)]\r
+                                                           , txts ["polyline Nothing"\r
+                                                                  ,"         [(zero,    zero    )"\r
+                                                                  ,"         ,(px 200.0,px 100.0)"\r
+                                                                  ,"         ,(px 200.0,zero    )"\r
+                                                                  ,"         ,(zero,    px 100.0)]"]] Nothing\r
+              ] Nothing\r
+         )\r
+where\r
+       txts lines = margin (px 5.0,px 10.0,px 10.0,px 10.0) (above [] [] (map (text (normalFontDef "Lucida Console"  10.0)) lines) Nothing)\r
+\r
+//  This examples shows all possible transformations on (composite) Image-s:\r
+transformed_images :: m *TagSource -> Image m\r
+transformed_images model tags\r
+       = margin (px 100.0) (\r
+           grid (Columns 4) (RowMajor,LeftToRight,TopToBottom) [] []\r
+              [ above (repeat AtMiddleX) [] [img,                    txt "img"]                           Nothing\r
+              , above (repeat AtMiddleX) [] [fit    (px  100.0) \r
+                                                    (px  100.0) img, txt "fit (px 100.0) (px 100.0) img"] Nothing\r
+              , above (repeat AtMiddleX) [] [fitx   (px  100.0) img, txt "fitx (px 100.0) img"]           Nothing\r
+              , above (repeat AtMiddleX) [] [fity   (px  100.0) img, txt "fity (px 100.0) img"]           Nothing\r
+              , above (repeat AtMiddleX) [] [rotate (deg -20.0) img, txt "rotate (deg -20.0) img"]        Nothing\r
+              , above (repeat AtMiddleX) [] [rotate (deg  20.0) img, txt "rotate (deg 20.0) img"]         Nothing\r
+              , above (repeat AtMiddleX) [] [skewx  (deg -20.0) img, txt "skewx (deg -20.0) img"]         Nothing\r
+              , above (repeat AtMiddleX) [] [skewx  (deg  20.0) img, txt "skewx (deg 20.0) img"]          Nothing\r
+              , above (repeat AtMiddleX) [] [flipx              img, txt "flipx img"]                     Nothing\r
+              , above (repeat AtMiddleX) [] [flipy              img, txt "flipy img"]                     Nothing\r
+              , above (repeat AtMiddleX) [] [skewy (deg -20.0)  img, txt "skewy (deg -20.0) img"]         Nothing\r
+              , above (repeat AtMiddleX) [] [skewy (deg  20.0)  img, txt "skewy (deg 20.0) img"]          Nothing\r
+              ] Nothing\r
+         )\r
+where\r
+       img   = text (normalFontDef "Times New Roman" 50.0) "F"\r
+       txt s = text (normalFontDef "Lucida Console"  10.0) s\r
+\r
+//     This example shows all overlay-combinations:\r
+overlays :: m *TagSource -> Image m\r
+overlays model tags\r
+       = margin (px 10.0) (\r
+            grid (Rows 3) (RowMajor,LeftToRight,TopToBottom) [] []\r
+               [ beside (repeat AtMiddleY) [] \r
+                        [ margin (px 5.0) (overlay (repeat (x_align,y_align)) [] discs Nothing)\r
+                        , txt ("(" <+++ x_align <+++ "," <+++ y_align <+++ ")*")\r
+                        ] Nothing\r
+               \\ x_align <- [AtLeft,AtMiddleX,AtRight]\r
+                , y_align <- [AtTop, AtMiddleY,AtBottom]\r
+               ] Nothing\r
+         )\r
+where\r
+       txt s = text (normalFontDef "Lucida Console"  10.0) s\r
+\r
+//     This example shows all beside and above combinations:\r
+linear :: m *TagSource -> Image m\r
+linear model tags\r
+       = margin (px 10.0) (\r
+            beside (repeat AtTop) []\r
+                [ beside (repeat AtMiddleY) []\r
+                     [ txt "  beside  " <@< {stroke = toSVGColor "blue"} <@< {fill = toSVGColor "blue"}\r
+                     , above (repeat AtLeft) []\r
+                         [ beside (repeat AtMiddleY) [] [ beside (repeat y_align) [] discs Nothing\r
+                                                        , txt ("  " <+++ y_align <+++ "*")\r
+                                                        ] Nothing\r
+                         \\ y_align <- [AtTop,AtMiddleY,AtBottom]\r
+                         ] Nothing\r
+                     ] Nothing\r
+                , beside (repeat AtMiddleY) []\r
+                     [ txt "  above  " <@< {stroke = toSVGColor "blue"} <@< {fill = toSVGColor "blue"}\r
+                     , beside (repeat AtTop) []\r
+                         [ above (repeat AtMiddleX) [] [ txt ("  " <+++ x_align <+++ "*")\r
+                                                       , above (repeat x_align) [] discs Nothing\r
+                                                       ] Nothing\r
+                         \\ x_align <- [AtLeft,AtMiddleX,AtRight]\r
+                         ] Nothing\r
+                     ] Nothing\r
+                ] Nothing\r
+         )\r
+where\r
+       txt s = text (normalFontDef "Lucida Console"  10.0) s\r
+\r
+//     This example shows all grid-layout combinations:\r
+grid_layouts :: m *TagSource -> Image m\r
+grid_layouts model tags\r
+       = margin (px zero) (\r
+            grid (Columns 4) (RowMajor,LeftToRight,TopToBottom) [] []\r
+               [  above (repeat AtMiddleX) []\r
+                     [ margin (px 5.0,px zero) (grid (Columns 2) (major,x_fill,y_fill) [] [] discs Nothing)\r
+                     , txt (" (" <+++ major <+++ "," <+++ x_fill <+++ "," <+++ y_fill <+++ ") ")\r
+                     ] Nothing\r
+               \\ major  <- [ColumnMajor,RowMajor   ]\r
+                , x_fill <- [LeftToRight,RightToLeft]\r
+                , y_fill <- [TopToBottom,BottomToTop]\r
+               ] Nothing\r
+         )\r
+where\r
+       txt s = text (normalFontDef "Lucida Console"  10.0) s\r
+\r
+//     This example shows the use of ImageTag to display two images inside a rectangle that depends on each others dimensions:\r
+box2 :: m *TagSource -> Image m\r
+box2 _ tags = pair (arrow, rotate (deg -90.0) arrow) tags\r
+where\r
+       arrow = polygon Nothing [(px zero,px -10.0),(px 55.0,px -10.0),(px 50.0,px -30.0),(px 85.0,px zero)\r
+                               ,(px 50.0,px  30.0),(px 55.0,px  10.0),(px zero,px  10.0)\r
+                               ]\r
+\r
+//     This example shows the use of ImageTag to display an arbitrary rose tree structure:\r
+rose :: m *TagSource -> Image m\r
+rose _ tags = fst (show show_my_node my_rose_tree tags)\r
+where\r
+       show_my_node txt ts\r
+               = (margin (px zero,px zero,px bottom,px zero) (\r
+                     overlay [(AtMiddleX,AtMiddleY)] []\r
+                         [text font txt]\r
+                         (Just (rect (textxspan font txt + textxspan font "MM") (px (height + text_y_margin)) <@< {fill = toSVGColor "white"})))\r
+                 , ts\r
+                 )\r
+       where\r
+               font          = normalFontDef "Arial" height\r
+               height        = 10.0\r
+               text_y_margin = 5.0\r
+               bottom        = 5.0\r
+\r
+//     This examples displays the number of times that you've clicked on the text\r
+count :: Int *TagSource -> Image Int\r
+count n _\r
+       = margin (px zero) (\r
+           overlay [(AtMiddleX,AtMiddleY)] [] \r
+              [ text font (toString n) <@< {fill = toSVGColor "white"}]\r
+              (Just (rect (textxspan font ("  " <+++ n)) (px (h + m))))\r
+              <@< {onclick = (+), local = False}\r
+         )\r
+where\r
+       font = normalFontDef "Times New Roman" h\r
+       h    = 100.0\r
+       m    = 6.0\r
+\r
+//     This example shows an image displayed by Marc Schoolderman during 'practicum' friday afternoon, may 22 2015\r
+clean :: m *TagSource -> Image m\r
+clean model tags\r
+       = overlay (repeat (AtMiddleX,AtMiddleY)) []\r
+            [ star 31 (r_in,r_out)\r
+            , circle (px r_in *. 1.6) <@< {strokewidth = px bandwidth} <@< {stroke = toSVGColor "white"}\r
+            , rotate (rad (pi * 0.25)) (circular (px r_in *. 0.8) (2.0 * pi) (repeatn 4 (circle (px bandwidth *. 0.8))))\r
+            , rotate (rad (pi * 0.32)) (circular (px zero)        (2.0 * pi) (map (arctext (px r_in *. 0.78) (0.4 * pi) narrowfont) ["NO VIRUSES","NO SPYWARE","NO VIRUSES","NO SPYWARE"]))\r
+            , above (repeat AtMiddleX) [] (map (((>@>) {fill = toSVGColor "white"}) o ((>@>) {stroke = toSVGColor "white"}) o (text bigfont)) ["100%", "CLEAN"]) Nothing\r
+            ] Nothing\r
+where\r
+       r_out      = 100.0\r
+       r_in       = 90.0\r
+       bandwidth  = r_in * 0.2\r
+       bigfont    = {normalFontDef "Arial"        (r_in * 0.35) & fontweight = "bolder"}\r
+       narrowfont =  normalFontDef "Arial Narrow" (r_in * 0.22)\r
+\r
+star :: Int (Real,Real) -> Image m\r
+star n (r_in,r_out)\r
+       = polygon Nothing (flatten \r
+            [  [(px r_out *. (cos (angle * (toReal outer_corner))), px r_out *. (sin (angle * (toReal outer_corner))))\r
+               ,(px r_in  *. (cos (angle * (toReal inner_corner))), px r_in  *. (sin (angle * (toReal inner_corner))))\r
+               ]\r
+            \\ outer_corner <- [0, 2 .. 2*n], let inner_corner = outer_corner+1\r
+            ])\r
+where\r
+       angle = pi / (toReal n)\r
+\r
+arctext :: Span Real FontDef String -> Image m\r
+arctext r a font txt\r
+       = circular r a [rotate (rad pi) (text font (toString c)) \\ c <-: txt]\r
+\r
+pair :: (Image m,Image m) *TagSource -> Image m\r
+pair (img1,img2) [(t1,ut1),(t2,ut2):tags]\r
+       = beside [] []\r
+             [overlay [(AtMiddleX,AtMiddleY)] [] [tag ut1 img1] host\r
+             ,overlay [(AtMiddleX,AtMiddleY)] [] [tag ut2 img2] host\r
+             ] Nothing\r
+where\r
+       (w1,h1) = (imagexspan t1,imageyspan t1)\r
+       (w2,h2) = (imagexspan t2,imageyspan t2)\r
+       host    = Just (rect (maxSpan [w1,w2]) (maxSpan [h1,h2]) <@< {fill = toSVGColor "none"})\r
+\r
+show :: (a -> St *TagSource (Image m)) (Rose a) -> St *TagSource (Image m)\r
+show show_node (Rose r []) \r
+       = show_node r\r
+show show_node (Rose r rs) \r
+       = \[(t1,ut1), (t2,ut2) : ts] ->\r
+               let (image,  ts1) = show_node r ts\r
+                   (images, ts2) = seqList (map (show show_node) rs) ts1\r
+                in ( above (repeat AtLeft) []\r
+                         [ image\r
+                         , beside (repeat AtTop) []\r
+                                  [ yline Nothing (imageyspan t1 - imageyspan t2)\r
+                                  , tag ut1 \r
+                                       (grid (Columns 2) (ColumnMajor,LeftToRight,TopToBottom) [] []\r
+                                             (repeatn (length rs) (xline Nothing (px 10.0)) ++ init images ++ [tag ut2 (last images)])\r
+                                             Nothing\r
+                                       ) \r
+                                  ] Nothing \r
+                         ] Nothing\r
+                   , ts2\r
+                   )\r
+\r
+\r
+discs :: [Image m]\r
+discs = [circle (px 15.0 + px 8.0 *. d) <@< {fill = toSVGColor {r=255-d*25,g=210-d*70,b=210-d*70}} \\ d <- [3,2,1,0]]\r
+\r
+derive gText XAlign, YAlign, GridMajor, GridXLayout, GridYLayout\r
+\r
+:: Rose a = Rose a [Rose a]\r
+\r
+from StdFunc import const, seqList, :: St(..)\r
+\r
+my_rose_tree :: Rose String\r
+my_rose_tree = Rose "Clean 2.2 Language Report" \r
+                  [Rose "BASIC SEMANTICS" \r
+                      [Rose "Graph Rewriting" \r
+                          [Rose "A Small Example" []]\r
+                      ,Rose "Global Graphs" []\r
+                      ]\r
+                  ,Rose "MODULES AND SCOPES"\r
+                      [Rose "Identifiers, Scopes and Name Spaces" \r
+                          [Rose "Naming Conventions of Identifiers" []\r
+                          ,Rose "Scopes and Name Spaces" []\r
+                          ,Rose "Nesting of Scopes" []\r
+                          ]\r
+                      ,Rose "Modular Structure of Clean Programs" []\r
+                      ,Rose "Implementation Modules" \r
+                          [Rose "The Main or Start Module" []\r
+                          ,Rose "Scope of Global Definitions in Implementation Modules" []\r
+                          ,Rose "Begin and End of a Definition: the Layout Rule" []\r
+                          ]\r
+                      ,Rose "Definition Modules" []\r
+                      ,Rose "Importing Definitions" \r
+                          [Rose "Explicit Imports of Definitions" []\r
+                          ,Rose "Implicit Imports of Definitions" []\r
+                          ]\r
+                      ,Rose "System Definition and Implementation Modules" []\r
+                      ]\r
+                  ,Rose "DEFINING FUNCTIONS AND CONSTANTS"\r
+                      [Rose "Functions" []\r
+                      ,Rose "Patterns" []\r
+                      ,Rose "Guards" []\r
+                      ,Rose "Expressions"\r
+                          [Rose "Lambda Abstraction" []\r
+                          ,Rose "Case Expression and Conditional Expression" []\r
+                          ]\r
+                      ,Rose "Local Definitions" \r
+                          [Rose "Let Expression: Local Definitions in Expressions" []\r
+                          ,Rose "Where Block: Local Definitions in a Function Alternative" []\r
+                          ,Rose "With Block: Local Definitions in a Guarded Alternative" []\r
+                          ,Rose "Let-Before Expression: Local Constants defined between Guards" []\r
+                          ]\r
+                      ,Rose "Defining Constants" \r
+                          [Rose "Selectors" []]\r
+                      ,Rose "Typing Functions" \r
+                          [Rose "Typing Curried Functions" []\r
+                          ,Rose "Typing Operators" []\r
+                          ,Rose "Typing Partial Functions" []\r
+                          ,Rose "Explicit use of the Universal Quantifier in Function Types" []\r
+                          ,Rose "Functions with Strict Arguments" []\r
+                          ]\r
+                      ]\r
+                  ,Rose "PREDEFINED TYPES"\r
+                      [Rose "Basic Types: Int, Real, Char and Bool" \r
+                          [Rose "Creating Constant Values of Basic Types" []\r
+                          ,Rose "Patterns of Basic Types" []\r
+                          ]\r
+                      ,Rose "Lists" \r
+                          [Rose "Creating Lists" []\r
+                          ,Rose "List Patterns" []\r
+                          ]\r
+                      ,Rose "Tuples" \r
+                          [Rose "Creating Tuples" []\r
+                          ,Rose "Tuple Patterns" []\r
+                          ]\r
+                      ,Rose "Arrays" \r
+                          [Rose "Creating Arrays and Selection of field Elements" []\r
+                          ,Rose "Array Patterns" []\r
+                          ]\r
+                      ,Rose "Predefined Type Constructors" []\r
+                      ,Rose "Arrow Types" []\r
+                      ,Rose "Predefined Abstract Types" []\r
+                      ]\r
+                  ,Rose "DEFINING NEW TYPES"\r
+                      [Rose "Defining Algebraic Data Types" \r
+                          [Rose "Using Constructors in Patterns" []\r
+                          ,Rose "Using Higher Order Types" []\r
+                          ,Rose "Defining Algebraic Data Types with Existentially Quantified Variables" []\r
+                          ,Rose "Defining Algebraic Data Types with Universally Quantified Variables" []\r
+                          ,Rose "Strictness Annotations in Type Definitions" []\r
+                          ,Rose "Semantic Restrictions on Algebraic Data Types" []\r
+                          ]\r
+                      ,Rose "Defining Record Types"\r
+                          [Rose "Creating Records and Selection of Record Fields" []\r
+                          ,Rose "Record Patterns" []\r
+                          ]\r
+                      ,Rose "Defining Synomym Types" []\r
+                      ,Rose "Defining Abstract Data Types" \r
+                          [Rose "Defining Abstract Data Types with Synonym Type Definition" []]\r
+                      ]\r
+                  ,Rose "OVERLOADING"\r
+                      [Rose "Type Classes" []\r
+                      ,Rose "Functions Defined in Terms of Overloaded Functions" []\r
+                      ,Rose "Instances of Type Classes Defined in Terms of Overloaded Functions" []\r
+                      ,Rose "Type Constructor Classes" []\r
+                      ,Rose "Overlapping Instances" []\r
+                      ,Rose "Internal Overloading" []\r
+                      ,Rose "Defining Derived Members in a Class" []\r
+                      ,Rose "A Shorthand for Defining Overloaded Functions" []\r
+                      ,Rose "Classes Defined in Terms of Other Classes" []\r
+                      ,Rose "Exporting Type Classes" []\r
+                      ,Rose "Semantic Restrictions on Type Classes" []\r
+                      ]\r
+                  ,Rose "GENERIC PROGRAMMING"\r
+                      [Rose "Basic Ideas Behing Generic Programming" []\r
+                      ,Rose "Defining Generic Functions" []\r
+                      ,Rose "Deriving Generic Functions" []\r
+                      ,Rose "Applying Generic Functions" []\r
+                      ,Rose "Using Constructor Information" []\r
+                      ,Rose "Generic Functions and Uniqueness Typing" []\r
+                      ,Rose "Exporting Generic Functions" []\r
+                      ]\r
+                  ,Rose "DYNAMICS"\r
+                      [Rose "Packing Expressions into a Dynamic" \r
+                          [Rose "Packing Abstract Data Types" []\r
+                          ,Rose "Packing Overloaded Functions" []\r
+                          ,Rose "Packing Expressions of Unique Type" []\r
+                          ,Rose "Packing Arguments of Unknown Type" []\r
+                          ,Rose "Using Dynamic Typing to Defeat the Static Type System" []\r
+                          ]\r
+                      ,Rose "Unpacking Dynamics Using a Dynamic Pattern Match" \r
+                          [Rose "Unpacking Abstract Data Types" []\r
+                          ,Rose "Unpacking of Overloaded Functions" []\r
+                          ,Rose "Unpacking Expressions of Unique Type" []\r
+                          ,Rose "Checking and Unifying Types Schemes using Type Pattern Variables" []\r
+                          ,Rose "Checking and Unifying Unknown Types using Overloaded Type Variables" []\r
+                          ]\r
+                      ,Rose "Type Safe Communication using Dynamics" []\r
+                      ,Rose "Architecture of the implementation" []\r
+                      ,Rose "Semantic Restrictions on Dynamics" []\r
+                      ]\r
+                  ,Rose "UNIQUENESS TYPING"\r
+                      [Rose "Basic Ideas behind Uniqueness Typing" []\r
+                      ,Rose "Attribute Propagation" []\r
+                      ,Rose "Defining New Types with Uniqueness Attributes" []\r
+                      ,Rose "Uniqueness and Sharing" \r
+                          [Rose "Higher Order Uniqueness Typing" []\r
+                          ,Rose "Uniqueness Type Coercions" []\r
+                          ]\r
+                      ,Rose "Combining Uniqueness Typing and Overloading" \r
+                          [Rose "Constructor Classes" []]\r
+                      ,Rose "Higher-Order Type Definitions" []\r
+                      ,Rose "Destructive Updates using Uniqueness Typing" []\r
+                      ]\r
+                  ,Rose "STRICTNESS, MACROS AND EFFICIENCY"\r
+                      [Rose "Annotations to Change Lazy Evaluation into Strict Evaluation" \r
+                          [Rose "Advantages and Disadvantages of Lazy versus Strict Evaluation" []\r
+                          ,Rose "Strict and Lazy Context" []\r
+                          ,Rose "Space Consumption in Strict and Lazy Context" []\r
+                          ,Rose "Time Consumption in Strict and Lazy Context" []\r
+                          ,Rose "Changing Lazy into Strict Evaluation" []\r
+                          ]\r
+                      ,Rose "Defining Graphs on the Global Level" []\r
+                      ,Rose "Defining Macros" []\r
+                      ,Rose "Efficiency Tips" []\r
+                      ]\r
+                  ,Rose "FOREIGN LANGUAGE INTERFACE"\r
+                      [Rose "Foreign Export" []\r
+                      ,Rose "Using ABC instructions" []\r
+                      ]\r
+                  ]\r
+\r
+\r
+//     a generally useful image combinator:\r
+circular :: !Span !Real ![Image m] -> Image m\r
+circular r a imgs\r
+  #! n      = length imgs\r
+  #! sign_a = toReal (sign a)\r
+  #! a`     = normalize (rad a)\r
+  #! alpha  = (toRad a`) / (toReal n)\r
+  = overlay (repeat (AtMiddleX,AtMiddleY))\r
+                    [(~r *. cos angle,~r *. sin angle) \\ i <- [0.0, sign_a ..], angle <- [i*alpha - 0.5*pi]]\r
+                    [rotate (rad (i*alpha)) img \\ i <- [0.0, sign_a ..] & img <- imgs]\r
+                    (Just (empty (r *. 2) (r *. 2)))              // BUG: using Nothing creates incorrect image (offset to left)\r
+\r
+pi =: 3.14159265359\r
diff --git a/fp2/week6/mart/SimpleSVG.prj b/fp2/week6/mart/SimpleSVG.prj
new file mode 100644 (file)
index 0000000..3c9346a
--- /dev/null
@@ -0,0 +1,56 @@
+Version: 1.4
+Global
+       ProjectRoot:    .
+       Target: StdEnv
+       Exec:   {Project}/SimpleSVG.exe
+       CodeGen
+               CheckStacks:    False
+               CheckIndexes:   True
+       Application
+               HeapSize:       2097152
+               StackSize:      512000
+               ExtraMemory:    8192
+               IntialHeapSize: 204800
+               HeapSizeMultiplier:     4096
+               ShowExecutionTime:      False
+               ShowGC: False
+               ShowStackSize:  False
+               MarkingCollector:       False
+               DisableRTSFlags:        False
+               StandardRuntimeEnv:     True
+               Profile
+                       Memory: False
+                       MemoryMinimumHeapSize:  0
+                       Time:   False
+                       Stack:  False
+               Output
+                       Output: ShowConstructors
+                       Font:   Monaco
+                       FontSize:       9
+                       WriteStdErr:    False
+       Link
+               LinkMethod:     Static
+               GenerateRelocations:    False
+               GenerateLinkMap:        False
+               LinkResources:  False
+               ResourceSource: 
+               GenerateDLL:    False
+               ExportedNames:  
+       Paths
+               Path:   {Project}
+       Precompile:     
+       Postlink:       
+MainModule
+       Name:   SimpleSVG
+       Dir:    {Project}
+       Compiler
+               NeverMemoryProfile:     False
+               NeverTimeProfile:       False
+               StrictnessAnalysis:     True
+               ListTypes:      StrictExportTypes
+               ListAttributes: True
+               Warnings:       True
+               Verbose:        True
+               ReadableABC:    False
+               ReuseUniqueNodes:       True
+               Fusion: False