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
|
## -*- tcl -*-
# # ## ### ##### ######## ############# ######################
## (c) 2022 Andreas Kupries
##
## Originally developed within the AKIS project (c) Andreas Kupries
# @@ Meta Begin
# Package map::mark 0.1
# Meta author {Andreas Kupries}
# Meta location https://core.tcl.tk/tklib
# Meta platform tcl
# Meta summary Map Action Engine: Mark A Point
# Meta description Attachment to map display widgets providing custom behaviour.
# Meta description Enables user to mark locations. Marked locations are reported
# Meta description via callback.
# Meta subject map {location marking} {mark location}
# Meta require {Tcl 8.6-}
# Meta require debug
# Meta require debug::caller
# Meta require snit
# @@ Meta End
package provide map::mark 0.1
# # ## ### ##### ######## ############# ######################
## API
#
## <class> OBJ MAP <options...>
#
## <obj> disable -> VOID
## <obj> enable -> VOID
## <obj> active -> bool
#
## -command Callback reporting the marks
## -on-event Event spec for triggering a mark, only at construction-time
#
# # ## ### ##### ######## ############# ######################
## Requirements
package require Tcl 8.6-
# ;# Tcllib
package require debug ;# - Narrative Tracing
package require debug::caller ;#
package require snit ;# - OO system
# # ## ### ##### ######## ############# ######################
## Ensemble setup.
namespace eval map { namespace export mark ; namespace ensemble create }
debug level tklib/map/mark
debug prefix tklib/map/mark {<[pid]> [debug caller] | }
# # ## ### ##### ######## ############# ######################
snit::type ::map::mark {
# . . .. ... ..... ........ ............. .....................
## User configuration
option -command -default {}
option -on-event -default Double-Button-1 -readonly 1
# ..................................................................
## State
variable mymap {} ;# The map::display (*) the instance is attached to
variable mycanvas {} ;# The canvas internal to the map display
variable myactive 0 ;# State flag
## (*) Or API compatible widget. This class uses the map display methods
#
## - canvas (once, retrieve map internal canvas, for binding)
## - at (at each mark, retrieve crosshair location (geo))
# . . .. ... ..... ........ ............. .....................
## Lifecycle
constructor {map args} {
debug.tklib/map/mark {}
$self configurelist $args
set mymap $map
set mycanvas [$map canvas]
set myactive no
$self enable
return
}
destructor {
debug.tklib/map/mark {}
if {![winfo exists $mycanvas]} return
$self disable
return
}
# ..................................................................
## API
method disable {} {
debug.tklib/map/mark {}
if {!$myactive} return
bind $mycanvas <$options(-on-event)> {}
set myactive no
return
}
method enable {} {
debug.tklib/map/mark {}
if {$myactive} return
bind $mycanvas <$options(-on-event)> [mymethod MarkTriggered]
set myactive yes
return
}
method active {} {
debug.tklib/map/mark {}
return $myactive
}
# ..................................................................
## Internal
method MarkTriggered {} {
debug.tklib/map/mark {}
if {![llength $options(-command)]} return
uplevel #0 [list {*}$options(-command) [$mymap at]]
return
}
# ..................................................................
}
# # ## ### ##### ######## ############# ######################
return
|
