pd/src desire.tk,1.1.2.96,1.1.2.97 - Pd-cvs

2 Nov 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6031
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
more stuff
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.96
retrieving revision 1.1.2.97
diff -C2 -d -r1.1.2.96 -r1.1.2.97
*** desire.tk	2 Nov 2005 11:49:43 -0000	1.1.2.96
--- desire.tk	2 Nov 2005 13:39:03 -0000	1.1.2.97
***************
*** 523,527 ****
  set look(objectframe2) #668888
  set look(objectframe3) #000000
! set look(objectframe4) #00ffff
  set look(canvasbgrun) #ffffff
  set look(canvasbgedit) #dddddd
--- 523,527 ----
  set look(objectframe2) #668888
  set look(objectframe3) #000000
! set look(objectframe4) #0080ff
  set look(canvasbgrun) #ffffff
  set look(canvasbgedit) #dddddd
***************
*** 536,541 ****
          default {list 1}}]
- set current_x 0
- set current_y 0
  set dehighlight {}
--- 536,539 ----
***************
*** 585,594 ****
  #	if {[info exists focus(createdby)]} {
  #		switch $focus(createdby) {
! #		  butt {mset {@x1 @y1} 40 40}
  #		  ctrl {
  #		    if {[string length $focus(objname)] > 0} {
  #			mset {@x1 @y1} $focus(oldpos)
  #		    } else {
! #			mset {@x1 @y1} $_($canvas:current)
  #			set focus(oldpos) [list $@x1 $@y1]}}}}
    # todo: should compute GOP stuff here
--- 583,593 ----
  #	if {[info exists focus(createdby)]} {
  #		switch $focus(createdby) {
! #		  butt {mset {@x1 @y1} {40 40}}
  #		  ctrl {
  #		    if {[string length $focus(objname)] > 0} {
  #			mset {@x1 @y1} $focus(oldpos)
  #		    } else {
! #			set @x1 $_($canvas:current_x)
! #			set @y1 $_($canvas:current_y)
  #			set focus(oldpos) [list $@x1 $@y1]}}}}
    # todo: should compute GOP stuff here
***************
*** 651,655 ****
set canvasmenu(put) {
! 	{Object  {obj_create $focus(canvas) ctrl} "Ctrl+1"}
    {Message {pd %W msg 0} "Ctrl+2"}
    {Number  {pd %W floatatom 0} "Ctrl+3"}
--- 650,654 ----
set canvasmenu(put) {
! 	{Object  {pd %W obj %X %Y} "Ctrl+1"}
    {Message {pd %W msg 0} "Ctrl+2"}
    {Number  {pd %W floatatom 0} "Ctrl+3"}
***************
*** 681,686 ****
    osx {}
    default {
!     lappend canvasmenu(media) {{Audio settings...} {pd pd audio-properties ;} {}}
!     lappend canvasmenu(media) {{MIDI settings...} {pd pd midi-properties ;} {}}
    }
  }
--- 680,685 ----
    osx {}
    default {
!     lappend canvasmenu(media) {{Audio settings...} {pd pd audio-properties} {}}
!     lappend canvasmenu(media) {{MIDI settings...}  {pd pd midi-properties}  {}}
    }
  }
***************
*** 744,748 ****
  #-----------------------------------------------------------------------------------#
! def* canvas init {{width 300} {height 400} {geometry 400x300+0+0} {editable 0}} {
      super
      global pd_opendir pd_tearoff OS cmdline canvasmenu focus
--- 743,747 ----
  #-----------------------------------------------------------------------------------#
! def* canvas init {{width 400} {height 300} {geometry +0+0} {editable 0}} {
      super
      global pd_opendir pd_tearoff OS cmdline canvasmenu focus
***************
*** 911,919 ****
      puts "name: $name"
      pd $name editmode 0
- 
  }
def canvas editmodeswitch {args} {
-     global _
      set name .x$self
      if {$@editmode} {
--- 910,917 ----
      puts "name: $name"
      pd $name editmode 0
  }
+ # wow. what is this for?
  def canvas editmodeswitch {args} {
      set name .x$self
      if {$@editmode} {
***************
*** 974,977 ****
--- 972,977 ----
    set cmd $accels(ctrl+$key)
    regsub -all %W $cmd $top cmd
+ 	regsub -all %X $cmd $@current_x cmd
+ 	regsub -all %Y $cmd $@current_y cmd
    #puts $cmd
    eval $cmd
***************
*** 1116,1123 ****
  def* textbox after_key {canvas widget} {
    set @text [$widget get 1.0 1.end]
! 	$self changed
! #	post "@text is '%s'" $@text
! #	$self update_size
! #	$self draw $canvas
  }
--- 1116,1121 ----
  def* textbox after_key {canvas widget} {
    set @text [$widget get 1.0 1.end]
! 	$self update_size
! 	$self draw $canvas
  }
***************
*** 1177,1181 ****
    set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
    set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
- 	#shadow_draw $self $canvas $xya
    item $self $canvas BASE  rectangle $xya -fill $look(objectbg)
    item $self $canvas BASE2 line      $xyb -fill $look(objectframe2)
--- 1175,1178 ----
***************
*** 1349,1354 ****
def canvas motion {x y mods state} {
!     global current_x current_y old_x old_y mouse font
!     global tooltip _ dehighlight look
      set c .x$self.c
      set x [$c canvasx $x]
--- 1346,1351 ----
def canvas motion {x y mods state} {
!     global old_x old_y mouse font
!     global tooltip dehighlight look
      set c .x$self.c
      set x [$c canvasx $x]
***************
*** 1459,1463 ****
def statusbar update {x y} {
!     global _ cmdline
      set c .x$self.c
      set bar .x$self.stat
--- 1456,1460 ----
def statusbar update {x y} {
!     global cmdline
      set c .x$self.c
      set bar .x$self.stat
***************
*** 1586,1590 ****
def* canvas click {x y b f} {
!     global OS mouse font look focus
      set c .x$self.c
      set x [$c canvasx $x]
--- 1583,1587 ----
def* canvas click {x y b f} {
!     global mouse look focus
      set c .x$self.c
      set x [$c canvasx $x]
***************
*** 1601,1605 ****
def canvas unclick {x y b} {
!     global wire_to font look offset_wire
      set c .x$self.c
      set cx [$c canvasx $x]
--- 1598,1602 ----
def canvas unclick {x y b} {
!     global font look offset_wire
      set c .x$self.c
      set cx [$c canvasx $x]
***************
*** 1614,1622 ****
    	set wire_id l[format %x [expr 0x80f8ea8 - $offset_wire]]
    	set wire_id l$wire_id
! 		set from [lindex $@wire_from 0]
! 		set outlet_number [lindex $@wire_from 1]
! 		set to [lindex $wire_to 0]
! 		set inlet_number [lindex $wire_to 1]
! 
    	if {[info exists _($from:o:$outlet_number)]} {
    		lappend _($from:o:$outlet_number) $wire_id
--- 1611,1616 ----
    	set wire_id l[format %x [expr 0x80f8ea8 - $offset_wire]]
    	set wire_id l$wire_id
! 		mset {from outlet_number} $@wire_from
! 		mset {to    inlet_number} $@wire_to
    	if {[info exists _($from:o:$outlet_number)]} {
    		lappend _($from:o:$outlet_number) $wire_id
***************
*** 2062,2066 ****
  # fix me
  class_new shadow {qwerty}
- 
  def shadow draw {canvas coords} {
    global look
--- 2056,2059 ----
***************
*** 2080,2084 ****
    set points [list $x1 $y1 [expr $x2+4] $y1 $x2 [expr $y1+4] $x2 [expr $y2-4] \
    	[expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
- 	#shadow_draw $self $canvas $points
    item $self $canvas BASE polygon $points -fill $look(objectbg) -outline $look(objectframe3)
    io_draw $self $canvas
--- 2073,2076 ----
***************
*** 2100,2104 ****
    set y2 [expr $y1+$ys]
    set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
- 	#shadow_draw $self $canvas $points
    if {[catch {$canvas canvasx $x1}]} {
    	post "atom_draw: canvas $canvas does not exist"
--- 2092,2095 ----
***************
*** 2111,2118 ****
  }
! class_new numbox {view}
  def numbox draw {canvas} {
    global look
- 	if {![info exists @buf]} {set @buf ""}
    mset {x1 y1} [$self xy $canvas]
    set xs [expr 4+10*$@w]
--- 2102,2135 ----
  }
! class_new comment {view}
! def comment draw {canvas xs ys ins outs} {
! 	if {[llength [$canvas gettags $self]] != 0} {}
! 	mset {x1 y1} [$self xy $canvas]
! }
! 
! class_new bluebox {labeled view}
! def bluebox draw {canvas x1 y1 xs ys ins outs} {
! 	global look
! 	set x2 [expr $x1+$xs]
! 	set y2 [expr $y1+$ys]
! 	set xya [list $x1 $y1 $x2 $y2]
! 	set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
! 	set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
! 	set color [bluify [parse_color $@bcol]]
! 	item $self $canvas BASE  rectangle $xya -fill $color
! 	item $self $canvas BASE2 line      $xyb -fill #ffffff
! 	item $self $canvas BASE3 line      $xyc -fill [darker $color]
! 	io_draw $self $canvas
! 	if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
! 	$canvas itemconfigure ${self}BASE -outline $frcol
! }
! 
! class_new numbox {bluebox}
! def* numbox init {args} {
! 	set @buf ""
! }
! 
  def numbox draw {canvas} {
    global look
    mset {x1 y1} [$self xy $canvas]
    set xs [expr 4+10*$@w]
***************
*** 2127,2133 ****
    set xt [expr $x1+$ys/2+2]
    set yt [expr $y1+$ys/2+1+$xs/34]
- 	#shadow_draw $self $canvas $points
    set points2 [list $x1 $y1 [expr $x1+$ys/2] [expr $y1+$ys/2] $x1 $y2]
- 	puts "numbox_draw $self $canvas"
    if {$isnew} {set @clicking 0}
    item $self $canvas BASE   polygon $points  -fill [parse_color $@bcol] -outline $look(objectframe3)
--- 2144,2148 ----
***************
*** 2145,2149 ****
    if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    $canvas itemconfigure ${self}BASE -outline $frcol
- 	puts "/numbox_draw $self $canvas"
  }
--- 2160,2163 ----
***************
*** 2188,2200 ****
  }
! def numbox unfocus {canvas} {
! 	set @buf ""
! 	numbox_draw $self $canvas
! }
def numbox unclick {canvas x y} {
    set @clicking 0
    if {$@oval!=$@val} {
! 		canvas_unfocus $canvas
    	pd x$self float $@val
    }
--- 2202,2211 ----
  }
! def numbox unfocus {canvas} {set @buf ""; $self changed}
def numbox unclick {canvas x y} {
    set @clicking 0
    if {$@oval!=$@val} {
! 		$canvas unfocus
    	pd x$self float $@val
    }
***************
*** 2202,2215 ****
def numbox key {canvas key shift} {
-     global look
      set c -1
      catch {set c [format %c $key]}
      if {[string first $c 0123456789.eE+-]>=0} {
    set @buf "$@buf$c"
! 	numbox_draw $self $canvas
      } elseif {$key==13} {
    # Return
    catch {set @val [expr $@buf]}
!         canvas_unfocus $canvas
    pd x$self float $@val
      } elseif {$key==8 || $key==127} {
--- 2213,2225 ----
def numbox key {canvas key shift} {
      set c -1
      catch {set c [format %c $key]}
      if {[string first $c 0123456789.eE+-]>=0} {
    set @buf "$@buf$c"
! 	$self changed
      } elseif {$key==13} {
    # Return
    catch {set @val [expr $@buf]}
! 	$canvas unfocus
    pd x$self float $@val
      } elseif {$key==8 || $key==127} {
***************
*** 2218,2222 ****
    	set @buf [string range $@buf 0 end-1]
    }
! 	numbox_draw $self $canvas
      } elseif {$key==27} {
          # Escape
--- 2228,2232 ----
    	set @buf [string range $@buf 0 end-1]
    }
! 	$self changed
      } elseif {$key==27} {
          # Escape
***************
*** 2228,2255 ****
  }
- class_new comment {view}
- def comment draw {canvas xs ys ins outs} {
- 	if {[llength [$canvas gettags $self]] != 0} {}
- 	mset {x1 y1} [$self xy $canvas]
- }
- 
- class_new bluebox {view}
- def bluebox draw {canvas x1 y1 xs ys ins outs} {
- 	global look
- 	set x2 [expr $x1+$xs]
- 	set y2 [expr $y1+$ys]
- 	set xya [list $x1 $y1 $x2 $y2]
- 	set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
- 	set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
- 	#puts "bluebox: [parse_color $@bcol] [parse_color $@fcol] [parse_color $@lcol]"
- 	set color [bluify [parse_color $@bcol]]
- 	item $self $canvas BASE  rectangle $xya -fill $color
- 	item $self $canvas BASE2 line      $xyb -fill #ffffff
- 	item $self $canvas BASE3 line      $xyc -fill [darker $color]
- 	io_draw $self $canvas
- 	if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
- 	$canvas itemconfigure ${self}BASE -outline $frcol
- }
- 
  class_new radio {view}
  def radio orient {} {
--- 2238,2241 ----
***************
*** 2272,2276 ****
    set ins  [expr [string compare $@rcv empty]==0]
    set outs [expr [string compare $@snd empty]==0]
! 	bluebox_draw $self $canvas
    if {$orient} {set size $ys} {set size $xs}
    set size [expr $size/$n]
--- 2258,2262 ----
    set ins  [expr [string compare $@rcv empty]==0]
    set outs [expr [string compare $@snd empty]==0]
! 	super $canvas
    if {$orient} {set size $ys} {set size $xs}
    set size [expr $size/$n]
***************
*** 2283,2287 ****
    	if {$orient} {set y1 [expr $y1+$size]} {set x1 [expr $x1+$size]}
    }
- 	label_draw $self $canvas
    radio_set $self $canvas $@on
  }
--- 2269,2272 ----
***************
*** 2316,2319 ****
--- 2301,2308 ----
  }
+ def* slider init {args} {
+ 	set @clicking 0
+ }
+ 
  def slider draw {canvas} {
    global look
***************
*** 2327,2336 ****
    set outs [expr [string compare $@snd empty]==0]
    switch $@class {hsl {set orient 0} vsl {set orient 1}}
! 	bluebox_draw $self $canvas
! 	if {![info exists @clicking]} {set @clicking 0}
    set color [bluify #ffffff]
    item $self $canvas KNOB rectangle $x1 $y1 $x1 $y1 \
    	-outline #000000 -fill [darker $color]
- 	label_draw $self $canvas
    set pos [$canvas coords ${self}BASE]
    set span [expr $@max-$@min]
--- 2316,2323 ----
    set outs [expr [string compare $@snd empty]==0]
    switch $@class {hsl {set orient 0} vsl {set orient 1}}
! 	super $canvas
    set color [bluify #ffffff]
    item $self $canvas KNOB rectangle $x1 $y1 $x1 $y1 \
    	-outline #000000 -fill [darker $color]
    set pos [$canvas coords ${self}BASE]
    set span [expr $@max-$@min]
***************
*** 2401,2407 ****
  def slider unfocus {canvas} {$self draw $canvas}
! class_new labelled {view}
! def labelled draw {canvas} {
    mset {x1 y1} [$self xy $canvas]
    set lx [expr $x1+$@ldx]
--- 2388,2394 ----
  def slider unfocus {canvas} {$self draw $canvas}
! class_new labeled {view}
! def labeled draw {canvas} {
    mset {x1 y1} [$self xy $canvas]
    set lx [expr $x1+$@ldx]
***************
*** 2416,2421 ****
  }
! def labelled erase {canvas} {
! 	$canvas delete ${self}LABEL
  }
--- 2403,2408 ----
  }
! def labeled erase {canvas} {
! #	$canvas delete ${self}LABEL
  }
***************
*** 2430,2435 ****
    set @noutlets [expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
! 	bluebox_draw $self $canvas
! 	io_draw      $self $canvas
    set xs $@w; set x2 [expr $x1+$xs]
    set ys $@w; set y2 [expr $y1+$ys]
--- 2417,2421 ----
    set @noutlets [expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
! 	super $canvas
    set xs $@w; set x2 [expr $x1+$xs]
    set ys $@w; set y2 [expr $y1+$ys]
***************
*** 2437,2441 ****
    	[list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]] \
    	-fill [bluify $colour] -tags ${self}BUT
- 	label_draw $self $canvas
  }
--- 2423,2426 ----
***************
*** 2459,2464 ****
    set outs [expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
! 	bluebox_draw $self $canvas
! 	io_draw      $self $canvas
    set w 1
    if {$xs >= 30} {set w 2}
--- 2444,2448 ----
    set outs [expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
! 	super $canvas
    set w 1
    if {$xs >= 30} {set w 2}
***************
*** 2469,2473 ****
    set x4 [expr $x2-$w-2]
    set y4 [expr $y2-$w-2]
- 	label_draw $self $canvas
    if {$@on} {
    	set fill [parse_color $@fcol]
--- 2453,2456 ----
***************
*** 2512,2522 ****
    set outs 2
    set colour [parse_color $@bcol]
! 	bluebox_draw $self $canvas [expr $x1-1] [expr $y1-2] [expr $xs+2] [expr $ys+4] $ins $outs
! 	label_draw $self $canvas
! 
    set led_size [vu_led_size $self]
    set x3 [expr $x1+$xs/4]
    set x4 [expr $x1+$xs-$xs/4]
- 
    $canvas delete ${self}RMS
    for {set i 1} {$i<=40} {incr i} {
--- 2495,2502 ----
    set outs 2
    set colour [parse_color $@bcol]
! 	super $canvas
    set led_size [vu_led_size $self]
    set x3 [expr $x1+$xs/4]
    set x4 [expr $x1+$xs-$xs/4]
    $canvas delete ${self}RMS
    for {set i 1} {$i<=40} {incr i} {
***************
*** 2525,2529 ****
    		-fill [parse_color [lindex $vu_col $i]] -width 0
    }
- 
    item $self $canvas MASK rectangle $x3 $y1 $x4 $y1 -width 0 -fill [bluify $colour]
    if {!$@scale} {return}
--- 2505,2508 ----
***************
*** 2580,2584 ****
      set ins  [expr [string compare $@rcv empty]==0]
      set outs [expr [string compare $@snd empty]==0]
!     bluebox_draw $self $canvas $x1 $y1 [expr $xs + 1] [expr $xs + 1] $ins $outs
      if {$isnew} {
    canvas $canvas.${self}DROP -width $xs -height $xs -bg $colour -highlightbackground $lcolour -highlightcolor $colour
--- 2559,2563 ----
      set ins  [expr [string compare $@rcv empty]==0]
      set outs [expr [string compare $@snd empty]==0]
!     super $canvas
      if {$isnew} {
    canvas $canvas.${self}DROP -width $xs -height $xs -bg $colour -highlightbackground $lcolour -highlightcolor $colour
***************
*** 2597,2601 ****
  }
! class_new cnv {view}
  def cnv draw {canvas} {
    mset {x1 y1} [$self xy $canvas]
--- 2576,2580 ----
  }
! class_new cnv {labeled view}
  def cnv draw {canvas} {
    mset {x1 y1} [$self xy $canvas]
***************
*** 2604,2608 ****
    item $self $canvas BASE rectangle $x1 $y1 [expr $x1+$xs] [expr $y1+$ys] \
    	-fill [parse_color $@bcol]
! 	label_draw $self $canvas
  }
--- 2583,2587 ----
    item $self $canvas BASE rectangle $x1 $y1 [expr $x1+$xs] [expr $y1+$ys] \
    	-fill [parse_color $@bcol]
! 	super $canvas
  }
***************
*** 2821,2825 ****
  proc obj_create {doc flag} {
    global _ focus
! 	set  focus(createdby) $flag
    #puts " ||| $doc :: $_($doc:createdby)"
    pd $doc obj 0
--- 2800,2804 ----
  proc obj_create {doc flag} {
    global _ focus
! 	set focus(createdby) $flag
    #puts " ||| $doc :: $_($doc:createdby)"
    pd $doc obj 0
***************
*** 2835,2839 ****
def canvas show_tooltip {x y text} {
! 	global current_x current_y tooltip
    if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
    $self hide_tooltip
--- 2814,2818 ----
def canvas show_tooltip {x y text} {
! 	global tooltip
    if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
    $self hide_tooltip
***************
*** 2850,2855 ****
    	-fill "#ffffcc" -outline "#000000" -tags tooltip_bg
    $c lower tooltip_bg tooltip_fg
! 	set tooltip(mx) $current_x
! 	set tooltip(my) $current_y
    set tooltip(canvas) $self
    set tooltip(visible) 1
--- 2829,2834 ----
    	-fill "#ffffcc" -outline "#000000" -tags tooltip_bg
    $c lower tooltip_bg tooltip_fg
! 	set tooltip(mx) $@current_x
! 	set tooltip(my) $@current_y
    set tooltip(canvas) $self
    set tooltip(visible) 1