[PD-cvs] pd/src desire.tk, 1.1.2.600.2.185, 1.1.2.600.2.186 kb-mode.tcl, 1.1.2.1, 1.1.2.2

Tue May 29 02:28:42 CEST 2007

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
! }