blob: ee6a2fb4da4e6628f752fd2d9b7063621381f879 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
(ns viz.forest
(:require [viz.grid :as grid])
)
(defn new-forest [grid-def]
{:grid (grid/new-grid grid-def)
:nodes {}
:roots #{}
:leaves #{}
:next-id 0})
(defn- new-id [forest]
(let [id (:next-id forest)]
[(assoc forest :next-id (inc id))
id]))
(defn- unset-parent [forest id parent-id]
(-> forest
(update-in [:nodes id] dissoc :parent-id :parent-pos)
(update-in [:nodes parent-id :child-ids] disj id)
(update-in [:roots] conj id)
(update-in [:leaves] conj parent-id)
))
(defn- set-parent [forest id parent-id]
(let [parent-pos (get-in forest [:nodes parent-id :pos])
prev-parent-id (get-in forest [:nodes id :parent-id])
]
(-> forest
(assoc-in [:nodes id :parent-id] parent-id)
(assoc-in [:nodes id :parent-pos] parent-pos)
(update-in [:nodes parent-id :child-ids] #(if %1 (conj %1 id) #{id}))
(update-in [:roots] disj id)
(update-in [:leaves] disj parent-id)
;; If there was a previous parent of the child, unset that shit
(#(if prev-parent-id (unset-parent %1 id prev-parent-id) %1))
)))
(defn node-at-pos? [forest pos]
(boolean (some #(= pos (:pos %)) (vals (:nodes forest)))))
(defn empty-adjacent-points [forest pos]
(grid/empty-adjacent-points (:grid forest) pos))
(defn add-node [forest pos]
(let [[forest id] (new-id forest)
forest (-> forest
(update-in [:grid] grid/add-point pos)
(assoc-in [:nodes id] {:id id :pos pos})
(update-in [:roots] conj id)
(update-in [:leaves] conj id)
)
]
[forest id]))
(defn remove-node [forest id]
(let [node (get-in forest [:nodes id])
child-ids (:child-ids node)
parent-id (:parent-id node)]
(-> forest
(update-in [:grid] grid/rm-point (:pos node))
;; unset this node's parent, if it has one
(#(if parent-id (unset-parent %1 id parent-id) %1))
;; unset this node's children, if it has any
((fn [forest] (reduce #(unset-parent %1 %2 id) forest child-ids)))
;; remove from all top-level sets
(update-in [:nodes] dissoc id)
(update-in [:roots] disj id)
(update-in [:leaves] disj id)
)))
(defn update-node-meta [forest id f]
(update-in forest [:nodes id :meta] f))
(defn get-node-meta [forest id]
(get-in forest [:nodes id :meta]))
(defn get-node [forest id]
(get-in forest [:nodes id]))
(defn spawn-child [forest parent-id pos]
(let [[forest id] (add-node forest pos)
forest (-> forest
(set-parent id parent-id)
)
]
[forest id]))
(defn roots [forest] (-> forest :nodes (select-keys (:roots forest)) (vals)))
(defn root? [node] (not (boolean (:parent-id node))))
(defn leaves [forest] (-> forest :nodes (select-keys (:leaves forest)) (vals)))
(defn leaf? [node] (empty? (:child-ids node)))
(defn lines [forest]
(->> forest
(:nodes)
(vals)
(remove #(empty? (:parent-pos %)))
(map #(vector (:pos %) (:parent-pos %)))
))
;(let [forest (new-forest grid/isometric)
; [forest id0] (add-node forest [0 0])
; forest (update-node-meta forest id0 #(assoc % :color :red))
; ]
; (print (get-node-meta forest id0)))
|
