pd/src desire.tk,1.1.2.39,1.1.2.40 - Pd-cvs

10 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20849
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
added the properties dialog generator (for future use)
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.39
retrieving revision 1.1.2.40
diff -C2 -d -r1.1.2.39 -r1.1.2.40
*** desire.tk	10 Sep 2005 18:18:27 -0000	1.1.2.39
--- desire.tk	10 Sep 2005 20:30:40 -0000	1.1.2.40
***************
*** 3005,3011 ****
    set ins  [expr 2*([string compare $@rcv empty]==0)]
    set outs 2
- 	#[expr [string compare $@snd empty]==0]
    set colour [parse_color $@bcol]
- #	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
    bluebox_draw $self $canvas [expr $x1-1] [expr $y1-2] [expr $xs+2] [expr $ys+4] $ins $outs
    label_draw $self $canvas
--- 3005,3009 ----
***************
*** 3491,3492 ****
--- 3489,3616 ----
  }
+ ############ properties_dialog #########
+ 
+ proc color_popup_select {self name c} {
+ 	global _ preset_colors
+ 	set _($self:$name) $c
+ 	.$self.$name.color configure \
+ 		-background [format #%6.6x $_($self:$name)] \
+ 		-highlightbackground [format #%6.6x $_($self:$name)]
+ }
+ 
+ proc color_popup {self w name i} {
+ 	set w $w.$name.popup
+ 	if [winfo exists $w] {destroy $w}
+ 	menu $w -tearoff false
+ 	global preset_colors
+ 	for {set i 0} {$i<[llength $preset_colors]} {incr i} {
+ 		set c [lindex $preset_colors $i]
+ 		$w add command -label "     " \
+ 		-background "#$c" -foreground "#$c" \
+ 		-command [list color_popup_select $self $name [expr 0x$c]]
+ 	}
+ 	tk_popup $w \
+ 		[expr [winfo rootx .$self.$name]] \
+ 		[expr [winfo rooty .$self.$name]] 0
+ }
+ 
+ proc iemgui_choose_col {id var title} {
+     set self [string trimleft $id .]
+     global _
+     set c $_($self:$var)
+     if {[string index $c 0]=="#"} {set c [string replace $c 0 0 0x]}
+     set color [tk_chooseColor -title $title \
+ 	    -initialcolor [format "#%6.6x" [expr $c&0xFFFFFF]]]
+     if {$color != ""} {
+ 	color_popup_select $self $var [expr [string replace $color 0 0 "0x"]&0xFFFFFF]
+     }
+ }
+ 
+ proc change_entry {self val} {
+ 	set v [expr [$self get]+$val]
+ 	$self delete 0 end
+ 	$self insert 0 $v
+ }
+ 
+ proc properties_dialog {self w ok struct} {
+     global _
+     foreach {name label type options} $struct {
+ 	set f $w.$name
+         switch -- $type {
+ 	    side {
+ 		frame $f
+ 		label $f.label -text $label
+ 		pack  $f.label -side left
+ 		frame $f.side -relief ridge -borderwidth 2
+ 		foreach {i side} {0 left 1 right 2 top 3 bottom} {
+ 			radiobutton $f.side.$side -value $i \
+ 				-variable _($self:$name) -text $side
+ 		}
+ 		pack $f.side.left   -side   left -fill y
+ 		pack $f.side.right  -side  right -fill y
+ 		pack $f.side.top    -side    top
+ 		pack $f.side.bottom -side bottom
+ 		pack  $f.side -side left
+ 	    }
+ 	    color {
+ 		frame $f
+ 		label $f.label -text $label
+ 		# wtf, %6.6x sometimes gives me _8_ chars !?!
+ 		set c $_($self:$name)
+ 		switch -regexp -- $c { ^# { set c 0x[string trimleft $c #] } }
+ 		set c [expr $c & 0xFCFCFC]
+ 		button $f.color -text "      " -font {Courier 8} -width 10 -pady 2 \
+ 			-command [list iemgui_choose_col $w $name $label] \
+ 			-relief sunken -background [format #%6.6x $c] \
+ 			-highlightbackground       [format #%6.6x $c]
+ 		
+ 		button $f.preset -text "..." -pady 2 -font {Helvetica 8} -command [list color_popup $self $w $name $i]
+ 		pack  $f.label $f.color $f.preset -side left
+ 	    }
+ 	    choice {
+ 		frame $f
+ 		set i 0
+ 		label $f.label -text [lindex $label 0]
+ 		pack $f.label $f -side left
+ 		foreach part [lrange $label 1 end] {
+ 			radiobutton $f.$i -text $part -value $i -variable _($self:$name) -anchor w
+ 			pack $f.$i -side top -fill x
+ 			incr i
+ 		}
+ 	    }
+ 	    toggle {
+ 		frame $f
+ 		label $f.label -text $label
+ 		checkbutton $f.toggle -variable _($self:name)
+ 	    }
+ 	    section {
+ 	        label $f -text $label -bg "#0000aa" -fg "#ffff55" -font {helvetica -10 bold}
+ 	    }
+ 	    default {
+ 		frame $f
+ 		label $f.label -text $label
+ 		pack  $f.label -side left
+ 		eval "entry $f.entry -textvariable _($self:$name) $options"
+ 		pack $f.entry -side left
+ 		bind $f.entry <Return> "$ok $w"
+ 		switch -regexp -- $type {
+ 		    integer|float|fontsize {
+ 			frame $f.b -borderwidth 0
+ 			button $f.b.1 -image icon_uparrow   -command "change_entry $f.entry +1"
+ 			button $f.b.2 -image icon_downarrow -command "change_entry $f.entry -1"
+ 			pack $f.b.1 $f.b.2 -side top
+ 			pack $f.b -side left
+ 		    }
+ 		    entry {}
+ 		    default {
+ 			label $f.type -text "($type)" -fg "#808080"
+ 			pack $f.type -side right -anchor e
+ 		    }
+ 		}
+ 	    }
+ 	}
+ 	pack $f -side top -fill x
+ 	catch {$f.label configure -width 15 -anchor e}
+     }
+ }
+