fp2/week6/camil/BinSearchTreeImage.icl

   1 module BinSearchTreeImage
   2
   3 /* Instructions:
   4
   5 (1) copy BinTree.(i/d)cl and BinSearchTree.(i/d)cl from Practicum to
   6     {iTasks-SDK}\Experiments\SVG_tests\
   7
   8 (2) in these modules change the type
   9
  10     :: Tree a = Node a (Tree a) (Tree a) | Leaf
  11
  12     to
  13
  14     :: BTree a = BLeaf | BNode a (BTree a) (BTree a)    // ORDER OF DATACONSTRUCTORS IS ESSENTIAL!!
  15
  16     and adapt the corresponding function definitions.
  17
  18 (3) this main file (BinSearchTreeImage.icl) must be in the same folder:
  19     {iTasks-SDK}\Experiments\SVG_tests\
  20
  21 (4) create a new project and set de environment to 'iTasks'
  22
  23 (5) Bring-Up-To-Date and start generated application
  24
  25 (6) Open a browser and navigate to localhost.
  26     The application creates two tasks:
  27     (a) The task on the left allows you to enter subsequent elements that are inserted in the tree, one after another.
  28     (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
  29         that Nodes of the same depth have the same y-coordinate, and the root having the smallest y-coordinate.
  30 */
  31
  32 import iTasks                                                           // de algemene iTask API
  33 import iTasks.API.Extensions.SVG.SVGlet         // specialiseer task editors
  34 from   StdFunc import flip
  35
  36 import BinSearchTree                                            // type definition of Tree and sample trees z0 .. z8
  37 derive class iTask BTree
  38
  39 Start                           :: *World -> *World
  40 Start world                     = startEngine [publish "/" (WebApp []) (\_ -> task)] world
  41
  42 task                            :: Task [Int]
  43 task                            = withShared [] (\sharedList ->
  44                                                 (  (updateSharedInformation (Title "Edit list") [] sharedList <<@ ArrangeHorizontal)
  45                                                    -||-
  46                                                    (viewSharedInformation (Title "Tree view") [imageView treeImage` (\_ _ -> Nothing)] sharedList <<@ ArrangeHorizontal)
  47                                                 ) <<@ ArrangeHorizontal
  48                                           ) <<@ FullScreen
  49
  50 font                            = normalFontDef "Courier New" fonthoogte
  51 fonthoogte                      = 14.0
  52
  53 treeImage`                      :: [Int] *TagSource -> Image m
  54 treeImage` nrs tags     = fst(treeImage (foldl (flip insertTree) BLeaf nrs) tags)
  55
  56 TMargin = 10.0
  57
  58 treeImage                       :: (BTree Int) *TagSource -> (Image m, *TagSource)
  59 treeImage BLeaf ts = (margin (px zero, px TMargin) (circle (px fonthoogte)), ts)
  60 treeImage (BNode x t1 t2) [(tg1, utg1),(tg2, utg2):ts]
  61 = (above (repeat AtMiddleX) [] [textbox, lines, subtrees] Nothing, ts2)
  62         where
  63                 (i1, ts1) = treeImage t1 ts
  64                 (i2, ts2) = treeImage t2 ts1
  65                 subtrees = beside (repeat AtTop) [] [tag utg1 i1, tag utg2 i2] Nothing
  66                 box = rect (textxspan font (toString x)) (px fonthoogte) <@< {fill=toSVGColor "none"}
  67                 lines_with_subtrees = above (repeat AtMiddleX) [] [lines, subtrees] Nothing
  68                 textbox = overlay (repeat (AtMiddleX, AtMiddleY)) [] [box, text font (toString x)] Nothing
  69                 lines = beside (repeat AtBottom) [] [
  70                         empty (((imagexspan tg1) /. 2) - ((imagexspan tg2) /. 2)) (px TMargin), // ignored if negative
  71                         line Nothing Slash ((imagexspan tg2) /. 2) (px TMargin),
  72                         line Nothing Backslash ((imagexspan tg1) /. 2) (px TMargin),
  73                         empty (((imagexspan tg2) /. 2) - ((imagexspan tg1) /. 2)) (px TMargin)] // ignored if negative
  74                         Nothing
  75