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
|
#! /usr/bin/env tclsh
# -*- tcl -*-
# # ## ### ##### ######## ############# #####################
# demo_map.tcl --
#
# This demonstration script shows a basic map.
# Tiles from OpenStreetMap, Mapnik.
# Box Editor with Load / Save
# # ## ### ##### ######## ############# #####################
## Requirements
package require Tcl 8.6-
# Extend the package search path so that this demonstration works with
# the non-installed tklib packages well. A regular application should
# not require this.
apply {{selfdir} {
set ::sd $selfdir
#puts ($selfdir)
lappend ::auto_path $selfdir
lappend ::auto_path [file normalize $selfdir/../../modules]
}} [file dirname [file normalize [info script]]]
package require Tk 8.6-
package require map::display
package require map::box::entry
package require map::box::display
package require map::box::file
package require map::provider::osm
# # ## ### ##### ######## ############# #####################
proc main {} {
cmdline
do $::env(HOME)/.cache/demo
vwait __forever__
}
proc cmdline {} {
global argv
if {[llength $argv]} usage
}
proc usage {} {
global argv0
puts stderr "Usage: $argv0"
exit 1
}
proc do {cachedir} {
file mkdir $cachedir
map provider osm TILE $cachedir
wm withdraw .
toplevel .m
wm title .m "Map Display + Box Entry"
wm iconname .m "MAP"
map box display .m.box
map display .m.map \
-provider TILE \
-initial-geo [home] \
-initial-zoom [expr {[TILE levels]-1}]
map box entry ENTRY .m.map -on-box-change action-changed
button .m.exit -command ::exit -text Exit
button .m.rehome -command rehome -text Home
button .m.fit -command action-fit -text Fit
button .m.clear -command action-clear -text Clear
button .m.save -command action-save -text Save
button .m.load -command action-load -text Load
grid rowconfigure .m 0 -weight 1
grid rowconfigure .m 1 -weight 0
grid columnconfigure .m 0 -weight 0
grid columnconfigure .m 1 -weight 0
grid columnconfigure .m 2 -weight 0
grid columnconfigure .m 3 -weight 0
grid columnconfigure .m 4 -weight 0
grid columnconfigure .m 5 -weight 0
grid columnconfigure .m 6 -weight 1
grid .m.box -row 0 -column 0 -sticky swen
grid .m.map -row 0 -column 1 -columnspan 6 -sticky swen
grid .m.exit -row 1 -column 1 -sticky swen
grid .m.rehome -row 1 -column 2 -sticky swen
grid .m.fit -row 1 -column 3 -sticky swen
grid .m.clear -row 1 -column 4 -sticky swen
grid .m.save -row 1 -column 5 -sticky swen
grid .m.load -row 1 -column 6 -sticky swn
ENTRY enable
return
}
proc action-fit {} {
ENTRY fit
return
}
proc action-clear {} {
ENTRY clear
return
}
proc action-changed {geobox} {
.m.box set $geobox
return
}
proc action-save {} {
set path [tk_getSaveFile \
-filetypes [list [list boxes .box] {all *}] \
-parent .m \
-title "Export Box"]
if {$path eq {}} return
set name [file rootname [file tail $path]]
dict set g names [list $name]
dict set g geo [ENTRY box]
map box file write $path $g
return
}
proc action-load {} {
set path [tk_getOpenFile \
-filetypes [list [list boxes .box] {all *}] \
-parent .m \
-title "Import Box"]
if {$path eq {}} return
# TODO: error message from reader
set box [map box file read $path]
# TODO: error message
if {![dict size $box]} return
ENTRY set [dict get $box geo]
return
}
proc rehome {} { .m.map center [home] }
proc home {} { return {51.667205 6.451442} } ;# Xanten Ampitheater/Coliseum
main
exit 0
|
