[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