[PD-cvs] pd/src desire.tk,1.1.2.178,1.1.2.179

22 Apr 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30306
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
misc varia stuff
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.178
retrieving revision 1.1.2.179
diff -C2 -d -r1.1.2.178 -r1.1.2.179
*** desire.tk	22 Apr 2006 03:41:13 -0000	1.1.2.178
--- desire.tk	22 Apr 2006 06:44:41 -0000	1.1.2.179
***************
*** 17,22 ****
#-----------------------------------------------------------------------------------#
! # some list processing functions
proc min {x y} {if {$x<$y} {return $x} {return $y}}
  proc max {x y} {if {$x>$y} {return $x} {return $y}}
--- 17,27 ----
#-----------------------------------------------------------------------------------#
! # some list processing functions and some math too
+ proc clip {x min max} {
+ 	if {$x<$min} {return $min}
+ 	if {$x>$max} {return $max}
+ 	return $x
+ }
  proc min {x y} {if {$x<$y} {return $x} {return $y}}
  proc max {x y} {if {$x>$y} {return $x} {return $y}}
***************
*** 97,101 ****
    	post %s "$o: $poolset($o)"
    	unset poolset($o)
- 		puts ".....draw $o ....."
    	$o draw
    }
--- 102,105 ----
***************
*** 872,875 ****
--- 876,885 ----
  def Canvas quit {} {global main; $main quit}
+ proc wonder {} {tk_messageBox -message "this would be a cool feature, eh?" -type yesno -icon question}
+ 
+ def Canvas popup_properties {} {wonder}
+ def Canvas popup_open {} {wonder}
+ def Canvas popup_help {} {wonder}
+ 
  def* Canvas eval% {code} {
    regsub -all %X $code $@current_x code
***************
*** 969,976 ****
  def Canvas editmode {} {return $@editmode}
  def Canvas editmode= {mode} {
!     global look edit_toggle
      set @editmode $mode
      #sets the edit_toggle so the edit mode checkbox will follow if key binding is used
-     set edit_toggle $@editmode
      catch {.$self.bbar.edit configure -image icon_mode_$mode}
      .$self.c configure -background [if $@editmode {concat $look(canvasbgedit)} {concat $look(canvasbgrun)}]
--- 979,985 ----
  def Canvas editmode {} {return $@editmode}
  def Canvas editmode= {mode} {
!     global look
      set @editmode $mode
      #sets the edit_toggle so the edit mode checkbox will follow if key binding is used
      catch {.$self.bbar.edit configure -image icon_mode_$mode}
      .$self.c configure -background [if $@editmode {concat $look(canvasbgedit)} {concat $look(canvasbgrun)}]
***************
*** 1192,1202 ****
$m.edit add checkbutton -label [say edit_mode] \
!     	-selectcolor grey0 -command "menu_editmode $name" \
      	-accelerator [accel_munge "Ctrl+e"] -indicatoron 1 \
! 	-variable edit_toggle -onvalue 1 -offvalue 0
!     #binds the state of the checkbox to global variable edit_toggle
!     
!     dict append @accels "Ctrl+e" "menu_editmode $name"
!     
      $m.edit   configure -postcommand "$self fix_edit_menu"
      $m.window configure -postcommand "menu_fixwindowmenu"
--- 1201,1209 ----
$m.edit add checkbutton -label [say edit_mode] \
!     	-selectcolor grey0 -command "$self editmode 0" \
      	-accelerator [accel_munge "Ctrl+e"] -indicatoron 1 \
! 	-variable @editmode -onvalue 1 -offvalue 0
!     #binds the state of the checkbox to global variable editmod
!     dict append @accels "Ctrl+e" "$self editmode 0"
      $m.edit   configure -postcommand "$self fix_edit_menu"
      $m.window configure -postcommand "menu_fixwindowmenu"
***************
*** 1211,1219 ****
  }
- proc menu_editmode {name} {
-     global _ edit_toggle
-     pd $name editmode 0
- }
- 
  def Canvas editmodeswitch {args} {
      set @editmode [expr !$@editmode]
--- 1218,1221 ----
***************
*** 1359,1366 ****
    global font look
    set @textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! 	set @topwidth [expr ($@ninlets + ($@ninlets - 1)) * $look(iowidth)]
! 	set @bottomwidth [expr ($@noutlets + ($@noutlets - 1)) * $look(iowidth)]
    set @xs [max $look(minobjwidth) [max $@bottomwidth [max $@topwidth $@textwidth]]]
! 	set @ys  [expr $font(pady)+$font(height)]
  }
--- 1361,1368 ----
    global font look
    set @textwidth [expr $font(padx)+$font(width)*([string length $@text]+$@edit)]
! 	set @topwidth    [expr (2* $@ninlets-1) * $look(iowidth)]
! 	set @bottomwidth [expr (2*$@noutlets-1) * $look(iowidth)]
    set @xs [max $look(minobjwidth) [max $@bottomwidth [max $@topwidth $@textwidth]]]
! 	set @ys [expr $font(pady)+$font(height)]
  }
***************
*** 1566,1570 ****
  }
! def* View move {dx dy} {
    mset {x y} [$self xy]
    set @x1 [expr $@x1+$dx]
--- 1568,1572 ----
  }
! def View move {dx dy} {
    mset {x y} [$self xy]
    set @x1 [expr $@x1+$dx]
***************
*** 1769,1774 ****
    set c .[$self canvas].c
    mset {type id} [$self identify_target $x $y $b $f "click"]
! 	puts "object_in_edit: $@obj_in_edit id:$id"
! 	if {$f&8} {post "right click!"; return}
    if {[llength $@obj_in_edit]} {$@obj_in_edit unedit; set @obj_in_edit {}}
    # if clicked on empty space in edit mode, draw dash sel rect
--- 1771,1778 ----
    set c .[$self canvas].c
    mset {type id} [$self identify_target $x $y $b $f "click"]
! 	if {$f&8} {
! 		tk_popup .$self.popup [winfo pointerx $c] [winfo pointery $c]
! 		return
! 	}
    if {[llength $@obj_in_edit]} {$@obj_in_edit unedit; set @obj_in_edit {}}
    # if clicked on empty space in edit mode, draw dash sel rect
***************
*** 2051,2086 ****
def* Box draw_wires {} {
- 	
      puts "wires:$@wires"
!     
!     foreach wire $@wires {
!     $wire draw
!     }
  }
def* Box delete_wire {wire} {
! 	set find [lsearch $@wires $wire]
! 	if { $find != -1} {
! 	set @wires [lreplace $@wires $find $find]
! 	}
  }
! def* Box move {dx dy} {
! 	global _
! 	super $dx $dy
! 	#$self draw_wires
! 	foreach wire $@wires {
! 	# the select_by is ugly, remove later... $_($@canvas:select_by)
! 	set _($wire:select_by) $_($@canvas:select_by)
!     	$wire draw
!     	}
  }
- 
  def* Box clickedit {x y butt key in_selection selection} {
      #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....
--- 2055,2082 ----
def* Box draw_wires {} {
      puts "wires:$@wires"
!     foreach wire $@wires {$wire draw}
  }
def* Box delete_wire {wire} {
!   set find [lsearch $@wires $wire]
!   if {$find != -1} {set @wires [lreplace $@wires $find $find]}
  }
! def Box move {dx dy} {
!   super $dx $dy
!   #$self draw_wires
!   foreach wire $@wires {
!     # the select_by is ugly, remove later... $_($@canvas:select_by)
!     set _($wire:select_by) $_($@canvas:select_by)
!     $wire draw
!   }
  }
def* Box clickedit {x y butt key in_selection selection} {
      #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....
***************
*** 2267,2275 ****
  set classinfo(tgl)     {Toggle}
  set classinfo(bng)     {Bang}
! set classinfo(nbx)     {numbox}
! set classinfo(hsl)     {slider}
! set classinfo(hradio)  {radio}
! set classinfo(vu)      {vu}
! set classinfo(dropper) {dropper}
  set classinfo(vsl)     $classinfo(hsl)
  set classinfo(vradio)  $classinfo(hradio)
--- 2263,2271 ----
  set classinfo(tgl)     {Toggle}
  set classinfo(bng)     {Bang}
! set classinfo(nbx)     {NumBox}
! set classinfo(hsl)     {Slider}
! set classinfo(hradio)  {Radio}
! set classinfo(vu)      {Vu}
! set classinfo(dropper) {Dropper}
  set classinfo(vsl)     $classinfo(hsl)
  set classinfo(vradio)  $classinfo(hradio)
***************
*** 2277,2281 ****
  set classinfo(vdl)     $classinfo(hradio)
  set classinfo(canvas)  {Canvas}
! set classinfo(cnv)     {cnv}
proc update_object {x d} {
--- 2273,2277 ----
  set classinfo(vdl)     $classinfo(hradio)
  set classinfo(canvas)  {Canvas}
! set classinfo(cnv)     {Cnv}
proc update_object {x d} {
***************
*** 2352,2356 ****
    	incr i
    }
- 	puts "==== x:$x"
    $x changed
  }
--- 2348,2351 ----
***************
*** 2359,2364 ****
# fix me
! class_new shadow {qwerty}
! def shadow draw {coords} {
    global look
    set light [darker ${look(objectbg)}]
--- 2354,2359 ----
# fix me
! class_new Shadow {} ;# make a Box class inherit from this
! def Shadow draw {coords} {
    global look
    set light [darker ${look(objectbg)}]
***************
*** 2436,2441 ****
  }
! class_new BlueBox {labeled Box}
! #class_new BlueBox {Box labeled}
def* BlueBox draw {} {
--- 2431,2436 ----
  }
! class_new BlueBox {Labeled Box}
! #class_new BlueBox {Box Labeled}
def* BlueBox draw {} {
***************
*** 2459,2464 ****
  }
! class_new numbox {labeled Box}
! def* numbox init {args} {
    eval [concat [list super] $args]
    set @clicking 0
--- 2454,2459 ----
  }
! class_new NumBox {Labeled Box}
! def* NumBox init {args} {
    eval [concat [list super] $args]
    set @clicking 0
***************
*** 2466,2470 ****
  }
! def* numbox draw {} {
    $self update_size
    global look
--- 2461,2465 ----
  }
! def* NumBox draw {} {
    $self update_size
    global look
***************
*** 2485,2489 ****
    $self item BASE   polygon $points  -fill [parse_color $@bcol] -outline $look(objectframe3)
    $self item BASE4  polygon $points2 -fill $color4 -outline $look(objectframe3)
! 	$self item NUMBER text [list $xt $yt] -anchor w -text [numbox_ftoa $self] \
    	-font [list $font $@fs bold] -fill [parse_color $@fcol]
    .$@canvas.c delete ${self}CURS
--- 2480,2484 ----
    $self item BASE   polygon $points  -fill [parse_color $@bcol] -outline $look(objectframe3)
    $self item BASE4  polygon $points2 -fill $color4 -outline $look(objectframe3)
! 	$self item NUMBER text [list $xt $yt] -anchor w -text [$self ftoa] \
    	-font [list $font $@fs bold] -fill [parse_color $@fcol]
    .$@canvas.c delete ${self}CURS
***************
*** 2493,2502 ****
    }
    io_draw $self
! 	labeled_draw $self
    if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    .$@canvas.c itemconfigure ${self}BASE -outline $frcol
  }
! def* numbox update_size  {} {
    global font look
    set @textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
--- 2488,2497 ----
    }
    io_draw $self
! 	Labeled_draw $self
    if {[$self selected?]} {set frcol $look(objectframe4)} {set frcol $look(objectframe3)}
    .$@canvas.c itemconfigure ${self}BASE -outline $frcol
  }
! def* NumBox update_size {} {
    global font look
    set @textwidth [expr $font(padx)+$font(width)*[string length $@buf]]
***************
*** 2509,2513 ****
! def numbox ftoa {} {
    set f $@val
    set is_exp 0
--- 2504,2508 ----
! def NumBox ftoa {} {
    set f $@val
    set is_exp 0
***************
*** 2530,2534 ****
  }
! def numbox click {x y b f} {
    $@canvas focus $self
    $@canvas itemconfigure ${self}BASE4 -fill #00ff00
--- 2525,2529 ----
  }
! def NumBox click {x y b f} {
    $@canvas focus $self
    $@canvas itemconfigure ${self}BASE4 -fill #00ff00
***************
*** 2539,2543 ****
  }
! def numbox motion {x y mod} {
    set focused [$self == [$@canvas focus]]
    if {!$focused} {return}
--- 2534,2538 ----
  }
! def NumBox motion {x y mod} {
    set focused [$self == [$@canvas focus]]
    if {!$focused} {return}
***************
*** 2549,2555 ****
  }
! def numbox unfocus {} {set @buf ""; $self changed}
! def numbox unclick {x y} {
    set @clicking 0
    if {$@oval!=$@val} {
--- 2544,2550 ----
  }
! def NumBox unfocus {} {set @buf ""; $self changed}
! def NumBox unclick {x y} {
    set @clicking 0
    if {$@oval!=$@val} {
***************
*** 2559,2563 ****
  }
! def numbox key {key shift} {
      set c -1
      catch {set c [format %c $key]}
--- 2554,2558 ----
  }
! def NumBox key {key shift} {
      set c -1
      catch {set c [format %c $key]}
***************
*** 2581,2590 ****
          $@canvas unfocus
      } else {
! 	puts "numbox_key $key"
      }
  }
! class_new radio {BlueBox}
! def radio orient {} {
    switch $@pdclass {
    	hradio {set orient 0} hdl {set orient 0}
--- 2576,2585 ----
          $@canvas unfocus
      } else {
! 	puts "NumBox_key $key"
      }
  }
! class_new Radio {BlueBox}
! def Radio orient {} {
    switch $@pdclass {
    	hradio {set orient 0} hdl {set orient 0}
***************
*** 2595,2599 ****
  }
! def radio bbox {} {
    set orient [$self orient]
    mset {x1 y1} [$self xy]
--- 2590,2594 ----
  }
! def Radio bbox {} {
    set orient [$self orient]
    mset {x1 y1} [$self xy]
***************
*** 2603,2607 ****
  }
! def* radio draw {} {
    set orient [$self orient]
    mset {x1 y1 x2 y2} [$self bbox]
--- 2598,2602 ----
  }
! def* Radio draw {} {
    set orient [$self orient]
    mset {x1 y1 x2 y2} [$self bbox]
***************
*** 2619,2628 ****
  }
! def radio set {value} {
    .$@canvas.c itemconfigure ${self}BUT       -fill #ffffff
    .$@canvas.c itemconfigure ${self}BUT$value -fill #000000
  }
! def radio click {x y b f} {
    mset {x1 y1} [$self xy]
    set x [expr $x-$x1]
--- 2614,2623 ----
  }
! def Radio set {value} {
    .$@canvas.c itemconfigure ${self}BUT       -fill #ffffff
    .$@canvas.c itemconfigure ${self}BUT$value -fill #000000
  }
! def Radio click {x y b f} {
    mset {x1 y1} [$self xy]
    set x [expr $x-$x1]
***************
*** 2633,2644 ****
  }
! proc clamp {x min max} {
! 	if {$x<$min} {return $min}
! 	if {$x>$max} {return $max}
! 	return $x
! }
! 
! class_new slider {BlueBox}
! def slider orient {} {
    switch $@pdclass {
    	vsl {set orient 1} default {set orient 0}
--- 2628,2633 ----
  }
! class_new Slider {BlueBox}
! def Slider orient {} {
    switch $@pdclass {
    	vsl {set orient 1} default {set orient 0}
***************
*** 2647,2661 ****
  }
! def* slider init {args} {
    super
    set @clicking 0
  }
! def slider bbox {} {
    mset {x1 y1} [$self xy]
    list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]
  }
! def slider draw {} {
    global look
    mset {x1 y1 x2 y2} [$self bbox]
--- 2636,2650 ----
  }
! def Slider init {args} {
    super
    set @clicking 0
  }
! def Slider bbox {} {
    mset {x1 y1} [$self xy]
    list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]
  }
! def Slider draw {} {
    global look
    mset {x1 y1 x2 y2} [$self bbox]
***************
*** 2691,2703 ****
# not used
! def slider draw_notches {} {
    set orient [$self orient]
    if {$orient} {
! 		set thick [clamp [expr $xs/3] 1 5]
    	set x3 [expr $x1+$xs-$thick/2-2]
    	set eighth [expr round($ys/8-1)]
    	set coords [list $x3 $y1 $x3 [expr $y1+$ys]]
    } else {
! 		set thick [clamp [expr $ys/3] 1 5]
    	set y3 [expr $y1+$ys-$thick/2-2]
    	set eighth [expr $xs/8]
--- 2680,2692 ----
# not used
! def Slider draw_notches {} {
    set orient [$self orient]
    if {$orient} {
! 		set thick [clip [expr $xs/3] 1 5]
    	set x3 [expr $x1+$xs-$thick/2-2]
    	set eighth [expr round($ys/8-1)]
    	set coords [list $x3 $y1 $x3 [expr $y1+$ys]]
    } else {
! 		set thick [clip [expr $ys/3] 1 5]
    	set y3 [expr $y1+$ys-$thick/2-2]
    	set eighth [expr $xs/8]
***************
*** 2707,2711 ****
  }
! def slider click {x y b f} {
    $@canvas focus $self
    set @first [list $x $y]
--- 2696,2700 ----
  }
! def Slider click {x y b f} {
    $@canvas focus $self
    set @first [list $x $y]
***************
*** 2715,2719 ****
  }
! def slider unclick {x y} {
    set @clicking 0
    if {[lindex $@first 1] != $y} {
--- 2704,2708 ----
  }
! def Slider unclick {x y} {
    set @clicking 0
    if {[lindex $@first 1] != $y} {
***************
*** 2723,2727 ****
  }
! def slider motion {x y mods} {
    set focused [$self == [$@canvas focus]]
    if {!$focused} {return}
--- 2712,2716 ----
  }
! def Slider motion {x y mods} {
    set focused [$self == [$@canvas focus]]
    if {!$focused} {return}
***************
*** 2736,2744 ****
  }
! def slider unfocus {} {$self draw}
! class_new labeled {}
! def* labeled draw {} {
    mset {x1 y1} [$self xy]
    set lx [expr $x1+$@ldx]
--- 2725,2733 ----
  }
! def Slider unfocus {} {$self draw}
! class_new Labeled {}
! def* Labeled draw {} {
    mset {x1 y1} [$self xy]
    set lx [expr $x1+$@ldx]
***************
*** 2752,2756 ****
  }
! def labeled erase {} {
  #	$@canvas delete ${self}LABEL
  }
--- 2741,2745 ----
  }
! def Labeled erase {} {
  #	$@canvas delete ${self}LABEL
  }
***************
*** 2788,2792 ****
def Toggle init {args} {
- 	puts "!!!!!! args:$args"
    super
    set @on 0
--- 2777,2780 ----
***************
*** 2828,2832 ****
  }
! class_new vu {View}
set vu_col {
--- 2816,2820 ----
  }
! class_new Vu {View}
set vu_col {
***************
*** 2835,2839 ****
  }
! def vu led_size {} {
    set n [expr $@h/40]
    if {$n < 2} {set n 2}
--- 2823,2827 ----
  }
! def Vu led_size {} {
    set n [expr $@h/40]
    if {$n < 2} {set n 2}
***************
*** 2841,2845 ****
  }
! def vu draw {} {
    global vu_col
    mset {x1 y1} [$self xy]
--- 2829,2833 ----
  }
! def Vu draw {} {
    global vu_col
    mset {x1 y1} [$self xy]
***************
*** 2883,2887 ****
  }
! def vu set {i j} {
    global vu_col
    mset {x1 y1} [$self xy]
--- 2871,2875 ----
  }
! def Vu set {i j} {
    global vu_col
    mset {x1 y1} [$self xy]
***************
*** 2906,2911 ****
  }
! class_new dropper {View}
! def dropper draw {} {	
      set isnew [expr [llength [$@canvas gettags ${self}BASE]] == 0]
      mset {x1 y1} [$self xy]
--- 2894,2899 ----
  }
! class_new Dropper {View}
! def Dropper draw {} {	
      set isnew [expr [llength [$@canvas gettags ${self}BASE]] == 0]
      mset {x1 y1} [$self xy]
***************
*** 2927,2934 ****
  }
! def dropper erase {} {destroy $@canvas.${self}DROP; super}
! class_new cnv {labeled View}
! def cnv draw {} {
    mset {x1 y1} [$self xy]
    set xs $@w
--- 2915,2922 ----
  }
! def Dropper erase {} {destroy $@canvas.${self}DROP; super}
! class_new Cnv {Labeled View}
! def Cnv draw {} {
    mset {x1 y1} [$self xy]
    set xs $@w

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.178,1.1.2.179