diff options
Diffstat (limited to 'fp2/week6/camil/BinSearchTreeImage.icl')
-rw-r--r-- | fp2/week6/camil/BinSearchTreeImage.icl | 75 |
1 files changed, 75 insertions, 0 deletions
diff --git a/fp2/week6/camil/BinSearchTreeImage.icl b/fp2/week6/camil/BinSearchTreeImage.icl new file mode 100644 index 0000000..00ae8b1 --- /dev/null +++ b/fp2/week6/camil/BinSearchTreeImage.icl @@ -0,0 +1,75 @@ +module BinSearchTreeImage + +/* Instructions: + +(1) copy BinTree.(i/d)cl and BinSearchTree.(i/d)cl from Practicum to + {iTasks-SDK}\Experiments\SVG_tests\ + +(2) in these modules change the type + + :: Tree a = Node a (Tree a) (Tree a) | Leaf + + to + + :: BTree a = BLeaf | BNode a (BTree a) (BTree a) // ORDER OF DATACONSTRUCTORS IS ESSENTIAL!! + + and adapt the corresponding function definitions. + +(3) this main file (BinSearchTreeImage.icl) must be in the same folder: + {iTasks-SDK}\Experiments\SVG_tests\ + +(4) create a new project and set de environment to 'iTasks' + +(5) Bring-Up-To-Date and start generated application + +(6) Open a browser and navigate to localhost. + The application creates two tasks: + (a) The task on the left allows you to enter subsequent elements that are inserted in the tree, one after another. + (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 + that Nodes of the same depth have the same y-coordinate, and the root having the smallest y-coordinate. +*/ + +import iTasks // de algemene iTask API +import iTasks.API.Extensions.SVG.SVGlet // specialiseer task editors +from StdFunc import flip + +import BinSearchTree // type definition of Tree and sample trees z0 .. z8 +derive class iTask BTree + +Start :: *World -> *World +Start world = startEngine [publish "/" (WebApp []) (\_ -> task)] world + +task :: Task [Int] +task = withShared [] (\sharedList -> + ( (updateSharedInformation (Title "Edit list") [] sharedList <<@ ArrangeHorizontal) + -||- + (viewSharedInformation (Title "Tree view") [imageView treeImage` (\_ _ -> Nothing)] sharedList <<@ ArrangeHorizontal) + ) <<@ ArrangeHorizontal + ) <<@ FullScreen + +font = normalFontDef "Courier New" fonthoogte +fonthoogte = 14.0 + +treeImage` :: [Int] *TagSource -> Image m +treeImage` nrs tags = fst(treeImage (foldl (flip insertTree) BLeaf nrs) tags) + +TMargin = 10.0 + +treeImage :: (BTree Int) *TagSource -> (Image m, *TagSource) +treeImage BLeaf ts = (margin (px zero, px TMargin) (circle (px fonthoogte)), ts) +treeImage (BNode x t1 t2) [(tg1, utg1),(tg2, utg2):ts] += (above (repeat AtMiddleX) [] [textbox, lines, subtrees] Nothing, ts2) + where + (i1, ts1) = treeImage t1 ts + (i2, ts2) = treeImage t2 ts1 + subtrees = beside (repeat AtTop) [] [tag utg1 i1, tag utg2 i2] Nothing + box = rect (textxspan font (toString x)) (px fonthoogte) <@< {fill=toSVGColor "none"} + lines_with_subtrees = above (repeat AtMiddleX) [] [lines, subtrees] Nothing + textbox = overlay (repeat (AtMiddleX, AtMiddleY)) [] [box, text font (toString x)] Nothing + lines = beside (repeat AtBottom) [] [ + empty (((imagexspan tg1) /. 2) - ((imagexspan tg2) /. 2)) (px TMargin), // ignored if negative + line Nothing Slash ((imagexspan tg2) /. 2) (px TMargin), + line Nothing Backslash ((imagexspan tg1) /. 2) (px TMargin), + empty (((imagexspan tg2) /. 2) - ((imagexspan tg1) /. 2)) (px TMargin)] // ignored if negative + Nothing + |