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