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