first commit
It doesn't really work as a game.
This commit is contained in:
Christian Lawson-Perfect
commit
1916afcb03
12 changed files with 7797 additions and 0 deletions
3
.gitignore
vendored
Normal file
3
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
.make.*
|
||||
elm-stuff/
|
||||
error.txt
|
||||
2
.watchmakerc
Normal file
2
.watchmakerc
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
extensions:
|
||||
- .elm
|
||||
11
Makefile
Normal file
11
Makefile
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
DIRNAME=$(notdir $(CURDIR))
|
||||
|
||||
ELMS=$(wildcard src/*.elm)
|
||||
|
||||
app.js: src/App.elm $(ELMS)
|
||||
-elm make $< --output=$@ 2> error.txt
|
||||
@cat error.txt
|
||||
|
||||
upload: app.js index.html style.css
|
||||
rsync -avz . clpland:~/domains/somethingorotherwhatever.com/html/$(DIRNAME)
|
||||
@echo "Uploaded to https://somethingorotherwhatever.com/$(DIRNAME)"
|
||||
28
elm.json
Normal file
28
elm.json
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
{
|
||||
"type": "application",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"elm-version": "0.19.1",
|
||||
"dependencies": {
|
||||
"direct": {
|
||||
"elm/browser": "1.0.2",
|
||||
"elm/core": "1.0.5",
|
||||
"elm/html": "1.0.0",
|
||||
"elm/random": "1.0.0",
|
||||
"elm/svg": "1.0.1",
|
||||
"elm-community/list-extra": "8.7.0",
|
||||
"elm-community/random-extra": "3.2.0"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/json": "1.1.3",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm/virtual-dom": "1.0.3"
|
||||
}
|
||||
},
|
||||
"test-dependencies": {
|
||||
"direct": {},
|
||||
"indirect": {}
|
||||
}
|
||||
}
|
||||
23
index.html
Normal file
23
index.html
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
<!DOCTYPE HTML>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<meta name="viewport" content="width=device-width,initial-scale=1.0">
|
||||
<title>Elm app by clp</title>
|
||||
<link rel="stylesheet" href="style.css">
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<header>
|
||||
<h1>Elm app by clp</h1>
|
||||
</header>
|
||||
<main>
|
||||
<p>This is an app which will either load succesfully, and you'll wonder whether you saw this text at all, or fail ignominiously, showing you only this text.</p>
|
||||
<p>On balance of probabilities: I'm sorry I couldn't be bothered to make this work for you.</p>
|
||||
</main>
|
||||
<footer>Made by <a href="https://somethingorotherwhatever.com">clp</a></footer>
|
||||
|
||||
<script src="app.js"></script>
|
||||
<script src="load-app.js" type="module"></script>
|
||||
</body>
|
||||
</html>
|
||||
10
load-app.js
Normal file
10
load-app.js
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
import show_error from './show-error.mjs';
|
||||
async function init_app() {
|
||||
const compilation_error = await show_error;
|
||||
if(compilation_error) {
|
||||
return;
|
||||
}
|
||||
const app = Elm.App.init({node: document.body, flags: {}});
|
||||
}
|
||||
|
||||
init_app();
|
||||
21
show-error.mjs
Normal file
21
show-error.mjs
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
export default fetch('/error.txt').then(r=>{
|
||||
if(r.ok) {
|
||||
return r.text();
|
||||
} else {
|
||||
throw('');
|
||||
}
|
||||
}).then(text => {
|
||||
if(!text) {
|
||||
return false;
|
||||
}
|
||||
document.body.innerHTML = '';
|
||||
const error_show = document.createElement('pre');
|
||||
error_show.setAttribute('id','build-error');
|
||||
error_show.style.background = 'black';
|
||||
error_show.style.color = 'white';
|
||||
error_show.style.padding = '1em';
|
||||
error_show.style['font-size'] = '16px';
|
||||
error_show.textContent = text;
|
||||
document.body.appendChild(error_show);
|
||||
return true;
|
||||
}).catch(e => false);
|
||||
439
src/App.elm
Normal file
439
src/App.elm
Normal file
|
|
@ -0,0 +1,439 @@
|
|||
module App exposing (..)
|
||||
|
||||
import Browser
|
||||
import ConstraintLayout as CL
|
||||
import Html as H exposing (Html)
|
||||
import Html.Attributes as HA
|
||||
import Html.Events as HE
|
||||
import List.Extra as LE
|
||||
import Random as R
|
||||
import Random.Extra as RE
|
||||
import Random.List as RL
|
||||
import Svg exposing (Svg)
|
||||
import Svg.Attributes as SA
|
||||
import Svg.Events as SE
|
||||
import Tuple exposing (first, second, pair)
|
||||
import Vector exposing (..)
|
||||
|
||||
type alias Value = Int
|
||||
|
||||
type alias Id = Int
|
||||
|
||||
type alias JunctionFunction = Value -> List Value -> List Value
|
||||
|
||||
type alias Junction =
|
||||
{ id : Id
|
||||
, fn : JunctionFunction
|
||||
, label : String
|
||||
, next : List Id
|
||||
, stack : List Value
|
||||
, position : Vector
|
||||
, solution_stack : List Value
|
||||
}
|
||||
|
||||
type alias Model =
|
||||
{ junctions : List Junction
|
||||
, selected_junction : Maybe Id
|
||||
}
|
||||
|
||||
type Msg
|
||||
= Move (Id, Id)
|
||||
| SetJunctions (List Junction)
|
||||
| ClickJunction Id
|
||||
| RandomMove
|
||||
|
||||
|
||||
lerp : Float -> Float -> Float -> Float
|
||||
lerp a b t = t*b + (1-t)*a
|
||||
|
||||
is_id : Id -> { a | id : Id } -> Bool
|
||||
is_id id = .id >> (==) id
|
||||
|
||||
get_junction : List Junction -> Id -> Maybe Junction
|
||||
get_junction junctions id = junctions |> LE.find (is_id id)
|
||||
|
||||
set_junction : Id -> Junction -> List Junction -> List Junction
|
||||
set_junction id j junctions = LE.setIf (is_id id) j junctions
|
||||
|
||||
iterate : (a -> a) -> Int -> a -> a
|
||||
iterate fn n a =
|
||||
if n > 0 then
|
||||
iterate fn (n-1) (fn a)
|
||||
else
|
||||
a
|
||||
|
||||
layout_junctions : Model -> Model
|
||||
layout_junctions model =
|
||||
let
|
||||
gap = 100
|
||||
|
||||
min_dist_constraints =
|
||||
List.range 0 (List.length model.junctions)
|
||||
|> LE.uniquePairs
|
||||
|> List.map (\(a,b) -> (CL.MinDistance gap, a, b))
|
||||
|
||||
max_dist_constraints =
|
||||
model.junctions
|
||||
|> List.concatMap (\j -> List.map (\i -> (CL.MaxDistance (gap), j.id, i)) j.next)
|
||||
|
||||
same_y_constraints =
|
||||
model.junctions
|
||||
|> List.concatMap (\j -> List.map (\i -> (CL.SameY, j.id, i)) j.next)
|
||||
|
||||
below_constraints =
|
||||
model.junctions
|
||||
|> List.concatMap (\j -> List.map2 (\i k -> (CL.Below (gap/2), i, k)) j.next (List.drop 1 j.next))
|
||||
|
||||
right_of_constraints =
|
||||
model.junctions
|
||||
|> List.concatMap (\j -> List.map (\i -> (CL.RightOf gap, j.id, i)) j.next)
|
||||
|
||||
constraints =
|
||||
[(CL.FixedPosition (0,0),0,0)]
|
||||
++ min_dist_constraints
|
||||
++ max_dist_constraints
|
||||
++ right_of_constraints
|
||||
-- ++ below_constraints
|
||||
++ same_y_constraints
|
||||
|
||||
new_positions =
|
||||
model.junctions
|
||||
|> List.map .position
|
||||
|> iterate (CL.layout constraints) 1000
|
||||
|
||||
junctions = List.map2
|
||||
(\j p -> { j | position = p })
|
||||
model.junctions
|
||||
new_positions
|
||||
in
|
||||
{ model | junctions = junctions }
|
||||
|
||||
path_through_points : List Vector -> String
|
||||
path_through_points points =
|
||||
points
|
||||
|> List.indexedMap (\i (x,y) -> (if i==0 then "M" else "L")++" "++(ff x)++" "++(ff y))
|
||||
|> String.join " "
|
||||
|
||||
bezier_curve : Vector -> Vector -> Vector -> Vector -> String
|
||||
bezier_curve (x1,y1) (x2,y2) (x3,y3) (x4,y4) =
|
||||
"M "++(ff x1)++" "++(ff y1)++" C "++(ff x2)++" "++(ff y2)++" "++(ff x3)++" "++(ff y3)++" "++(ff x4)++" "++(ff y4)
|
||||
translate_to : Vector -> String
|
||||
translate_to (x,y) = "translate("++(ff x)++","++(ff y)++")"
|
||||
|
||||
main = Browser.document
|
||||
{ init = init
|
||||
, update = update
|
||||
, subscriptions = subscriptions
|
||||
, view = view
|
||||
}
|
||||
|
||||
blank_junction : Junction
|
||||
blank_junction =
|
||||
{ id = 0
|
||||
, fn = add_to_end
|
||||
, label = ""
|
||||
, stack = []
|
||||
, position = (0,0)
|
||||
, next = []
|
||||
, solution_stack = []
|
||||
}
|
||||
|
||||
add_to_end a list = list++[a]
|
||||
|
||||
add_junction_links : Junction -> Id -> List Id -> Junction
|
||||
add_junction_links j id next = { j | id = id, next = next }
|
||||
|
||||
source_junction stack = { blank_junction | stack = stack, label="S" } |> add_junction_links
|
||||
|
||||
empty_junction = blank_junction |> add_junction_links
|
||||
|
||||
final_junction = add_junction_links { blank_junction | label = "F" }
|
||||
|
||||
unary_junction fn label = { blank_junction | fn = fn >> add_to_end, label = label } |> add_junction_links
|
||||
|
||||
|
||||
random_junctions : R.Generator (List Junction)
|
||||
random_junctions =
|
||||
let
|
||||
sources : R.Generator (List Junction)
|
||||
sources =
|
||||
R.int 1 2 |> R.andThen (\n -> R.list n (R.int 1 3 |> R.andThen (\m -> R.list m (R.int 1 9) |> R.map (source_junction))))
|
||||
|> R.map (List.indexedMap (\i j -> j i []))
|
||||
|
||||
add_op = R.int -4 5 |> R.map (\x -> if x<=0 then x-1 else x) |> R.map (\x -> unary_junction ((+) x) (if x > 0 then "+"++(fi x) else fi x))
|
||||
other_ops =
|
||||
[ R.int 2 5 |> R.map (\x -> unary_junction ((*) x) ("×"++(fi x)))
|
||||
]
|
||||
|
||||
ops : R.Generator (List (Int -> List Id -> Junction))
|
||||
ops = R.int 1 4 |> R.andThen (\n -> R.list n (R.uniform add_op other_ops |> R.andThen identity))
|
||||
|
||||
finals = R.int 1 1 |> R.andThen (\n -> R.list n (R.constant final_junction))
|
||||
|
||||
step : (List Junction, List Junction, List (Int -> List Id -> Junction)) -> R.Generator (List Junction, List Junction)
|
||||
step (last, prev, next) =
|
||||
let
|
||||
q = Debug.log "join" (List.map .label prev, List.map .label id_next)
|
||||
|
||||
maxid = List.maximum (List.map .id prev) |> Maybe.withDefault -1
|
||||
|
||||
-- add IDs to the next junctions
|
||||
id_next : List Junction
|
||||
id_next =
|
||||
next
|
||||
|> List.indexedMap (\i j -> j (i+maxid+1) [])
|
||||
|
||||
add_track : List Junction -> List Junction -> R.Generator (List (Id,Id))
|
||||
add_track ps ns = case (ps,ns) of
|
||||
(p::prest, n::nrest) -> (add_track prest nrest) |> R.map ((::) (p.id,n.id))
|
||||
|
||||
(p::prest, []) ->
|
||||
case id_next of
|
||||
n1::nrest -> R.uniform n1 nrest |> R.map2 (\r n -> (p.id, n.id)::r) (add_track prest [])
|
||||
[] -> R.constant []
|
||||
|
||||
([], n::nrest) ->
|
||||
case prev of
|
||||
p1::prest -> R.uniform p1 prest |> R.map2 (\r p -> (p.id, n.id)::r) (add_track [] nrest)
|
||||
[] -> R.constant []
|
||||
|
||||
([], []) -> R.constant []
|
||||
|
||||
tracks = add_track prev id_next
|
||||
|
||||
add_joins : Junction -> R.Generator Junction
|
||||
add_joins j =
|
||||
tracks
|
||||
|> R.map (List.filter (first >> (==) j.id) >> List.map second)
|
||||
|> R.map (\n -> { j | next = n })
|
||||
|
||||
joined_prev : R.Generator (List Junction)
|
||||
joined_prev = RE.sequence (List.map add_joins prev)
|
||||
in
|
||||
R.map (\p -> (last++p, id_next))
|
||||
joined_prev
|
||||
|
||||
add_level : R.Generator (List (Int -> List Id -> Junction)) -> R.Generator (List Junction, List Junction) -> R.Generator (List Junction, List Junction)
|
||||
add_level rnext rlastprev =
|
||||
R.map2 (\next (last,prev) -> step (last, prev, next))
|
||||
rnext
|
||||
rlastprev
|
||||
|> R.andThen identity
|
||||
in
|
||||
List.foldl add_level (R.map (pair []) sources) ((List.repeat 3 ops)++[finals])
|
||||
|> R.map (\(a,b) -> a++b)
|
||||
|
||||
random_position = R.map2 pair (R.float 0 1) (R.float 0 1)
|
||||
|
||||
scatter_junctions : List Junction -> R.Generator (List Junction)
|
||||
scatter_junctions junctions =
|
||||
R.list (List.length junctions) random_position
|
||||
|> R.map (List.map2 (\j p -> { j | position = p}) junctions)
|
||||
|
||||
available_moves : List Junction -> List (Id,Id)
|
||||
available_moves junctions =
|
||||
junctions
|
||||
|> List.filter (.stack >> List.length >> (<) 0)
|
||||
|> List.concatMap (\j -> List.map (pair j.id) j.next)
|
||||
|
||||
random_solution : List Junction -> R.Generator (List Junction)
|
||||
random_solution junctions =
|
||||
let
|
||||
step : List Junction -> R.Generator (List Junction)
|
||||
step js = case available_moves js of
|
||||
[] -> R.constant js
|
||||
a::rest ->
|
||||
R.uniform a rest
|
||||
|> R.andThen (\move -> step (move_item move js))
|
||||
in
|
||||
(step junctions)
|
||||
|> R.map (List.map .stack)
|
||||
|> R.map (List.map2 (\j s -> { j | solution_stack = s }) junctions)
|
||||
|
||||
|
||||
|
||||
{- ------------------- -}
|
||||
|
||||
init_model =
|
||||
{ junctions =
|
||||
[ source_junction [1,2,3,4,5,6] 0 [1,3]
|
||||
, unary_junction ((*) 2) "×2" 1 [2]
|
||||
, unary_junction (\x -> x - 1) "-1" 2 [4]
|
||||
, unary_junction ((+) 1) "+1" 3 [2,4,5]
|
||||
, final_junction 4 []
|
||||
, final_junction 5 []
|
||||
]
|
||||
, selected_junction = Nothing
|
||||
}
|
||||
|
||||
init : () -> (Model, Cmd Msg)
|
||||
init _ =
|
||||
( init_model
|
||||
, Cmd.batch
|
||||
[ R.generate (SetJunctions) (random_junctions |> R.andThen scatter_junctions |> R.andThen random_solution)
|
||||
]
|
||||
)
|
||||
|
||||
nocmd model = (model, Cmd.none)
|
||||
|
||||
maybeFilter : (a -> Bool) -> Maybe a -> Maybe a
|
||||
maybeFilter predicate = Maybe.andThen (\a -> if predicate a then Just a else Nothing)
|
||||
|
||||
update : Msg -> Model -> (Model, Cmd Msg)
|
||||
update msg model = case msg of
|
||||
Move (from,to) -> { model | junctions = move_item (from,to) model.junctions } |> nocmd
|
||||
|
||||
SetJunctions junctions -> { model | junctions = junctions } |> layout_junctions |> nocmd
|
||||
|
||||
ClickJunction id ->
|
||||
model.selected_junction
|
||||
|> Maybe.andThen (get_junction model.junctions >> maybeFilter (.next >> List.member id))
|
||||
|> Maybe.map (\j -> { model | junctions = move_item (j.id, id) model.junctions })
|
||||
|> Maybe.withDefault model
|
||||
|> (\m -> { m | selected_junction = Just id })
|
||||
|> nocmd
|
||||
|
||||
RandomMove -> case available_moves model.junctions of
|
||||
m::rest -> (model, R.generate Move (R.uniform m rest))
|
||||
[] -> model |> nocmd
|
||||
|
||||
move_item : (Id,Id) -> List Junction -> List Junction
|
||||
move_item (from,to) junctions = case (get_junction junctions from, get_junction junctions to) of
|
||||
(Just jfrom, Just jto) -> case jfrom.stack of
|
||||
v::rest ->
|
||||
let
|
||||
nfrom = { jfrom | stack = rest }
|
||||
nto = { jto | stack = jto.fn v jto.stack }
|
||||
in
|
||||
junctions
|
||||
|> (set_junction from nfrom)
|
||||
|> (set_junction to nto)
|
||||
|
||||
_ -> junctions
|
||||
|
||||
|
||||
_ -> junctions
|
||||
|
||||
subscriptions model = Sub.none
|
||||
|
||||
fi = String.fromInt
|
||||
ff = String.fromFloat
|
||||
tf = toFloat
|
||||
|
||||
view : Model -> Browser.Document Msg
|
||||
view model =
|
||||
let
|
||||
positions = List.map .position model.junctions
|
||||
|
||||
minx = positions |> List.map first |> List.minimum |> Maybe.withDefault 0
|
||||
maxx = positions |> List.map first |> List.maximum |> Maybe.withDefault 0
|
||||
miny = positions |> List.map second |> List.minimum |> Maybe.withDefault 0
|
||||
maxy = positions |> List.map second |> List.maximum |> Maybe.withDefault 0
|
||||
|
||||
margin = 100
|
||||
|
||||
viewbox = (ff <| minx-margin)++" "++(ff <| miny-margin)++" "++(ff <| maxx-minx + 2*margin)++" "++(ff <| (maxy-miny + 2*margin))
|
||||
|
||||
view_junction junction =
|
||||
let
|
||||
(x,y) = junction.position
|
||||
|
||||
can_move_to =
|
||||
model.selected_junction
|
||||
|> Maybe.andThen (get_junction model.junctions)
|
||||
|> Maybe.map (.next >> List.member junction.id)
|
||||
|> Maybe.withDefault False
|
||||
|
||||
selected = model.selected_junction == Just junction.id
|
||||
|
||||
view_stack_item in_solution i n =
|
||||
let
|
||||
path = (junction.id, i)
|
||||
|
||||
selected_item = (not in_solution) && (model.selected_junction == Just junction.id) && i == 0
|
||||
in
|
||||
Svg.g
|
||||
[ SA.transform <| translate_to (0,(tf i)*11 + 18)
|
||||
]
|
||||
[ Svg.circle
|
||||
[ SA.r "5"
|
||||
, SA.fill (if in_solution then "lightgray" else if selected_item then "yellow" else "lightblue")
|
||||
]
|
||||
[]
|
||||
, Svg.text_
|
||||
[ SA.textAnchor "middle"
|
||||
, SA.dominantBaseline "middle"
|
||||
, SA.fontSize "5"
|
||||
]
|
||||
[ Svg.text <| fi n
|
||||
]
|
||||
]
|
||||
|
||||
in
|
||||
Svg.g
|
||||
[ SA.transform <| translate_to junction.position ]
|
||||
[ Svg.g
|
||||
[ SE.onClick (ClickJunction junction.id) ]
|
||||
[ Svg.circle
|
||||
[ SA.r "10"
|
||||
, SA.fill (if selected then "pink" else if can_move_to then "lightgreen" else "grey")
|
||||
, SA.stroke "black"
|
||||
]
|
||||
[]
|
||||
, Svg.text_
|
||||
[ SA.fontSize "10"
|
||||
, SA.textAnchor "middle"
|
||||
, SA.dominantBaseline "middle"
|
||||
]
|
||||
[ Svg.text junction.label ]
|
||||
]
|
||||
, Svg.g
|
||||
[]
|
||||
(List.indexedMap (view_stack_item True) junction.solution_stack)
|
||||
, Svg.g
|
||||
[]
|
||||
(List.indexedMap (view_stack_item False) junction.stack)
|
||||
]
|
||||
|
||||
junctions_by_y =
|
||||
model.junctions
|
||||
|> List.sortBy (.position >> second)
|
||||
|
||||
tracks =
|
||||
junctions_by_y
|
||||
|> List.concatMap (\j -> j.next |> List.map (get_junction model.junctions >> Maybe.map (\j2 -> (j.position, j2.position))) )
|
||||
|> List.filterMap identity
|
||||
|
||||
num_tracks = List.length tracks
|
||||
|
||||
view_track i ((x1,y1),(x2,y2)) =
|
||||
let
|
||||
yo = (tf i) / (tf num_tracks) * 10 - 5
|
||||
in
|
||||
Svg.path
|
||||
[ SA.d <| bezier_curve (x1,y1) (lerp x1 x2 0.5,y1) (lerp x1 x2 0.5,y2) (x2,y2)
|
||||
, SA.fill "none"
|
||||
, SA.stroke "black"
|
||||
, SA.strokeDasharray "2 2"
|
||||
]
|
||||
[]
|
||||
in
|
||||
{
|
||||
title = "Hey",
|
||||
body =
|
||||
[ Svg.svg
|
||||
[ HA.attribute "viewBox" viewbox
|
||||
]
|
||||
[ Svg.g
|
||||
[]
|
||||
(List.indexedMap view_track tracks)
|
||||
, Svg.g
|
||||
[]
|
||||
(List.map view_junction model.junctions)
|
||||
]
|
||||
, H.p
|
||||
[]
|
||||
[ H.button [ HE.onClick RandomMove] [H.text "Random move"]]
|
||||
, H.pre [] [H.text <| Debug.toString <| available_moves model.junctions ]
|
||||
]
|
||||
}
|
||||
72
src/ConstraintLayout.elm
Normal file
72
src/ConstraintLayout.elm
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
module ConstraintLayout exposing (layout, satisfy, Constraint, ConstraintKind(..))
|
||||
|
||||
import List.Extra as LE
|
||||
import Tuple exposing (first, second)
|
||||
import Vector exposing (..)
|
||||
|
||||
type alias Index = Int
|
||||
|
||||
type alias Constraint = (ConstraintKind, Index, Index)
|
||||
|
||||
type ConstraintKind
|
||||
= MinDistance Float
|
||||
| MaxDistance Float
|
||||
| RightOf Float
|
||||
| Below Float
|
||||
| FixedPosition Vector
|
||||
| SameY
|
||||
|
||||
satisfy : List Vector -> Constraint -> List (Index,Vector)
|
||||
satisfy positions (constraint,ia,ib) =
|
||||
case (LE.getAt ia positions, LE.getAt ib positions) of
|
||||
(Just a, Just b) ->
|
||||
case constraint of
|
||||
MinDistance mind ->
|
||||
let
|
||||
d = distance a b
|
||||
n = sub b a |> normalise
|
||||
f = max 0 ((mind-d)/2)
|
||||
m = smul f n
|
||||
in
|
||||
[ (ia, neg m)
|
||||
, (ib, m)
|
||||
]
|
||||
|
||||
FixedPosition p -> [ (ia, sub p a)]
|
||||
|
||||
RightOf d->
|
||||
let
|
||||
dx = (first a) - ((first b) - d)
|
||||
f = max 0 dx/2
|
||||
in
|
||||
[ (ia, (-f,0))
|
||||
, (ib, (f,0))
|
||||
]
|
||||
|
||||
Below d->
|
||||
let
|
||||
dy = (first a) - ((first b) - d)
|
||||
f = max 0 dy/2
|
||||
in
|
||||
[ (ia, (0,-f))
|
||||
, (ib, (0,f))
|
||||
]
|
||||
|
||||
SameY ->
|
||||
let
|
||||
dy = (second b) - (second a)
|
||||
in
|
||||
[ (ia, (0, dy/10))
|
||||
, (ib, (0,-dy/10))
|
||||
]
|
||||
_ -> []
|
||||
_ -> []
|
||||
|
||||
|
||||
layout : List Constraint -> List Vector -> List Vector
|
||||
layout constraints positions =
|
||||
let
|
||||
f = 0.1
|
||||
changes = List.concatMap (satisfy positions) constraints
|
||||
in
|
||||
List.foldl (\(i,v) -> LE.updateAt i (add (smul f v))) positions changes
|
||||
43
src/Vector.elm
Normal file
43
src/Vector.elm
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
module Vector exposing (..)
|
||||
|
||||
import Tuple exposing (pair, first, second)
|
||||
|
||||
type alias Vector = (Float, Float)
|
||||
|
||||
type alias LineSegment = (Vector, Vector)
|
||||
|
||||
add (x1,y1) (x2,y2) = (x1+x2, y1+y2)
|
||||
sub (x1,y1) (x2,y2) = (x1-x2, y1-y2)
|
||||
len (x,y) = sqrt (x*x + y*y)
|
||||
smul s (x,y) = (s*x, s*y)
|
||||
neg (x,y) = (-x,-y)
|
||||
distance v1 v2 = sub v1 v2 |> len
|
||||
|
||||
midpoint (x1,y1) (x2,y2) = ((x1+x2)/2, (y1+y2)/2)
|
||||
|
||||
normalise (x,y) =
|
||||
let
|
||||
d = len (x,y)
|
||||
in
|
||||
(x/d, y/d)
|
||||
|
||||
normal (x,y) = normalise (-y,x)
|
||||
|
||||
dot (x1,y1) (x2,y2) = x1*x2 + y1*y2
|
||||
|
||||
sum : List Vector -> Vector
|
||||
sum = List.foldl add (0,0)
|
||||
|
||||
point_line_distance p (p1,p2) =
|
||||
let
|
||||
v1 = sub p2 p1
|
||||
v2 = sub p p1
|
||||
n = normal v1
|
||||
d1 = len v1
|
||||
alpha = (dot v1 v2) / d1
|
||||
d = len (sub p (add p1 (smul alpha v1)))
|
||||
in
|
||||
if alpha<0 then len (sub p p1) else if alpha>d1 then len (sub p p2) else d
|
||||
|
||||
closest : (a -> Vector) -> Vector -> List a -> Maybe (Int, Float, a)
|
||||
closest get_position p1 = List.map (\a -> (a, get_position a |> sub p1 |> len)) >> List.indexedMap (\i (a,d) -> (i,d,a)) >> List.sortBy (\(i,d,a) -> d) >> List.head
|
||||
0
style.css
Normal file
0
style.css
Normal file
Loading…
Add table
Add a link
Reference in a new issue