[PD-cvs] pd/src u_main.tk,1.1.1.4.2.7.4.59,1.1.1.4.2.7.4.60
Mathieu Bouchard
matju at users.sourceforge.net
Tue May 4 06:52:25 CEST 2004
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 ----
More information about the Pd-cvs
mailing list