[PD-cvs] pd/src kb-mode.tcl,NONE,1.1.2.1

[chunlee]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24940

Added Files:
      Tag: desiredata
	kb-mode.tcl 
Log Message:
kb-mode


--- NEW FILE: kb-mode.tcl ---
package provide kb-mode 0.1

set kbmode 1

proc kb-mode_init {} {
	puts "init kb-mode"
	append_callback kb-mode key kb-mode_key
	append_callback kb-mode motion kb-mode_motion
}

def Canvas kb-mode_key {x y key iso shift} {
	if {![info exists @kbcursor]} {set @kbcursor [Kb_cursor new_as kbcursor $self]}
	switch -regexp -- $key {
		Up    {$@kbcursor coords 0 -10}
		Down    {$@kbcursor coords 0 +10}
		Left    {$@kbcursor coords -10 0}
		Right    {$@kbcursor coords +10 0}
		default {}
	}
	$@kbcursor draw
}

def Canvas kb-mode_motion {x y f target} {}

class_new Kb_cursor {View}

def Kb_cursor init {canvas} {
	super
	set @canvas $canvas
	set @x 200
	set @y 200
	set @h 10
}

def Kb_cursor draw {} {
	set line1 [list $@x $@y $@x [expr $@y+$@h]]
	set line2 [list $@x $@y [expr $@x+3] $@y]
	set line3 [list $@x [expr $@y+$@h] [expr $@x+3] [expr $@y+10]]
	$self item LINE1 line $line1 -fill red -width 2
	$self item LINE2 line $line2 -fill red -width 2
	$self item LINE3 line $line3 -fill red -width 2
}

def Kb_cursor coords {x y} {
	set @x [expr $@x + $x]
	set @y [expr $@y + $y]
}