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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
## -*- tcl -*-
# # ## ### ##### ######## ############# ######################
## (c) 2022 Andreas Kupries
# @@ Meta Begin
# Package map::area::store::memory 0.1
# Meta author {Andreas Kupries}
# Meta location https://core.tcl.tk/tklib
# Meta platform tcl
# Meta summary In-memory store for geo/area definitions
# Meta description In-memory store for geo/area definitions, with
# Meta description memoized calculation of extended attributes.
# Meta description Base data is taken from a backing store.
# Meta description Anything API-compatible to map::area::store::fs
# Meta subject {center, geo/area}
# Meta subject {diameter, geo/area}
# Meta subject {geo/area pixels, zoom}
# Meta subject {geo/area, center}
# Meta subject {geo/area, diameter}
# Meta subject {geo/area, memory store}
# Meta subject {geo/area, perimeter length}
# Meta subject {length, geo/area, perimeter}
# Meta subject {memory store, geo/area}
# Meta subject {perimeter length, geo/area}
# Meta subject {pixels, zoom, geo/area}
# Meta subject {store, geo/area, memory}
# Meta subject {zoom, geo/area pixels}
# Meta require {Tcl 8.6-}
# Meta require debug
# Meta require debug::caller
# Meta require {map::slippy 0.8}
# Meta require snit
# @@ Meta End
package provide map::area::store::memory 0.1
# # ## ### ##### ######## ############# ######################
## API
#
## <class> OBJ backend-store
#
## <obj> ids -> list (id...)
## <obj> get ID -> dict (name, geo, diameter, length, parts, center)
## <obj> visible GEOBOX -> list (id...)
## <obj> pixels ID ZOOM -> list (point...)
#
# # ## ### ##### ######## ############# ######################
## Requirements
package require Tcl 8.6-
#
# ;# Tcllib
package require debug ;# - Narrative Tracing
package require debug::caller ;#
package require map::slippy 0.8 ;# - Map utilities
package require snit ;# - OO system
# # ## ### ##### ######## ############# ######################
## Ensemble setup.
namespace eval map { namespace export area ; namespace ensemble create }
namespace eval map::area { namespace export store ; namespace ensemble create }
namespace eval map::area::store { namespace export memory ; namespace ensemble create }
debug level tklib/map/area/store/memory
debug prefix tklib/map/area/store/memory {<[pid]> [debug caller] | }
# # ## ### ##### ######## ############# ######################
snit::type ::map::area::store::memory {
# ..................................................................
## System configuration
typevariable ourmagic 4.5 ;# This 1.5*3, where 3 is the default circle radius used in
# # canvas::edit::points for the display of point markers.
# TODO: synch with area-display configuration, i.e. radius changes.
# YET: Doing at indexing time will require a fixed threshold.
# . . .. ... ..... ........ ............. .....................
## State
#
# - Backing store, command prefix
# - Pixel store :: dict (id -> zoom -> list(point...))
# - Attribute store :: dict (id -> attr)
# attr :: dict ("names" -> list (string...)
# "geo" -> list (geo...)
# "diameter" -> double
# "perimeter" -> double
# "center" -> geo
# "bbox" -> geobox
# "parts" -> int)
variable mystore {}
variable myattr {}
variable mypixels {}
# . . .. ... ..... ........ ............. .....................
## Lifecycle
constructor {store} {
debug.tklib/map/area/store/memory {}
set mystore $store
return
}
destructor {
debug.tklib/map/area/store/memory {}
return
}
# . . .. ... ..... ........ ............. .....................
## API
delegate method * to mystore except get ;# ids, visible
method get {id} {
debug.tklib/map/area/store/memory {}
if {![dict exists $myattr $id]} {
dict set myattr $id [$self Attributes $id]
}
return [dict get $myattr $id]
}
method pixels {id zoom} {
debug.tklib/map/area/store/memory {}
if {![dict exists $mypixels $id $zoom]} {
dict set mypixels $id $zoom [$self Pixels $zoom $id]
}
return [dict get $mypixels $id $zoom]
}
# . . .. ... ..... ........ ............. .....................
## Helpers
method Attributes {id} {
set attr [DO get $id]
set geos [dict get $attr geo]
set bbox [map slippy geo bbox-list $geos]
set center [map slippy geo center-list $geos]
set diameter [map slippy geo diameter-list $geos]
set perimeter [map slippy geo distance-list 1 $geos]
set parts [llength $geos]
if {$parts < 3} { incr parts -1 }
dict set attr bbox $bbox
dict set attr center $center
dict set attr diameter $diameter
dict set attr perimeter $perimeter
dict set attr parts $parts
#puts |$id|$attr|
return $attr
}
method Pixels {zoom id} {
debug.tklib/map/area/store/memory {}
set attr [DO get $id]
set geos [dict get $attr geo]
set points [map slippy geo 2point-list $zoom $geos]
set points [map slippy point simplify radial $ourmagic 1 $points]
set points [map slippy point simplify rdp $points]
return $points
}
proc DO {args} {
debug.tklib/map/area/store/memory {}
upvar 1 mystore mystore
return [uplevel #0 [list {*}$mystore {*}$args]]
}
# . . .. ... ..... ........ ............. .....................
}
# # ## ### ##### ######## ############# ######################
return
|
