Skip to content

Commit e46b5d3

Browse files
committed
add predefined generation methods
1 parent f0a41fa commit e46b5d3

File tree

3 files changed

+129
-23
lines changed

3 files changed

+129
-23
lines changed

src/earthgen/db.cljs

+4-9
Original file line numberDiff line numberDiff line change
@@ -8,13 +8,13 @@
88
[earthgen.grid.core :as grid]
99
[earthgen.generation.core :as generation]
1010
[earthgen.generation.generic :as generic]
11-
[earthgen.generation.operations :as ops]
11+
[earthgen.generation.predefined :as predefined]
1212
[earthgen.validation :as validation]))
1313

1414
(def default-db
1515
(let
1616
[grids (iterate grid/subdivide (grid/initial))
17-
subdivisions 5
17+
subdivisions 7
1818
seed (random/random-seed 12)
1919
granularity 2
2020
irregularity 0.4
@@ -25,12 +25,7 @@
2525
:irregularity irregularity
2626
:amplitude amplitude
2727
:sea-level sea-level}
28-
model (ops/terrain seed
29-
sea-level
30-
(ops/heightmap
31-
{:granularity granularity
32-
:irregularity irregularity
33-
:amplitude amplitude}))
28+
model (predefined/continents)
3429
[_ planet] (generation/transform
3530
grids
3631
subdivisions
@@ -62,7 +57,7 @@
6257
:perspectives perspectives
6358
:model model
6459
:view {:subdivisions (str subdivisions)
65-
:mode :simple
60+
:mode :predefined
6661
:simple-terrain (validation/simple-terrain-str-values simple-terrain)
6762
:current-perspective current-perspective}
6863
:time-per-frame 20
+85
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,85 @@
1+
(ns earthgen.generation.predefined
2+
(:require [earthgen.generation.operations :as ops]))
3+
4+
(defn supercontinents []
5+
(let
6+
[amplitude 4000
7+
sea-level 500
8+
glacial-sea-level (- sea-level 200)]
9+
(ops/terrain nil
10+
sea-level
11+
(ops/heightmap-let
12+
[["landform" (ops/heightmap {:granularity 1 :irregularity 0.2 :amplitude amplitude})]
13+
["sea-level-adjusted" (ops/op- "landform" glacial-sea-level)]
14+
["flatten" (ops/op* (ops/op- "landform" sea-level)
15+
(ops/sigmoid-at [0 0.75] [0.2 sea-level] [0.8 (+ sea-level 200)] "landform"))]
16+
["land?" (ops/sigmoid-at [0 1] [0.2 (- glacial-sea-level 200)] [0.8 sea-level] "landform")]
17+
["ocean?" (ops/sigmoid-at [0 1] [0.1 -200] [0.9 -400] "sea-level-adjusted")]
18+
["highlands" (ops/abs (ops/heightmap {:granularity 1 :irregularity 0.3 :amplitude 1}))]
19+
["highlands?" (ops/sigmoid-at [0 1] [0.8 0.14] [0.1 0.16] "highlands")]
20+
["highland-elevation" (ops/sigmoid-at [600 1000] [0.1 0] [0.8 500] (ops/abs (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 1000})))]
21+
["coastal?" (ops/sigmoid-at [0 1] [0.2 300] [0.8 150] (ops/abs "sea-level-adjusted"))]
22+
["coast-sign" (ops/sigmoid-at [-1 1] [0.2 -50] [0.8 50] (ops/max "sea-level-adjusted" (ops/min 0 (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 1000}))))]
23+
["coastal-mountain-elevation" (ops/max 0 (ops/heightmap {:granularity 3 :irregularity 0.2 :amplitude 6000}))]
24+
25+
["mountains" (ops/abs (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 1}))]
26+
["mountains?" (ops/sigmoid-at [0 1] [0.8 0.02] [0.1 0.1] "mountains")]
27+
["mountain-elevation" (ops/abs (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 5000}))]]
28+
29+
(ops/op+ (ops/op- "landform" "flatten")
30+
(ops/op* 3 "ocean?" "sea-level-adjusted")
31+
(ops/op* "land?" "highlands?" "highland-elevation")
32+
(ops/op* (ops/op- 1 "coastal?") "land?" "mountains?" "mountain-elevation")
33+
(ops/op* "coastal?" "coast-sign" "coastal-mountain-elevation"))))))
34+
35+
(defn continents []
36+
(let
37+
[amplitude 4000
38+
sea-level 800
39+
glacial-sea-level (- sea-level 200)]
40+
(ops/terrain nil
41+
sea-level
42+
(ops/heightmap-let
43+
[["ocean" (ops/op+ 1000 (ops/heightmap {:granularity 1 :irregularity 0.2 :amplitude (* 2 amplitude)}))]
44+
["continents" (ops/heightmap {:granularity 2 :irregularity 0.1 :amplitude amplitude})]
45+
["smooth" (ops/sigmoid-at [0 1] [0.2 -200] [0.8 200] "ocean")]
46+
["landform" (ops/op+ (ops/op* "smooth" "continents")
47+
(ops/op* (ops/op- 1 "smooth") (ops/min "continents" "ocean")))]
48+
49+
["sea-level-adjusted" (ops/op- "landform" glacial-sea-level)]
50+
["flatten" (ops/op* (ops/op- "landform" sea-level)
51+
(ops/sigmoid-at [0 0.75] [0.2 sea-level] [0.8 (+ sea-level 200)] "landform"))]
52+
["land?" (ops/sigmoid-at [0 1] [0.2 (- glacial-sea-level 200)] [0.8 sea-level] "landform")]
53+
["ocean?" (ops/sigmoid-at [0 1] [0.1 -200] [0.9 -400] "sea-level-adjusted")]
54+
["highlands" (ops/abs (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 1}))]
55+
["highlands?" (ops/sigmoid-at [0 1] [0.8 0.14] [0.1 0.16] "highlands")]
56+
["highland-elevation" (ops/sigmoid-at [600 1000] [0.1 0] [0.8 500] (ops/abs (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 1000})))]
57+
["coastal?" (ops/sigmoid-at [0 1] [0.2 350] [0.8 150] (ops/abs "sea-level-adjusted"))]
58+
["coast-sign" (ops/sigmoid-at [-1 1] [0.2 -50] [0.8 50] (ops/max "sea-level-adjusted" (ops/min 0 (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 1000}))))]
59+
["coastal-mountain-elevation" (ops/max 0 (ops/heightmap {:granularity 1 :irregularity 0.2 :amplitude 6000}))]
60+
61+
["mountains" (ops/abs (ops/heightmap {:granularity 3 :irregularity 0.2 :amplitude 1}))]
62+
["mountains?" (ops/sigmoid-at [0 1] [0.8 0.02] [0.1 0.1] "mountains")]
63+
["mountain-elevation" (ops/abs (ops/heightmap {:granularity 2 :irregularity 0.2 :amplitude 5000}))]]
64+
65+
(ops/op+ (ops/op- "landform" "flatten")
66+
(ops/op* 2 "ocean?" "sea-level-adjusted")
67+
(ops/op* "land?" "highlands?" "highland-elevation")
68+
(ops/op* (ops/op- 1 "coastal?") "land?" "mountains?" "mountain-elevation")
69+
(ops/op* "coastal?" "coast-sign" "coastal-mountain-elevation"))))))
70+
71+
(defn archipelago []
72+
(let
73+
[amplitude 1500
74+
sea-level 1200]
75+
(ops/terrain nil
76+
sea-level
77+
(ops/heightmap-let
78+
[["landform" (ops/heightmap {:granularity 0 :irregularity 0.25 :amplitude amplitude})]
79+
["deep?" (ops/sigmoid-at [0 4] [0.1 (- sea-level 1000)] [0.8 (- sea-level 1500)] "landform")]
80+
["extra-depth" (ops/op* "deep?" (ops/op- (ops/abs "landform")))]
81+
["shallow?" (ops/sigmoid-at [0 1] [0.1 (- sea-level 1200)] [0.8 (- sea-level 1000)] "landform")]
82+
["islands" (ops/abs (ops/heightmap {:granularity 2 :irregularity 0.15 :amplitude 1}))]
83+
["islands?" (ops/sigmoid-at [0 1] [0.8 0.02] [0.1 0.08] "islands")]
84+
["island-elevation" (ops/abs (ops/heightmap {:granularity 5 :irregularity 0.3 :amplitude 5000}))]]
85+
(ops/op+ "landform" "extra-depth" (ops/op* "shallow?" "islands?" "island-elevation"))))))

src/earthgen/views.cljs

+40-14
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,8 @@
66
[earthgen.subs :as subs]
77
[earthgen.events :as events]
88
[earthgen.input :as input]
9-
[earthgen.graphics.core :as graphics]))
9+
[earthgen.graphics.core :as graphics]
10+
[earthgen.generation.predefined :as predefined]))
1011

1112
(defn canvas-inner []
1213
(let [mount (fn [canvas]
@@ -44,7 +45,7 @@
4445
{:padding "8px 8px"
4546
:margin "4px 4px"})
4647

47-
(defn generation [view input button]
48+
(defn simple-mode [generate input button]
4849
[:div
4950
[:h3 " "]
5051
[:div
@@ -68,9 +69,9 @@
6869
(input [:simple-terrain :sea-level])]
6970
[:sup "Floods the land"]
7071
[:div
71-
(button "Generate" (fn [_] (re-frame/dispatch [::events/generate-simple (:subdivisions view) (:simple-terrain view)])))]])
72+
(button "Generate" generate)]])
7273

73-
(defn custom-mode [view update-input button]
74+
(defn custom-mode [generate view update-input button]
7475
[:div
7576
[:h3]
7677
[:div "Input text to recreate a previous result,"]
@@ -80,7 +81,17 @@
8081
:value (:custom view)
8182
:on-change (update-input [:custom])}]
8283
[:div
83-
(button "Generate" (fn [_] (re-frame/dispatch [::events/generate (:subdivisions view) (js->clj (.parse js/JSON (:custom view)) :keywordize-keys true)])))]])
84+
(button "Generate" (generate (js->clj (.parse js/JSON (:custom view)) :keywordize-keys true)))]])
85+
86+
(defn predefined-mode [generate button]
87+
[:div
88+
[:h3]
89+
[:div "Press a button to generate a planet of that type"]
90+
[:div "Results will trend towards description, but may sometimes diverge"]
91+
[:div
92+
(button "Continents" (generate (predefined/continents)))
93+
(button "Supercontinents" (generate (predefined/supercontinents)))
94+
(button "Archipelago" (generate (predefined/archipelago)))]])
8495

8596
(defn view-section [view]
8697
[:div
@@ -101,8 +112,10 @@
101112
[view @(re-frame/subscribe [::subs/view])
102113
mode (:mode view)
103114
model @(re-frame/subscribe [::subs/model])
104-
subdivisions (parse-long (:subdivisions view))
105-
subdivisions (or (and subdivisions (max 0 subdivisions)) 0)
115+
subdivisions (:subdivisions view)
116+
generate-model (fn [model]
117+
(fn [_]
118+
(re-frame/dispatch [::events/generate subdivisions model])))
106119
update-input (fn [keys]
107120
(fn [e] (re-frame/dispatch
108121
[::events/set-view (assoc-in view keys (gettext e))])))
@@ -127,19 +140,32 @@
127140
"Subdivisions "
128141
(input [:subdivisions])]
129142
[:div [:sup "[0, 1, 2 ...] Each increment roughly triples the polygon count. Recommended 6-8"]]
130-
(when subdivisions
131-
[:div [:sup (str subdivisions " "
132-
(if (= 1 subdivisions) "subdivision" "subdivisions")
143+
[:div [:sup (let
144+
[parsed (parse-long subdivisions)
145+
num (or (and parsed (max 0 parsed)) 0)]
146+
(str num " "
147+
(if (= 1 num) "subdivision" "subdivisions")
133148
" will create "
134-
(+ 2 (* 10 (Math/pow 3 subdivisions)))
135-
" polygons")]])
149+
(+ 2 (* 10 (Math/pow 3 num)))
150+
" polygons"))]]
136151
[:div
137152
[:b "Terrain : "]
153+
(if (= :predefined mode) "Suggested" (button "Suggested" (set-mode :predefined)))
138154
(if (= :simple mode) "Simple" (button "Simple" (set-mode :simple)))
139155
(if (= :custom mode) "Text input" (button "Text input" (set-mode :custom)))]
140156
(case mode
141-
:simple [generation view input button]
142-
:custom [custom-mode view update-input button])
157+
:predefined [predefined-mode
158+
generate-model
159+
button]
160+
:simple [simple-mode
161+
(fn [_] (re-frame/dispatch [::events/generate-simple subdivisions (:simple-terrain view)]))
162+
input
163+
button]
164+
:custom [custom-mode
165+
generate-model
166+
view
167+
update-input
168+
button])
143169
[:h3]
144170
[:b "Output"]
145171
[:div [:sub "Copy-paste into the text input box to recreate"]]

0 commit comments

Comments
 (0)