[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