← Back to branch summary

~ubuntu-branches/ubuntu/vivid/grass/vivid-proposed

« back to all changes in this revision

Viewing changes to scripts/d.rast.edit/d.rast.edit.tcl

  • Committer: Package Import Robot
  • Author(s): Bas Couwenberg
  • Date: 2015-02-20 23:12:08 UTC
  • mfrom: (8.2.6 experimental)
  • Revision ID: package-import@ubuntu.com-20150220231208-1u6qvqm84v430b10
Tags: 7.0.0-1~exp1
* New upstream release.
* Update python-ctypes-ternary.patch to use if/else instead of and/or.
* Drop check4dev patch, rely on upstream check.
* Add build dependency on libpq-dev to grass-dev for libpq-fe.h.
* Drop patches applied upstream, refresh remaining patches.
* Update symlinks for images switched from jpg to png.

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/d.rast.edit/d.rast.edit.tcl
1
 
 
2
 
if {[array get env GISBASE] == ""} {
3
 
    puts stderr "You must be in GRASS GIS to run this program."
4
 
    exit 1
5
 
}
6
 
 
7
 
if {$tcl_platform(platform) == "windows"} {
8
 
        set stderr NUL:
9
 
} else {
10
 
        set stderr @stderr
11
 
}
12
 
 
13
 
set outmap $env(GIS_OPT_OUTPUT)
14
 
set inmap $env(GIS_OPT_INPUT)
15
 
if {[info exists env(GIS_OPT_ASPECT)]} {
16
 
    set aspect $env(GIS_OPT_ASPECT)
17
 
} else {
18
 
    set aspect ""
19
 
}
20
 
set width $env(GIS_OPT_WIDTH)
21
 
set height $env(GIS_OPT_HEIGHT)
22
 
set size $env(GIS_OPT_SIZE)
23
 
set rows $env(GIS_OPT_ROWS)
24
 
set cols $env(GIS_OPT_COLS)
25
 
 
26
 
set status(row) ""
27
 
set status(col) ""
28
 
set status(x) ""
29
 
set status(y) ""
30
 
set status(value) ""
31
 
set status(aspect) ""
32
 
 
33
 
set brush "*"
34
 
 
35
 
set origin(x) 0
36
 
set origin(y) 0
37
 
 
38
 
set finalized false
39
 
 
40
 
proc initialize {} {
41
 
        global tempbase tempfile tempreg tempmap env stderr
42
 
        global inmap outmap
43
 
 
44
 
        set tempbase [exec g.tempfile pid=[pid]]
45
 
        file delete $tempbase
46
 
 
47
 
        set tempfile $tempbase.ppm
48
 
        set tempreg tmp.d.rast.edit
49
 
        set tempmap tmp.d.rast.edit
50
 
 
51
 
        exec g.region --q --o save=$tempreg 2>$stderr
52
 
 
53
 
        set env(WIND_OVERRIDE) $tempreg
54
 
 
55
 
        exec g.copy --q --o rast=$inmap,$outmap 2>$stderr
56
 
        exec r.colors --q map=$outmap rast=$inmap 2>$stderr
57
 
}
58
 
 
59
 
proc finalize {} {
60
 
        global tempfile tempreg tempmap stderr finalized
61
 
 
62
 
        if {$finalized} return
63
 
 
64
 
        save_map
65
 
 
66
 
        file delete $tempfile
67
 
        exec g.remove --q rast=$tempmap region=$tempreg 2>$stderr
68
 
 
69
 
        set finalized true
70
 
 
71
 
        exit 0
72
 
}
73
 
 
74
 
proc force_window {} {
75
 
        global origin rows cols total
76
 
 
77
 
        if {$origin(x) < 0} {set origin(x) 0}
78
 
        if {$origin(x) > $total(cols) - $cols} {set origin(x) [expr $total(cols) - $cols]}
79
 
        if {$origin(y) < 0} {set origin(y) 0}
80
 
        if {$origin(y) > $total(rows) - $rows} {set origin(y) [expr $total(rows) - $rows]}
81
 
}
82
 
 
83
 
proc set_window {x y} {
84
 
        global origin rows cols
85
 
 
86
 
        set origin(x) [expr [.overview.canvas canvasx $x] - $cols / 2]
87
 
        set origin(y) [expr [.overview.canvas canvasy $y] - $rows / 2]
88
 
 
89
 
        force_window
90
 
 
91
 
        set x0 $origin(x)
92
 
        set y0 $origin(y)
93
 
        set x1 [expr $x0 + $cols]
94
 
        set y1 [expr $y0 + $rows]
95
 
 
96
 
        .overview.canvas delete window
97
 
        .overview.canvas create rectangle $x0 $y0 $x1 $y1 -dash {4 4} -tags window
98
 
}
99
 
 
100
 
proc update_window {} {
101
 
        global wind total origin rows cols
102
 
 
103
 
        set x0 $origin(x)
104
 
        set y0 $origin(y)
105
 
        set x1 [expr $x0 + $cols]
106
 
        set y1 [expr $y0 + $rows]
107
 
 
108
 
        set wind(n) [expr $total(n) - $y0 * $total(nsres)]
109
 
        set wind(s) [expr $total(n) - $y1 * $total(nsres)]
110
 
        set wind(w) [expr $total(w) + $x0 * $total(ewres)]
111
 
        set wind(e) [expr $total(w) + $x1 * $total(ewres)]
112
 
        set wind(rows) $rows
113
 
        set wind(cols) $cols
114
 
}
115
 
 
116
 
proc change_window {} {
117
 
        save_map
118
 
        update_window
119
 
        load_map
120
 
        load_aspect
121
 
        refresh_canvas
122
 
}
123
 
 
124
 
proc create_overview {} {
125
 
        global inmap outmap stderr env total rows cols tempfile
126
 
 
127
 
        exec g.region --q rast=$inmap 2>$stderr
128
 
        exec r.out.ppm --q $inmap out=$tempfile 2>$stderr
129
 
 
130
 
        set reg [exec g.region --q -g 2>$stderr]
131
 
        set reg [regsub -all {[\r\n]+} $reg { }]
132
 
        set reg [regsub -all {=} $reg { }]
133
 
        array set total $reg
134
 
 
135
 
        image create photo overview -file $tempfile
136
 
        file delete $tempfile
137
 
 
138
 
        toplevel .overview
139
 
        wm title .overview "d.rast.edit overview ($inmap)"
140
 
 
141
 
        set w $total(cols)
142
 
        set h $total(rows)
143
 
 
144
 
        canvas .overview.canvas -width $w -height $h -scrollregion [list 0 0 $w $h] \
145
 
            -xscrollcommand {.overview.xscroll set} -yscrollcommand {.overview.yscroll set}
146
 
 
147
 
        scrollbar .overview.xscroll -orient horizontal -command {.overview.canvas xview}
148
 
        scrollbar .overview.yscroll -orient vertical   -command {.overview.canvas yview}
149
 
 
150
 
        if {$cols > $total(cols)} {set cols $total(cols)}
151
 
        if {$rows > $total(rows)} {set rows $total(rows)}
152
 
 
153
 
        force_window
154
 
 
155
 
        .overview.canvas create image 0 0 -anchor nw -image overview -tags image
156
 
        .overview.canvas create rectangle 0 0 $cols $rows -dash {4 4} -tags window
157
 
 
158
 
        grid .overview.canvas .overview.yscroll -sticky nsew
159
 
        grid .overview.xscroll -sticky nsew
160
 
 
161
 
        grid rowconfigure    .overview 0 -weight 1
162
 
        grid columnconfigure .overview 0 -weight 1
163
 
 
164
 
        bind .overview.canvas <ButtonPress-1>   { set_window %x %y }
165
 
        bind .overview.canvas <B1-Motion>       { set_window %x %y }
166
 
        bind .overview.canvas <ButtonRelease-1> { set_window %x %y ; change_window }
167
 
 
168
 
        bind .overview <Destroy> { finalize }
169
 
}
170
 
 
171
 
proc read_header {infile window} {
172
 
        upvar \#0 $window wind
173
 
 
174
 
        regexp {^north: *([0-9]+)$} [gets $infile] dummy wind(n)
175
 
        regexp {^south: *([0-9]+)$} [gets $infile] dummy wind(s)
176
 
        regexp {^east: *([0-9]+)$}  [gets $infile] dummy wind(e)
177
 
        regexp {^west: *([0-9]+)$}  [gets $infile] dummy wind(w)
178
 
        regexp {^rows: *([0-9]+)$}  [gets $infile] dummy wind(rows)
179
 
        regexp {^cols: *([0-9]+)$}  [gets $infile] dummy wind(cols)
180
 
}
181
 
 
182
 
proc read_data {infile array} {
183
 
        global wind
184
 
        upvar \#0 $array values
185
 
 
186
 
        for {set row 0} {$row < $wind(rows)} {incr row} {
187
 
                gets $infile line
188
 
                set col 0
189
 
                foreach elem $line {
190
 
                        set values($row,$col) $elem
191
 
                        incr col
192
 
                }
193
 
        }
194
 
}
195
 
 
196
 
proc clear_changes {} {
197
 
        global wind changed
198
 
 
199
 
        for {set row 0} {$row < $wind(rows)} {incr row} {
200
 
                for {set col 0} {$col < $wind(cols)} {incr col} {
201
 
                        set changed($row,$col) 0
202
 
                }
203
 
        }
204
 
}
205
 
 
206
 
proc load_map {} {
207
 
        global tempfile wind values changed colors inmap stderr
208
 
 
209
 
        exec g.region --q n=$wind(n) s=$wind(s) e=$wind(e) w=$wind(w) \
210
 
            rows=$wind(rows) cols=$wind(cols) 2>$stderr
211
 
 
212
 
        set infile [open "|r.out.ascii --q input=$inmap 2>$stderr" r]
213
 
        read_header $infile wind
214
 
        read_data $infile values
215
 
        close $infile
216
 
 
217
 
        clear_changes
218
 
 
219
 
        exec r.out.ppm --q input=$inmap output=$tempfile 2>$stderr
220
 
 
221
 
        image create photo colorimg -file $tempfile
222
 
        file delete $tempfile
223
 
 
224
 
        for {set row 0} {$row < $wind(rows)} {incr row} {
225
 
                for {set col 0} {$col < $wind(cols)} {incr col} {
226
 
                        set val $values($row,$col)
227
 
                        if {[array get colors $val] != ""} continue
228
 
                        set pix [colorimg get $col $row]
229
 
                        set r [lindex $pix 0]
230
 
                        set g [lindex $pix 1]
231
 
                        set b [lindex $pix 2]
232
 
                        set color [format "#%02x%02x%02x" $r $g $b]
233
 
                        set colors($val) $color
234
 
                }
235
 
        }
236
 
 
237
 
        image delete colorimg
238
 
}
239
 
 
240
 
proc load_aspect {} {
241
 
        global wind angles aspect stderr
242
 
 
243
 
        if {$aspect == ""} return
244
 
 
245
 
        set infile [open "|r.out.ascii --q input=$aspect 2>$stderr" r]
246
 
        read_header $infile dummy
247
 
        read_data $infile angles
248
 
        close $infile
249
 
}
250
 
 
251
 
proc save_map {} {
252
 
        global inmap outmap tempmap stderr
253
 
        global wind values changed
254
 
 
255
 
        set outfile [open "|r.in.ascii --q --o input=- output=$tempmap 2>$stderr" w]
256
 
 
257
 
        puts $outfile "north: $wind(n)"
258
 
        puts $outfile "south: $wind(s)"
259
 
        puts $outfile "east: $wind(e)"
260
 
        puts $outfile "west: $wind(w)"
261
 
        puts $outfile "rows: $wind(rows)"
262
 
        puts $outfile "cols: $wind(cols)"
263
 
 
264
 
        for {set row 0} {$row < $wind(rows)} {incr row} {
265
 
                for {set col 0} {$col < $wind(cols)} {incr col} {
266
 
                        if {$col > 0} {
267
 
                                puts -nonewline $outfile " "
268
 
                        }
269
 
                        if {$changed($row,$col)} {
270
 
                                puts -nonewline $outfile "$values($row,$col)"
271
 
                        } else {
272
 
                                puts -nonewline $outfile "*"
273
 
                        }
274
 
                }
275
 
                puts $outfile ""
276
 
        }
277
 
 
278
 
        close $outfile
279
 
 
280
 
        exec g.region --q rast=$inmap 2>$stderr
281
 
        exec r.patch --q --o input=$tempmap,$outmap output=$outmap 2>$stderr
282
 
        exec r.colors --q map=$outmap rast=$inmap 2>$stderr
283
 
        exec g.remove --q rast=$tempmap 2>$stderr
284
 
}
285
 
 
286
 
proc force_color {val} {
287
 
        global tempfile tempreg tempmap colors inmap stderr env
288
 
 
289
 
        exec g.region --q rows=1 cols=1 2>$stderr
290
 
        exec r.mapcalc "$tempmap = $val" 2>$stderr
291
 
        exec r.colors --q map=$tempmap rast=$inmap 2>$stderr
292
 
        exec r.out.ppm --q $tempmap out=$tempfile 2>$stderr
293
 
        exec g.remove --q rast=$tempmap 2>$stderr
294
 
 
295
 
        image create photo tempimg -file $tempfile
296
 
        file delete $tempfile
297
 
 
298
 
        set pix [tempimg get 0 0]
299
 
        set r [lindex $pix 0]
300
 
        set g [lindex $pix 1]
301
 
        set b [lindex $pix 2]
302
 
        set color [format "#%02x%02x%02x" $r $g $b]
303
 
        set colors($val) $color
304
 
        image delete tempimg
305
 
}
306
 
 
307
 
proc get_color {val} {
308
 
        global colors
309
 
 
310
 
        if {[array get colors $val] == ""} {
311
 
                if {[catch {force_color $val}]} {
312
 
                        set colors($val) "#ffffff"
313
 
                }
314
 
        }
315
 
 
316
 
        return $colors($val)
317
 
}
318
 
 
319
 
proc brush_update {} {
320
 
        global brush colors
321
 
 
322
 
        if {$brush == "*"} {
323
 
                .tools.color configure -bitmap gray12 -foreground black
324
 
        } else {
325
 
                .tools.color configure -bitmap gray75 -foreground [get_color $brush]
326
 
        }
327
 
}
328
 
 
329
 
proc current_cell {} {
330
 
        global canvas
331
 
 
332
 
        set row ""
333
 
        set col ""
334
 
 
335
 
        set tags [.canvas itemcget current -tags]
336
 
 
337
 
        foreach tag $tags {
338
 
                if {[regexp {row-([0-9]+)} $tag dummy r]} {set row $r}
339
 
                if {[regexp {col-([0-9]+)} $tag dummy c]} {set col $c}
340
 
        }
341
 
 
342
 
        return [list $row $col]
343
 
}
344
 
 
345
 
proc cell_enter {} {
346
 
        global status
347
 
        global wind values angles
348
 
 
349
 
        set pos [current_cell]
350
 
        set row [lindex $pos 0]
351
 
        set col [lindex $pos 1]
352
 
 
353
 
        if {$row == "" || $col == ""} return
354
 
 
355
 
        set status(row) $row
356
 
        set status(col) $col
357
 
        set status(x) [expr {$wind(e) + ($col + 0.5) * ($wind(e) - $wind(w)) / $wind(cols)}]
358
 
        set status(y) [expr {$wind(n) - ($row + 0.5) * ($wind(n) - $wind(s)) / $wind(rows)}]
359
 
        set status(value) $values($row,$col)
360
 
        if {[array exists angles]} {
361
 
                set status(aspect) $angles($row,$col)
362
 
        }
363
 
}
364
 
 
365
 
proc cell_leave {} {
366
 
        global status
367
 
 
368
 
        set status(row) ""
369
 
        set status(col) ""
370
 
        set status(x) ""
371
 
        set status(y) ""
372
 
        set status(value) ""
373
 
        set status(aspect) ""
374
 
}
375
 
 
376
 
proc cell_get {} {
377
 
        global brush values colors
378
 
 
379
 
        set pos [current_cell]
380
 
        set row [lindex $pos 0]
381
 
        set col [lindex $pos 1]
382
 
 
383
 
        set brush $values($row,$col)
384
 
 
385
 
        brush_update
386
 
}
387
 
 
388
 
proc cell_set {} {
389
 
        global canvas brush values changed colors
390
 
 
391
 
        set pos [current_cell]
392
 
        set row [lindex $pos 0]
393
 
        set col [lindex $pos 1]
394
 
        set val $brush
395
 
 
396
 
        set values($row,$col) $val
397
 
        set changed($row,$col) 1
398
 
 
399
 
        set cell [.canvas find withtag "(cell&&row-$row&&col-$col)"]
400
 
 
401
 
        if {$val == "*"} {
402
 
                set fill black
403
 
                set stipple gray12 
404
 
        } else {
405
 
                set fill [get_color $val]
406
 
                set stipple ""
407
 
        }
408
 
 
409
 
        .canvas itemconfigure $cell -outline white -fill $fill -stipple $stipple
410
 
}
411
 
 
412
 
proc refresh_canvas {} {
413
 
        global wind size values colors angles
414
 
 
415
 
        .canvas delete all
416
 
 
417
 
        set aspect [array exists angles]
418
 
        set pi [expr 2 * acos(0)]
419
 
 
420
 
        for {set row 0} {$row < $wind(rows)} {incr row} {
421
 
                for {set col 0} {$col < $wind(cols)} {incr col} {
422
 
                        set x0 [expr $col * $size + 1]
423
 
                        set x1 [expr $x0 + $size - 1]
424
 
                        set y0 [expr $row * $size + 1]
425
 
                        set y1 [expr $y0 + $size - 1]
426
 
 
427
 
                        if {$values($row,$col) == "*"} {
428
 
                                set color black
429
 
                                set stipple gray12
430
 
                        } else {
431
 
                                set color $colors($values($row,$col))
432
 
                                set stipple ""
433
 
                        }
434
 
 
435
 
                        .canvas create polygon $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1 \
436
 
                            -fill $color -stipple $stipple \
437
 
                            -outline black -activeoutline red \
438
 
                            -tags [list cell row-$row col-$col]
439
 
 
440
 
                        if {! $aspect} continue
441
 
 
442
 
                        if {$angles($row,$col) == "*"} continue
443
 
 
444
 
                        set cx [expr ($x0 + $x1) / 2]
445
 
                        set cy [expr ($y0 + $y1) / 2]
446
 
 
447
 
                        set a [expr $angles($row,$col) * $pi / 180]
448
 
 
449
 
                        set dx [expr   cos($a) * $size / 2]
450
 
                        set dy [expr - sin($a) * $size / 2]
451
 
 
452
 
                        set x0 [expr $cx - $dx]
453
 
                        set y0 [expr $cy - $dy]
454
 
                        set x1 [expr $cx + $dx]
455
 
                        set y1 [expr $cy + $dy]
456
 
 
457
 
                        .canvas create line $x0 $y0 $x1 $y1 \
458
 
                            -arrow last \
459
 
                            -disabledfill white -state disabled \
460
 
                            -tags [list arrow row-$row col-$col]
461
 
                }
462
 
        }
463
 
}
464
 
 
465
 
proc make_canvas {} {
466
 
        global canvas values colors angles rows cols
467
 
        global size width height
468
 
 
469
 
        set cx [expr $width  / $cols]
470
 
        set cy [expr $height / $rows]
471
 
 
472
 
        set sz [expr ($cx > $cy) ? $cx : $cy]
473
 
        if {$size < $sz} {set size $sz}
474
 
 
475
 
        set w [expr $cols * $size]
476
 
        set h [expr $rows * $size]
477
 
 
478
 
        canvas .canvas -width $width -height $height -scrollregion [list 0 0 $w $h] \
479
 
            -xscrollcommand {.xscroll set} -yscrollcommand {.yscroll set}
480
 
 
481
 
        scrollbar .xscroll -orient horizontal -command {.canvas xview}
482
 
        scrollbar .yscroll -orient vertical   -command {.canvas yview}
483
 
 
484
 
        .canvas bind cell <Any-Enter> { cell_enter }
485
 
        .canvas bind cell <Any-Leave> { cell_leave }
486
 
 
487
 
        .canvas bind cell <Button-1> { cell_set }
488
 
        .canvas bind cell <Button-3> { cell_get }
489
 
 
490
 
        bind .canvas <Any-Leave> { cell_leave }
491
 
}
492
 
 
493
 
proc make_ui {} {
494
 
        global canvas inmap
495
 
 
496
 
        wm title . "d.rast.edit ($inmap)"
497
 
        bind . <Destroy> { finalize }
498
 
 
499
 
        menu .menu -tearoff 0
500
 
        menu .menu.file -tearoff 0
501
 
        .menu add cascade -label "File" -menu .menu.file -underline 0
502
 
        .menu.file add command -label "Save" -underline 0 -command {save_map}
503
 
        .menu.file add command -label "Exit" -underline 1 -command {destroy .}
504
 
 
505
 
        . configure -menu .menu
506
 
 
507
 
        frame .status
508
 
        label .status.row_l -text "Row:"
509
 
        entry .status.row -textvariable status(row) -width 6
510
 
        label .status.col_l -text "Col:"
511
 
        entry .status.col -textvariable status(col) -width 6
512
 
        label .status.x_l -text "X:"
513
 
        entry .status.x -textvariable status(x) -width 10
514
 
        label .status.y_l -text "Y:"
515
 
        entry .status.y -textvariable status(y) -width 10
516
 
        label .status.value_l -text "Value:"
517
 
        entry .status.value -textvariable status(value) -width 10
518
 
        label .status.aspect_l -text "Aspect:"
519
 
        entry .status.aspect -textvariable status(aspect) -width 10
520
 
 
521
 
        pack \
522
 
            .status.row_l .status.row \
523
 
            .status.col_l .status.col \
524
 
            .status.x_l .status.x \
525
 
            .status.y_l .status.y \
526
 
            .status.value_l .status.value \
527
 
            .status.aspect_l .status.aspect \
528
 
            -side left
529
 
 
530
 
        frame .tools
531
 
        label .tools.value_l -text "New value:"
532
 
        entry .tools.value -textvariable brush
533
 
        label .tools.color_l -text "Color:"
534
 
        label .tools.color -bitmap gray12 -foreground black
535
 
 
536
 
        pack \
537
 
            .tools.value_l .tools.value \
538
 
            .tools.color_l .tools.color \
539
 
            -side left
540
 
 
541
 
        bind .tools.value <KeyPress-Return> brush_update
542
 
 
543
 
        grid .canvas .yscroll -sticky nsew
544
 
        grid .xscroll -sticky nsew
545
 
        grid .status  -sticky nsew
546
 
        grid .tools  -sticky nsew
547
 
 
548
 
        grid rowconfigure    . 0 -weight 1
549
 
        grid columnconfigure . 0 -weight 1
550
 
}
551
 
 
552
 
initialize
553
 
create_overview
554
 
make_canvas
555
 
make_ui
556
 
update_window
557
 
load_map
558
 
load_aspect
559
 
refresh_canvas