#!/bin/sh
#
# Beispiel für die Verwendung des Canvas-Widgets  aus Tk,
# lange Version
# 
# Carsten Zerbst, zerbst@tu-harburg, Mai 2001 für das
# Linux-Magazin
#
# \
exec tclsh $0 $@

package require Tk

wm title . "Beispiel für das Canvas Widget"

# Erzeugen eines Canvas mit Scrollbars
canvas .c -width 400 -height 500 -bg white \
  -xscrollcommand [list .hscroll set] \
  -yscrollcommand [list .vscroll set] 
scrollbar .hscroll -orient horizontal -command [list .c xview]
scrollbar .vscroll -orient vertical -command [list .c yview]

grid .c .vscroll -sticky news
grid .hscroll -sticky ew

grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1

# Erzeugen der Linien für das Koordinatensystem,
# Y-Koordinate per Hand umgedreht

.c create line -100 0 1100 0 -fill red -arrow last -tags coord
.c create line 0 400 0 -1100 -fill red -arrow last -tags coord

# Einstellen des Scrollbereichs mit festen Werten 
.c configure -scrollregion {-100 -1100 400 1100}

# Skalieren 
set scale 0.4
.c scale coord 0 0 $scale $scale
# und Scrollbereich anpassen, so daß alles paßt
.c configure -scrollregion [.c bbox all]

# Ein Ausrufungszeichen

# 1. Der Strich 
set item [.c create polygon 440 800 560 800 530 270 470 270 \
  -fill seagreen2 -outline seagreen4 -tags umr1 ]
.c scale $item 0 0 $scale -$scale

# 2. Die Knoten
foreach coords {{440 800} {560 800} {530 270} {470 270}} {
   foreach {x y} $coords {}
   set x1 [expr $x - 5/$scale]
   set y1 [expr $y - 5/$scale]
   set x2 [expr $x1 + 10/$scale]
   set y2 [expr $y1 + 10/$scale]
   .c create rectangle $x1 $y1 $x2 $y2 -tags {node umr1}\
      -fill seagreen2 -outline seagreen4 
}
.c scale node 0 0 $scale -$scale

# 3. Vier Kurven-Segmente für den Punkt, bestehend aus
# je einem Knotenpunkt, Kontrollpkt., Kontrollpkt., Knotenpunkt
.c create line 400 60 400 100 450 140 500 140 \
   -smooth true -tags segmente -fill seagreen4  
.c create line 500 140 550 140 600 100 600 60\
   -smooth true -tags segmente -fill seagreen4 
.c create line 600 60 600 20 550 -20 500 -20 \
   -smooth true -tags segmente -fill seagreen4  
.c create line 500 -20 450 -20 400 20 400 60\
   -smooth true -tags segmente -fill seagreen4  

.c scale segmente  0 0 $scale -$scale

# Etwas Text
.c create text 100 -100 -text "Drucken mit ^p"


# Ausgabe der Koordinanten
proc koords {_x _y} {
 set x [expr int([.c canvasx $_x]/$::scale)]
 set y [expr int(-[.c canvasy $_y]/$::scale)]
 .c delete text 
 .c create text [expr [.c canvasx $_x] + 5] [.c canvasy $_y] \
     -text "$x : $y" -tag text -anchor sw 
}

bind .c <Motion> "koords %x %y"

# Selektieren
proc deselektieren {} {
   .c itemconfigure umr1 -outline green4 -fill green2 \
      -stipple "" ;# -dash ""
   .c bind umr1 <Button-1> selektieren
}
proc selektieren {} {
   .c itemconfigure umr1 -fill firebrick1 -outline firebrick4 \
      -stipple gray25 ;# -dash "..,"
   .c bind umr1  <Button-1> deselektieren
}
.c bind umr1 <Button-1> selektieren

# Spielkram
.c bind node <Enter> {.c configure -cursor crosshair}
.c bind node <Leave> {.c configure -cursor ""}

# Drucken des sichtbaren Bereiches
proc drucken {} {
   puts stderr "Drucke Postscript canvas.ps"
   set fd [open canvas.ps w]
   puts $fd [.c postscript ]
   close $fd
}

bind . <Control-p> drucken


vwait forever