Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23871
Modified Files: Tag: impd_0_37 u_main.tk Log Message: refactoring pdtk_canvas_new
Index: u_main.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/u_main.tk,v retrieving revision 1.1.1.4.2.7.4.59 retrieving revision 1.1.1.4.2.7.4.60 diff -C2 -d -r1.1.1.4.2.7.4.59 -r1.1.1.4.2.7.4.60 *** u_main.tk 3 May 2004 19:44:52 -0000 1.1.1.4.2.7.4.59 --- u_main.tk 4 May 2004 04:52:22 -0000 1.1.1.4.2.7.4.60 *************** *** 560,563 **** --- 560,579 ---- #########
+ proc statusbar_new {name} { + set f $name.stat + frame $f -border 2 -relief ridge + foreach {a b} {pos 12 what 32 mode 4 action 4 sel 4} { + label $f.$a -width $b -font {courier 9} \ + -background #cccccc -foreground black + } + label $f.mode_l -text " Mode: " + label $f.action_l -text " Action: " + label $f.sel_l -text " Sel: " + pack $f.pos -side left + pack $f.what -side left -padx 8 + pack $f -side bottom -fill x + pack $f.mode_l $f.mode $f.action_l $f.action $f.sel_l $f.sel -side left + } + proc statusbar_update {self x y} { global _ cmdline *************** *** 587,632 **** }
! ############# pdtk_canvas_new -- create a new canvas ############### ! proc pdtk_canvas_new {name width height geometry editable} { ! global pd_opendir pd_tearoff pd_nt cmdline ! toplevel $name -menu $name.m ! wm geometry $name $geometry ! canvas $name.c \ ! -width $width -height $height \ ! -background white \ ! -yscrollcommand "$name.scrollvert set" \ ! -xscrollcommand "$name.scrollhort set" \ ! -scrollregion [list 0 0 $width $height] ! scrollbar $name.scrollvert -command "$name.c yview" ! scrollbar $name.scrollhort -command "$name.c xview" -orient horizontal ! if {[string compare $cmdline(look) ""]} { ! make_button_bar $name.bbar $name ! pack $name.bbar -side top -fill x -expand no ! } ! if {$cmdline(statusbar)} { ! set f $name.stat ! frame $f -border 2 -relief ridge ! foreach {a b} {pos 12 what 32 mode 4 action 4 sel 4} { ! label $f.$a -width $b -font {courier 9} \ ! -background #cccccc -foreground black ! } ! label $f.mode_l -text " Mode: " ! label $f.action_l -text " Action: " ! label $f.sel_l -text " Sel: " ! pack $f.pos -side left ! pack $f.what -side left -padx 8 ! pack $f -side bottom -fill x ! pack $f.mode_l $f.mode $f.action_l $f.action $f.sel_l $f.sel -side left ! } ! pack $name.scrollhort -side bottom -fill x ! pack $name.scrollvert -side right -fill y ! pack $name.c -side left -expand 1 -fill both ! wm minsize $name 1 1 ! wm geometry $name $geometry ! ! menu $name.m ! menu $name.m.file -tearoff $pd_tearoff ! $name.m add cascade -label File -menu $name.m.file ! populate_menu $name.m.file $name { {New {menu_new} "Ctrl+n"} {Open {menu_open} "Ctrl+o"} --- 603,607 ---- }
! set canvasmenu(file) { {New {menu_new} "Ctrl+n"} {Open {menu_open} "Ctrl+o"} *************** *** 641,649 **** {} {Quit {menu_quit} "Ctrl+q"} ! }
! menu $name.m.edit -postcommand "menu_fixeditmenu $name" -tearoff $pd_tearoff ! $name.m add cascade -label Edit -menu $name.m.edit ! populate_menu $name.m.edit $name { {Undo {menu_undo %W} "Ctrl+z"} {Redo {menu_redo %W} "Ctrl+Z"} --- 616,622 ---- {} {Quit {menu_quit} "Ctrl+q"} ! }
! set canvasmenu(edit) { {Undo {menu_undo %W} "Ctrl+z"} {Redo {menu_redo %W} "Ctrl+Z"} *************** *** 659,685 **** {"Tidy Up" {pd "%W tidy ;"} {}} {} ! } ! ! # instead of "red = #BC3C60" we take "grey85", so there is no difference if ! # widget is selected or not. ! ! $name.m.edit add checkbutton -label "Edit mode" \ ! -indicatoron true -selectcolor grey85 \ ! -command "menu_editmode $name" \ ! -accelerator [accel_munge "Ctrl+e"] ! ! if { $editable == 0 } { ! $name.m.edit entryconfigure "Edit mode" -indicatoron false } ! ! menu $name.m.view -tearoff $pd_tearoff ! $name.m add cascade -label View -menu $name.m.view ! populate_menu $name.m.view $name { ! {Redraw {pd "%W map 0 ; %W map 1 ;"} {}} ! } ! # {Crosshair {global crosshair; set crosshair [expr !!$crosshair]} "" toggle}
! menu $name.m.put -tearoff $pd_tearoff ! $name.m add cascade -label Put -menu $name.m.put ! populate_menu $name.m.put $name { {Object {pd "%W obj 0 ;"} "Ctrl+1"} {Message {pd "%W msg 0 ;"} "Ctrl+2"} --- 632,638 ---- {"Tidy Up" {pd "%W tidy ;"} {}} {} ! }
! set canvasmenu(put) { {Object {pd "%W obj 0 ;"} "Ctrl+1"} {Message {pd "%W msg 0 ;"} "Ctrl+2"} *************** *** 701,705 **** --- 654,709 ---- {Graph {pd "%W graph ;"} {}} {Array {pd "%W menuarray ;"} {}} + } + + proc pdtk_canvas_new {name width height geometry editable} { + global pd_opendir pd_tearoff pd_nt cmdline canvasmenu + toplevel $name -menu $name.m + wm geometry $name $geometry + canvas $name.c \ + -width $width -height $height \ + -background white \ + -yscrollcommand "$name.scrollvert set" \ + -xscrollcommand "$name.scrollhort set" \ + -scrollregion [list 0 0 $width $height] + scrollbar $name.scrollvert -command "$name.c yview" + scrollbar $name.scrollhort -command "$name.c xview" -orient horizontal + if {[string compare $cmdline(look) ""]} { + make_button_bar $name.bbar $name + pack $name.bbar -side top -fill x -expand no } + if {$cmdline(statusbar)} {statusbar_new $name} + pack $name.scrollhort -side bottom -fill x + pack $name.scrollvert -side right -fill y + pack $name.c -side left -expand 1 -fill both + wm minsize $name 1 1 + wm geometry $name $geometry + menu $name.m + menu $name.m.file -tearoff $pd_tearoff + $name.m add cascade -label File -menu $name.m.file + populate_menu $name.m.file $name $canvasmenu(file) + menu $name.m.edit -postcommand "menu_fixeditmenu $name" -tearoff $pd_tearoff + $name.m add cascade -label Edit -menu $name.m.edit + populate_menu $name.m.edit $name $canvasmenu(edit) + + # instead of "red = #BC3C60" we take "grey85", so there is no difference if + # widget is selected or not. + + $name.m.edit add checkbutton -label "Edit mode" \ + -indicatoron true -selectcolor grey85 \ + -command "menu_editmode $name" \ + -accelerator [accel_munge "Ctrl+e"] + + if {!$editable} {$name.m.edit entryconfigure "Edit mode" -indicatoron false} + + menu $name.m.view -tearoff $pd_tearoff + $name.m add cascade -label View -menu $name.m.view + populate_menu $name.m.view $name { + {Redraw {pd "%W map 0 ; %W map 1 ;"} {}} + } + # {Crosshair {global crosshair; set crosshair [expr !!$crosshair]} "" toggle} + + menu $name.m.put -tearoff $pd_tearoff + $name.m add cascade -label Put -menu $name.m.put + populate_menu $name.m.put $name $canvasmenu(put)
menu $name.m.find -tearoff $pd_tearoff *************** *** 737,741 **** {"Open" {popup_action %W 1} ""} {"Help" {popup_action %W 2} ""} ! }
wm protocol $name WM_DELETE_WINDOW "menu_close $name" --- 741,745 ---- {"Open" {popup_action %W 1} ""} {"Help" {popup_action %W 2} ""} ! }
wm protocol $name WM_DELETE_WINDOW "menu_close $name" *************** *** 763,769 **** bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8} bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2} ! } ! # change mac to right-click, not middle click -atl 2002.09.02 ! bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b} bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0} --- 767,772 ---- bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8} bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2} ! } ! # change mac to right-click, not middle click -atl 2002.09.02 bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b} bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0} *************** *** 799,807 **** #catch {image create photo mybackground -file "test2.gif"} #catch {$name.c create image -6 -39 -anchor nw -image mybackground -tag bg} - #scale $name.bbar.bg -orient horizontal -showvalue false -from 0 -to 255 -command {} - #pack $name.bbar.bg -side right - # set bw [expr [winfo size - # $name [$name.c cget -width] [winfo screenwidth $name] - # set mh [winfo screenheight $name] global _ set self [canvastosym $name.c] --- 802,805 ---- *************** *** 809,813 **** set _($self:selection) {} set _($self:grab) "" - #puts "self = $self, self.mode = $_($self:mode)" }
--- 807,810 ---- *************** *** 893,897 **** wire_draw lnew $canvas 1 $cx $cy $cx $cy #!@#$ -dash blows up on OSX ! #$canvas itemconfigure lnew -dash "4 4 4 4" set wire_from [list $id $out] return --- 890,894 ---- wire_draw lnew $canvas 1 $cx $cy $cx $cy #!@#$ -dash blows up on OSX ! switch -- $pd_nt { 2 {} default { $canvas itemconfigure lnew -dash "4 4 4 4" }} set wire_from [list $id $out] return *************** *** 959,964 **** set current_y $cy if {[llength [$canvas gettags lnew]]} { - #foreach {ox1 oy1 ox2 oy2} [$canvas coords lnew] {} - #$canvas coords lnew $ox1 $oy1 $cx $cy foreach {ox1 oy1 ox2 oy2} [lrange [$canvas coords lnew] end-3 end] {} set l [$canvas coords lnew] --- 956,959 ---- *************** *** 968,973 **** lappend l $cx $cy $canvas coords lnew $l - #$canvas coords lnew [lindex $l 0] [lindex $l 1] [lindex $l end-1] [lindex $l end] - #return } switch $_($self:action) { --- 963,966 ----