Skip to content

Commit 2a41551

Browse files
sjoerdvisschersjoerdvisscher
committed
Add UIComponent class with toSVG method (#305)
1 parent 7572230 commit 2a41551

File tree

5 files changed

+101
-88
lines changed

5 files changed

+101
-88
lines changed

‎halogen-grid-kit/src/GridKit/Example/Example.purs

+48-34
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,8 @@ module GridKit.Example.Example where
33
import Prelude hiding (div)
44

55
import Data.Array ((..))
6-
import Data.Int (toNumber, floor)
7-
import Data.Lens (Lens, (+~), (-~), (%~))
6+
import Data.Int (toNumber, floor, even)
7+
import Data.Lens (Lens', (+~), (-~), (%~))
88
import Data.Lens.Record (prop)
99
import Data.Maybe
1010
import Data.Number (fromString)
@@ -22,9 +22,12 @@ import Svg.Elements as S
2222
import Svg.Attributes as S
2323

2424
import GridKit.KeyHandler
25+
import GridKit.UIComponent
2526
import View.ReactiveInput as ReactiveInput
26-
import View.GridKit.Grid as Grid
27-
import View.GridKit.Point as Point
27+
import View.GridKit.Grid (Grid(..))
28+
import View.GridKit.Point (Point(..))
29+
import View.GridKit.Rect (Rect(..))
30+
2831

2932
type Input = {}
3033

@@ -40,44 +43,54 @@ type State =
4043
, keyHelpVisible :: Boolean
4144
}
4245

43-
_logScale :: ∀ a b r. Lens { logScale :: a | r } { logScale :: b | r } a b
46+
_logScale :: Lens' State Number
4447
_logScale = prop (SProxy :: SProxy "logScale")
4548

46-
_keyHelpVisible :: ∀ a b r. Lens { keyHelpVisible :: a | r } { keyHelpVisible :: b | r } a b
49+
_keyHelpVisible :: Lens' State Boolean
4750
_keyHelpVisible = prop (SProxy :: SProxy "keyHelpVisible")
4851

49-
type ChildSlots =
50-
( grid :: Grid.Slot Unit
51-
, point :: Point.Slot Int
52-
)
52+
initialState :: State
53+
initialState =
54+
{ logSpacing: 1.0
55+
, logScale: 0.0
56+
, posX: 0.0
57+
, posY: 0.0
58+
, radius: 0.5
59+
, count: 10.0
60+
, keyHelpVisible: false
61+
}
62+
5363

54-
ui :: ∀ q m. MonadEffect m => H.Component HTML q Input Void m
64+
data Thing = PointThing Point | RectThing Rect
65+
66+
instance uiComponentThing :: UIComponent Thing where
67+
toSVG transform (PointThing p) = toSVG transform p
68+
toSVG transform (RectThing r) = toSVG transform r
69+
70+
newtype Model = Model
71+
{ grid :: Grid
72+
, things :: Array Thing
73+
}
5574

75+
instance uiComponentModel :: UIComponent Model where
76+
toSVG transform (Model { grid, things }) = toSVG transform grid <> toSVG transform things
77+
78+
79+
ui :: ∀ q m. MonadEffect m => H.Component HTML q Input Void m
5680
ui = ReactiveInput.mkComponent
57-
{ initialState:
58-
{ logSpacing: 1.0
59-
, logScale: 0.0
60-
, posX: 0.0
61-
, posY: 0.0
62-
, radius: 0.5
63-
, count: 10.0
64-
, keyHelpVisible: false
65-
}
81+
{ initialState
6682
, render
6783
, handleAction
6884
, handleInput: \_ -> pure unit
6985
}
7086

71-
handleAction :: ∀ m. MonadEffect m => Input -> Action -> H.HalogenM State Action ChildSlots Void m Unit
87+
handleAction :: ∀ m. MonadEffect m => Input -> Action -> H.HalogenM State Action () Void m Unit
7288
handleAction _ (ChangeState f) = H.modify_ f
7389

74-
render :: ∀ m. MonadEffect m => Input -> State -> H.ComponentHTML Action ChildSlots m
90+
render :: ∀ m. MonadEffect m => Input -> State -> H.ComponentHTML Action () m
7591
render _ { logSpacing, logScale, posX, posY, radius, count, keyHelpVisible } = div
7692
[ tabIndex 0, keys.onKeyDown ]
77-
[ S.svg [ S.width (_x size), S.height (_y size) ] $
78-
[ grid gridInput ] <>
79-
((1 .. floor count) <#> \n ->
80-
point n { position: rotate (toNumber n * 2.0 * pi / count) `transform` point2 radius 0.0, model2svg })
93+
[ S.svg [ S.width (_x size), S.height (_y size) ] $ toSVG model2svg model <#> fromPlainHTML
8194
, p_ [ input [ type_ InputRange, H.min 0.0, H.max 2.0, step Any, value (show logSpacing)
8295
, onValueInput $ \s -> s # fromString <#> \v -> ChangeState (_ { logSpacing = v })
8396
]
@@ -124,10 +137,17 @@ render _ { logSpacing, logScale, posX, posY, radius, count, keyHelpVisible } = d
124137

125138
model2svg = range `containedIn` size
126139

127-
range = Box { topLeft: (vec2 (-0.5) (-0.5) - pos) * pure scaling
128-
, bottomRight: (vec2 0.5 0.5 - pos) * pure scaling
140+
range = Box { topLeft: pure (-0.5 * scaling) - pos
141+
, bottomRight: pure ( 0.5 * scaling) - pos
129142
}
130143

144+
model = Model { grid: Grid { gridSpacing: pow 10.0 logSpacing, size }
145+
, things: (1 .. floor count) <#> \n ->
146+
let center = rotate (toNumber n * 2.0 * pi / count) `transform` point2 radius 0.0 in
147+
if even n then RectThing $ Rect { topLeft: center - vec2 0.05 0.05, size: vec2 0.1 0.1 }
148+
else PointThing $ Point center
149+
}
150+
131151
zoomInKey = keyHandler
132152
[ Shortcut metaKey "Equal", Shortcut ctrlKey "Equal"]
133153
(Just $ text "Zoom in")
@@ -142,12 +162,6 @@ render _ { logSpacing, logScale, posX, posY, radius, count, keyHelpVisible } = d
142162
, popupAction: ChangeState $ _keyHelpVisible %~ not
143163
}
144164

145-
grid :: ∀ m. MonadEffect m => Grid.Input -> H.ComponentHTML Action ChildSlots m
146-
grid input = slot (SProxy :: SProxy "grid") unit Grid.ui input (const Nothing)
147-
148-
point :: ∀ m. MonadEffect m => Int -> Point.Input -> H.ComponentHTML Action ChildSlots m
149-
point id input = slot (SProxy :: SProxy "point") id Point.ui input (const Nothing)
150-
151165

152166
containedIn :: Box Number -> Vec2 Number -> AffineTransform Number
153167
containedIn range size = translate svgCenter * scale scaleMin * translate (-rangeCenter)

‎halogen-grid-kit/src/GridKit/UIComponent.purs

+11
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
module GridKit.UIComponent where
2+
3+
import Data.Vec3.AffineTransform
4+
import Data.Foldable (foldMap)
5+
import Halogen.HTML (PlainHTML)
6+
7+
class UIComponent a where
8+
toSVG :: AffineTransform Number -> a -> Array PlainHTML
9+
10+
instance uiComponentArray :: UIComponent a => UIComponent (Array a) where
11+
toSVG transform = foldMap (toSVG transform)

‎halogen-grid-kit/src/View/GridKit/Grid.purs

+14-27
Original file line numberDiff line numberDiff line change
@@ -6,43 +6,30 @@ import Data.Array ((..), filter)
66
import Data.Int (floor, ceil, toNumber)
77
import Data.Vec3 (Vec2, vec2, _x, _y, origin2, point2)
88
import Data.Vec3.AffineTransform
9-
import Effect.Class (class MonadEffect)
10-
import Halogen as H
119
import Halogen.HTML hiding (code, head, prop, map, div)
1210
import Math (log, pow, ln10, round, sqrt)
1311
import Svg.Elements as S
1412
import Svg.Attributes as S
1513

16-
import View.ReactiveInput as ReactiveInput
14+
import GridKit.UIComponent
1715

18-
19-
type Input =
16+
newtype Grid = Grid
2017
{ gridSpacing :: Number
21-
, model2svg :: AffineTransform Number
2218
, size :: Vec2 Number
2319
}
2420

25-
data VoidF a
26-
type Slot = H.Slot VoidF Void
27-
28-
ui :: ∀ q m. MonadEffect m => H.Component HTML q Input Void m
29-
ui = ReactiveInput.mkComponent
30-
{ initialState: {}
31-
, render
32-
, handleAction: \_ _ -> pure unit
33-
, handleInput: \_ -> pure unit
34-
}
35-
36-
render :: ∀ m. Input -> {} -> H.ComponentHTML Void () m
37-
render { gridSpacing, model2svg, size } _ =
38-
S.g []
39-
[ S.g [ S.class_ "grid grid-v" ] $
40-
gridLines spacing (_x topLeft) (_x bottomRight)
41-
# map \{ width, pos } -> let x = m2s_x pos in S.line [ S.strokeWidth width, S.x1 x, S.y1 0.0, S.x2 x, S.y2 (_y size) ]
42-
, S.g [ S.class_ "grid grid-h" ] $
43-
gridLines spacing (_y topLeft) (_y bottomRight)
44-
# map \{ width, pos } -> let y = m2s_y pos in S.line [ S.strokeWidth width, S.x1 0.0, S.y1 y, S.x2 (_x size), S.y2 y ]
45-
]
21+
instance uiComponentGrid :: UIComponent Grid where
22+
toSVG = render
23+
24+
render :: AffineTransform Number -> Grid -> Array PlainHTML
25+
render model2svg (Grid { gridSpacing, size }) =
26+
[ S.g [ S.class_ "grid grid-v" ] $
27+
gridLines spacing (_x topLeft) (_x bottomRight)
28+
# map \{ width, pos } -> let x = m2s_x pos in S.line [ S.strokeWidth width, S.x1 x, S.y1 0.0, S.x2 x, S.y2 (_y size) ]
29+
, S.g [ S.class_ "grid grid-h" ] $
30+
gridLines spacing (_y topLeft) (_y bottomRight)
31+
# map \{ width, pos } -> let y = m2s_y pos in S.line [ S.strokeWidth width, S.x1 0.0, S.y1 y, S.x2 (_x size), S.y2 y ]
32+
]
4633
where
4734
svg2model = inverse model2svg
4835
spacing = _x (svg2model `transform` vec2 gridSpacing gridSpacing)

‎halogen-grid-kit/src/View/GridKit/Point.purs

+8-27
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,16 @@
11
module View.GridKit.Point where
22

3-
import Prelude
4-
53
import Data.Vec3 (Point2, _x, _y)
64
import Data.Vec3.AffineTransform
7-
import Effect.Class (class MonadEffect)
8-
import Halogen as H
9-
import Halogen.HTML
105
import Svg.Elements as S
11-
import Svg.Attributes hiding (path) as S
12-
13-
import View.ReactiveInput as ReactiveInput
14-
15-
type Input =
16-
{ position :: Point2 Number
17-
, model2svg :: AffineTransform Number
18-
}
6+
import Svg.Attributes as S
197

20-
data VoidF a
21-
type Slot = H.Slot VoidF Void
8+
import GridKit.UIComponent
229

23-
ui :: ∀ q m. MonadEffect m => H.Component HTML q Input Void m
24-
ui = ReactiveInput.mkComponent
25-
{ initialState: {}
26-
, render
27-
, handleAction: \_ _ -> pure unit
28-
, handleInput: \_ -> pure unit
29-
}
10+
newtype Point = Point (Point2 Number)
3011

31-
render :: ∀ m. Input -> {} -> H.ComponentHTML Void () m
32-
render { position, model2svg } _ =
33-
S.circle [ S.class_ "point", S.cx (_x center), S.cy (_y center), S.r 5.0 ]
34-
where
35-
center = model2svg `transform` position
12+
instance uiComponentPoint :: UIComponent Point where
13+
toSVG model2svg (Point position) =
14+
[ S.circle [ S.class_ "point", S.cx (_x center), S.cy (_y center), S.r 3.0 ] ]
15+
where
16+
center = model2svg `transform` position

‎halogen-grid-kit/src/View/GridKit/Rect.purs

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
module View.GridKit.Rect where
2+
3+
import Data.Vec3 (Point2, Vec2, _x, _y)
4+
import Data.Vec3.AffineTransform
5+
import Svg.Elements as S
6+
import Svg.Attributes as S
7+
8+
import GridKit.UIComponent
9+
10+
newtype Rect = Rect
11+
{ topLeft :: Point2 Number
12+
, size :: Vec2 Number
13+
}
14+
15+
instance uiComponentRect :: UIComponent Rect where
16+
toSVG model2svg (Rect { topLeft, size }) =
17+
[ S.rect [ S.class_ "rect", S.x (_x xy), S.y (_y xy), S.width (_x wh), S.height (_y wh) ] ]
18+
where
19+
xy = model2svg `transform` topLeft
20+
wh = model2svg `transform` size

0 commit comments

Comments
 (0)