pd/src desire.tk,1.1.2.35,1.1.2.36 - Pd-cvs

10 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22347
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
whatever
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.35
retrieving revision 1.1.2.36
diff -C2 -d -r1.1.2.35 -r1.1.2.36
*** desire.tk	6 Sep 2005 11:37:52 -0000	1.1.2.35
--- desire.tk	10 Sep 2005 08:26:46 -0000	1.1.2.36
***************
*** 13,17 ****
  #   (thanks for taking time looking at this code)
  #-----------------------------------------------------------------------------------#
! # This section is matju's object system
proc class_new {name body} {
--- 13,18 ----
  #   (thanks for taking time looking at this code)
  #-----------------------------------------------------------------------------------#
! # This section is matju's object system (the base class is called base because
! # there's already something else called class)
proc class_new {name body} {
***************
*** 24,27 ****
--- 25,41 ----
  }
+ rename unknown _original_unknown
+ proc unknown {args} {
+ 	global _
+ 	if {[catch {
+ 		set name $_($self:_class)_$selector
+ 		set self [lindex $args 0]
+ 		set selector [lindex $args 1]
+ 		uplevel 1 [linsert [concat [list $self] [lrange $args 2 end] 0 $selector]]
+ 	}]} {
+ 		uplevel 1 [linsert $args 0 _original_unknown]
+ 	}
+ }
+ 
  #some questions to matju --chun
  #
***************
*** 162,179 ****
for {set i 0} {$i < $argc} {incr i} {
!   global cmdline
    set o [lindex $argv $i]
    switch -regexp -- $o {
!     -console {
!       incr i
!       set cmdline(console) [lindex $argv $i]
!     }
!     -gdb {set cmdline(gdb) 1}
!     -nogdb {set cmdline(gdb) 0}
!     -* {puts "ERROR: command line argument: unknown $o"}
!     default {
!       incr i
!       lappend files_to_open [lindex $argv $i]
!     }
    }
  }
--- 176,187 ----
for {set i 0} {$i < $argc} {incr i} {
!   global cmdline files_to_open
    set o [lindex $argv $i]
    switch -regexp -- $o {
!     ^-console$ {incr i; set cmdline(console) [lindex $argv $i]}
!     ^-gdb$ {set cmdline(gdb) 1}
!     ^-nogdb$ {set cmdline(gdb) 0}
!     ^- {puts "ERROR: command line argument: unknown $o"}
!     default {lappend files_to_open [lindex $argv $i]}
    }
  }
***************
*** 315,322 ****
    	poll_sock
    	global files_to_open
    	foreach f $files_to_open {
! 			set ff [file split $f]
    		set ffl [llength $ff]
! 			pd "pd open [lindex $ff [expr $ffl-1]] [file join [lrange $ff 0 [expr $ffl-2]]] ;"
    	}
    } {
--- 323,335 ----
    	poll_sock
    	global files_to_open
+ 		post "files_to_open='$files_to_open'"
    	foreach f $files_to_open {
! 			set ff [file split [file normalize $f]]
    		set ffl [llength $ff]
! 			set file [lindex $ff [expr $ffl-1]]
! 			set dir [join [lrange $ff 0 [expr $ffl-2]] [file separator]]
! 			post "f='$f' ff='$ff' ffl='$ffl'"
! 			post "pd open $file $dir ;"
! 			pd "pd open $file $dir ;"
    	}
    } {
***************
*** 513,517 ****
    	objectbox_draw $object_id $canvas.c \
    		[expr ($_($object_id:name_len)*$font(width)) + $font(padx)] \
! 			[expr $font(height) + $font(pady)] 1 3
pdtk_text_new \
--- 526,530 ----
    	objectbox_draw $object_id $canvas.c \
    		[expr ($_($object_id:name_len)*$font(width)) + $font(padx)] \
! 			[expr $font(height) + $font(pady)]
pdtk_text_new \
***************
*** 632,658 ****
  #-----------------------------------------------------------------------------------#
  proc populate_menu {menu context list} {
- 	#puts "__populate_menu::: $menu $context $list"
- 
    global accels
    foreach e $list {
! 	    switch -- [llength $e] {
! 	        0 {
! 		    $menu add separator
! 		}
! 		3 {
! 		    set cmd [lindex $e 1]
! 		    set accel [accel_munge [lindex $e 2]]
! 		    if {$accel != ""} {set accels([string tolower $accel]) $cmd}
! 		    regsub -all %W $cmd $context cmd
! 		    $menu add command -label [lindex $e 0] -command $cmd \
! 			    -accelerator $accel
! 		}
! 		4 {
! 		    set cmd [lindex $e 1]
! 		    set accel [accel_munge [lindex $e 2]]
! 		    if {$accel != ""} {set accels([string tolower $accel]) $cmd}
! 		    regsub -all %W $cmd $context cmd
! 		    $menu add checkbutton -label [lindex $e 0] -command $cmd \
! 			    -accelerator $accel -indicatoron ???
    	}
        }
--- 645,661 ----
  #-----------------------------------------------------------------------------------#
  proc populate_menu {menu context list} {
    global accels
    foreach e $list {
! 	  if {[llength $e]==0} {$menu add separator} {
! 	    set cmd [lindex $e 1]
! 	    set accel [accel_munge [lindex $e 2]]
! 	    regsub -all %W $cmd $context cmd
! 	    if {$accel != ""} {set accels([string tolower $accel]) $cmd}
! 	    if {[llength $e]==3} {
! 		$menu add command -label [lindex $e 0] -command $cmd \
! 			-accelerator $accel
! 	    } { # 4
! 		$menu add checkbutton -label [lindex $e 0] -command $cmd \
! 			-accelerator $accel -indicatoron ???
    	}
        }
***************
*** 693,697 ****
  #-----------------------------------------------------------------------------------#
  set look(iowidth) 7
! set look(iopos) 1
  set look(objectfg) #000000
  set look(objectbg) #ffffff
--- 696,700 ----
  #-----------------------------------------------------------------------------------#
  set look(iowidth) 7
! set look(iopos) 0
  set look(objectfg) #000000
  set look(objectbg) #ffffff
***************
*** 735,738 ****
--- 738,751 ----
  }
  #-----------------------------------------------------------------------------------#
+ 
+ proc menu_close {name} {pd "$name menuclose 0 ;"}
+ proc menu_save   {name} {pdtk_canvas_checkgeometry $name; pd "$name menusave ;"}
+ proc menu_saveas {name} {pdtk_canvas_checkgeometry $name; pd "$name menusaveas ;"}
+ proc menu_print {name} {
+     set filename [tk_getSaveFile -initialfile pd.ps -defaultextension .ps \
+        -filetypes { {{postscript} {.ps}} }]
+     if {$filename != ""} {$name.c postscript -file $filename}
+ }
+ 
  proc menu_addstd {mbar} {
      puts "menu_addstd::: $mbar"
***************
*** 771,777 ****
    {}
    {Close   {foo menu_close} "Ctrl+w"}
! 	{Save    {foo menu_save} "Ctrl+s"}
! 	{"Save as..." {foo menu_saveas} "Ctrl+S"}
! 	{Print   {foo menu_print} "Ctrl+p"}
    {}
    {Quit    {foo menu_quit} "Ctrl+q"}
--- 784,790 ----
    {}
    {Close   {foo menu_close} "Ctrl+w"}
! 	{Save    {menu_save} "Ctrl+s"}
! 	{"Save as..." {menu_saveas} "Ctrl+S"}
! 	{Print   {menu_print} "Ctrl+p"}
    {}
    {Quit    {foo menu_quit} "Ctrl+q"}
***************
*** 1081,1089 ****
# for quit/save/undo
!     #switch -- $key {
!     #  q {if {$shift} {menu_really_quit} else {menu_quit}; return}
!     #  s {if {$shift} {menu_saveas $topname} {menu_save $topname}; return}
!     #  z {if {$shift} {menu_redo $topname} else {menu_undo $topname}; return}
!     #}
global accels
--- 1094,1102 ----
# for quit/save/undo
!     switch -- $key {
!       #q {if {$shift} {menu_really_quit} else {menu_quit}; return}
!       s {if {$shift} {menu_saveas $topname} {menu_save $topname}; return}
!       #z {if {$shift} {menu_redo $topname} else {menu_undo $topname}; return}
!     }
global accels
***************
*** 1107,1110 ****
--- 1120,1124 ----
      }
  }
+ 
  #-----------------------------------------------------------------------------------#
  proc pdtk_canvas_altkey {name key iso} {
***************
*** 1122,1130 ****
      }
  }
- #-----------------------------------------------------------------------------------#
- 
- proc foo {args} {
- 	puts " $args not there yet...."
- }
#-----------------------------------------------------------------------------------#
--- 1136,1139 ----
***************
*** 1141,1145 ****
  #-----------------------------------------------------------------------------------#
  def object xy {canvas} {
- 	puts "object_xy"
    set canvas_id [canvastosym $canvas]
    if {[info exists @cx]} {
--- 1150,1153 ----
***************
*** 1150,1172 ****
    	
    	#don't delete these two lines
! 		set @cx $_($canvas_id:current_x)
! 		set @cy $_($canvas_id:current_y)
! 		
! 		#set @cx 40
! 		#set @cy 40
! 		
    	return [list $@cx $@cy]
    }
  }
! #-----------------------------------------------------------------------------------#
! def brokenbox draw {canvas xs ys ins outs} {
!         puts "brokenbox_draw:: $self $canvas $xs $ys $ins $outs"
!         objectbox_draw $self $canvas $xs $ys $ins $outs
!         $canvas itemconfigure ${self}BASE -outline blue -width 3
  }
! #-----------------------------------------------------------------------------------#
! def objectbox draw {canvas xs ys ins outs} {
! 	puts "objectbox_draw ::: $self $canvas $xs $ys $ins $outs"
global look
--- 1158,1183 ----
    	
    	#don't delete these two lines
! 		set @cx 40; catch {set @cx $_($canvas_id:current_x)}
! 		set @cy 40; catch {set @cy $_($canvas_id:current_y)}
    	return [list $@cx $@cy]
    }
  }
! 
! proc canvas_of {self} {
! 	global _
! 	return $_($self:canvas)
  }
! def brokenbox draw {canvas} {
!         puts "brokenbox_draw:: $self $canvas"
!         $canvas itemconfigure ${self}BASE -width 1 -dash {8 8 8 8}
! }
! 
! 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
***************
*** 1304,1311 ****
    set sx [expr ($font(width) * ($name_len+1) + $font(padx))]
    set sy [expr $font(height) + $font(pady)]
    if {[expr $@isnew == 1]} {
! 		brokenbox_draw $self $canvas $sx $sy 0 0
    } {
! 		objectbox_draw $self $canvas $sx $sy 1 3
    }
    
--- 1315,1324 ----
    set sx [expr ($font(width) * ($name_len+1) + $font(padx))]
    set sy [expr $font(height) + $font(pady)]
+ 	set @sx sx
+ 	set @sy sy
    if {[expr $@isnew == 1]} {
! 		brokenbox_draw $self $canvas
    } {
! 		objectbox_draw $self $canvas
    }
    
***************
*** 1553,1591 ****
      		set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
      		set _($obj:cy) [expr $_($obj:cy) + $cy-$old_y]
-     		
    	puts "**** class==> $_($obj:class) *****"
- 		
    	switch $_($obj:class) {
! 		
! 		
! 		textobj {
! 		
! 		puts "move textobj"
! 		
! 		objectbox_draw $obj $canvas \
! 		[expr ($_($obj:name_len)*$font(width)) + $font(padx)] \
! 		[expr $font(height) + $font(pady)] 1 3
! 		
! 		set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
! 		set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
! 		
! 		if {$_($self:obj_in_edit)} {$canvas coords ${obj}text $text_pos}
! 		$canvas coords ${obj}TEXT $text_pos2
! 		
! 		
! 		}
! 		
! 		bang {
! 		
! 		puts "move bang"
! 		bang_draw $obj $canvas
! 		
! 		}
! 		
! 		
    	}
- 		
-     		
- 	
    	#----handles the wire update----
    	#set _($self:inlets)  $ins
--- 1566,1586 ----
      		set _($obj:cx) [expr $_($obj:cx) + $cx-$old_x]
      		set _($obj:cy) [expr $_($obj:cy) + $cy-$old_y]
    	puts "**** class==> $_($obj:class) *****"
    	switch $_($obj:class) {
! 		  textobj {
! 			puts "move textobj"
! 			set $_($obj:sx) [expr ($_($obj:name_len)*$font(width)) + $font(padx)]
! 			set $_($obj:sy) [expr $font(height) + $font(pady)]
! 			objectbox_draw $obj $canvas
! 			set text_pos [list [expr $_($obj:cx)+1] [expr $_($obj:cy)+1]]
! 			set text_pos2 [list [expr $_($obj:cx)+2] [expr $_($obj:cy)+2]]
! 			if {$_($self:obj_in_edit)} {$canvas coords ${obj}text $text_pos}
! 			$canvas coords ${obj}TEXT $text_pos2
! 		  }
! 		  bang {
! 			puts "move bang"
! 			bang_draw $obj $canvas
! 		  }
    	}
    	#----handles the wire update----
    	#set _($self:inlets)  $ins
***************
*** 2463,2467 ****
  #set fields(msg)
! set classinfo(obj)     {Object      object}
  set classinfo(tgl)     {Toggle      toggle}
  set classinfo(bng)     {Bang        bang}
--- 2458,2462 ----
  #set fields(msg)
! set classinfo(obj)     {Object      objectbox}
  set classinfo(tgl)     {Toggle      toggle}
  set classinfo(bng)     {Bang        bang}
***************
*** 2479,2483 ****
  proc call {sel self args} {
    global _ classinfo
! 	set class [lindex $classinfo($_($self:class)) 1]
    eval [linsert $args 0 ${class}_$sel $self]
  }
--- 2474,2479 ----
  proc call {sel self args} {
    global _ classinfo
! 	set class objectbox
! 	catch {set class [lindex $classinfo($_($self:class)) 1]}
    eval [linsert $args 0 ${class}_$sel $self]
  }