hoi

[fp1415.git] / fp2 / week6 / mart / BinSearchTreeImage.icl

diff --git a/fp2/week6/mart/BinSearchTreeImage.icl b/fp2/week6/mart/BinSearchTreeImage.icl
new file mode 100755 (executable)
index 0000000..9b93810
--- /dev/null
+++ b/fp2/week6/mart/BinSearchTreeImage.icl
@@ -0,0 +1,71 @@
+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    = fst(treeImage (foldl (flip insertTree) BLeaf nrs) tags)\r
+\r
+TMargin = 10.0\r
+\r
+treeImage                      :: (BTree Int) *TagSource -> (Image m, *TagSource)\r
+treeImage BLeaf ts = (margin (px TMargin) (circle (px fonthoogte)), ts)\r
+treeImage (BNode x t1 t2) [(tg1, utg1),(tg2, utg2):ts]\r
+= (above (repeat AtMiddleX) [] [textbox, lines, subtrees] Nothing, ts2)\r
+       where\r
+               (i1, ts1) = treeImage t1 ts\r
+               (i2, ts2) = treeImage t2 ts1\r
+               subtrees = beside (repeat AtTop) [] [tag utg1 i1, tag utg2 i2] Nothing\r
+               box = rect (textxspan font (toString x)) (px fonthoogte) <@< {fill=toSVGColor "none"}\r
+               textbox = overlay (repeat (AtMiddleX, AtMiddleY)) [] [box, text font (toString x)] Nothing\r
+               lines = beside (repeat AtBottom) [] [\r
+                       line Nothing Slash ((imagexspan tg1) /. 2) (px TMargin),\r
+                       line Nothing Backslash ((imagexspan tg2) /. 2) (px TMargin)] Nothing\r
+\r