Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16023
Modified Files: Tag: desiredata desire.tk kb-mode.tcl Log Message: more on keyboard control
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.600.2.185 retrieving revision 1.1.2.600.2.186 diff -C2 -d -r1.1.2.600.2.185 -r1.1.2.600.2.186 *** desire.tk 25 May 2007 02:28:52 -0000 1.1.2.600.2.185 --- desire.tk 29 May 2007 00:28:38 -0000 1.1.2.600.2.186 *************** *** 176,185 **** proc modes_callback {self def {args}} { global callback_list dict for {mode callbacks} $callback_list { foreach {when call} $callbacks { ! if {$def == $when} {eval $self $call $args; return 1} } } ! return 0 }
--- 176,187 ---- proc modes_callback {self def {args}} { global callback_list + set i 0 dict for {mode callbacks} $callback_list { foreach {when call} $callbacks { ! if {$def == $when} {eval $self $call $args; incr i} } } ! ! if {!$i} {return 0} else {return 1} }
*************** *** 1719,1722 **** --- 1721,1725 ---- $c configure -yscrollcommand "$win.yscroll set" -xscrollcommand "$win.xscroll set" \ -scrollregion [list 0 0 $xregion $yregion] + puts " xregion:: $xregion || yregion:: $yregion" }
*************** *** 4404,4409 **** package require kb-mode $@runcommand defs ! kb-mode_init ! puts "packages:::: [package names]" } } --- 4407,4412 ---- package require kb-mode $@runcommand defs ! if {![info exists @kbcursor]} {set @kbcursor [kb-mode_init $self]} ! puts "cursor::: $@kbcursor" } } *************** *** 4529,4533 **** def Canvas key {x y key iso shift} { global tooltip; if {$tooltip ne ""} {$tooltip delete; set tooltip ""} ! if {[modes_callback $self "key" $x $y $key $iso $shift]} {puts "there is a callback...."} if {[$self focus] != ""} { [$self focus] key $key $shift --- 4532,4536 ---- def Canvas key {x y key iso shift} { global tooltip; if {$tooltip ne ""} {$tooltip delete; set tooltip ""} ! if {[modes_callback $self "key" $x $y $key $iso $shift]} {return} if {[$self focus] != ""} { [$self focus] key $key $shift
Index: kb-mode.tcl =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/kb-mode.tcl,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -C2 -d -r1.1.2.1 -r1.1.2.2 *** kb-mode.tcl 25 May 2007 02:32:31 -0000 1.1.2.1 --- kb-mode.tcl 29 May 2007 00:28:40 -0000 1.1.2.2 *************** *** 3,22 **** 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 }
--- 3,26 ---- set kbmode 1
! proc kb-mode_init {canvas} { puts "init kb-mode" + set self "kbcursor" append_callback kb-mode key kb-mode_key append_callback kb-mode motion kb-mode_motion + Kb_cursor new_as $self $canvas + $self draw + return $self }
def Canvas kb-mode_key {x y key iso shift} { ! set c [$self widget] ! switch -regexp -- $key { ! Up {$@kbcursor move 0 -10} ! Down {$@kbcursor move 0 +10} ! Left {$@kbcursor move -10 0} ! Right {$@kbcursor move +10 0} default {} } }
*************** *** 31,37 **** --- 35,44 ---- set @y 200 set @h 10 + #set c [$@canvas widget] + #pack configure $c -expand 0 -fill none }
def Kb_cursor draw {} { + set c [$@canvas widget] set line1 [list $@x $@y $@x [expr $@y+$@h]] set line2 [list $@x $@y [expr $@x+3] $@y] *************** *** 40,47 **** $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] ! } \ No newline at end of file --- 47,124 ---- $self item LINE2 line $line2 -fill red -width 2 $self item LINE3 line $line3 -fill red -width 2 + + set z [$@canvas zoom] + mset {cx1 cy1 cx2 cy2} [$@canvas get_bbox] + mset {l r} [$c xview] + mset {t b} [$c yview] + set width [winfo width $c]; set height [winfo height $c] + set w [expr (1 / ($r - $l)) * $width] + set h [expr (1 / ($b - $t)) * $height] + set x1 [expr floor(($w*$l+$cx1)/$z)+7] + set y1 [expr floor(($h*$t+$cy1)/$z)+7] + set x2 [expr $x1+$width-21] + set y2 [expr $height+$y1-21] + #$self item BOUND rect [list $x1 $y1 $x2 $y2] -outline red -width 1 }
! def Kb_cursor move {x y} { set @x [expr $@x + $x] set @y [expr $@y + $y] ! #$self scroll_canvas ! $self test_bounds ! $self draw ! } ! ! def Kb_cursor scroll_canvas {} { ! set c [$@canvas widget] ! mset {x1 y1 x2 y2} [$c bbox all] ! puts "xview [$c xview]" ! set x2 [expr $x2]; set y2 [expr $y2] ! #$c configure -scrollregion [list $x1 $y1 $x2 $y2] ! } ! ! def Kb_cursor test_bounds {} { ! set c [$@canvas widget] ! set width [winfo width $c]; set height [winfo height $c] ! set x1 [$c canvasx 2]; set y1 [$c canvasy 2] ! set x2 [expr $x1+$width-2] ! set y2 [expr $y1+$height-2] ! #puts "----------------------------------------" ! #puts "width :: $width || height :: $height" ! #puts "x1 $x1 || y1 $y1 || x2 $x2 || y2 $y2" ! #puts "x :: $@x || y ::$@y" ! if {$@x >= $x2} {$self scroll r [expr int($@x-$x2)]} ! if {$@x <= $x1} {$self scroll l [expr int($@x-$x1)]} ! if {$@y >= $y2} {$self scroll b [expr int($@y-$y2)]} ! if {$@y <= $y1} {$self scroll t [expr int($@y-$y1)]} ! } ! ! def Kb_cursor scroll {direction diff} { ! set c [$@canvas widget] ! set width [winfo width $c]; set height [winfo height $c] ! set x1 [$c canvasx 2]; set y1 [$c canvasy 2] ! mset {l r} [$c xview] ! mset {t b} [$c yview] ! foreach {n0 n1 n2 n3 region} [$c configure -scrollregion] {mset {rx1 ry1 rx2 ry2} $region} ! switch $direction { ! r {set axis "x"; if {$r == 1} {set rx2 [expr $rx2+$width]}} ! l {set axis "x"; if {$l == 0} {set rx1 [expr $rx1-$width]}} ! b {set axis "y"; if {$b == 1} {set ry2 [expr $ry2+$height]}} ! t {set axis "y"; if {$t == 0} {set ry1 [expr $ry1-$height]}} ! } ! $c configure -scrollregion [list $rx1 $ry1 $rx2 $ry2] ! $c [list $axis]view scroll $diff units ! } ! ! def Canvas kbcursor_recenter {} {$@kbcursor recenter} ! ! def Kb_cursor recenter {} { ! set c [$@canvas widget] ! set width [winfo width $c]; set height [winfo height $c] ! set x1 [$c canvasx 2]; set y1 [$c canvasy 2] ! set x2 [expr $x1+$width] ! set y2 [expr $y1+$height] ! set @x [expr $x1+($width/2)] ! set @y [expr $y1+($height/2)] ! $self draw ! }