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
|
# 09jul22 Software Lab. Alexander Burger
(symbols 'gis 'pico)
(push1 '*JS (allow "@lib/gis.js"))
(local) (lat lon fmt)
(de lat (Lat F)
(dec 'Lat 90.0)
(if F
(format (*/ Lat 1000 1.0) 3)
(format Lat `*Scl) ) )
(de lon (Lon F)
(dec 'Lon 180.0)
(if F
(format (*/ Lon 1000 1.0) 3)
(format Lon `*Scl) ) )
(de fmt (Lat Str Lon F)
(when (or Lat Lon)
(pack (lat Lat F) Str (lon Lon F)) ) )
# Short distance, assuming flat earth
(local) distance
(de distance (Lat1 Lon1 Lat2 Lon2) # [m]
(let
(DX (*/ (- Lon2 Lon1) 6371000 pi 180.0)
DY (*/ (cos (*/ Lat1 pi 180.0)) (- Lat2 Lat1) 6371000 pi `(* 1.0 180.0)) )
(sqrt (+ (* DX DX) (* DY DY))) ) )
# Latitude Field
(local) +LatField
(class +LatField +Fmt +FixField)
(dm T @
(pass super
'((Num) (- Num 90.0))
'((Lat) (+ Lat 90.0))
`*Scl ) )
# Longitude Field
(local) +LonField
(class +LonField +Fmt +FixField)
(dm T @
(pass super
'((Num) (- Num 180.0))
'((Lon) (+ Lon 180.0))
`*Scl ) )
# Clickable position field
(local) +LatLonField
(class +LatLonField +TextField)
(dm T (Msg . @)
(=: msg Msg)
(pass super)
(=: able) )
(dm set> (X Dn)
(=: obj (car X))
(=: lt (cadr X))
(=: ln (cddr X))
(super (fmt (: lt) ", " (: ln)) Dn) )
(dm js> ()
(if (try (: msg) (: obj) (: lt) (: ln))
(pack
(fmt (: lt) ", " (: ln))
"&+"
(ht:Fmt (sesId (mkUrl @))) )
(super) ) )
(dm val> ()
(cons (: obj) (: lt) (: ln)) )
(dm show> ("Var")
(showFld
(if (try (: msg) (: obj) (: lt) (: ln))
(<href>
(fmt (: lt) ", " (: ln))
(mkUrl @) )
(super "Var") ) ) )
# OpenLayers / OpenStreetMap
# (val *Osm) -> ((lat1 . lat2) (lon1 . lon2) . zoom)
(local) (*Osm <osm> osmStat osmClick osmDrag <poi> <line>)
(mapc allow '(osmStat osmClick osmDrag osmHover))
(de <osm> (Lat Lon Zoom Click Upd)
(<div> '(map (id . map)))
(when (val *Osm)
(setq
Lat (*/ (+ (caar @) (cdar @)) 2)
Lon (*/ (+ (caadr @) (cdadr @)) 2)
Zoom (cddr @) ) )
(with *Top
(css "https://cdn.rawgit.com/openlayers/openlayers.github.io/master/en/v5.3.0/css/ol.css")
(javascript "https://cdn.rawgit.com/openlayers/openlayers.github.io/master/en/v5.3.0/build/ol.js"
"osm('map', " Lat ", " Lon ", " Zoom ", "
(if2 Click (and Upd (: able)) 2 1 0 0) ")" )
(=: osmClick Click) ) )
(de osmStat (Lat1 Lon1 Lat2 Lon2 Zoom)
(when *Osm
(set @
(cons
(cons Lat1 Lat2)
(cons Lon1 Lon2)
Zoom ) ) ) )
(de osmClick (Lat Lon)
(with *Top
(and (: osmClick) (@ Lat Lon)) ) )
(de osmDrag (Txt Lat Lon)
(with *Top
(and
(: able)
(assoc Txt (: osmDrag))
((cdr @) Txt Lat Lon) ) ) )
(de osmHover (Txt)
(with *Top
(and
(assoc Txt (: osmHover))
((cdr @) Txt) ) ) )
(de <poi> (Lat Lon Img X Y Txt DY Col Url Drag Upd Hover)
(with *Top
(<javascript>
"poi(" Lat ", " Lon ", '" (sesId Img) "', " X ", " Y ", '"
(replace (chop Txt) "\\" "\\\\" "'" "\\'")
"', " DY ", '" Col "', '" (and Url (sesId @)) "', "
(if2 (and Drag (: able)) Upd 2 1 0 0) ")" )
(and Drag (push (:: osmDrag) (cons Txt @)))
(and Hover (push (:: osmHover) (cons Txt @))) ) )
(de <line> (Col Lat1 Lon1 Lat2 Lon2)
(with *Top
(<javascript>
"line('" Col "', " Lat1 ", " Lon1 ", " Lat2 ", " Lon2 ")" ) ) )
# Google Maps
(local) (google <google>)
(de google (Ttl Lat Lon Zoom Tar)
(<href> Ttl
(pack "https://www.google.com/maps/@" (fmt Lat "," Lon) "," Zoom "z")
Tar ) )
(de <google> (Lat Lon DX DY)
(prinl
"<iframe width=\"" DX "\" height=\"" DY "\" frameborder=\"3\" \
src=\"https://www.google.com/maps?source=s_q&q="
(fmt Lat "," Lon)
"&output=embed\"></iframe>" ) )
|
