clp/draggy-road-game
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

first commit

Browse source
This commit is contained in:
Christian Lawson-Perfect 2025-02-09 20:11:49 +00:00
commit 3714d6e1fc
13 changed files with 10781 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
.gitignore vendored Normal file
View file

@ -0,0 +1,3 @@
.make.*
elm-stuff/
error.txt

2
.watchmakerc Normal file
View file

@ -0,0 +1,2 @@
extensions:
- .elm

11
Makefile Normal file
View 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)"

9302
app.js Normal file
View file

File diff suppressed because it is too large Load diff

29
elm.json Normal file
View file

@ -0,0 +1,29 @@
{
"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/json": "1.1.3",
"elm/parser": "1.1.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/time": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.3"
}
},
"test-dependencies": {
"direct": {},
"indirect": {}
}
}

23
index.html Normal file
View 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?1"></script>
<script src="load-app.js" type="module"></script>
</body>
</html>

11
load-app.js Normal file
View file

@ -0,0 +1,11 @@
import show_error from './show-error.mjs';
import './svg-events.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();

22
show-error.mjs Normal file
View file

@ -0,0 +1,22 @@
export default fetch('/error.txt').then(r=>{
if(r.ok) {
return r.text();
} else {
throw('');
}
}).then(text => {
if(!text) {
return false;
}
document.body.innerHTML = '';
document.body.classList.add('compilation-error');
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);

1184
src/App.elm Normal file
View file

File diff suppressed because it is too large Load diff

17
src/Util.elm Normal file
View file

@ -0,0 +1,17 @@
module Util exposing (..)
fi = String.fromInt
ff = String.fromFloat
tf = toFloat
pairMap : (a -> b) -> a -> (a,b)
pairMap fn a = (a, fn a)
third : (a,b,c) -> c
third (a,b,c) = c
maybeIf : (a -> Bool) -> Maybe a -> Maybe a
maybeIf condition = Maybe.andThen (\a -> if condition a then Just a else Nothing)
capitalise : String -> String
capitalise str = (String.left 1 str |> String.toUpper) ++ (String.dropLeft 1 str)

60
src/Vector.elm Normal file
View file

@ -0,0 +1,60 @@
module Vector exposing (..)
import Tuple exposing (pair, first, second)
import Util exposing (maybeIf)
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)
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
closest_within : (a -> Float) -> (a -> Vector) -> Vector -> List a -> Maybe (Int, Float, a)
closest_within get_limit get_position p1 things =
closest get_position p1 things
|> maybeIf (\(i,d,a) -> d < get_limit a)
{- The closest point to the given segment. Returns how far along the segment the point is (0 to 1), and the point -}
closest_point_on_segment : LineSegment -> Vector -> (Float,Vector)
closest_point_on_segment (p1,p2) p =
let
v = sub p2 p1
vp = sub p p1
l = len v
d = (dot v vp) / ((len v)^2)
t = clamp 0 1 d
in
(d, add p1 (smul t v))

55
style.css Normal file
View file

@ -0,0 +1,55 @@
body {
display: grid;
grid-template:
"svg" 1fr
"controls" 10em
;
height: 100svh;
margin: 0;
user-select: none;
&.compilation-error {
grid-template: "error" 1fr;
}
& #debug-log {
background: #f4f4f4;
}
& svg {
width: 100%;
height: 100%;
& text {
user-select: none;
paint-order: stroke fill;
stroke-linejoin: round;
stroke-linecap: round;
fill: white;
stroke: black;
stroke-width: 0.2em;
}
& #obstacle-outlines circle {
filter: blur(0.5px);
}
}
& #controls {
display: grid;
grid-auto-flow: column;
}
& .road path {
stroke-linejoin: round;
}
& #recipe-list {
list-style: none;
margin: 0;
padding: 0;
max-height: 100%;
overflow: scroll;
}
}

62
svg-events.mjs Normal file
View file

@ -0,0 +1,62 @@
function getsvg(event) {
let t = event.target;
while(t && t.tagName.toLowerCase()!='svg') {
t = t.parentElement;
}
return t;
}
function getcoords(event) {
const t = getsvg(event);
const point = t.createSVGPoint()
point.x = event.clientX
point.y = event.clientY
const position = point.matrixTransform(t.getScreenCTM().inverse())
return position;
}
var observer = new MutationObserver(function (mutations) {
mutations.forEach(function (mutation) {
if (mutation.type === 'childList') {
Array
.from(mutation.addedNodes)
.forEach(function (node) {
if(node.nodeType != document.ELEMENT_NODE || node.tagName.toLowerCase() !== 'svg') {
return;
}
node.addEventListener('pointermove', function (event) {
const t = getsvg(event);
if(!t) {
return;
}
const position = getcoords(event);
const svgMoveEvent = new CustomEvent('svgmove', {
detail: {x: position.x, y: position.y},
});
t.dispatchEvent(svgMoveEvent);
});
function svg_touch_event(name) {
node.addEventListener(name, function(event) {
const t = getsvg(event);
if(!t) {
return;
}
event.preventDefault();
//event.stopPropagation();
const touches = Array.from(event.changedTouches).map(touch => {
const position = getcoords(touch);
return {identifier: touch.identifier, position: position}
});
const touchEvent = new CustomEvent('svg'+name, {
detail: touches
});
t.dispatchEvent(touchEvent);
});
};
['touchstart','touchmove','touchend'].forEach(svg_touch_event)
});
}
});
});
observer.observe(document.body, { childList: true, subtree: true });