fp2/week6/mart/SimpleSVG.icl

   1 module SimpleSVG
   2
   3 /* How to create and test an iTask program:
   4    1. Install the iTask Clean compiler
   5    2. Create a new project with this module as main module
   6    3. Select the 'iTasks' environment
   7    4. Bring the project Up-Uo-Date
   8    5. Start the generated exe (this launches a local web server, allow your OS to unblock the exe)
   9    6. Open a web browser (Google Chrome gives the best results)
  10    7. Navigate to http://localhost/ activates the root-application (hello world)
  11    8. Navigate to http://localhost/LABEL activates the application with the corresponding LABEL (e.g. http://localhost/basic)
  12 */
  13
  14 import iTasks                                                           // the iTask API
  15 import iTasks.API.Extensions.SVG.SVGlet         // required to embed Image-tasks inside other tasks
  16 import StdArray
  17
  18 const2 :: .a .b .c -> .a
  19 const2 x _ _ = x
  20
  21 :: Person = {name :: String, surname :: String, birth :: Date}
  22 derive class iTask Person
  23
  24 person = {name = "Peter", surname = "Achten", birth = {day=9,mon=1,year=1967}}
  25
  26 Start :: *World -> *World
  27 Start world
  28         = startEngine [publish "/"                (WebApp []) (const (viewInformation "Hello" [] "World!"                                                     <<@ FullScreen))
  29                       ,publish "/basic"           (WebApp []) (const (viewInformation "Basic Images"    [imageView basic_images       (const2 Nothing)] model <<@ FullScreen))
  30                       ,publish "/transformations" (WebApp []) (const (viewInformation "Transformations" [imageView transformed_images (const2 Nothing)] model <<@ FullScreen))
  31                       ,publish "/overlays"        (WebApp []) (const (viewInformation "Overlays"        [imageView overlays           (const2 Nothing)] model <<@ FullScreen))
  32                       ,publish "/linear"          (WebApp []) (const (viewInformation "Linear"          [imageView linear             (const2 Nothing)] model <<@ FullScreen))
  33                       ,publish "/grid"            (WebApp []) (const (viewInformation "Grid"            [imageView grid_layouts       (const2 Nothing)] model <<@ FullScreen))
  34                       ,publish "/box"             (WebApp []) (const (viewInformation "Box"             [imageView box2               (const2 Nothing)] model <<@ FullScreen))
  35                       ,publish "/rose"            (WebApp []) (const (viewInformation "Rose"            [imageView rose               (const2 Nothing)] model <<@ FullScreen))
  36                       ,publish "/onclick"         (WebApp []) (const (updateInformation "On-Click"    [imageUpdate id count (\_ _ -> Nothing) (\_ n -> n) ] 0 <<@ FullScreen))
  37                       ,publish "/100percent"      (WebApp []) (const (viewInformation "100% Clean!"     [imageView clean              (const2 Nothing)] model <<@ FullScreen))
  38                       ] world
  39 where
  40         model = ()                                                              // for these examples, the model is actually irrelevant
  41
  42 //      This examples displays the basic Image shapes
  43 basic_images :: m *TagSource -> Image m
  44 basic_images model tags
  45         = margin (px zero,px 100.0,px zero,px zero) (
  46             grid (Columns 3) (RowMajor,LeftToRight,TopToBottom) (updateAt 6 (AtLeft,AtMiddleY) (repeat (AtLeft,AtTop))) []
  47                [ above [] [] [empty (px 200.0) (px 100.0),    txts ["empty (px 200.0) (px 100.0)"]] Nothing
  48                , above [] [] [margin (px zero,px 5.0,px zero,px 5.0) (rect  (px 200.0) (px 100.0))
  49                                                             , txts ["rect (px 200.0) (px 100.0)"]] Nothing
  50                , above [] [] [rect  (px 200.0) (px 100.0) <@< {fill = toSVGColor "none"}
  51                                                             , txts ["rect (px 200.0) (px 100.0)"
  52                                                                    ,"<@< {fill = toSVGColor \"none\"}"
  53                                                                    ]] Nothing
  54                , above [] [] [circle  (px 100.0),             txts ["circle (px 100.0)"]] Nothing
  55                , above [] [] [ellipse (px 200.0) (px 100.0),  txts ["ellipse (px 200.0) (px 100.0)"]] Nothing
  56                , above [] [] [overlay [] []
  57                                  [text (normalFontDef "Times New Roman" 100.0) "Hey World!"]
  58                                  (Just (empty (px 200.0) (px 100.0)))
  59                                                             , txts ["text (normalFontDef \"Times New Roman\" 100.0) \"Hey World!\""]] Nothing
  60                , above [] [] [xline Nothing (px 200.0),       txts ["xline Nothing (px 200.0)"]] Nothing
  61                , above [AtMiddleX] [] [yline Nothing (px 100.0),       txts ["yline Nothing (px 100.0)"]] Nothing
  62                , above [] [] [line Nothing Slash (px 200.0) (px 100.0)
  63                                                             , txts ["line Nothing Slash (px 200.0) (px 100.0)"]] Nothing
  64                , above [] [] [line Nothing Backslash (px 200.0) (px 100.0)
  65                                                             , txts ["line Nothing Backslash (px 200.0) (px 100.0)"]] Nothing
  66                , above [] [] [polygon  Nothing [(zero,zero),(px 200.0,px 100.0),(px 200.0,zero),(zero,px 100.0)]
  67                                                             , txts ["polygon Nothing"
  68                                                                    ,"        [(zero,    zero    )"
  69                                                                    ,"        ,(px 200.0,px 100.0)"
  70                                                                    ,"        ,(px 200.0,zero    )"
  71                                                                    ,"        ,(zero,    px 100.0)]"]] Nothing
  72                , above [] [] [polyline Nothing [(zero,zero),(px 200.0,px 100.0),(px 200.0,zero),(zero,px 100.0)]
  73                                                             , txts ["polyline Nothing"
  74                                                                    ,"         [(zero,    zero    )"
  75                                                                    ,"         ,(px 200.0,px 100.0)"
  76                                                                    ,"         ,(px 200.0,zero    )"
  77                                                                    ,"         ,(zero,    px 100.0)]"]] Nothing
  78                ] Nothing
  79           )
  80 where
  81         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)
  82
  83 //  This examples shows all possible transformations on (composite) Image-s:
  84 transformed_images :: m *TagSource -> Image m
  85 transformed_images model tags
  86         = margin (px 100.0) (
  87             grid (Columns 4) (RowMajor,LeftToRight,TopToBottom) [] []
  88                [ above (repeat AtMiddleX) [] [img,                    txt "img"]                           Nothing
  89                , above (repeat AtMiddleX) [] [fit    (px  100.0)
  90                                                      (px  100.0) img, txt "fit (px 100.0) (px 100.0) img"] Nothing
  91                , above (repeat AtMiddleX) [] [fitx   (px  100.0) img, txt "fitx (px 100.0) img"]           Nothing
  92                , above (repeat AtMiddleX) [] [fity   (px  100.0) img, txt "fity (px 100.0) img"]           Nothing
  93                , above (repeat AtMiddleX) [] [rotate (deg -20.0) img, txt "rotate (deg -20.0) img"]        Nothing
  94                , above (repeat AtMiddleX) [] [rotate (deg  20.0) img, txt "rotate (deg 20.0) img"]         Nothing
  95                , above (repeat AtMiddleX) [] [skewx  (deg -20.0) img, txt "skewx (deg -20.0) img"]         Nothing
  96                , above (repeat AtMiddleX) [] [skewx  (deg  20.0) img, txt "skewx (deg 20.0) img"]          Nothing
  97                , above (repeat AtMiddleX) [] [flipx              img, txt "flipx img"]                     Nothing
  98                , above (repeat AtMiddleX) [] [flipy              img, txt "flipy img"]                     Nothing
  99                , above (repeat AtMiddleX) [] [skewy (deg -20.0)  img, txt "skewy (deg -20.0) img"]         Nothing
 100                , above (repeat AtMiddleX) [] [skewy (deg  20.0)  img, txt "skewy (deg 20.0) img"]          Nothing
 101                ] Nothing
 102           )
 103 where
 104         img   = text (normalFontDef "Times New Roman" 50.0) "F"
 105         txt s = text (normalFontDef "Lucida Console"  10.0) s
 106
 107 //      This example shows all overlay-combinations:
 108 overlays :: m *TagSource -> Image m
 109 overlays model tags
 110         = margin (px 10.0) (
 111              grid (Rows 3) (RowMajor,LeftToRight,TopToBottom) [] []
 112                 [ beside (repeat AtMiddleY) []
 113                          [ margin (px 5.0) (overlay (repeat (x_align,y_align)) [] discs Nothing)
 114                          , txt ("(" <+++ x_align <+++ "," <+++ y_align <+++ ")*")
 115                          ] Nothing
 116                 \\ x_align <- [AtLeft,AtMiddleX,AtRight]
 117                  , y_align <- [AtTop, AtMiddleY,AtBottom]
 118                 ] Nothing
 119           )
 120 where
 121         txt s = text (normalFontDef "Lucida Console"  10.0) s
 122
 123 //      This example shows all beside and above combinations:
 124 linear :: m *TagSource -> Image m
 125 linear model tags
 126         = margin (px 10.0) (
 127              beside (repeat AtTop) []
 128                  [ beside (repeat AtMiddleY) []
 129                       [ txt "  beside  " <@< {stroke = toSVGColor "blue"} <@< {fill = toSVGColor "blue"}
 130                       , above (repeat AtLeft) []
 131                           [ beside (repeat AtMiddleY) [] [ beside (repeat y_align) [] discs Nothing
 132                                                          , txt ("  " <+++ y_align <+++ "*")
 133                                                          ] Nothing
 134                           \\ y_align <- [AtTop,AtMiddleY,AtBottom]
 135                           ] Nothing
 136                       ] Nothing
 137                  , beside (repeat AtMiddleY) []
 138                       [ txt "  above  " <@< {stroke = toSVGColor "blue"} <@< {fill = toSVGColor "blue"}
 139                       , beside (repeat AtTop) []
 140                           [ above (repeat AtMiddleX) [] [ txt ("  " <+++ x_align <+++ "*")
 141                                                         , above (repeat x_align) [] discs Nothing
 142                                                         ] Nothing
 143                           \\ x_align <- [AtLeft,AtMiddleX,AtRight]
 144                           ] Nothing
 145                       ] Nothing
 146                  ] Nothing
 147           )
 148 where
 149         txt s = text (normalFontDef "Lucida Console"  10.0) s
 150
 151 //      This example shows all grid-layout combinations:
 152 grid_layouts :: m *TagSource -> Image m
 153 grid_layouts model tags
 154         = margin (px zero) (
 155              grid (Columns 4) (RowMajor,LeftToRight,TopToBottom) [] []
 156                 [  above (repeat AtMiddleX) []
 157                       [ margin (px 5.0,px zero) (grid (Columns 2) (major,x_fill,y_fill) [] [] discs Nothing)
 158                       , txt (" (" <+++ major <+++ "," <+++ x_fill <+++ "," <+++ y_fill <+++ ") ")
 159                       ] Nothing
 160                 \\ major  <- [ColumnMajor,RowMajor   ]
 161                  , x_fill <- [LeftToRight,RightToLeft]
 162                  , y_fill <- [TopToBottom,BottomToTop]
 163                 ] Nothing
 164           )
 165 where
 166         txt s = text (normalFontDef "Lucida Console"  10.0) s
 167
 168 //      This example shows the use of ImageTag to display two images inside a rectangle that depends on each others dimensions:
 169 box2 :: m *TagSource -> Image m
 170 box2 _ tags = pair (arrow, rotate (deg -90.0) arrow) tags
 171 where
 172         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)
 173                                 ,(px 50.0,px  30.0),(px 55.0,px  10.0),(px zero,px  10.0)
 174                                 ]
 175
 176 //      This example shows the use of ImageTag to display an arbitrary rose tree structure:
 177 rose :: m *TagSource -> Image m
 178 rose _ tags = fst (show show_my_node my_rose_tree tags)
 179 where
 180         show_my_node txt ts
 181                 = (margin (px zero,px zero,px bottom,px zero) (
 182                       overlay [(AtMiddleX,AtMiddleY)] []
 183                           [text font txt]
 184                           (Just (rect (textxspan font txt + textxspan font "MM") (px (height + text_y_margin)) <@< {fill = toSVGColor "white"})))
 185                   , ts
 186                   )
 187         where
 188                 font          = normalFontDef "Arial" height
 189                 height        = 10.0
 190                 text_y_margin = 5.0
 191                 bottom        = 5.0
 192
 193 //      This examples displays the number of times that you've clicked on the text
 194 count :: Int *TagSource -> Image Int
 195 count n _
 196         = margin (px zero) (
 197             overlay [(AtMiddleX,AtMiddleY)] []
 198                [ text font (toString n) <@< {fill = toSVGColor "white"}]
 199                (Just (rect (textxspan font ("  " <+++ n)) (px (h + m))))
 200                <@< {onclick = (+), local = False}
 201           )
 202 where
 203         font = normalFontDef "Times New Roman" h
 204         h    = 100.0
 205         m    = 6.0
 206
 207 //      This example shows an image displayed by Marc Schoolderman during 'practicum' friday afternoon, may 22 2015
 208 clean :: m *TagSource -> Image m
 209 clean model tags
 210         = overlay (repeat (AtMiddleX,AtMiddleY)) []
 211              [ star 31 (r_in,r_out)
 212              , circle (px r_in *. 1.6) <@< {strokewidth = px bandwidth} <@< {stroke = toSVGColor "white"}
 213              , rotate (rad (pi * 0.25)) (circular (px r_in *. 0.8) (2.0 * pi) (repeatn 4 (circle (px bandwidth *. 0.8))))
 214              , 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"]))
 215              , above (repeat AtMiddleX) [] (map (((>@>) {fill = toSVGColor "white"}) o ((>@>) {stroke = toSVGColor "white"}) o (text bigfont)) ["100%", "CLEAN"]) Nothing
 216              ] Nothing
 217 where
 218         r_out      = 100.0
 219         r_in       = 90.0
 220         bandwidth  = r_in * 0.2
 221         bigfont    = {normalFontDef "Arial"        (r_in * 0.35) & fontweight = "bolder"}
 222         narrowfont =  normalFontDef "Arial Narrow" (r_in * 0.22)
 223
 224 star :: Int (Real,Real) -> Image m
 225 star n (r_in,r_out)
 226         = polygon Nothing (flatten
 227              [  [(px r_out *. (cos (angle * (toReal outer_corner))), px r_out *. (sin (angle * (toReal outer_corner))))
 228                 ,(px r_in  *. (cos (angle * (toReal inner_corner))), px r_in  *. (sin (angle * (toReal inner_corner))))
 229                 ]
 230              \\ outer_corner <- [0, 2 .. 2*n], let inner_corner = outer_corner+1
 231              ])
 232 where
 233         angle = pi / (toReal n)
 234
 235 arctext :: Span Real FontDef String -> Image m
 236 arctext r a font txt
 237         = circular r a [rotate (rad pi) (text font (toString c)) \\ c <-: txt]
 238
 239 pair :: (Image m,Image m) *TagSource -> Image m
 240 pair (img1,img2) [(t1,ut1),(t2,ut2):tags]
 241         = beside [] []
 242               [overlay [(AtMiddleX,AtMiddleY)] [] [tag ut1 img1] host
 243               ,overlay [(AtMiddleX,AtMiddleY)] [] [tag ut2 img2] host
 244               ] Nothing
 245 where
 246         (w1,h1) = (imagexspan t1,imageyspan t1)
 247         (w2,h2) = (imagexspan t2,imageyspan t2)
 248         host    = Just (rect (maxSpan [w1,w2]) (maxSpan [h1,h2]) <@< {fill = toSVGColor "none"})
 249
 250 show :: (a -> St *TagSource (Image m)) (Rose a) -> St *TagSource (Image m)
 251 show show_node (Rose r [])
 252         = show_node r
 253 show show_node (Rose r rs)
 254         = \[(t1,ut1), (t2,ut2) : ts] ->
 255                 let (image,  ts1) = show_node r ts
 256                     (images, ts2) = seqList (map (show show_node) rs) ts1
 257                  in ( above (repeat AtLeft) []
 258                           [ image
 259                           , beside (repeat AtTop) []
 260                                    [ yline Nothing (imageyspan t1 - imageyspan t2)
 261                                    , tag ut1
 262                                         (grid (Columns 2) (ColumnMajor,LeftToRight,TopToBottom) [] []
 263                                               (repeatn (length rs) (xline Nothing (px 10.0)) ++ init images ++ [tag ut2 (last images)])
 264                                               Nothing
 265                                         )
 266                                    ] Nothing
 267                           ] Nothing
 268                     , ts2
 269                     )
 270
 271
 272 discs :: [Image m]
 273 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]]
 274
 275 derive gText XAlign, YAlign, GridMajor, GridXLayout, GridYLayout
 276
 277 :: Rose a = Rose a [Rose a]
 278
 279 from StdFunc import const, seqList, :: St(..)
 280
 281 my_rose_tree :: Rose String
 282 my_rose_tree = Rose "Clean 2.2 Language Report"
 283                   [Rose "BASIC SEMANTICS"
 284                       [Rose "Graph Rewriting"
 285                           [Rose "A Small Example" []]
 286                       ,Rose "Global Graphs" []
 287                       ]
 288                   ,Rose "MODULES AND SCOPES"
 289                       [Rose "Identifiers, Scopes and Name Spaces"
 290                           [Rose "Naming Conventions of Identifiers" []
 291                           ,Rose "Scopes and Name Spaces" []
 292                           ,Rose "Nesting of Scopes" []
 293                           ]
 294                       ,Rose "Modular Structure of Clean Programs" []
 295                       ,Rose "Implementation Modules"
 296                           [Rose "The Main or Start Module" []
 297                           ,Rose "Scope of Global Definitions in Implementation Modules" []
 298                           ,Rose "Begin and End of a Definition: the Layout Rule" []
 299                           ]
 300                       ,Rose "Definition Modules" []
 301                       ,Rose "Importing Definitions"
 302                           [Rose "Explicit Imports of Definitions" []
 303                           ,Rose "Implicit Imports of Definitions" []
 304                           ]
 305                       ,Rose "System Definition and Implementation Modules" []
 306                       ]
 307                   ,Rose "DEFINING FUNCTIONS AND CONSTANTS"
 308                       [Rose "Functions" []
 309                       ,Rose "Patterns" []
 310                       ,Rose "Guards" []
 311                       ,Rose "Expressions"
 312                           [Rose "Lambda Abstraction" []
 313                           ,Rose "Case Expression and Conditional Expression" []
 314                           ]
 315                       ,Rose "Local Definitions"
 316                           [Rose "Let Expression: Local Definitions in Expressions" []
 317                           ,Rose "Where Block: Local Definitions in a Function Alternative" []
 318                           ,Rose "With Block: Local Definitions in a Guarded Alternative" []
 319                           ,Rose "Let-Before Expression: Local Constants defined between Guards" []
 320                           ]
 321                       ,Rose "Defining Constants"
 322                           [Rose "Selectors" []]
 323                       ,Rose "Typing Functions"
 324                           [Rose "Typing Curried Functions" []
 325                           ,Rose "Typing Operators" []
 326                           ,Rose "Typing Partial Functions" []
 327                           ,Rose "Explicit use of the Universal Quantifier in Function Types" []
 328                           ,Rose "Functions with Strict Arguments" []
 329                           ]
 330                       ]
 331                   ,Rose "PREDEFINED TYPES"
 332                       [Rose "Basic Types: Int, Real, Char and Bool"
 333                           [Rose "Creating Constant Values of Basic Types" []
 334                           ,Rose "Patterns of Basic Types" []
 335                           ]
 336                       ,Rose "Lists"
 337                           [Rose "Creating Lists" []
 338                           ,Rose "List Patterns" []
 339                           ]
 340                       ,Rose "Tuples"
 341                           [Rose "Creating Tuples" []
 342                           ,Rose "Tuple Patterns" []
 343                           ]
 344                       ,Rose "Arrays"
 345                           [Rose "Creating Arrays and Selection of field Elements" []
 346                           ,Rose "Array Patterns" []
 347                           ]
 348                       ,Rose "Predefined Type Constructors" []
 349                       ,Rose "Arrow Types" []
 350                       ,Rose "Predefined Abstract Types" []
 351                       ]
 352                   ,Rose "DEFINING NEW TYPES"
 353                       [Rose "Defining Algebraic Data Types"
 354                           [Rose "Using Constructors in Patterns" []
 355                           ,Rose "Using Higher Order Types" []
 356                           ,Rose "Defining Algebraic Data Types with Existentially Quantified Variables" []
 357                           ,Rose "Defining Algebraic Data Types with Universally Quantified Variables" []
 358                           ,Rose "Strictness Annotations in Type Definitions" []
 359                           ,Rose "Semantic Restrictions on Algebraic Data Types" []
 360                           ]
 361                       ,Rose "Defining Record Types"
 362                           [Rose "Creating Records and Selection of Record Fields" []
 363                           ,Rose "Record Patterns" []
 364                           ]
 365                       ,Rose "Defining Synomym Types" []
 366                       ,Rose "Defining Abstract Data Types"
 367                           [Rose "Defining Abstract Data Types with Synonym Type Definition" []]
 368                       ]
 369                   ,Rose "OVERLOADING"
 370                       [Rose "Type Classes" []
 371                       ,Rose "Functions Defined in Terms of Overloaded Functions" []
 372                       ,Rose "Instances of Type Classes Defined in Terms of Overloaded Functions" []
 373                       ,Rose "Type Constructor Classes" []
 374                       ,Rose "Overlapping Instances" []
 375                       ,Rose "Internal Overloading" []
 376                       ,Rose "Defining Derived Members in a Class" []
 377                       ,Rose "A Shorthand for Defining Overloaded Functions" []
 378                       ,Rose "Classes Defined in Terms of Other Classes" []
 379                       ,Rose "Exporting Type Classes" []
 380                       ,Rose "Semantic Restrictions on Type Classes" []
 381                       ]
 382                   ,Rose "GENERIC PROGRAMMING"
 383                       [Rose "Basic Ideas Behing Generic Programming" []
 384                       ,Rose "Defining Generic Functions" []
 385                       ,Rose "Deriving Generic Functions" []
 386                       ,Rose "Applying Generic Functions" []
 387                       ,Rose "Using Constructor Information" []
 388                       ,Rose "Generic Functions and Uniqueness Typing" []
 389                       ,Rose "Exporting Generic Functions" []
 390                       ]
 391                   ,Rose "DYNAMICS"
 392                       [Rose "Packing Expressions into a Dynamic"
 393                           [Rose "Packing Abstract Data Types" []
 394                           ,Rose "Packing Overloaded Functions" []
 395                           ,Rose "Packing Expressions of Unique Type" []
 396                           ,Rose "Packing Arguments of Unknown Type" []
 397                           ,Rose "Using Dynamic Typing to Defeat the Static Type System" []
 398                           ]
 399                       ,Rose "Unpacking Dynamics Using a Dynamic Pattern Match"
 400                           [Rose "Unpacking Abstract Data Types" []
 401                           ,Rose "Unpacking of Overloaded Functions" []
 402                           ,Rose "Unpacking Expressions of Unique Type" []
 403                           ,Rose "Checking and Unifying Types Schemes using Type Pattern Variables" []
 404                           ,Rose "Checking and Unifying Unknown Types using Overloaded Type Variables" []
 405                           ]
 406                       ,Rose "Type Safe Communication using Dynamics" []
 407                       ,Rose "Architecture of the implementation" []
 408                       ,Rose "Semantic Restrictions on Dynamics" []
 409                       ]
 410                   ,Rose "UNIQUENESS TYPING"
 411                       [Rose "Basic Ideas behind Uniqueness Typing" []
 412                       ,Rose "Attribute Propagation" []
 413                       ,Rose "Defining New Types with Uniqueness Attributes" []
 414                       ,Rose "Uniqueness and Sharing"
 415                           [Rose "Higher Order Uniqueness Typing" []
 416                           ,Rose "Uniqueness Type Coercions" []
 417                           ]
 418                       ,Rose "Combining Uniqueness Typing and Overloading"
 419                           [Rose "Constructor Classes" []]
 420                       ,Rose "Higher-Order Type Definitions" []
 421                       ,Rose "Destructive Updates using Uniqueness Typing" []
 422                       ]
 423                   ,Rose "STRICTNESS, MACROS AND EFFICIENCY"
 424                       [Rose "Annotations to Change Lazy Evaluation into Strict Evaluation"
 425                           [Rose "Advantages and Disadvantages of Lazy versus Strict Evaluation" []
 426                           ,Rose "Strict and Lazy Context" []
 427                           ,Rose "Space Consumption in Strict and Lazy Context" []
 428                           ,Rose "Time Consumption in Strict and Lazy Context" []
 429                           ,Rose "Changing Lazy into Strict Evaluation" []
 430                           ]
 431                       ,Rose "Defining Graphs on the Global Level" []
 432                       ,Rose "Defining Macros" []
 433                       ,Rose "Efficiency Tips" []
 434                       ]
 435                   ,Rose "FOREIGN LANGUAGE INTERFACE"
 436                       [Rose "Foreign Export" []
 437                       ,Rose "Using ABC instructions" []
 438                       ]
 439                   ]
 440
 441
 442 //      a generally useful image combinator:
 443 circular :: !Span !Real ![Image m] -> Image m
 444 circular r a imgs
 445   #! n      = length imgs
 446   #! sign_a = toReal (sign a)
 447   #! a`     = normalize (rad a)
 448   #! alpha  = (toRad a`) / (toReal n)
 449   = overlay (repeat (AtMiddleX,AtMiddleY))
 450                     [(~r *. cos angle,~r *. sin angle) \\ i <- [0.0, sign_a ..], angle <- [i*alpha - 0.5*pi]]
 451                     [rotate (rad (i*alpha)) img \\ i <- [0.0, sign_a ..] & img <- imgs]
 452                     (Just (empty (r *. 2) (r *. 2)))              // BUG: using Nothing creates incorrect image (offset to left)
 453
 454 pi =: 3.14159265359