[PD-cvs] pd/src desire.tk,1.1.2.121,1.1.2.122

Tue Nov 15 04:25:50 CET 2005

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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
bang rendering code fixed, class hierarchy might not be entirely correct 
and there might be some duped code. will 


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.121
retrieving revision 1.1.2.122
diff -C2 -d -r1.1.2.121 -r1.1.2.122
*** desire.tk	12 Nov 2005 19:46:33 -0000	1.1.2.121
--- desire.tk	15 Nov 2005 03:25:46 -0000	1.1.2.122
***************
*** 689,694 ****
  # in the future, one view may have several canvases. (??)
  # this would mean that the following proc will have to die.
! def view canvas  {}  {return $@canvas}
! def view canvas= {c} {set @canvas $c}
  
  #-----------------------------------------------------------------------------------#
--- 689,694 ----
  # in the future, one view may have several canvases. (??)
  # this would mean that the following proc will have to die.
! def* view canvas  {}  {return $@canvas}
! def* view canvas= {c} {set @canvas $c}
  
  #-----------------------------------------------------------------------------------#
***************
*** 743,747 ****
  	{Comment {pd %W text 0} "Ctrl+5"}
  	{}
! 	{Bang    {bang_new} "Alt+b"}
          {Toggle  {pd %W toggle 0} "Alt+t"}
          {Number2 {pd %W numbox 0} "Alt+n"}
--- 743,747 ----
  	{Comment {pd %W text 0} "Ctrl+5"}
  	{}
! 	{Bang    {pd %W bng %X %Y} "Alt+b"}
          {Toggle  {pd %W toggle 0} "Alt+t"}
          {Number2 {pd %W numbox 0} "Alt+n"}
***************
*** 1013,1017 ****
  
  # wow. what is this for?
! # to switch between edit/run mode with ctrl+1 -chun
  def canvas editmodeswitch {args} {
      set name .$self
--- 1013,1017 ----
  
  # wow. what is this for?
! # to switch between edit/run mode with ctrl+e -chun
  def canvas editmodeswitch {args} {
      set name .$self
***************
*** 1081,1084 ****
--- 1081,1086 ----
  	set cmd $accels(alt+$key)
  	regsub -all %W $cmd $topname cmd
+ 	regsub -all %X $cmd $@current_x cmd
+ 	regsub -all %Y $cmd $@current_y cmd
  	puts $cmd
  	eval $cmd
***************
*** 1158,1162 ****
  }
  
! def textbox draw {} {
      # TEXT = the text label
      # text = the input text field
--- 1160,1164 ----
  }
  
! def* textbox draw {} {
      # TEXT = the text label
      # text = the input text field
***************
*** 1947,1951 ****
  #-----------------------------------------------------------------------------------#
  class_new box {view}
! class_new wire {view}
  
  def* box init {args} {
--- 1949,1953 ----
  #-----------------------------------------------------------------------------------#
  class_new box {view}
! 
  
  def* box init {args} {
***************
*** 1961,1964 ****
--- 1963,1995 ----
  }
  
+ def* box draw {} {
+ 
+ }
+ 
+ def box bbox {} {
+ 	mset {x y} [$self xy]
+ 	list $x $y [expr $x+$@xs] [expr $y+$@ys]
+ }
+ 
+ # type is i or o
+ def box hilite_io {type x y} {
+ 	global look
+ 	mset {cx cy} [$self xy]
+ 	set c .$@canvas.c
+ 	set ports 0; catch {switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}}
+ 	if {$ports==0} return
+ 	set port [expr int(($x-$cx)*$ports/$@xs)]
+ 	if {$port >= $ports} {set port [expr $ports-1]}
+ 	set p ${self}${type}${port}
+ 	#if {![llength $@wire_from]} {}
+ 	set outline [switch $type {i {list $look(outletfg)} o {list $look(inletfg)}}]
+ 	$c create rectangle [l+ [$c coords $p] {-4 -4 +4 +4}] -outline $outline -width 1 -tags ${p}b
+ 	switch $type {i {set tip "inlet $port"} o {set tip "outlet $port"}}
+ 	$@canvas show_tooltip $x $y $tip
+ 	return $port
+ }
+ #-----------------------------------------------------------------------------------#
+ class_new wire {view}
+ 
  def* wire init {children from outno to inno} {
      super
***************
*** 2100,2105 ****
  		obj {set i 4; set class [lindex $d 4]}
  	}
- 	puts "class = $class"
- 	
  	if {![info exists _($x:_class)]} {
  		# new object
--- 2131,2134 ----
***************
*** 2119,2123 ****
  			set _($x:_class) objectbox
  		}
! 
  		$x init
  		#puts "_($x:_class)=$_($x:_class)"
--- 2148,2152 ----
  			set _($x:_class) objectbox
  		}
! 		#puts "+++++++ class:$_($x:_class) ++++++"
  		$x init
  		#puts "_($x:_class)=$_($x:_class)"
***************
*** 2220,2225 ****
  }
  
! class_new bluebox {labeled view}
! def bluebox draw {x1 y1 xs ys ins outs} {
  	global look
  	set x2 [expr $x1+$xs]
--- 2249,2256 ----
  }
  
! class_new bluebox {box}
! #class_new bluebox {labeled view}
! 
! def* bluebox makebox {x1 y1 xs ys ins outs} {
  	global look
  	set x2 [expr $x1+$xs]
***************
*** 2234,2238 ****
  	io_draw $self
  	if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
! 	$@canvas itemconfigure ${self}BASE -outline $frcol
  }
  
--- 2265,2273 ----
  	io_draw $self
  	if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
! 	.$@canvas.c itemconfigure ${self}BASE -outline $frcol
! }
! 
! def bluebox motionedit {args} {
! 	#puts "motions in $self in edit mode"
  }
  
***************
*** 2520,2527 ****
  
  #-----------------------------------------------------------------------------------#
! class_new bang {view}
! def bang init {} {
  	super
! 	puts "init bang!!!!!!!"	
  }
  
--- 2555,2566 ----
  
  #-----------------------------------------------------------------------------------#
! #class_new bang {view}
! class_new bang {bluebox}
! def* bang init {args} {
! 	puts "!!!!!! args:$args"
  	super
! 	set @w 15
! 	set @xs $@w
! 	set @ys $@w
  }
  
***************
*** 2531,2554 ****
  def bang noutlets {} {return $@noutlets}
  
! def bang draw {} {
  	mset {x1 y1} [$self xy]
! 	set @ninlets  [expr [string compare $@rcv empty]==0]
! 	set @noutlets [expr [string compare $@snd empty]==0]
  	set colour [parse_color $@bcol]
  	#super
  	set xs $@w; set x2 [expr $x1+$xs]
  	set ys $@w; set y2 [expr $y1+$ys]
  	$self item BUT oval \
  		[list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]] \
! 		-fill [bluify $colour] -tags ${self}BUT
  }
  
  def bang click {x y b f} {
! 	pd x$self click $x $y 0 0 0
  }
  
  def bang bang {} {
! 	$canvas itemconfigure ${self}BUT -fill [bluify [parse_color $@fcol]]
! 	after 100 [list $@canvas itemconfigure ${self}BUT -fill [bluify [parse_color $@bcol]]]
  }
  
--- 2570,2614 ----
  def bang noutlets {} {return $@noutlets}
  
! def* bang draw {} {
  	mset {x1 y1} [$self xy]
! 	#set @ninlets  [expr [string compare $@rcv empty]==0]
! 	#set @noutlets [expr [string compare $@snd empty]==0]
  	set colour [parse_color $@bcol]
  	#super
  	set xs $@w; set x2 [expr $x1+$xs]
  	set ys $@w; set y2 [expr $y1+$ys]
+ 	$self makebox $x1 $y1 $@w $@w $@ninlets $@noutlets
  	$self item BUT oval \
  		[list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]] \
! 		-fill [bluify $colour] -tags "${self}BUT $self"
! }
! 
! def* bang clickedit {x y butt key in_selection selection} {
!     global _ 
!     #handles the shift click
!     #if {($f&1) && !$already} {post "add to selection?"; return}
!     if {($key&1) && $selection>0} {
!     puts "add $self to selection...."
!     }
!     #if clicked obj is part of the $@selection, than....
!     if {$in_selection && [llength $selection]>1} {
!        set _($@canvas:action) move
!     } {
!        $@canvas deselect_all
!        set _($@canvas:selection) $self
!        set _($@canvas:action) move
!     }
! 
!     
  }
  
  def bang click {x y b f} {
! 	pd $self click $x $y 0 0 0
! 	$self bang
  }
  
  def bang bang {} {
! 	.$@canvas.c itemconfigure ${self}BUT -fill [bluify [parse_color $@fcol]]
! 	after 100 [list .$@canvas.c itemconfigure ${self}BUT -fill [bluify [parse_color $@bcol]]]
  }