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