+++ /dev/null
-module SimpleSVG\r
-\r
-/* How to create and test an iTask program:\r
- 1. Install the iTask Clean compiler\r
- 2. Create a new project with this module as main module\r
- 3. Select the 'iTasks' environment\r
- 4. Bring the project Up-Uo-Date\r
- 5. Start the generated exe (this launches a local web server, allow your OS to unblock the exe)\r
- 6. Open a web browser (Google Chrome gives the best results)\r
- 7. Navigate to http://localhost/ activates the root-application (hello world)\r
- 8. Navigate to http://localhost/LABEL activates the application with the corresponding LABEL (e.g. http://localhost/basic)\r
-*/\r
-\r
-import iTasks // the iTask API\r
-import iTasks.API.Extensions.SVG.SVGlet // required to embed Image-tasks inside other tasks\r
-import StdArray\r
-\r
-const2 :: .a .b .c -> .a\r
-const2 x _ _ = x\r
-\r
-:: Person = {name :: String, surname :: String, birth :: Date}\r
-derive class iTask Person\r
-\r
-person = {name = "Peter", surname = "Achten", birth = {day=9,mon=1,year=1967}}\r
-\r
-Start :: *World -> *World\r
-Start world\r
- = startEngine [publish "/" (WebApp []) (const (viewInformation "Hello" [] "World!" <<@ FullScreen))\r
- ,publish "/basic" (WebApp []) (const (viewInformation "Basic Images" [imageView basic_images (const2 Nothing)] model <<@ FullScreen))\r
- ,publish "/transformations" (WebApp []) (const (viewInformation "Transformations" [imageView transformed_images (const2 Nothing)] model <<@ FullScreen))\r
- ,publish "/overlays" (WebApp []) (const (viewInformation "Overlays" [imageView overlays (const2 Nothing)] model <<@ FullScreen))\r
- ,publish "/linear" (WebApp []) (const (viewInformation "Linear" [imageView linear (const2 Nothing)] model <<@ FullScreen))\r
- ,publish "/grid" (WebApp []) (const (viewInformation "Grid" [imageView grid_layouts (const2 Nothing)] model <<@ FullScreen))\r
- ,publish "/box" (WebApp []) (const (viewInformation "Box" [imageView box2 (const2 Nothing)] model <<@ FullScreen))\r
- ,publish "/rose" (WebApp []) (const (viewInformation "Rose" [imageView rose (const2 Nothing)] model <<@ FullScreen))\r
- ,publish "/onclick" (WebApp []) (const (updateInformation "On-Click" [imageUpdate id count (\_ _ -> Nothing) (\_ n -> n) ] 0 <<@ FullScreen))\r
- ,publish "/100percent" (WebApp []) (const (viewInformation "100% Clean!" [imageView clean (const2 Nothing)] model <<@ FullScreen))\r
- ] world\r
-where\r
- model = () // for these examples, the model is actually irrelevant\r
-\r
-// This examples displays the basic Image shapes\r
-basic_images :: m *TagSource -> Image m\r
-basic_images model tags\r
- = margin (px zero,px 100.0,px zero,px zero) (\r
- grid (Columns 3) (RowMajor,LeftToRight,TopToBottom) (updateAt 6 (AtLeft,AtMiddleY) (repeat (AtLeft,AtTop))) []\r
- [ above [] [] [empty (px 200.0) (px 100.0), txts ["empty (px 200.0) (px 100.0)"]] Nothing\r
- , above [] [] [margin (px zero,px 5.0,px zero,px 5.0) (rect (px 200.0) (px 100.0))\r
- , txts ["rect (px 200.0) (px 100.0)"]] Nothing\r
- , above [] [] [rect (px 200.0) (px 100.0) <@< {fill = toSVGColor "none"}\r
- , txts ["rect (px 200.0) (px 100.0)"\r
- ,"<@< {fill = toSVGColor \"none\"}"\r
- ]] Nothing\r
- , above [] [] [circle (px 100.0), txts ["circle (px 100.0)"]] Nothing\r
- , above [] [] [ellipse (px 200.0) (px 100.0), txts ["ellipse (px 200.0) (px 100.0)"]] Nothing\r
- , above [] [] [overlay [] [] \r
- [text (normalFontDef "Times New Roman" 100.0) "Hey World!"]\r
- (Just (empty (px 200.0) (px 100.0)))\r
- , txts ["text (normalFontDef \"Times New Roman\" 100.0) \"Hey World!\""]] Nothing\r
- , above [] [] [xline Nothing (px 200.0), txts ["xline Nothing (px 200.0)"]] Nothing\r
- , above [AtMiddleX] [] [yline Nothing (px 100.0), txts ["yline Nothing (px 100.0)"]] Nothing\r
- , above [] [] [line Nothing Slash (px 200.0) (px 100.0)\r
- , txts ["line Nothing Slash (px 200.0) (px 100.0)"]] Nothing\r
- , above [] [] [line Nothing Backslash (px 200.0) (px 100.0)\r
- , txts ["line Nothing Backslash (px 200.0) (px 100.0)"]] Nothing\r
- , above [] [] [polygon Nothing [(zero,zero),(px 200.0,px 100.0),(px 200.0,zero),(zero,px 100.0)]\r
- , txts ["polygon Nothing"\r
- ," [(zero, zero )"\r
- ," ,(px 200.0,px 100.0)"\r
- ," ,(px 200.0,zero )"\r
- ," ,(zero, px 100.0)]"]] Nothing\r
- , above [] [] [polyline Nothing [(zero,zero),(px 200.0,px 100.0),(px 200.0,zero),(zero,px 100.0)]\r
- , txts ["polyline Nothing"\r
- ," [(zero, zero )"\r
- ," ,(px 200.0,px 100.0)"\r
- ," ,(px 200.0,zero )"\r
- ," ,(zero, px 100.0)]"]] Nothing\r
- ] Nothing\r
- )\r
-where\r
- 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)\r
-\r
-// This examples shows all possible transformations on (composite) Image-s:\r
-transformed_images :: m *TagSource -> Image m\r
-transformed_images model tags\r
- = margin (px 100.0) (\r
- grid (Columns 4) (RowMajor,LeftToRight,TopToBottom) [] []\r
- [ above (repeat AtMiddleX) [] [img, txt "img"] Nothing\r
- , above (repeat AtMiddleX) [] [fit (px 100.0) \r
- (px 100.0) img, txt "fit (px 100.0) (px 100.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [fitx (px 100.0) img, txt "fitx (px 100.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [fity (px 100.0) img, txt "fity (px 100.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [rotate (deg -20.0) img, txt "rotate (deg -20.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [rotate (deg 20.0) img, txt "rotate (deg 20.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [skewx (deg -20.0) img, txt "skewx (deg -20.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [skewx (deg 20.0) img, txt "skewx (deg 20.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [flipx img, txt "flipx img"] Nothing\r
- , above (repeat AtMiddleX) [] [flipy img, txt "flipy img"] Nothing\r
- , above (repeat AtMiddleX) [] [skewy (deg -20.0) img, txt "skewy (deg -20.0) img"] Nothing\r
- , above (repeat AtMiddleX) [] [skewy (deg 20.0) img, txt "skewy (deg 20.0) img"] Nothing\r
- ] Nothing\r
- )\r
-where\r
- img = text (normalFontDef "Times New Roman" 50.0) "F"\r
- txt s = text (normalFontDef "Lucida Console" 10.0) s\r
-\r
-// This example shows all overlay-combinations:\r
-overlays :: m *TagSource -> Image m\r
-overlays model tags\r
- = margin (px 10.0) (\r
- grid (Rows 3) (RowMajor,LeftToRight,TopToBottom) [] []\r
- [ beside (repeat AtMiddleY) [] \r
- [ margin (px 5.0) (overlay (repeat (x_align,y_align)) [] discs Nothing)\r
- , txt ("(" <+++ x_align <+++ "," <+++ y_align <+++ ")*")\r
- ] Nothing\r
- \\ x_align <- [AtLeft,AtMiddleX,AtRight]\r
- , y_align <- [AtTop, AtMiddleY,AtBottom]\r
- ] Nothing\r
- )\r
-where\r
- txt s = text (normalFontDef "Lucida Console" 10.0) s\r
-\r
-// This example shows all beside and above combinations:\r
-linear :: m *TagSource -> Image m\r
-linear model tags\r
- = margin (px 10.0) (\r
- beside (repeat AtTop) []\r
- [ beside (repeat AtMiddleY) []\r
- [ txt " beside " <@< {stroke = toSVGColor "blue"} <@< {fill = toSVGColor "blue"}\r
- , above (repeat AtLeft) []\r
- [ beside (repeat AtMiddleY) [] [ beside (repeat y_align) [] discs Nothing\r
- , txt (" " <+++ y_align <+++ "*")\r
- ] Nothing\r
- \\ y_align <- [AtTop,AtMiddleY,AtBottom]\r
- ] Nothing\r
- ] Nothing\r
- , beside (repeat AtMiddleY) []\r
- [ txt " above " <@< {stroke = toSVGColor "blue"} <@< {fill = toSVGColor "blue"}\r
- , beside (repeat AtTop) []\r
- [ above (repeat AtMiddleX) [] [ txt (" " <+++ x_align <+++ "*")\r
- , above (repeat x_align) [] discs Nothing\r
- ] Nothing\r
- \\ x_align <- [AtLeft,AtMiddleX,AtRight]\r
- ] Nothing\r
- ] Nothing\r
- ] Nothing\r
- )\r
-where\r
- txt s = text (normalFontDef "Lucida Console" 10.0) s\r
-\r
-// This example shows all grid-layout combinations:\r
-grid_layouts :: m *TagSource -> Image m\r
-grid_layouts model tags\r
- = margin (px zero) (\r
- grid (Columns 4) (RowMajor,LeftToRight,TopToBottom) [] []\r
- [ above (repeat AtMiddleX) []\r
- [ margin (px 5.0,px zero) (grid (Columns 2) (major,x_fill,y_fill) [] [] discs Nothing)\r
- , txt (" (" <+++ major <+++ "," <+++ x_fill <+++ "," <+++ y_fill <+++ ") ")\r
- ] Nothing\r
- \\ major <- [ColumnMajor,RowMajor ]\r
- , x_fill <- [LeftToRight,RightToLeft]\r
- , y_fill <- [TopToBottom,BottomToTop]\r
- ] Nothing\r
- )\r
-where\r
- txt s = text (normalFontDef "Lucida Console" 10.0) s\r
-\r
-// This example shows the use of ImageTag to display two images inside a rectangle that depends on each others dimensions:\r
-box2 :: m *TagSource -> Image m\r
-box2 _ tags = pair (arrow, rotate (deg -90.0) arrow) tags\r
-where\r
- 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)\r
- ,(px 50.0,px 30.0),(px 55.0,px 10.0),(px zero,px 10.0)\r
- ]\r
-\r
-// This example shows the use of ImageTag to display an arbitrary rose tree structure:\r
-rose :: m *TagSource -> Image m\r
-rose _ tags = fst (show show_my_node my_rose_tree tags)\r
-where\r
- show_my_node txt ts\r
- = (margin (px zero,px zero,px bottom,px zero) (\r
- overlay [(AtMiddleX,AtMiddleY)] []\r
- [text font txt]\r
- (Just (rect (textxspan font txt + textxspan font "MM") (px (height + text_y_margin)) <@< {fill = toSVGColor "white"})))\r
- , ts\r
- )\r
- where\r
- font = normalFontDef "Arial" height\r
- height = 10.0\r
- text_y_margin = 5.0\r
- bottom = 5.0\r
-\r
-// This examples displays the number of times that you've clicked on the text\r
-count :: Int *TagSource -> Image Int\r
-count n _\r
- = margin (px zero) (\r
- overlay [(AtMiddleX,AtMiddleY)] [] \r
- [ text font (toString n) <@< {fill = toSVGColor "white"}]\r
- (Just (rect (textxspan font (" " <+++ n)) (px (h + m))))\r
- <@< {onclick = (+), local = False}\r
- )\r
-where\r
- font = normalFontDef "Times New Roman" h\r
- h = 100.0\r
- m = 6.0\r
-\r
-// This example shows an image displayed by Marc Schoolderman during 'practicum' friday afternoon, may 22 2015\r
-clean :: m *TagSource -> Image m\r
-clean model tags\r
- = overlay (repeat (AtMiddleX,AtMiddleY)) []\r
- [ star 31 (r_in,r_out)\r
- , circle (px r_in *. 1.6) <@< {strokewidth = px bandwidth} <@< {stroke = toSVGColor "white"}\r
- , rotate (rad (pi * 0.25)) (circular (px r_in *. 0.8) (2.0 * pi) (repeatn 4 (circle (px bandwidth *. 0.8))))\r
- , 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"]))\r
- , above (repeat AtMiddleX) [] (map (((>@>) {fill = toSVGColor "white"}) o ((>@>) {stroke = toSVGColor "white"}) o (text bigfont)) ["100%", "CLEAN"]) Nothing\r
- ] Nothing\r
-where\r
- r_out = 100.0\r
- r_in = 90.0\r
- bandwidth = r_in * 0.2\r
- bigfont = {normalFontDef "Arial" (r_in * 0.35) & fontweight = "bolder"}\r
- narrowfont = normalFontDef "Arial Narrow" (r_in * 0.22)\r
-\r
-star :: Int (Real,Real) -> Image m\r
-star n (r_in,r_out)\r
- = polygon Nothing (flatten \r
- [ [(px r_out *. (cos (angle * (toReal outer_corner))), px r_out *. (sin (angle * (toReal outer_corner))))\r
- ,(px r_in *. (cos (angle * (toReal inner_corner))), px r_in *. (sin (angle * (toReal inner_corner))))\r
- ]\r
- \\ outer_corner <- [0, 2 .. 2*n], let inner_corner = outer_corner+1\r
- ])\r
-where\r
- angle = pi / (toReal n)\r
-\r
-arctext :: Span Real FontDef String -> Image m\r
-arctext r a font txt\r
- = circular r a [rotate (rad pi) (text font (toString c)) \\ c <-: txt]\r
-\r
-pair :: (Image m,Image m) *TagSource -> Image m\r
-pair (img1,img2) [(t1,ut1),(t2,ut2):tags]\r
- = beside [] []\r
- [overlay [(AtMiddleX,AtMiddleY)] [] [tag ut1 img1] host\r
- ,overlay [(AtMiddleX,AtMiddleY)] [] [tag ut2 img2] host\r
- ] Nothing\r
-where\r
- (w1,h1) = (imagexspan t1,imageyspan t1)\r
- (w2,h2) = (imagexspan t2,imageyspan t2)\r
- host = Just (rect (maxSpan [w1,w2]) (maxSpan [h1,h2]) <@< {fill = toSVGColor "none"})\r
-\r
-show :: (a -> St *TagSource (Image m)) (Rose a) -> St *TagSource (Image m)\r
-show show_node (Rose r []) \r
- = show_node r\r
-show show_node (Rose r rs) \r
- = \[(t1,ut1), (t2,ut2) : ts] ->\r
- let (image, ts1) = show_node r ts\r
- (images, ts2) = seqList (map (show show_node) rs) ts1\r
- in ( above (repeat AtLeft) []\r
- [ image\r
- , beside (repeat AtTop) []\r
- [ yline Nothing (imageyspan t1 - imageyspan t2)\r
- , tag ut1 \r
- (grid (Columns 2) (ColumnMajor,LeftToRight,TopToBottom) [] []\r
- (repeatn (length rs) (xline Nothing (px 10.0)) ++ init images ++ [tag ut2 (last images)])\r
- Nothing\r
- ) \r
- ] Nothing \r
- ] Nothing\r
- , ts2\r
- )\r
-\r
-\r
-discs :: [Image m]\r
-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]]\r
-\r
-derive gText XAlign, YAlign, GridMajor, GridXLayout, GridYLayout\r
-\r
-:: Rose a = Rose a [Rose a]\r
-\r
-from StdFunc import const, seqList, :: St(..)\r
-\r
-my_rose_tree :: Rose String\r
-my_rose_tree = Rose "Clean 2.2 Language Report" \r
- [Rose "BASIC SEMANTICS" \r
- [Rose "Graph Rewriting" \r
- [Rose "A Small Example" []]\r
- ,Rose "Global Graphs" []\r
- ]\r
- ,Rose "MODULES AND SCOPES"\r
- [Rose "Identifiers, Scopes and Name Spaces" \r
- [Rose "Naming Conventions of Identifiers" []\r
- ,Rose "Scopes and Name Spaces" []\r
- ,Rose "Nesting of Scopes" []\r
- ]\r
- ,Rose "Modular Structure of Clean Programs" []\r
- ,Rose "Implementation Modules" \r
- [Rose "The Main or Start Module" []\r
- ,Rose "Scope of Global Definitions in Implementation Modules" []\r
- ,Rose "Begin and End of a Definition: the Layout Rule" []\r
- ]\r
- ,Rose "Definition Modules" []\r
- ,Rose "Importing Definitions" \r
- [Rose "Explicit Imports of Definitions" []\r
- ,Rose "Implicit Imports of Definitions" []\r
- ]\r
- ,Rose "System Definition and Implementation Modules" []\r
- ]\r
- ,Rose "DEFINING FUNCTIONS AND CONSTANTS"\r
- [Rose "Functions" []\r
- ,Rose "Patterns" []\r
- ,Rose "Guards" []\r
- ,Rose "Expressions"\r
- [Rose "Lambda Abstraction" []\r
- ,Rose "Case Expression and Conditional Expression" []\r
- ]\r
- ,Rose "Local Definitions" \r
- [Rose "Let Expression: Local Definitions in Expressions" []\r
- ,Rose "Where Block: Local Definitions in a Function Alternative" []\r
- ,Rose "With Block: Local Definitions in a Guarded Alternative" []\r
- ,Rose "Let-Before Expression: Local Constants defined between Guards" []\r
- ]\r
- ,Rose "Defining Constants" \r
- [Rose "Selectors" []]\r
- ,Rose "Typing Functions" \r
- [Rose "Typing Curried Functions" []\r
- ,Rose "Typing Operators" []\r
- ,Rose "Typing Partial Functions" []\r
- ,Rose "Explicit use of the Universal Quantifier in Function Types" []\r
- ,Rose "Functions with Strict Arguments" []\r
- ]\r
- ]\r
- ,Rose "PREDEFINED TYPES"\r
- [Rose "Basic Types: Int, Real, Char and Bool" \r
- [Rose "Creating Constant Values of Basic Types" []\r
- ,Rose "Patterns of Basic Types" []\r
- ]\r
- ,Rose "Lists" \r
- [Rose "Creating Lists" []\r
- ,Rose "List Patterns" []\r
- ]\r
- ,Rose "Tuples" \r
- [Rose "Creating Tuples" []\r
- ,Rose "Tuple Patterns" []\r
- ]\r
- ,Rose "Arrays" \r
- [Rose "Creating Arrays and Selection of field Elements" []\r
- ,Rose "Array Patterns" []\r
- ]\r
- ,Rose "Predefined Type Constructors" []\r
- ,Rose "Arrow Types" []\r
- ,Rose "Predefined Abstract Types" []\r
- ]\r
- ,Rose "DEFINING NEW TYPES"\r
- [Rose "Defining Algebraic Data Types" \r
- [Rose "Using Constructors in Patterns" []\r
- ,Rose "Using Higher Order Types" []\r
- ,Rose "Defining Algebraic Data Types with Existentially Quantified Variables" []\r
- ,Rose "Defining Algebraic Data Types with Universally Quantified Variables" []\r
- ,Rose "Strictness Annotations in Type Definitions" []\r
- ,Rose "Semantic Restrictions on Algebraic Data Types" []\r
- ]\r
- ,Rose "Defining Record Types"\r
- [Rose "Creating Records and Selection of Record Fields" []\r
- ,Rose "Record Patterns" []\r
- ]\r
- ,Rose "Defining Synomym Types" []\r
- ,Rose "Defining Abstract Data Types" \r
- [Rose "Defining Abstract Data Types with Synonym Type Definition" []]\r
- ]\r
- ,Rose "OVERLOADING"\r
- [Rose "Type Classes" []\r
- ,Rose "Functions Defined in Terms of Overloaded Functions" []\r
- ,Rose "Instances of Type Classes Defined in Terms of Overloaded Functions" []\r
- ,Rose "Type Constructor Classes" []\r
- ,Rose "Overlapping Instances" []\r
- ,Rose "Internal Overloading" []\r
- ,Rose "Defining Derived Members in a Class" []\r
- ,Rose "A Shorthand for Defining Overloaded Functions" []\r
- ,Rose "Classes Defined in Terms of Other Classes" []\r
- ,Rose "Exporting Type Classes" []\r
- ,Rose "Semantic Restrictions on Type Classes" []\r
- ]\r
- ,Rose "GENERIC PROGRAMMING"\r
- [Rose "Basic Ideas Behing Generic Programming" []\r
- ,Rose "Defining Generic Functions" []\r
- ,Rose "Deriving Generic Functions" []\r
- ,Rose "Applying Generic Functions" []\r
- ,Rose "Using Constructor Information" []\r
- ,Rose "Generic Functions and Uniqueness Typing" []\r
- ,Rose "Exporting Generic Functions" []\r
- ]\r
- ,Rose "DYNAMICS"\r
- [Rose "Packing Expressions into a Dynamic" \r
- [Rose "Packing Abstract Data Types" []\r
- ,Rose "Packing Overloaded Functions" []\r
- ,Rose "Packing Expressions of Unique Type" []\r
- ,Rose "Packing Arguments of Unknown Type" []\r
- ,Rose "Using Dynamic Typing to Defeat the Static Type System" []\r
- ]\r
- ,Rose "Unpacking Dynamics Using a Dynamic Pattern Match" \r
- [Rose "Unpacking Abstract Data Types" []\r
- ,Rose "Unpacking of Overloaded Functions" []\r
- ,Rose "Unpacking Expressions of Unique Type" []\r
- ,Rose "Checking and Unifying Types Schemes using Type Pattern Variables" []\r
- ,Rose "Checking and Unifying Unknown Types using Overloaded Type Variables" []\r
- ]\r
- ,Rose "Type Safe Communication using Dynamics" []\r
- ,Rose "Architecture of the implementation" []\r
- ,Rose "Semantic Restrictions on Dynamics" []\r
- ]\r
- ,Rose "UNIQUENESS TYPING"\r
- [Rose "Basic Ideas behind Uniqueness Typing" []\r
- ,Rose "Attribute Propagation" []\r
- ,Rose "Defining New Types with Uniqueness Attributes" []\r
- ,Rose "Uniqueness and Sharing" \r
- [Rose "Higher Order Uniqueness Typing" []\r
- ,Rose "Uniqueness Type Coercions" []\r
- ]\r
- ,Rose "Combining Uniqueness Typing and Overloading" \r
- [Rose "Constructor Classes" []]\r
- ,Rose "Higher-Order Type Definitions" []\r
- ,Rose "Destructive Updates using Uniqueness Typing" []\r
- ]\r
- ,Rose "STRICTNESS, MACROS AND EFFICIENCY"\r
- [Rose "Annotations to Change Lazy Evaluation into Strict Evaluation" \r
- [Rose "Advantages and Disadvantages of Lazy versus Strict Evaluation" []\r
- ,Rose "Strict and Lazy Context" []\r
- ,Rose "Space Consumption in Strict and Lazy Context" []\r
- ,Rose "Time Consumption in Strict and Lazy Context" []\r
- ,Rose "Changing Lazy into Strict Evaluation" []\r
- ]\r
- ,Rose "Defining Graphs on the Global Level" []\r
- ,Rose "Defining Macros" []\r
- ,Rose "Efficiency Tips" []\r
- ]\r
- ,Rose "FOREIGN LANGUAGE INTERFACE"\r
- [Rose "Foreign Export" []\r
- ,Rose "Using ABC instructions" []\r
- ]\r
- ]\r
-\r
-\r
-// a generally useful image combinator:\r
-circular :: !Span !Real ![Image m] -> Image m\r
-circular r a imgs\r
- #! n = length imgs\r
- #! sign_a = toReal (sign a)\r
- #! a` = normalize (rad a)\r
- #! alpha = (toRad a`) / (toReal n)\r
- = overlay (repeat (AtMiddleX,AtMiddleY))\r
- [(~r *. cos angle,~r *. sin angle) \\ i <- [0.0, sign_a ..], angle <- [i*alpha - 0.5*pi]]\r
- [rotate (rad (i*alpha)) img \\ i <- [0.0, sign_a ..] & img <- imgs]\r
- (Just (empty (r *. 2) (r *. 2))) // BUG: using Nothing creates incorrect image (offset to left)\r
-\r
-pi =: 3.14159265359\r
repositories / fp1415.git / commitdiff