Skip to content

Commit 5bdfb7d

Browse files
epostepost
authored
Merge branch 'development' into execution-folding
2 parents 064c06c + 2fcbba1 commit 5bdfb7d

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

58 files changed

+13127
-578
lines changed

‎halogen-grid-kit/.gitignore

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
/.cache
2+
/.psci_modules
3+
/.spago
4+
/node_modules/
5+
/output/
6+
/dist

‎halogen-grid-kit/html/index.html

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
<meta charset="UTF-8">
2+
<style>
3+
line {
4+
stroke: rgb(166, 188, 233)
5+
}
6+
input {
7+
width: 600px;
8+
}
9+
</style>
10+
<body>
11+
<div id="example"></div>
12+
</body>
13+
<script src="index.js"></script>

‎halogen-grid-kit/html/index.js

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
var Main = require("../output/Main")
2+
var runHalogenAff = require("../output/Halogen.Aff.Util").runHalogenAff
3+
runHalogenAff(Main.run({})("#example"))()

‎halogen-grid-kit/package-lock.json

Lines changed: 8031 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎halogen-grid-kit/package.json

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
{
2+
"name": "halogen-grid-kit",
3+
"version": "1.0.0",
4+
"description": "Halogen Grid Kit",
5+
"scripts": {
6+
"postinstall": "spago install",
7+
"start": "concurrently --kill-others --handle-input npm:watch npm:serve",
8+
"build": "spago build --purs-args --censor-codes=ImplicitImport,ImplicitQualifiedImport,HidingImport",
9+
"watch": "spago build --watch --purs-args --censor-codes=ImplicitImport,ImplicitQualifiedImport,HidingImport",
10+
"docs": "spago docs",
11+
"repl": "spago repl",
12+
"serve": "parcel html/index.html",
13+
"bundle": "npm run build && parcel build html/index.html --public-url ."
14+
},
15+
"devDependencies": {
16+
"concurrently": "^5.0.2",
17+
"parcel-bundler": "^1.12.4",
18+
"purescript": "^0.13.5",
19+
"purescript-psa": "^0.7.3",
20+
"spago": "^0.13"
21+
}
22+
}

‎halogen-grid-kit/spago.dhall

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
{ name =
2+
"halogen-grid-kit"
3+
, dependencies =
4+
[ "console"
5+
, "debug"
6+
, "effect"
7+
, "functors"
8+
, "halogen"
9+
, "halogen-svg"
10+
, "numbers"
11+
, "ordered-collections"
12+
, "profunctor-lenses"
13+
, "psci-support"
14+
, "strings"
15+
, "variant"
16+
, "vec"
17+
]
18+
, packages =
19+
../packages.dhall
20+
, sources =
21+
[ "src/**/*.purs" ]
22+
}

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

Lines changed: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
1+
module Example where
2+
3+
import Prelude
4+
5+
import Data.Array ((..))
6+
import Data.Int (toNumber, floor)
7+
import Data.Maybe
8+
import Data.Number (fromString)
9+
import Data.Symbol (SProxy(..))
10+
import Data.Vec3 (Vec2, vec2, point2, _x, _y, Box(..), boxSize, boxCenter)
11+
import Data.Vec3.AffineTransform
12+
import Effect.Class (class MonadEffect)
13+
import Halogen as H
14+
import Halogen.HTML
15+
import Halogen.HTML.Events (onValueInput)
16+
import Halogen.HTML.Properties hiding (min, max)
17+
import Halogen.HTML.Properties as H
18+
import Math (pow, pi)
19+
import Svg.Elements as S
20+
import Svg.Attributes as S
21+
22+
import View.ReactiveInput as ReactiveInput
23+
import View.GridKit.Grid as Grid
24+
import View.GridKit.Point as Point
25+
26+
type Input = {}
27+
28+
data Action = ChangeState (State -> State)
29+
30+
type State =
31+
{ logSpacing :: Number
32+
, logScale :: Number
33+
, posX :: Number
34+
, posY :: Number
35+
, radius :: Number
36+
, count :: Number
37+
}
38+
39+
type ChildSlots =
40+
( grid :: Grid.Slot Unit
41+
, point :: Point.Slot Int
42+
)
43+
44+
ui :: ∀ q m. MonadEffect m => H.Component HTML q Input Void m
45+
ui = ReactiveInput.mkComponent
46+
{ initialState:
47+
{ logSpacing: 1.0
48+
, logScale: 0.0
49+
, posX: 0.0
50+
, posY: 0.0
51+
, radius: 0.5
52+
, count: 10.0
53+
}
54+
, render
55+
, handleAction
56+
, handleInput: \_ -> pure unit
57+
}
58+
59+
handleAction :: ∀ m. MonadEffect m => Action -> H.HalogenM State Action ChildSlots Void m Unit
60+
handleAction (ChangeState f) = H.modify_ f
61+
62+
render :: ∀ m. MonadEffect m => Input -> State -> H.ComponentHTML Action ChildSlots m
63+
render _ { logSpacing, logScale, posX, posY, radius, count } = div_
64+
[ S.svg [ S.width (_x size), S.height (_y size) ] $
65+
[ grid gridInput ] <>
66+
((1 .. floor count) <#> \n ->
67+
point n { position: rotate (toNumber n * 2.0 * pi / count) `transform` point2 radius 0.0, model2svg })
68+
, p_ [ input [ type_ InputRange, H.min 0.0, H.max 2.0, step Any, value (show logSpacing)
69+
, onValueInput $ \s -> s # fromString <#> \v -> ChangeState (_ { logSpacing = v })
70+
]
71+
, text " Grid spacing"
72+
]
73+
, p_ [ input [ type_ InputRange, H.min (-5.0), H.max 5.0, step Any, value (show logScale)
74+
, onValueInput $ \s -> s # fromString <#> \v -> ChangeState (_ { logScale = v })
75+
]
76+
, text " Scale"
77+
]
78+
, p_ [ input [ type_ InputRange, H.min (-5.0), H.max 5.0, step Any, value (show posX)
79+
, onValueInput $ \s -> s # fromString <#> \v -> ChangeState (_ { posX = v })
80+
]
81+
, text " X"
82+
]
83+
, p_ [ input [ type_ InputRange, H.min (-5.0), H.max 5.0, step Any, value (show posY)
84+
, onValueInput $ \s -> s # fromString <#> \v -> ChangeState (_ { posY = v })
85+
]
86+
, text " Y"
87+
]
88+
, p_ [ input [ type_ InputRange, H.min (-5.0), H.max 5.0, step Any, value (show radius)
89+
, onValueInput $ \s -> s # fromString <#> \v -> ChangeState (_ { radius = v })
90+
]
91+
, text " Radius"
92+
]
93+
, p_ [ input [ type_ InputRange, H.min 1.0, H.max 100.0, step (Step 1.0), value (show count)
94+
, onValueInput $ \s -> s # fromString <#> \v -> ChangeState (_ { count = v })
95+
]
96+
, text " Count"
97+
]
98+
]
99+
where
100+
scaling = pow 10.0 logScale
101+
102+
pos = vec2 posX posY
103+
104+
size = vec2 777.0 600.0
105+
106+
gridInput = { gridSpacing: pow 10.0 logSpacing
107+
, model2svg
108+
, size
109+
}
110+
111+
model2svg = range `containedIn` size
112+
113+
range = Box { topLeft: (vec2 (-0.5) (-0.5) - pos) * pure scaling
114+
, bottomRight: (vec2 0.5 0.5 - pos) * pure scaling
115+
}
116+
117+
grid :: ∀ m. MonadEffect m => Grid.Input -> H.ComponentHTML Action ChildSlots m
118+
grid input = slot (SProxy :: SProxy "grid") unit Grid.ui input (const Nothing)
119+
120+
point :: ∀ m. MonadEffect m => Int -> Point.Input -> H.ComponentHTML Action ChildSlots m
121+
point id input = slot (SProxy :: SProxy "point") id Point.ui input (const Nothing)
122+
123+
containedIn :: Box Number -> Vec2 Number -> AffineTransform Number
124+
containedIn range size = translate svgCenter * scale scaleMin * translate (-rangeCenter)
125+
where
126+
scaleXY = size / boxSize range
127+
scaleMin = min (_x scaleXY) (_y scaleXY)
128+
rangeCenter = boxCenter range
129+
svgCenter = size / pure 2.0

‎halogen-grid-kit/src/Main.purs

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
module Main where
2+
3+
import Prelude
4+
5+
import Data.Maybe (Maybe)
6+
import Data.Traversable (traverse)
7+
import Effect (Effect)
8+
import Effect.Aff (Aff)
9+
import Effect.Class.Console (log)
10+
import Halogen (HalogenIO)
11+
import Halogen.Aff.Util (selectElement)
12+
import Halogen.VDom.Driver (runUI)
13+
import Web.DOM.ParentNode (QuerySelector(..))
14+
15+
import Example as Example
16+
17+
18+
main :: Effect Unit
19+
main = log "main: loaded."
20+
21+
run :: ∀ f. {} -> String -> Aff (Maybe (HalogenIO f Void Aff))
22+
run {} selector = do
23+
elemMaybe <- selectElement (QuerySelector selector)
24+
runUI Example.ui {} `traverse` elemMaybe

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

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
1+
module View.GridKit.Grid where
2+
3+
import Prelude
4+
5+
import Data.Array ((..), filter)
6+
import Data.Int (floor, ceil, toNumber)
7+
import Data.Vec3 (Vec2, vec2, _x, _y, origin2, point2)
8+
import Data.Vec3.AffineTransform
9+
import Effect.Class (class MonadEffect)
10+
import Halogen as H
11+
import Halogen.HTML hiding (code, head, prop, map, div)
12+
import Math (log, pow, ln10, round, sqrt)
13+
import Svg.Elements as S
14+
import Svg.Attributes as S
15+
16+
import View.ReactiveInput as ReactiveInput
17+
18+
19+
type Input =
20+
{ gridSpacing :: Number
21+
, model2svg :: AffineTransform Number
22+
, size :: Vec2 Number
23+
}
24+
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.attr (AttrName "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.attr (AttrName "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+
]
46+
where
47+
svg2model = inverse model2svg
48+
spacing = _x (svg2model `transform` vec2 gridSpacing gridSpacing)
49+
m2s_x x = _x (model2svg `transform` point2 x 0.0)
50+
m2s_y y = _y (model2svg `transform` point2 0.0 y)
51+
topLeft = svg2model `transform` origin2
52+
bottomRight = svg2model `transform` (origin2 + size)
53+
54+
type GridLine = { pos :: Number, width :: Number }
55+
56+
gridLines :: Number -> Number -> Number -> Array GridLine
57+
gridLines spacing start end
58+
= (ceil (start / stepSize) .. floor (end / stepSize))
59+
# map (\n -> { pos: toNumber n * stepSize, width: w n - thresholdWidth })
60+
# filter (\{ width } -> width > 0.0)
61+
where
62+
stepSize = pow 10.0 (round (log (spacing / stepMultiplier) / ln10))
63+
zoom = stepSize / spacing
64+
w 0 = maxLineWidth
65+
w n =
66+
if n `mod` 5 /= 0 then onesWidth * zoom else
67+
if n `mod` 10 /= 0 then fivesWidth * zoom else
68+
min maxLineWidth (10.0 * w (n `div` 10))
69+
onesWidth = 0.3
70+
fivesWidth = 1.0
71+
maxLineWidth = 2.5
72+
-- the pixel width below the grid lines become hidden
73+
-- we subtract the threshold so the lines fade in/out instead of suddenly appearing/disappearing
74+
thresholdWidth = 0.1
75+
-- Increase the number of lines just when the fives-lines are appearing:
76+
stepMultiplier = fivesWidth / thresholdWidth / sqrt(10.0)

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

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
module View.GridKit.Point where
2+
3+
import Prelude
4+
5+
import Data.Vec3 (Point2, _x, _y)
6+
import Data.Vec3.AffineTransform
7+
import Effect.Class (class MonadEffect)
8+
import Halogen as H
9+
import Halogen.HTML
10+
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+
}
19+
20+
data VoidF a
21+
type Slot = H.Slot VoidF Void
22+
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+
}
30+
31+
render :: ∀ m. Input -> {} -> H.ComponentHTML Void () m
32+
render { position, model2svg } _ =
33+
S.circle [ S.attr (AttrName "class") "point", S.cx (_x center), S.cy (_y center), S.r 5.0 ]
34+
where
35+
center = model2svg `transform` position

0 commit comments

Comments
 (0)