[PD-cvs] pd/src desire.tk,1.1.2.12,1.1.2.13

chunlee chunlee at users.sourceforge.net
Thu Aug 25 20:40:22 CEST 2005


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
have main pd window and ctrl+n creates new canvas
next: handles multiple canvas


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.12
retrieving revision 1.1.2.13
diff -C2 -d -r1.1.2.12 -r1.1.2.13
*** desire.tk	23 Aug 2005 09:54:08 -0000	1.1.2.12
--- desire.tk	25 Aug 2005 18:40:20 -0000	1.1.2.13
***************
*** 27,30 ****
--- 27,438 ----
  #-----------------------------------------------------------------------------------#
  
+ set pd_nt 0
+ 
+ #option add *background pink widgetDefault
+ #option add *backgroundPixmap /usr/share/themes/BrushedMetalBlue/gtk/brushed-dark.xpm widgetDefault
+ #option add *backgroundPixmap /home/matju/brushed-dark.gif widgetDefault
+  option add *font {Helvetica -12}
+ #option add *font {Helvetica -12 bold}
+ option add *borderWidth 1
+ #option add *Menu*borderWidth 1
+ #option add *Button*borderWidth 1
+ #option add *Checkbutton*borderWidth 1
+ #option add *Radiobutton*borderWidth 1
+ option add *Checkbutton*selectColor #dd3000
+ option add *Radiobutton*selectColor #dd3000
+ 
+ #option add *Entry*background #d8c0c0 # motif-style
+ # option add *Entry*background #b0d8d8 # hospital-green (call it "lichen)
+ # option add *Entry*selectBackground #60b0b0
+ 
+ option add *Entry*background #b0c4d8
+ option add *Entry*selectBackground #6088b0
+ option add *background #ffffff
+ option add *foreground #000000
+ option add *activeBackground #000000
+ option add *activeForeground #00ff00
+ 
+ proc l+  {al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a+$b]}; return $r}
+ proc l-  {al bl} {set r {}; foreach a $al b $bl {lappend r [expr $a-$b]}; return $r}
+ proc l/2 {al   } {set r {}; foreach a $al       {lappend r [expr $a/2 ]}; return $r}
+ #proc lmap ...
+ 
+ proc lreverse {list} {
+ 	#puts "lreverse::: $list"
+ 
+ 	set r {}
+ 	for {set i [expr [llength $list]-1]} {$i>=0} {incr i -1} {
+ 		lappend r [lindex $list $i]
+ 	}
+ 	return $r
+ }
+ 
+ # there are two palettes of 30 colours used in Pd
+ # when placed in a 3*10 grid, the difference is that
+ # the left corner of 3*3 (the greys) are transposed (matrixwise)
+ # here is the one used in the swatch color selector:
+ set preset_colors {
+ 	fcfcfc e0e0e0 bcbcbc fce0e0 fce0c0 fcfcc8 d8fcd8 d8fcfc dce4fc f8d8fc
+ 	a0a0a0 7c7c7c 606060 fc2828 fcac44 e8e828 14e814 28f4f4 3c50fc f430f0
+ 	404040 202020 000000 8c0808 583000 782814 285014 004450 001488 580050
+ }
+ 
+ set preset_colors2 {
+ 	fcfcfc a0a0a0 404040 fce0e0 fce0c0 fcfcc8 d8fcd8 d8fcfc dce4fc f8d8fc
+ 	e0e0e0 7c7c7c 202020 fc2828 fcac44 e8e828 14e814 28f4f4 3c50fc f430f0
+ 	bcbcbc 606060 000000 8c0808 583000 782814 285014 004450 001488 580050
+ }
+ 
+ # very small icons:
+ image create bitmap icon_plus -data "#define z_width 7\n#define z_height 7
+ static unsigned char z_bits[] = { 8,8,8,127,8,8,8 };"
+ image create bitmap icon_minus -data "#define z_width 7\n#define z_height 7
+ static unsigned char z_bits[] = { 0,0,0,127,0,0,0 };"
+ image create bitmap icon_uparrow -data "#define z_width 7\n#define z_height 5
+ static unsigned char z_bits[] = { 8,28,62,127,0 };"
+ image create bitmap icon_downarrow -data "#define z_width 7\n#define z_height 5
+ static unsigned char z_bits[] = { 0,127,62,28,8 };"
+ 
+ 
+ # Tearoff is set to true by default:
+ set pd_tearoff 1
+ 
+ if {$pd_nt == 1} {
+     global pd_guidir pd_tearoff
+     set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0] - 1]]
+     regsub -all \\\\ $pd_gui2 / pd_gui3
+     set pd_guidir $pd_gui3/..
+     load $pd_guidir/bin/pdtcl
+     set pd_tearoff 1
+ }
+ 
+ if {$pd_nt == 2} {
+     global pd_guidir pd_tearoff
+     set pd_gui2 [string range $argv0 0 [expr [string last / $argv0] - 1]]
+     set pd_guidir $pd_gui2/..
+     load $pd_guidir/bin/pdtcl
+     set pd_tearoff 0
+ }
+ 
+ # hack so you can easily test-run this script in linux... define pd_guidir
+ # (which is normally defined at startup in pd under linux...)
+ 
+ if {$pd_nt == 0} {
+     if {! [info exists pd_guidir]} {
+     	global pd_guidir
+     	puts stderr {setting pd_guidir to '.'}
+ 	set pd_guidir .
+     }
+ }
+ 
+ # it's unfortunate but we seem to have to turn off global bindings
+ # for Text objects to get control-s and control-t to do what we want for
+ # "text" dialogs below.  Also we have to get rid of tab's changing the focus.
+ 
+ bind all <Key-Tab> ""
+ bind all <<PrevWindow>> ""
+ bind Text <Control-t> {}
+ bind Text <Control-s> {}
+ # puts stderr [bind all]
+ 
+ ################## set up main window #########################
+ menu .mbar
+ 
+ frame .controls
+ pack .controls -side top -fill x
+ menu .mbar.file -tearoff $pd_tearoff; .mbar add cascade -label "File" -menu .mbar.file
+ menu .mbar.find -tearoff $pd_tearoff; .mbar add cascade -label "Find" -menu .mbar.find
+ menu .mbar.windows -postcommand pdtk_fixwindowmenu -tearoff $pd_tearoff
+ menu .mbar.audio -tearoff $pd_tearoff
+ if {$pd_nt != 2} {
+     .mbar add cascade -label "Windows" -menu .mbar.windows
+     .mbar add cascade -label "Media" -menu .mbar.audio
+ } else {
+ # Perhaps this is silly, but Mac HIG want "Window  Help" as the last menus
+     .mbar add cascade -label "Media" -menu .mbar.audio
+     .mbar add cascade -label "Windows" -menu .mbar.windows
+ }
+ menu .mbar.help -tearoff $pd_tearoff
+ .mbar add cascade -label "Help" -menu .mbar.help
+ 
+ set ctrls_audio_on 0
+ set ctrls_meter_on 0
+ 
+ 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
+     foreach {z clip} [list in $inclip out $outclip] {
+ 	.controls.$z.1.clip configure -background [if {$clip==1} {list red} {list black}]
+     }
+ }
+ 
+ foreach z {in out} {
+ 	set f .controls.$z
+ 	frame $f
+ 	frame $f.1 -borderwidth 2 -relief groove
+ 	canvas $f.1.mtr -width 100 -height 10 -bg #222222
+ 	$f.1.mtr create line 0 0 0 0 -width 24 -fill [switch $z {in {set 0 blue} out {set 0 green}}] -tags m
+ 	canvas $f.1.clip -width 5 -height 10 -bg #222222
+ 	pack $f.1.mtr $f.1.clip -side left -pady 2 -padx 0
+ 	pack $f.1 -padx 6 -pady 9
+ 	label $f.2 -text [string tolower $z]
+ 	place $f.2 -x 11 -y -4
+ 	pack $f -side left -pady 0 -padx 0
+ }
+ 
+ proc pdtk_pd_dsp {value} {
+     puts "pdtk_pd_dsp::: $value"
+ 
+     global ctrls_audio_on
+     if {$value == "ON"} {set ctrls_audio_on 1} else {set ctrls_audio_on 0}
+ }
+ 
+ proc pdtk_pd_dio {red} {
+     puts "pdtk_pd_dio::: $red"
+ 
+     .controls.switches.dio configure -background red \
+ 	    -activebackground [if {$red==1} {list red} {list lightgrey}]
+ }
+ 
+ frame .controls.switches
+ foreach {w x y z} {
+ 	audiobutton "audio" ctrls_audio_on {pd    "pd dsp $ctrls_audio_on ;"}
+ 	meterbutton "meters"   ctrls_meter_on {pd "pd meters $ctrls_meter_on ;"}
+ } {
+ 	checkbutton .controls.switches.$w -text $x -variable $y -anchor w -command $z
+ 	pack .controls.switches.$w -side left
+ }
+ 
+ button .controls.switches.dio -text "io errors" -command {pd "pd audiostatus ;"}
+ pack .controls.switches.dio
+ pack .controls.switches -side right
+ 
+ bind . <Control-Key>       {pdtk_pd_ctrlkey %W %K 0}
+ bind . <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1}
+ if {$pd_nt == 2} {
+     bind . <Mod1-Key>       {pdtk_canvas_ctrlkey %W %K 0}
+     bind . <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
+ }
+ 
+ wm title . "Pd"
+ . configure -menu .mbar
+ 
+ ############### set up global variables ################################
+ 
+ set untitled_number 1
+ set untitled_directory [pwd]
+ set saveas_client doggy
+ set pd_opendir $untitled_directory
+ set pd_undoaction no
+ set pd_redoaction no
+ set pd_undocanvas no
+ 
+ ################ utility functions #########################
+ 
+ proc pdtk_enquote {x} {
+     puts "pdtk_enquote::: $x"
+ 
+     set foo [string map {"," "" ";" "" "\"" ""} $x]
+     return [string map {" " "\\ " "{" "" "}" ""} $foo]
+ }
+ 
+ proc pdtk_debug {x} {
+ 	puts "pdtk_debug::: $x"
+ 	
+ 	tk_messageBox -message $x -type ok
+ }
+ 
+ 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} }
+ #    	no {tk_messageBox -message "cancelled" -type ok}
+ }
+ 
+ set menu_windowlist {} 
+ 
+ proc pdtk_fixwindowmenu {} {
+     puts "pdtk_fixwindowmenu:::"
+ 
+     global menu_windowlist
+     .mbar.windows delete 0 end
+     foreach i $menu_windowlist {
+ 	.mbar.windows add command -label [lindex $i 0] \
+ 	    -command "menu_domenuwindow [lindex $i 1]]"
+         menu_fixwindowmenu [lindex $i 1]
+     }
+ }
+ 
+ 
+ # Odd little function to make better Mac accelerators
+ proc accel_munge {acc} {
+     puts "accel_munge::: $acc"
+ 
+     global pd_nt
+     if {$pd_nt == 2} {
+         set tmp [string toupper [string map {Ctrl Meta} $acc] end]
+ 	if [string is upper [string index $acc end]] {
+ 	    return Shift+$tmp
+ 	} else {
+ 	    return $tmp
+ 	}
+     } else {
+ 	return $acc
+     }
+ }
+ 
+ set offset_canvas 0
+ 
+ proc menu_new {} {
+     puts "menu_new:::"
+ 
+     global untitled_number untitled_directory
+     #pd "pd filename Untitled-$untitled_number $untitled_directory ;"
+     #pd {
+     #	#N canvas;
+     #	#X pop 1;
+     #}
+     
+     global offset_canvas _
+ 
+     	
+ 	#set canvas $_(focus)
+ 
+ 	set canvas_id [format %x [expr 0x80f2b50 + $offset_canvas]]
+ 	set canvas_id .$canvas_id
+ 	set offset_canvas [expr $offset_canvas + 1]
+ 
+ 	puts "new canvas id -> $canvas_id"
+ 
+ 	#object_add $object_id $canvas
+     
+     #set canvas .x80f2b50
+     
+     #set canvas 
+     
+     pdtk_canvas_new $canvas_id 300 300 +[expr $offset_canvas*50]+[expr $offset_canvas*50] 1
+     
+     set untitled_number [expr $untitled_number + 1]
+ }
+ 
+ proc menu_open {} {
+     puts "menu_open:::"
+ 
+     global pd_opendir
+     set filename [tk_getOpenFile -defaultextension .pd \
+     	-filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \
+         -initialdir $pd_opendir]
+     if {$filename != ""} {open_file $filename}
+ }
+ 
+ proc open_file {filename} {
+     puts "open_file $filename""
+ 
+     global pd_opendir
+     set directory [string range $filename 0 [expr [string last / $filename] - 1]]
+     set pd_opendir $directory
+     set basename [string range $filename [expr [string last / $filename] + 1] end]
+     if {[string last .pd $filename] >= 0} {
+         pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
+     }
+ }
+ 
+ proc menu_send {} {
+     puts "menu_send:::"
+ 
+     toplevel .sendpanel
+     entry .sendpanel.entry -textvariable send_textvariable
+     pack .sendpanel.entry -side bottom -fill both -ipadx 100
+     .sendpanel.entry select from 0
+     .sendpanel.entry select adjust end
+     bind .sendpanel.entry <KeyPress-Return> {
+     	pd "$send_textvariable ;"
+     	after 50 {destroy .sendpanel}
+     }
+     focus .sendpanel.entry
+ }
+ 
+ proc menu_really_quit {} {
+ 	puts "menu_really_quit:::"
+ 	pd "pd quit ;"
+ }
+ 
+ proc menu_quit {} {
+ 	puts "menu_quit:::"
+ 
+ 	pdtk_check "Do you really wish to quit?" "pd quit ;"
+ }
+ 
+ proc menu_pop_pd {} {
+ 	puts"menu_pop_pd:::"
+ 
+ 	raise .
+ }
+ 
+ proc menu_audio {flag} {
+ 	puts "menu_audio::: $flag"
+ 
+ 	pd "pd dsp $flag ;"
+ }
+ 
+ #-----------------------------------------------------------------------------------#
+ 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 ???
+ 		}
+ 	    }
+ 	}
+ }
+ 
+ #-----------------------------------------------------------------------------------#
+ 
+ #################### the "File" menu for the Pd window ##############
+ 
+ populate_menu .mbar.file {} {
+ 	{"New" {foo menu_new} "Ctrl+n"}
+ 	{"Open" {foo menu_open} "Ctrl+o"}
+ 	{}
+ 	{"Class List" {foo show_class_list} ""}
+ 	{".pdrc Editor" {foo pdrc_editor_new} ""}
+ 	{"Message"    {foo menu_send} "Ctrl+m"}
+ 	{"Path..."    {foo "pd start-path-dialog ;"} ""}
+ 	{}
+ 	{"Quit"       {foo menu_quit} "Ctrl+q"}
+ }
+ 
+ #-----------------------------------------------------------------------------------#
+ 
+ 
  set canvas .x80f2b50
  set offset 0
***************
*** 42,46 ****
  set mouse(b1down) 0
  
! set pd_nt 0
  
  set look(objectfg) #000000
--- 450,454 ----
  set mouse(b1down) 0
  
! #set pd_nt 0
  
  set look(objectfg) #000000
***************
*** 82,86 ****
  #button .buttons.button1 -text put -command {object_new}
  #button .buttons.button2 -text delete -command {object_delete $canvas.c}
! button .buttons.button3 -text foo -command {object_test $canvas.c}
  #button .buttons.button4 -text "edit obj" -command {object_edit $self $canvas.c} 
  
--- 490,494 ----
  #button .buttons.button1 -text put -command {object_new}
  #button .buttons.button2 -text delete -command {object_delete $canvas.c}
! #button .buttons.button3 -text foo -command {object_test $canvas.c}
  #button .buttons.button4 -text "edit obj" -command {object_edit $self $canvas.c} 
  
***************
*** 90,96 ****
  #pack .buttons.button1 .buttons.button3 .buttons.button2 .buttons.button4 -side left
  #pack .buttons.button1 .buttons.button2 .buttons.button3 -side left
! pack .buttons.button3 -side left
  #pack .buttons $canvas
! pack .buttons
  
  #-----------------------------------------------------------------------------------#
--- 498,504 ----
  #pack .buttons.button1 .buttons.button3 .buttons.button2 .buttons.button4 -side left
  #pack .buttons.button1 .buttons.button2 .buttons.button3 -side left
! #pack .buttons.button3 -side left
  #pack .buttons $canvas
! #pack .buttons
  
  #-----------------------------------------------------------------------------------#
***************
*** 162,194 ****
  }
  
! #-----------------------------------------------------------------------------------#
! 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 ???
! 		}
! 	    }
! 	}
! }
  
  #-----------------------------------------------------------------------------------#
--- 570,574 ----
  }
  
! #
  
  #-----------------------------------------------------------------------------------#
***************
*** 551,555 ****
  
  # 1 canvas
! pdtk_canvas_new $canvas 300 300 +700+0 1
  
  #-----------------------------------------------------------------------------------#
--- 931,935 ----
  
  # 1 canvas
! #pdtk_canvas_new $canvas 300 300 +700+0 1
  
  #-----------------------------------------------------------------------------------#
***************
*** 2189,2192 ****
--- 2569,2590 ----
  #-----------------------------------------------------------------------------------#
  
+ ############### event binding procedures for Pd window ################
+ 
+ proc pdtk_pd_ctrlkey {name key shift} {
+     puts "pdtk_pd_ctrlkey::: $name $key $shift"
+ 
+     set key [string tolower $key]
+     switch -- $key {
+       n {menu_new}
+       o {menu_open}
+       m {menu_send}
+       q {if {$shift == 1} {menu_really_quit} {menu_quit}}
+       slash  {menu_audio 1}
+       period {menu_audio 0}
+     }
+ }
+ 
+ #-----------------------------------------------------------------------------------#
+ 
  # modes:
  #   0: creation





More information about the Pd-cvs mailing list