#!/usr/bin/wish
#Ich kann malen
#TCL/TK Skript
#061109
#111209
#171209
#070110
#Copyright Stefan Hamann
#Das Programm ist Freeware und darf den Bedingungen der GPL (General Public Licence)
#entsprechend verwendet und weitergegeben werden 
#leapapi@aol.com
wm overrideredirect . 1
package require Tk
set farbe black
set form kreis
set id 0
proc malen {x y} {
global farbe
global form
set xmax [expr $x+10]
set ymax [expr $y+10]
set xmin [expr $x-10]
set ymin [expr $y-10]
if {$form=="kreis"} {set id [.c create oval $xmax $ymax $xmin $ymin -tag $farbe -fill $farbe -outline $farbe]}
if {$form=="quadr"} {set id [.c create rect $xmax $ymax $xmin $ymin -tag $farbe -fill $farbe -outline $farbe]}
if {$form=="drei"} {set id [.c create poly $xmin $ymax [expr ($xmin+10)] $ymin $xmax $ymax $xmin $ymax -tag $farbe -fill $farbe]}

return $id}

proc löschen {} {
global farbe
.c delete $farbe
}

proc zurück {} {
global id
.c delete $id
set id [expr $id-1]
}

proc drucken {} {
	set datei [tk_getSaveFile -defaultextension ps\
	-title "Kunstwerk speichern"]
	.c postscript -file $datei
}
canvas .c -width [winfo screenwidth .] -height [winfo screenheight .]
pack .c
focus -force .c
bind .c <Control-x> {exit}
bind .c <r> {set farbe red}
bind .c <b> {set farbe blue}
bind .c <g> {set farbe green}
bind .c <y> {set farbe yellow}
bind .c <s> {set farbe black}
bind .c <p> {set farbe pink}
bind .c <m> {set farbe magenta}
#bind .c <k> {löschen}
bind .c <z> {zurück}
bind .c <F2> {set form kreis}
bind .c <F3> {set form quadr}
bind .c <F4> {set form drei}
bind .c <d> {drucken}
bind .c <Motion> {
	set x %x
	set y %y
set id [malen $x $y]
}