File: point-file.tcl

package info (click to toggle)
tklib 0.9-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 23,156 kB
  • sloc: tcl: 105,088; sh: 2,573; ansic: 792; pascal: 359; makefile: 69; sed: 53; exp: 21
file content (182 lines) | stat: -rw-r--r-- 4,739 bytes parent folder | download
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
## -*- tcl -*-
# # ## ### ##### ######## ############# ######################
## (c) 2022 Andreas Kupries
##
## Filesystem based storage of geo/point information - Independent of AKIS
## Tklib geo/point file format
##
## - Line based
## - Ignores leading and trailing whitespace in lines
## - Ignores empty lines
## - Ignore lines starting with `//` - C++ line comments
## - Ignore lines starting with `#`  - Shell et al line comments
## - Magic word in first line identifying the file: "tklib/geo/point"

## - Multiple points allowed. Per point
##   - Zero! to more non-numeric lines specifying point kind, and names
##     - The kind is detected by having the prefix `kind:`
##     - In case of multiple kinds the last wins
##   - Exactly 2 numeric lines specifying coordinates
##   - Coordinates are validated as lat/lon
##
##   If no kind is specified it is `point`.
##   If no name is specified it is the name of the file, plus a sequence number.

# @@ Meta Begin
# Package map::point::file 0.1
# Meta author      {Andreas Kupries}
# Meta location    https://core.tcl.tk/tklib
# Meta platform    tcl
# Meta summary	   Reading/writing tklib geo/point files
# Meta description Reading/writing tklib geo/point files
# Meta subject	   map
# Meta subject	   {file, geo/point}
# Meta subject	   {geo/point, file}
# 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::point::file 0.1

# # ## ### ##### ######## ############# ######################
## API
#
##  read  PATH		-> INFO :: list (dict (names, kind, geo)...)
##  write PATH INFO	-> VOID
#
# # ## ### ##### ######## ############# ######################
## 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 point      ; namespace ensemble create }
namespace eval map::point       { namespace export file       ; namespace ensemble create }
namespace eval map::point::file { namespace export read write ; namespace ensemble create }

debug level  tklib/map/point/file
debug prefix tklib/map/point/file {<[pid]> [debug caller] | }

# # ## ### ##### ######## ############# ######################
## API

proc ::map::point::file::read {path} {
    debug.tklib/map/point/file {}

    if {[catch {
	set c [open $path r]
    }]} return

    set d [::read $c]
    close $c

    set points {}
    set names  {}
    set geo    {}
    set kind   {}

    set seq  0
    set head 1
    foreach line [split $d \n] {
	set line [string trim $line]
	#  ignore empty lines and comments
	if {$line eq {}} continue
	if {[string match //*  $line]} continue
	if {[string match "#*" $line]} continue

	# first line has to be magic
	if {$head} { set magic $line ; set head 0 ; continue }

	# collect names for current point
	if {![string is double -strict $line]} {
	    if {[string match kind:* $line]} {
		regexp {kind:(.*)$} $line -> kind
		set kind [string trim $kind]
		continue
	    }

	    lappend names $line
	    continue
	}

	# collect coordinate for current point
	lappend geo $line

	# save completed point and start next
	if {[llength $geo] == 2} {
	    if {![map slippy geo valid $geo]} {
		puts "$path/bad geo $geo"
		return
	    }

	    # Default name derived from file name, iff no name specified, with sequence number
	    if {![llength $names]} { lappend names [file rootname [file tail $path]]/[incr seq] }

	    if {$kind eq {}} { set kind point }

	    lappend points [dict create names $names geo $geo kind $kind]
	    set names {}
	    set geo   {}
	    set kind  {}
	}

	# collect more
    }

    if {(([llength $geo] == 0) && [llength $names]) || ([llength $geo] == 1)} {
	puts "$path\t/incomplete point at end"
	return
    }

    if {$magic ne "tklib/geo/point"} {
	puts "$path\t/no magic/bad magic"
	return
    }

    return $points
}

proc ::map::point::file::write {path gdata} {
    debug.tklib/map/point/file {}

    # gdata :: list (dict (names, kind, geo)...)

    set c [open $path w]

    puts $c tklib/geo/point

    foreach point [lsort -dict -unique $data] {
	dict with point {}
	# names, kind, geo

	if {$kind ne {}} {
	    puts $c kind:$kind
	}

	foreach name [lsort -dict -unique $names] {
	    puts $c $name
	}

	lassign $geo lat lon
	puts $c $lat
	puts $c $lon

	unset names kind geo
    }

    close $c
    return
}

# # ## ### ##### ######## ############# ######################
return