[PD-cvs] pd/src desire.tk,1.1.2.53,1.1.2.54

14 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6971
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
stuff and such
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.53
retrieving revision 1.1.2.54
diff -C2 -d -r1.1.2.53 -r1.1.2.54
*** desire.tk	14 Sep 2005 06:04:42 -0000	1.1.2.53
--- desire.tk	14 Sep 2005 07:53:11 -0000	1.1.2.54
***************
*** 256,261 ****
proc pdtk_pd_meters {indb outdb inclip outclip} {
-     #puts "pdtk_pd_meters::: $indb $outdb $inclip $outclip"
- 
      .controls.in.1.mtr coords m 0 0 $indb 0
      .controls.out.1.mtr coords m 0 0 $outdb 0
--- 256,259 ----
***************
*** 418,433 ****
proc enquote {x} {
-     puts "enquote::: $x"
      set foo [string map {"," "" ";" "" """ ""} $x]
      return [string map {" " "\ " "{" "" "}" ""} $foo]
  }
! proc pdtk_watchdog {} {
! 	puts "pdtk_watchdog:::"
! 	pd "pd ping ;"; after 2000 {pdtk_watchdog}
! }
proc pdtk_check {x message} {
-     puts "pdtk_check::: $x $message"
      set answer [tk_messageBox -message $x -type yesno -icon question]
      switch -- $answer {yes {pd $message}}
--- 416,426 ----
proc enquote {x} {
      set foo [string map {"," "" ";" "" """ ""} $x]
      return [string map {" " "\ " "{" "" "}" ""} $foo]
  }
! proc pdtk_watchdog {} {pd "pd ping ;"; after 2000 {pdtk_watchdog}}
proc pdtk_check {x message} {
      set answer [tk_messageBox -message $x -type yesno -icon question]
      switch -- $answer {yes {pd $message}}
***************
*** 463,467 ****
proc menu_new {} {
-     #puts "menu_new:::"
      global untitled_number untitled_directory offset_canvas _
      pd "pd filename Untitled-$untitled_number $untitled_directory ;"
--- 456,459 ----
***************
*** 473,477 ****
  #    set canvas_id .x$canvas_id
  #    set offset_canvas [expr $offset_canvas + 1]
- #    puts "new canvas id -> $canvas_id"
  #    canvas_new $canvas_id 300 300 +[expr $offset_canvas*50]+[expr $offset_canvas*50] 1
       set untitled_number [expr $untitled_number + 1]
--- 465,468 ----
***************
*** 480,485 ****
proc menu_open {} {
-     #puts "menu_open:::"
- 
      global pd_opendir
      set filename [tk_getOpenFile -defaultextension .pd \
--- 471,474 ----
***************
*** 490,495 ****
proc open_file {filename} {
-     #puts "open_file $filename"
- 
      global pd_opendir offset_canvas_file offset_wire_file offset_obj_file _ font
      global wire_from wire_to 
--- 479,482 ----
***************
*** 862,869 ****
  }
! proc menu_audio {flag} {
! 	puts "menu_audio::: $flag"
! 	pd "pd dsp $flag ;"
! }
#-----------------------------------------------------------------------------------#
--- 849,853 ----
  }
! proc menu_audio {flag} {pd "pd dsp $flag ;"}
#-----------------------------------------------------------------------------------#
***************
*** 884,888 ****
  # check or uncheck the "edit" menu item
  proc pdtk_canvas_editval {name value} {
-     #puts "pdtk_canvas_editval::: $name $value"
      global look _
      set self [canvastosym $name.c]
--- 868,871 ----
***************
*** 894,900 ****
  }
! proc pdtk_canvas_getscroll {args} {
!     puts "pdtk_canvas_getscroll: $args"
! }
#-----------------------------------------------------------------------------------#
--- 877,881 ----
  }
! proc pdtk_canvas_getscroll {args} {}
#-----------------------------------------------------------------------------------#
***************
*** 940,944 ****
wm protocol $name WM_DELETE_WINDOW "menu_close $name"
!     canvas_new_binds $name
      focus $name.c
      pdtk_canvas_editval $name $editable
--- 921,925 ----
wm protocol $name WM_DELETE_WINDOW "menu_close $name"
!     canvas_new_binds $self
      focus $name.c
      pdtk_canvas_editval $name $editable
***************
*** 955,963 ****
  #-----------------------------------------------------------------------------------#
! proc canvas_new_binds {name} {
      global OS
!     set c $name.c
      bind $c <Button>                   {canvas_click %W %x %y %b 0}
      bind $c <Shift-Button>             {canvas_click %W %x %y %b 1}
      bind $c <Control-Shift-Button>     {canvas_click %W %x %y %b 3}
      bind $c <Alt-Button>               {canvas_click %W %x %y %b 4}
--- 936,945 ----
  #-----------------------------------------------------------------------------------#
! def canvas new_binds {} {
      global OS
!     set c .x$self.c
      bind $c <Button>                   {canvas_click %W %x %y %b 0}
      bind $c <Shift-Button>             {canvas_click %W %x %y %b 1}
+     bind $c <Control-Button>           {canvas_click %W %x %y %b 2}
      bind $c <Control-Shift-Button>     {canvas_click %W %x %y %b 3}
      bind $c <Alt-Button>               {canvas_click %W %x %y %b 4}
***************
*** 972,976 ****
        default {
          bind $c <Button-3>       {canvas_click %W %x %y %b 8}
-         bind $c <Control-Button> {canvas_click %W %x %y %b 2}
        }
      }
--- 954,957 ----
***************
*** 996,1010 ****
  #   bind $c <Map>        {canvas_map %W}
  #   bind $c <Unmap>      {canvas_unmap %W}
!     bind $c <Motion> "+statusbar_update [c2self $name] %x %y"
      switch $OS { unix {
! 	bind $c <Button-4>       "canvas_scroll $name.c y -1"
!     	bind $c <Button-5>       "canvas_scroll $name.c y +1"
! 	bind $c <Shift-Button-4> "canvas_scroll $name.c x -1"
!     	bind $c <Shift-Button-5> "canvas_scroll $name.c x +1"
      } default {
! 	bind $c  <MouseWheel> \
! 	    "canvas_scroll $name.c y [expr -abs(%D)/%D]"
! 	bind $c  <Shift-MouseWheel> \
! 	    "canvas_scroll $name.c x [expr -abs(%D)/%D]"
      }}
  }
--- 977,989 ----
  #   bind $c <Map>        {canvas_map %W}
  #   bind $c <Unmap>      {canvas_unmap %W}
!     bind $c <Motion> "+statusbar_update $self %x %y"
      switch $OS { unix {
! 	bind $c <Button-4>       "canvas_scroll $c y -1"
!     	bind $c <Button-5>       "canvas_scroll $c y +1"
! 	bind $c <Shift-Button-4> "canvas_scroll $c x -1"
!     	bind $c <Shift-Button-5> "canvas_scroll $c x +1"
      } default {
! 	bind $c  <MouseWheel>       "canvas_scroll $c y [expr -abs(%D)/%D]"
! 	bind $c  <Shift-MouseWheel> "canvas_scroll $c x [expr -abs(%D)/%D]"
      }}
  }
***************
*** 1057,1082 ****
  }
! #-----------------------------------------------------------------------------------#
! proc menu_editmode {name} {
! 	#puts "menu_editmode::: $name"
! 	pd "$name editmode 0 ;"
! }
! #-----------------------------------------------------------------------------------#
  # correct edit menu, enabling or disabling undo/redo
  # LATER also cut/copy/paste
  proc menu_fixeditmenu {name} {
!     #puts "menu_fixeeditmenu::: $name"
! 
!     #global pd_undoaction pd_redoaction pd_undocanvas
!     #if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
! 	#$name.m.edit entryconfigure "Undo*" -state normal -label "Undo $pd_undoaction"
!     #} else {
! 	#$name.m.edit entryconfigure "Undo*" -state disabled -label "Undo"
!     #}
!     #if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
! 	#$name.m.edit entryconfigure "Redo*" -state normal -label "Redo $pd_redoaction"
!     #} else {
! 	#$name.m.edit entryconfigure "Redo*" -state disabled
!     #}
  }
--- 1036,1057 ----
  }
! proc menu_editmode {name} {pd "$name editmode 0 ;"}
! 
  # correct edit menu, enabling or disabling undo/redo
  # LATER also cut/copy/paste
  proc menu_fixeditmenu {name} {
!     return
!     global pd_undoaction pd_redoaction pd_undocanvas
!     set e $name.m.edit
!     if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
! 	$e entryconfigure "Undo*" -state normal -label "Undo $pd_undoaction"
!     } else {
! 	$e entryconfigure "Undo*" -state disabled -label "Undo"
!     }
!     if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
! 	$e entryconfigure "Redo*" -state normal -label "Redo $pd_redoaction"
!     } else {
! 	$e entryconfigure "Redo*" -state disabled
!     }
  }
***************
*** 1085,1095 ****
  # message from Pd to update the currently available undo/redo action
  proc pdtk_undomenu {name undoaction redoaction} {
!     #puts "pdtk_undomenu::: $name $undoaction $redoaction"
! 
!     #global pd_undoaction pd_redoaction pd_undocanvas
!     #set pd_undocanvas $name
!     #set pd_undoaction $undoaction
!     #set pd_redoaction $redoaction
!     #if {$name != "nobody"} {menu_fixeditmenu $name}
  }
--- 1060,1069 ----
  # message from Pd to update the currently available undo/redo action
  proc pdtk_undomenu {name undoaction redoaction} {
!     return
!     global pd_undoaction pd_redoaction pd_undocanvas
!     set pd_undocanvas $name
!     set pd_undoaction $undoaction
!     set pd_redoaction $redoaction
!     if {$name != "nobody"} {menu_fixeditmenu $name}
  }
***************
*** 1100,1104 ****
  }
! def canvas ctrlkey2 {key shift} {
      global accels
      set top .x$self
--- 1074,1078 ----
  }
! def* canvas ctrlkey2 {key shift} {
      global accels
      set top .x$self
***************
*** 1171,1184 ****
  }
! def objectbox draw {canvas} {
! 	set xs 42; catch {set xs $@xs}
! 	set ys 42; catch {set ys $@ys}
! 	set ins 2; catch {set ins $@nins}
! 	set outs 2; catch {set outs $@nouts}
! 	#puts "objectbox_draw ::: $self $canvas"
! 
          global look
          foreach {x1 y1} [object_xy $self $canvas] {}
-         #set x1 50; set y1 50
    set x2 [expr $x1+$xs]
          set y2 [expr $y1+$ys]
--- 1145,1156 ----
  }
! def* objectbox draw {canvas} {
! 	$self update_size
! 	set xs $@xs
! 	set ys $@ys
! 	set ins $@inlets
! 	set outs $@outlets
          global look
          foreach {x1 y1} [object_xy $self $canvas] {}
    set x2 [expr $x1+$xs]
          set y2 [expr $y1+$ys]
***************
*** 1191,1195 ****
    item $self $canvas BASE2 line      $xyb -fill $look(objectframe2)
    item $self $canvas BASE3 line      $xyc -fill $look(objectframe3)
!         io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
          #set @clickeditevent objectbox_clickedit
          #set @clickevent objectbox_click
--- 1163,1167 ----
    item $self $canvas BASE2 line      $xyb -fill $look(objectframe2)
    item $self $canvas BASE3 line      $xyc -fill $look(objectframe3)
!         io_draw $self $canvas
          #set @clickeditevent objectbox_clickedit
          #set @clickevent objectbox_click
***************
*** 1207,1254 ****
  #make objects turn blue.
! proc canvas_isselected {canvas member} {
!     #puts "canvas_isselected::: $canvas $member"
!     global _
!     set self [canvastosym $canvas]
!     set i [lsearch $_($self:selection) $member]
!     #puts "canvas_issellected ::: -> $i [expr $i>=0]"
      return [expr $i>=0]
  }
#-----------------------------------------------------------------------------------#
! def io draw {canvas x1 y1 xs ys ins outs} {
!     global look _
      set x2 [expr $x1+$xs]
      set y2 [expr $y1+$ys]
!     set fx $look(iopos)
!     set fy $look(iopos)
!     set @inlets  $ins
!     set @outlets $outs
!     set nplus [expr $ins == 1 ? 1 : $ins-1]
!     for {set i 0} {$i<$ins} {incr i} {
!         set onset [expr $x1 + ($xs - $look(iowidth)) * $i / $nplus]
!         set points [list [expr $onset+$fx] [expr $y1-$fy] \
!                 [expr $onset-$fx+$look(iowidth)] [expr $y1-$fy+$look(extrapix)]]
! 	# will update this code when proc item deals with mult.tags
! 	if {[llength [$canvas gettags ${self}i$i]] != 0} {
!             $canvas coords ${self}i$i $points
!         } {
!             $canvas create rectangle $points -tags "${self}i ${self}i$i $self" -outline $look(inletfg)
!         }
!     }
!     set nplus [expr $outs == 1 ? 1 : $outs-1]
!     for {set i 0} {$i<$outs} {incr i} {
!         set onset [expr $x1 + ($xs - $look(iowidth)) * $i / $nplus]
!         set points [list [expr $onset+$fx] [expr $y2-1+$fy] \
!                 [expr $onset-$fx+$look(iowidth)] [expr $y2+$fy]]
    # will update this code when proc item deals with mult.tags
!         if {[llength [$canvas gettags ${self}o$i]] != 0} {
!             $canvas coords ${self}o$i $points
          } {
!             $canvas create rectangle $points -tags "${self}o ${self}o$i $self" -outline $look(outletfg)
          }
      }
  }
def io erase {canvas} {$canvas delete ${self}i ${self}o}
--- 1179,1218 ----
  #make objects turn blue.
! def canvas isselected {member} {
!     set i [lsearch $@selection $member]
      return [expr $i>=0]
  }
#-----------------------------------------------------------------------------------#
! def io draw/2 {canvas which n y} {
!     global look
!     set nplus [expr $n==1 ? 1 : $n-1]
!     foreach {x1 y1} [object_xy $self $canvas] {}
!     set xs $@xs
!     set ys $@ys
      set x2 [expr $x1+$xs]
      set y2 [expr $y1+$ys]
!     for {set i 0} {$i<$n} {incr i} {
!         set onset [expr $x1 + ($@xs-$look(iowidth)) * $i / $nplus]
!         set points [list [expr $onset+$fx] $y [expr $onset-$fx+$look(iowidth)] [expr $y]]
!         set points [list [expr $onset+$fx] $y [expr $onset-$fx+$look(iowidth)] [expr $y]]
    # will update this code when proc item deals with mult.tags
! 	if {[llength [$canvas gettags ${self}$which$i]] != 0} {
!             $canvas coords ${self}$which$i $points
          } {
!             $canvas create rectangle $points -tags "$self$which $self$which$i $self" \
! 		-outline [switch $which { i {list $look(inletfg)} o {list $look(outletfg)}}]
          }
      }
  }
+ def io draw {canvas} {
+     global look
+     set fy $look(iopos)
+     foreach {x1 y1} [object_xy $self $canvas] {}
+     io_draw/2 $self $canvas i  $@inlets [expr $y1-$fy+$look(extrapix)]
+     io_draw/2 $self $canvas o $@outlets [expr $y1+$fy]
+ }
+ 
  def io erase {canvas} {$canvas delete ${self}i ${self}o}
***************
*** 1293,1297 ****
    $t configure -pady 0
          $t insert 1.0 $text
!         #bind $t <Motion>     {canvas_motion %W %x %y 0 %s}
    focus $t
    #puts "class name -> [winfo children ${canvas}]"
--- 1257,1261 ----
    $t configure -pady 0
          $t insert 1.0 $text
!         #bind $t <Motion> {canvas_motion %W %x %y 0 %s}
    focus $t
    #puts "class name -> [winfo children ${canvas}]"
***************
*** 1299,1308 ****
  }
! def text key {canvas widget x y key iso shift} {
    global font
    set @text [$widget get 1.0 1.end]
    $self update_size
    $self draw $canvas
! 	$widget configure -width [expr [llength $@text]+1]
  }
--- 1263,1274 ----
  }
! def* text key {canvas widget x y key iso shift} {
    global font
    set @text [$widget get 1.0 1.end]
+ 	set n [expr [string length $@text]+1]
+ 	puts "@text=$@text n=$n"
    $self update_size
    $self draw $canvas
! 	$widget configure -width $n
  }
***************
*** 1311,1314 ****
--- 1277,1282 ----
  def objectbox init {} {
    set @isnew 1
+ 	set @inlets 0
+ 	set @outlets 0
    #set canvas [canvastosym $_(focus)]
    set canvas $_(focus)
***************
*** 1318,1322 ****
  }
! def objectbox update_size {} {
    global font
    set @xs [expr $font(padx)+$font(width)*([llength $@text]+$@isnew)]
--- 1286,1290 ----
  }
! def* objectbox update_size {} {
    global font
    set @xs [expr $font(padx)+$font(width)*([llength $@text]+$@isnew)]
***************
*** 1472,1477 ****
    	}
    	#----handles the wire update----
- 		#set @inlets  $ins
-     		#set @outlets $outs
    	for {set x 0} {$x<$_($obj:inlets)} {incr x} {
    		#if {[info exists]}
--- 1440,1443 ----
***************
*** 2207,2214 ****
  }
! #def wire status {d} {
! #	puts "wire_update:: $self $d"
! #	foreach [list @obj1 @port1 @obj2 @port2] [lrange $d 0 3] {}
! #}
#-----------------------------------------------------------------------------------#
--- 2173,2179 ----
  }
! def wire status {d} {
! 	foreach [list @obj1 @port1 @obj2 @port2] [lrange $d 0 3] {}
! }
#-----------------------------------------------------------------------------------#
***************
*** 2351,2355 ****
class_new messagebox {view}
! def messagebox draw {canvas xs ys ins outs} {
    global look
    foreach {x1 y1} [object_xy $self $canvas] {}
--- 2316,2320 ----
class_new messagebox {view}
! def messagebox draw {canvas} {
    global look
    foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2360,2364 ****
    #shadow_draw $self $canvas $points
    item $self $canvas BASE polygon $points -fill $look(objectbg) -outline $look(objectframe3)
! 	io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
    if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    $canvas itemconfigure ${self}BASE -outline $frcol
--- 2325,2329 ----
    #shadow_draw $self $canvas $points
    item $self $canvas BASE polygon $points -fill $look(objectbg) -outline $look(objectframe3)
! 	io_draw $self $canvas
    if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    $canvas itemconfigure ${self}BASE -outline $frcol
***************
*** 2372,2376 ****
class_new atombox {view}
! def atombox draw {canvas xs ys ins outs} {
    global look
    foreach {x1 y1} [object_xy $self $canvas] {}
--- 2337,2341 ----
class_new atombox {view}
! def atombox draw {canvas} {
    global look
    foreach {x1 y1} [object_xy $self $canvas] {}
***************
*** 2384,2388 ****
    }
    item $self $canvas BASE polygon $points -tag -fill $look(objectbg) -outline $look(objectframe3)
! 	io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
    if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    $canvas itemconfigure ${self}BASE -outline $frcol
--- 2349,2353 ----
    }
    item $self $canvas BASE polygon $points -tag -fill $look(objectbg) -outline $look(objectframe3)
! 	io_draw $self $canvas
    if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    $canvas itemconfigure ${self}BASE -outline $frcol
***************
*** 2419,2423 ****
    	$canvas create line $x3 $y1 $x3 $y2 -tags ${self}CURS -fill red
    }
! 	io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
    label_draw $self $canvas
    set @clickevent numbox_click
--- 2384,2388 ----
    	$canvas create line $x3 $y1 $x3 $y2 -tags ${self}CURS -fill red
    }
! 	io_draw $self $canvas
    label_draw $self $canvas
    set @clickevent numbox_click
***************
*** 2529,2533 ****
    item $self $canvas BASE2 line      $xyb -fill #ffffff
    item $self $canvas BASE3 line      $xyc -fill [darker $color]
! 	io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
    if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    $canvas itemconfigure ${self}BASE -outline $frcol
--- 2494,2498 ----
    item $self $canvas BASE2 line      $xyb -fill #ffffff
    item $self $canvas BASE3 line      $xyc -fill [darker $color]
! 	io_draw $self $canvas
    if {[canvas_isselected $canvas $self]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    $canvas itemconfigure ${self}BASE -outline $frcol
***************
*** 2554,2558 ****
    set ins  [expr [string compare $@rcv empty]==0]
    set outs [expr [string compare $@snd empty]==0]
! 	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
    if {$orient} {set size $ys} {set size $xs}
    set size [expr $size/$n]
--- 2519,2523 ----
    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]
***************
*** 2609,2613 ****
    set outs [expr [string compare $@snd empty]==0]
    switch $@class {hsl {set orient 0} vsl {set orient 1}}
! 	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
    if {![info exists @clicking]} {set @clicking 0}
    set color [bluify #ffffff]
--- 2574,2578 ----
    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]
***************
*** 2742,2747 ****
    set outs [expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
! 	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! 	io_draw      $self $canvas $x1 $y1 $xs $ys $ins $outs
    item $self $canvas BUT oval \
    	[expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2] \
--- 2707,2712 ----
    set outs [expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
! 	bluebox_draw $self $canvas
! 	io_draw      $self $canvas
    item $self $canvas BUT oval \
    	[expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2] \
***************
*** 2770,2775 ****
    set outs [expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
! 	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! 	io_draw      $self $canvas $x1 $y1 $xs $ys $ins $outs
    set w 1
    if {$xs >= 30} {set w 2}
--- 2735,2740 ----
    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}

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

[PD-cvs] pd/src desire.tk,1.1.2.53,1.1.2.54