From: Mart Lubbers Date: Tue, 26 May 2015 18:17:55 +0000 (+0200) Subject: initial week 6 commit X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=eae6512719b20ad71e93c957581db3c744570ba9;p=fp1415.git initial week 6 commit --- diff --git a/fp2/week6/mart/BinSearchTreeImage.icl b/fp2/week6/mart/BinSearchTreeImage.icl new file mode 100644 index 0000000..1662608 --- /dev/null +++ b/fp2/week6/mart/BinSearchTreeImage.icl @@ -0,0 +1,57 @@ +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 new file mode 100644 index 0000000..8e6284a --- /dev/null +++ b/fp2/week6/mart/GuessWhat.icl @@ -0,0 +1,96 @@ +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 new file mode 100644 index 0000000..051640d --- /dev/null +++ b/fp2/week6/mart/QA.dcl @@ -0,0 +1,5 @@ +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 new file mode 100644 index 0000000..1f0b13d --- /dev/null +++ b/fp2/week6/mart/QA.icl @@ -0,0 +1,3 @@ +implementation module QA + +import Graphics.Scalable diff --git a/fp2/week6/mart/QA_shapes.dcl b/fp2/week6/mart/QA_shapes.dcl new file mode 100644 index 0000000..14664fc --- /dev/null +++ b/fp2/week6/mart/QA_shapes.dcl @@ -0,0 +1,5 @@ +definition module QA_shapes + +import QA + +queries :: [QA] diff --git a/fp2/week6/mart/QA_shapes.icl b/fp2/week6/mart/QA_shapes.icl new file mode 100644 index 0000000..fdb1a54 --- /dev/null +++ b/fp2/week6/mart/QA_shapes.icl @@ -0,0 +1,27 @@ +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 new file mode 100644 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 index 0000000..38544b1 --- /dev/null +++ b/fp2/week6/mart/SimpleSVG.icl @@ -0,0 +1,454 @@ +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 diff --git a/fp2/week6/mart/SimpleSVG.prj b/fp2/week6/mart/SimpleSVG.prj new file mode 100644 index 0000000..3c9346a --- /dev/null +++ b/fp2/week6/mart/SimpleSVG.prj @@ -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