@@ -1,195 +1,87 @@
2−module Graphics.Element
2+module Grapics.Element where
3− (left,right,down,up,inward,outward
3+
4− ,topLeft,topRight,bottomLeft,bottomRight
4+import Native.Guid (guid)
5− ,midLeft,midRight,midTop,midBottom
5+import JavaScript as JS
6− ,middle,absolute,relative
6+import List as List
7− ,topLeftAt,topRightAt,bottomLeftAt,bottomRightAt
7+import Graphics.FillStyle
8− ,width,height,size,widthOf,heightOf,sizeOf
8+
9− ,color,opacity
9+type Properties = {
10− ,text,image,fittedImage,video
10+ id : Int,
11− ,flow,above,below,beside,layers
11+ width : Int,
12− ,collage,spacer,container
12+ height : Int,
13− ,line,segment
13+ opacity : Float,
14− ,polygon,ngon,rect,oval,circle
14+ filling : FillStyle,
15− ,solid,dotted,dashed,customLine
15+ href : JSString,
16− ,filled,outlined,customOutline,textured
16+ tag : JSString
18− ,rotate,scale,move
18+
19− ) where
19+data Element = Element Properties ElementPrim
21−import Graphics.Color
21+getProp get e = let (Element props _) = e in get props
22−
22+widthOf e = getProp .width e
23−data Direction = DLeft | DRight | DUp | DDown | DIn | DOut
23+heightOf e = getProp .height e
24−
24+sizeOf e = getProp (\p -> (p.width, p.height)) e
32−data Pos1 = Absolute Int | Relative Float
33−data Pos2 = Near | Mid | Far
37− | PositionAt Pos1 Pos1
38− | PositionTL Pos1 Pos1
39− | PositionTR Pos1 Pos1
40− | PositionBL Pos1 Pos1
41− | PositionBR Pos1 Pos1
43−topLeft = Position Near Near
44−topRight = Position Far Near
45−bottomLeft = Position Near Far
46−bottomRight = Position Far Far
48−midLeft = Position Near Mid
49−midRight = Position Far Mid
50−midTop = Position Mid Near
51−midBottom = Position Mid Far
53−middle = Position Mid Mid
56−topLeftAt = PositionTL
57−topRightAt = PositionTR
58−bottomLeftAt = PositionBL
59−bottomRightAt = PositionBR
64−data Element = Element Int BasicElement Int Int Float (Maybe Color) (Just String)
66−newElement = Element 0
67−basicNewElement e w h = Element 0 e w h 1 Nothing Nothing
73− | EFittedImage String
74− | EFlow Direction [Element]
75− | ECollage Int Int [Form]
77− | EContainer Position Element
79−width w' (Element _ e w h o c l) =
26+width w e =
81− { EText _ -> newElement e w' h o c l
28+ Element props prim -> Element {props| width <- w} prim
82− ; EImage _ -> newElement e w' h o c l
83− ; EVideo _ -> newElement e w' h o c l
84− ; _ -> newElement e w' h o c l }
85−height h' (Element _ e w h o c l) =
29+height h e =
87− { EText _ -> newElement e w h' o c l
31+ Element props prim -> Element {props| height <- h} prim
88− ; EImage _ -> newElement e w h' o c l
32+opacity o e =
89− ; EVideo _ -> newElement e w h' o c l
33+ case e of
90− ; _ -> newElement e w h' o c l }
34+ Element props prim -> Element {props| opacity <- o} prim
91−size w' h' (Element _ e w h o c l) = newElement e w' h' o c l
35+color c e =
92−opacity o' (Element _ e w h o c l) = newElement e w h o' c l
36+ case e of
93−color c' (Element _ e w h o c l) = newElement e w h o (Just c') l
37+ Element props prim -> Element {props| filling <- c} prim
94−link l' (Element _ e w h o c l) = newElement e w h o c (Just l')
38+filling f e =
96−widthOf (Element _ _ w _ _ _ _) = w
40+ Element props prim -> Element {props| filling <- f} prim
97−heightOf (Element _ _ _ h _ _ _) = h
41+tag name e =
98−sizeOf (Element _ _ w h _ _ _) = (w,h)
42+ case e of
99−
43+ Element props prim -> Element {props| tag <- JS.fromString name } prim
100−n1 = 0-1
44+link href e =
102−text t = basicNewElement (EText t) n1 n1
103−image w h s = basicNewElement (EImage s) w h
104−video w h s = basicNewElement (EVideo s) w h
105−fittedImage w h s = basicNewElement (EFittedImage s) w h
108− let { w = let ws = map widthOf es in
109− case dir of { DLeft -> sum ws
45+ case e of
110− ; DRight -> sum ws
46+ Element props prim -> Element {props| href <- JS.fromString href } prim
112− ; h = let hs = map heightOf es in
113− case dir of { DDown -> sum hs
116− } in basicNewElement (EFlow dir es) w h
120− (EFlow DDown [e1,e2])
121− (max (widthOf e1) (widthOf e2))
122− (heightOf e1 + heightOf e2) 1 Nothing Nothing
125− basicNewElement (EFlow DDown [e2,e1])
126− (max (widthOf e1) (widthOf e2))
127− (heightOf e1 + heightOf e2)
130− basicNewElement (EFlow DRight [e1,e2])
131− (widthOf e1 + widthOf e2)
132− (max (heightOf e1) (heightOf e2))
135− basicNewElement (EFlow DIn es)
136− (maximum (map widthOf es))
137− (maximum (map heightOf es))
139−collage w h forms = basicNewElement (ECollage w h forms) w h
141−spacer w h = basicNewElement EEmpty w h
143−container w h pos e =
144− basicNewElement (EContainer pos e) w h
148−data LineStyle = Solid | Dotted | Dashed | Custom [Int]
149−data ShapeStyle = Filled | Outlined | CustomOutline [Int] | Textured String
151−data Line = Line [(Float,Float)]
154−segment p1 p2 = Line [p1,p2]
156−data Shape = Shape [(Float,Float)] (Float,Float)
159−rect w h pos = Shape [(0-w/2,0-h/2),(0-w/2,h/2),(w/2,h/2),(w/2,0-h/2)] pos
162− let f i = ( w/2 * cos (2*pi/n * i), h/2 * sin (2*pi/n * i)) in
163− Shape (map f [0..n-1]) pos
164−circle r = oval (2*r) (2*r)
166− let m = toFloat n in
167− let f i = ( r * cos (2*pi/m * i), r * sin (2*pi/m * i)) in
168− Shape (map f [0..n-1]) pos
170−data Form = Form Float Float (Float,Float) BasicForm
48+emptyStr = JS.fromString ""
50+ Element (Properties (guid ()) w h 1 NoFill emptyStr emptyStr) e
172−data BasicForm
52+data ElementPrim
173− = FLine LineStyle Color Line
53+ = Image ImageStyle String
174− | FShape ShapeStyle Color Shape
54+ | Container Position Element
175− | FImage Int Int String
55+ | Flow Direction [Element]
176− | FElement Element
56+ | Spacer
178−solid clr ln = Form 0 1 (0,0) (FLine Solid clr ln)
60+data ImageStyle = Plain | Fitted | Cropped (Int,Int) Int Int
179−dotted clr ln = Form 0 1 (0,0) (FLine Dotted clr ln)
61+data Direction = DUp | DDown | DLeft | DRight | DIn | DOut
180−dashed clr ln = Form 0 1 (0,0) (FLine Dashed clr ln)
181−customLine pattern clr ln =
182− Form 0 1 (0,0) (FLine (Custom pattern) clr ln)
184−filled clr (Shape ps pos) = Form 0 1 pos (FShape Filled clr (Shape ps pos))
63+image w h src = newElement w h (Image Plain src)
185−outlined clr (Shape ps pos) = Form 0 1 pos (FShape Outlined clr (Shape ps pos))
64+fittedImage w h src = newElement w h (Image Fitted src)
186−customOutline pattern clr (Shape ps pos) =
65+croppedImage w h pos src = newElement w h (Image (Cropped pos w h) src)
187− Form 0 1 pos (FShape (CustomOutline pattern) clr (Shape ps pos))
188−textured src (Shape ps pos) = Form 0 1 pos (FShape (Textured src) black (Shape ps pos))
190−sprite w h pos src = Form 0 1 pos (FImage w h src)
67+container w h pos e = newElement w h (Container pos e)
191−toForm pos e = Form 0 1 pos (FElement e)
68+spacer w h = newElement w h Spacer
193−rotate t (Form theta scale pos form) = Form (t+theta) scale pos form
70+flow dir es =
194−scale s (Form theta scale pos form) = Form theta (s*scale) pos form
71+ let ws = map widthOf es
195−move x y (Form theta scale (px,py) form) = Form theta scale (x+px,y+py) form
72+ hs = map heightOf es
73+ newFlow w h = newElement w h (Flow dir es)
76+ DUp -> newFlow (List.maximum ws) (List.sum hs)
77+ DDown -> newFlow (List.maximum ws) (List.sum hs)
78+ DLeft -> newFlow (List.sum ws) (List.maximum hs)
79+ DRight -> newFlow (List.sum ws) (List.maximum hs)
80+ DIn -> newFlow (List.maximum ws) (List.maximum hs)
81+ DOut -> newFlow (List.maximum ws) (List.maximum hs)
83+above hi lo = newElement (max (widthOf hi) (widthOf lo)) (heightOf hi + heightOf lo) (Flow DDown [hi,lo])
84+below lo hi = newElement (max (widthOf hi) (widthOf lo)) (heightOf hi + heightOf lo) (Flow DDown [hi,lo])
85+beside lft rht = newElement (widthOf lft + widthOf rht) (max (heightOf lft) (heightOf rht)) (Flow right [lft,rht])
87+text : Text -> Element