commit 94c58e7f74473fc8b135d5796724b79d5da5d0e4 Author: Christian Lawson-Perfect Date: Sun Feb 9 20:13:36 2025 +0000 first commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3b9e915 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.make.* +elm-stuff/ +error.txt +app.js \ No newline at end of file diff --git a/.watchmakerc b/.watchmakerc new file mode 100644 index 0000000..285f521 --- /dev/null +++ b/.watchmakerc @@ -0,0 +1,2 @@ +extensions: + - .elm \ No newline at end of file diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..092ea03 --- /dev/null +++ b/Makefile @@ -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)" \ No newline at end of file diff --git a/TODO b/TODO new file mode 100644 index 0000000..fa0ce37 --- /dev/null +++ b/TODO @@ -0,0 +1,10 @@ +* Draw outlines around the cells based on their depth, so it's easier to see how deep they are. + +* Add something like a "mining machine" which must be at level 0, and makes a path of steps of 1 height. + The aim is to have a way of getting money once you're stuck, and to give an incentive to not dig some cells. + +* An expensive "just dig this cell no matter what" tool? + +* Add a popup thing each time you make a move, showing how much money you dug up or spent. + +* Different kinds of treasure, to make it interesting. \ No newline at end of file diff --git a/elm.json b/elm.json new file mode 100644 index 0000000..eb881cf --- /dev/null +++ b/elm.json @@ -0,0 +1,25 @@ +{ + "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/random": "1.0.0" + }, + "indirect": { + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.3" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/index.html b/index.html new file mode 100644 index 0000000..ad818c7 --- /dev/null +++ b/index.html @@ -0,0 +1,23 @@ + + + + + + Elm app by clp + + + + +

Elm app by clp

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.

On balance of probabilities: I'm sorry I couldn't be bothered to make this work for you.

+ + + + + + diff --git a/load-app.js b/load-app.js new file mode 100644 index 0000000..ff737aa --- /dev/null +++ b/load-app.js @@ -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(); diff --git a/show-error.mjs b/show-error.mjs new file mode 100644 index 0000000..0c9d53e --- /dev/null +++ b/show-error.mjs @@ -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); diff --git a/src/App.elm b/src/App.elm new file mode 100644 index 0000000..60ec5dd --- /dev/null +++ b/src/App.elm @@ -0,0 +1,331 @@ +module App exposing (..) + +import Array exposing (Array) +import Browser +import Browser.Events +import Grid exposing (Coords) +import Html as H exposing (Html) +import Html.Attributes as HA +import Html.Events as HE +import Json.Decode as JD +import Random +import Tuple exposing (pair, first, second) + +dynamite_cost level = (level+1) * 5 + +money_for level = + Array.get level + (Array.fromList [0,5,10,20,50,75,100]) + |> Maybe.withDefault (level * 50 - 200) +{- 4, 9, 16, 25 -} +{- 5, 10, 20, 50, 100 -} + +main = Browser.document + { init = init + , update = update + , subscriptions = subscriptions + , view = view + } + +type Action + = Dig + | Fill + +type Rock + = Dirt + | Boulder + | Treasure + +type alias Cell = + { dug : Int + , rocks : Array (Rock, Bool) + } + +cell_rock : Cell -> Rock +cell_rock cell = (Array.get cell.dug cell.rocks) |> Maybe.map first |> Maybe.withDefault Dirt + +type alias Grid = Grid.Grid Cell + +type alias Model = + { grid : Grid + , money : Int + , action : Action + } + +default_cell = + { dug = 0 + , rocks = (Array.repeat 10 (Dirt, False)) + } + +empty_grid : Grid +empty_grid = Grid.fill 5 5 default_cell + +rock_probabilities = + [ (10, Boulder) + ] + +random_rock : Random.Generator (Rock, Bool) +random_rock = + Random.weighted + (100, Dirt) + rock_probabilities + + |> Random.map (\r -> (r, False)) + +random_walk : Random.Generator (List Coords) +random_walk = + let + start = Random.map2 pair (Random.int 0 9) (Random.int 0 9) + + step : Int -> (Random.Generator (List Coords)) -> (Random.Generator (List Coords)) + step _ rlast = + rlast |> Random.andThen + (\last -> case last of + [] -> Random.map List.singleton start + (x,y)::others -> + let + choices = [(x-1,y),(x+1,y),(x,y-1),(x,y+1)] |> List.filter (\(x2,y2) -> x>=0 && x<10 && y>=0 && y<10) + in + Random.uniform (x,y) choices |> Random.map (\c -> c::last) + ) + in + List.foldl + step + (Random.constant []) + (List.range 0 10) + +random_grid : Random.Generator Grid +random_grid = + let + width = 7 + height = 7 + + rcells = + Random.list + (width*height) + ( Random.list 10 random_rock + |> Random.map (Array.fromList >> (\rocks -> { default_cell | rocks = rocks })) + ) + |> Random.map Array.fromList + + rgrid = + rcells + |> Random.map (\cells -> { width = width, height = height, cells = cells }) + + rwalks : Random.Generator (List (List Coords)) + rwalks = Random.list 10 random_walk + + apply_walk : List Coords -> Int -> Grid -> Grid + apply_walk walk start grid = + List.foldl + (\(z,pos) -> Grid.map_cell pos (\cell -> { cell | rocks = Array.set (z+start) (Treasure, False) cell.rocks})) + grid + (List.indexedMap pair walk) + in + Random.andThen + (\walks -> + List.foldl + (\walk -> Random.map2 (apply_walk walk) (Random.int 1 3)) + rgrid + walks + ) + rwalks + +init_model : Model +init_model = + { grid = empty_grid + , money = 0 + , action = Dig + } + +type Msg + = SelectCell Int Coords + | SetGrid Grid + | SetAction Action + | Noop + +nocmd model = (model, Cmd.none) + +init : () -> (Model, Cmd Msg) +init _ = (init_model, Random.generate SetGrid random_grid) + +update msg model = case (Debug.log "msg" msg) of + SelectCell button coords -> click_cell button coords model |> nocmd + + SetGrid grid -> { model | grid = Debug.log "grid" grid } |> nocmd + + SetAction action -> { model | action = action } |> nocmd + + Noop -> model |> nocmd + +click_result : Coords -> Model -> Maybe (Cell, Int) +click_result coords model = + let + grid = model.grid + cell = Grid.get_cell coords grid |> Maybe.withDefault default_cell + neighbours = Grid.neighbours 1 coords model.grid + num_equal = neighbours |> List.filter (.dug >> (==) cell.dug) |> List.length + sum_diff = neighbours |> List.map (\c2 -> c2.dug - cell.dug) |> List.sum + all_greater = neighbours |> List.all (.dug >> (<) cell.dug) + rock = cell_rock cell + res : Maybe (Cell, Int) + res = + case (rock, model.action) of + (Treasure, Dig) -> Just ({ cell | rocks = Array.set cell.dug (Dirt,True) cell.rocks }, money_for cell.dug) + + (Dirt, Dig) -> + if num_equal >= cell.dug + 1 || sum_diff > 2 || all_greater || cell.dug == 0 then + Just ({ cell | dug = cell.dug + 1 }, cell.dug) + else + Nothing + + (Boulder, Dig) -> + Just ({ cell | rocks = Array.set cell.dug (Dirt, False) cell.rocks }, -(dynamite_cost cell.dug)) + + (_, Fill) -> + if cell.dug > 0 then + Just ({ cell | dug = cell.dug - 1 }, -(cell.dug-1)) + else + Nothing + in + res |> Maybe.andThen (\(ncell, cost) -> if model.money + cost >= 0 then res else Nothing) + +button_action button action = case button of + 0 -> action + _ -> case action of + Dig -> Fill + _ -> Dig + +click_cell button coords model = + case click_result coords { model | action = button_action button model.action } of + Nothing -> model + Just (ncell, money) -> + let + ngrid = Grid.set_cell coords ncell model.grid + in + { model | grid = ngrid, money = model.money + money } + +can_action_cell : Coords -> Model -> Bool +can_action_cell coords model = click_result coords model /= Nothing + +total_score : Grid -> Int +total_score = + (.cells) + >> Array.toList + >> List.map (.dug) + >> List.sum + +subscriptions model = + Browser.Events.onKeyDown + ( JD.field "key" JD.string + |> JD.andThen (\key -> + case (String.toUpper key) of + "D" -> JD.succeed (SetAction Dig) + "F" -> JD.succeed (SetAction Fill) + _ -> JD.fail (Debug.log "bad" ("unrecognised key "++key)) + ) + ) + + +radio : List (H.Attribute Msg) -> String -> Html Msg +radio attr label = + H.label + [] + [ H.input + (([ HA.type_ "radio"])++attr) + [] + , H.text label + ] + +view : Model -> Browser.Document Msg +view model = + let + grid = model.grid + + view_cell : Coords -> Cell -> Html Msg + view_cell coords v = + let + (rock, flag) = Array.get v.dug v.rocks |> Maybe.withDefault (Dirt, False) + in + H.td + [ HA.classList + [ ("can-increment", can_action_cell coords model) + ] + , HA.style "background" <| "hsl(60,50%,"++(String.fromFloat (50 / (toFloat (v.dug+1))))++"%)" + , HA.attribute "data-background" <| "hsl(60,50%,"++(String.fromFloat (50 / (toFloat (v.dug+1))))++")" + , HE.on "mousedown" + ( JD.field "button" JD.int + |> JD.map (\button -> + let + z = Debug.log "button" button + in + SelectCell button coords + ) + ) + , HE.preventDefaultOn "contextmenu" <| JD.succeed (Noop, True) + ] + [ H.div + [] + [ H.text <| + ( + case rock of + Dirt -> " " + Boulder -> "🪨" + Treasure -> "🪙" + ) ++ ( + String.fromInt v.dug + ) ++ ( + if flag then "⚐" else " " + ) + ] + ] + + view_grid : Html Msg + view_grid = + H.table [] + ( List.range 0 (grid.height-1) + |> List.map + (\y -> + H.tr + [] + (List.range 0 (grid.width-1) + |> List.map + (\x -> + view_cell (x,y) (Grid.get_cell (x,y) grid |> Maybe.withDefault default_cell) + ) + ) + ) + ) + + action_radio action label = + radio + [ HE.onClick <| SetAction action + , HA.value label + , HA.name "action" + , HA.checked <| model.action == action + ] + label + in + { + title = "Hey", + body = + [ view_grid + + , H.p + [] + [ H.text <| ("Score: "++(String.fromInt <| total_score model.grid)) + ] + , H.p + [] + [ H.text <| ("Money: £"++(String.fromInt <| model.money)) + ] + , H.fieldset + [ ] + [ H.legend + [] + [ H.text <| "Action: " ++ (Debug.toString model.action) ] + , action_radio Dig "Dig / Fill" + , action_radio Fill "Fill / Dig" + ] + ] + } \ No newline at end of file diff --git a/src/Grid.elm b/src/Grid.elm new file mode 100644 index 0000000..05d1938 --- /dev/null +++ b/src/Grid.elm @@ -0,0 +1,126 @@ +module Grid exposing + (Grid, + Coords, + fromString, + fromCoords, + fill, + get_row, + set_cell, + get_cell, + map_cell, + coords, + connected_components, + neighbours, + neighbour_coords + ) + +import Array exposing (Array) +import Set + +type alias Coords = (Int,Int) + +type alias Grid x = + { width: Int + , height: Int + , cells: Array x + } + +fromCoords width height fn = + let + decide i = + let + x = modBy width i + y = (i - x) // width + in + fn (x,y) + in + Grid width height ((Array.fromList << List.map decide) (List.range 0 (width*height-1))) + +fromString str parse_cell = + let + rows = (String.split "\n" (String.trim str)) + height = List.length rows + width = Maybe.withDefault 0 (Maybe.map String.length (List.head rows)) + cells = (String.join "" >> String.toList >> (List.map parse_cell) >> Array.fromList) rows + in + { width = width + , height = height + , cells = cells + } + +fill width height value = + { width = width + , height = height + , cells = Array.repeat (width*height) value + } + +get_row : Int -> Grid x -> Array x +get_row row grid = Array.slice (row*grid.width) ((row+1)*grid.width) grid.cells + +set_cell : Coords -> x -> Grid x -> Grid x +set_cell (x,y) value grid = + let + i = y*grid.width + x + in + { grid | cells = (Array.indexedMap (\j -> \c -> if j==i then value else c) grid.cells) } + +get_cell : Coords -> Grid x -> Maybe x +get_cell (x,y) grid = + let + i = y*grid.width + x + in + if x>=0 && x=0 && y List.map (\x -> (x,y)) (List.range 0 (grid.width-1))) (List.range 0 (grid.height-1)) + +map_cell : Coords -> (x -> x) -> Grid x -> Grid x +map_cell pos fn grid = + case get_cell pos grid of + Nothing -> grid + Just x -> set_cell pos (fn x) grid + +connected_components : Bool -> (x -> Bool) -> Grid x -> List (List Coords) +connected_components allow_diagonals include grid = + let + init_components : Array (Maybe Int) + init_components = Array.indexedMap (\i -> \c -> if include c then Just i else Nothing) grid.cells + + merge_components : y -> y -> Array y -> Array y + merge_components a b components = Array.map (\c -> if c==b then a else c) components + check_edge p1 p2 components = + let + g : Grid (Maybe Int) + g = Grid grid.width grid.height components + a = get_cell p1 g + b = get_cell p2 g + in + case (a,b) of + (Just (Just ja), Just (Just jb)) -> if ja /= jb then merge_components (Just ja) (Just jb) components else components + _ -> components + check_pos pos = + let + check p2 components = check_edge pos p2 components + (x,y) = pos + straights = check (x-1,y) >> check (x+1,y) >> check (x,y-1) >> check (x,y+1) + in + if allow_diagonals then + check (x-1,y-1) >> check (x-1,y+1) >> check (x+1,y+1) >> check (x-1,y+1) >> straights + else + straights + + component_per_cell = (Array.toList << List.foldl check_pos init_components) (coords grid) + unique_components = (List.filterMap identity >> Set.fromList >> Set.toList) component_per_cell + final_components = List.map (\id -> List.filterMap identity <| List.map2 (\component -> \pos -> if component == Just id then Just pos else Nothing) component_per_cell (coords grid)) unique_components + in + final_components + +{- Coords of cells at most d steps from given position, excluding that position -} +neighbour_coords : Int -> Coords -> List Coords +neighbour_coords d (x,y) = (List.concatMap (\dy -> List.map (\dx -> (x+dx,y+dy)) <| List.range -d d) (List.range -d d)) |> List.filter ((/=) (x,y)) + +{- Cells at most d steps from given position, excluding that position -} +neighbours : Int -> Coords -> Grid x -> List x +neighbours d pos grid = neighbour_coords d pos |> List.filterMap (\npos -> get_cell npos grid) \ No newline at end of file diff --git a/style.css b/style.css new file mode 100644 index 0000000..4c140fb --- /dev/null +++ b/style.css @@ -0,0 +1,41 @@ +* { + box-sizing: border-box; +} + +body { + margin: 0; +} + +table { + border-collapse: collapse; + touch-action: manipulation; + user-select: none; + margin: 1em auto; +} + +td { + background: green; + font-size: 6svw; + font-family: monospace; + text-align: center; + + &.can-increment { + color: green; + cursor: pointer; + } + + & div { + width: 2em; + height: 2em; + line-height: 2em; + border-radius: 50%; + background: white; + } +} +fieldset { + display: flex; + & label { + flex-grow: 1; + text-align: center; + } +} \ No newline at end of file