fix AtomBox labels (floatatom,symbolatom)

svn path=/trunk/; revision=11590

1 files changed, 33 insertions, 10 deletions

diff --git a/desiredata/src/desire.tk b/desiredata/src/desire.tk
index b19e0a2b..07fb195d 100644
--- a/desiredata/src/desire.tk
+++ b/desiredata/src/desire.tk
@@ -5642,6 +5642,26 @@ def MessageBox bang {flag} {
 # it shouldn't have mattered, but super doesn't support proper pruning yet
 #class_new AtomBox {Box}
 class_new AtomBox {Labelled TextBox}
+def AtomBox label_xy {} {
+	mset {x1 y1} [$self xy]
+	switch -- $@pos {
+	  0 {list [expr {$x1-3}] [expr {$y1+2}]}
+	  1 {list [expr {$x1+2}] [expr {$y1+2}]}
+	  2 {list [expr {$x1-1}] [expr {$y1-1}]}
+	  3 {list [expr {$x1-1}] [expr {$y1+3}]}
+	}
+}
+def AtomBox label_anchor {} {
+	switch -- $@pos {
+	  0 {return ne}
+	  1 {return nw}
+	  2 {return sw}
+	  3 {return nw}
+	}
+}
+def AtomBox label_font {} {list Courier 10 bold}
+def AtomBox label_color {} {return -1}
+
 def AtomBox draw_box {} {
 	$self update_size
 	mset {x1 y1 x2 y2} [$self bbox]
@@ -6350,17 +6370,20 @@ class_new Labelled {}
 def Labelled draw {} {
 	super
 	mset {lx ly} [$self label_xy]
-	set label $@lab; switch -- $label {empty {set label ""}}
-	set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
-	set lcolor [parse_color $@lcol]
+	set label $@lab; switch -- $label {empty {set label ""} - {set label ""}}
+	set lfont [$self label_font]
+	set lcolor [parse_color [$self label_color]]
 	if {$::leet} {
 		    set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $label]
 	    } else {
 		    set text $label
 	    }
-	$self item LABEL text [list $lx $ly] -text $text -anchor w -font $lfont -fill $lcolor
+	$self item LABEL text [list $lx $ly] -text $text -anchor [$self label_anchor] -font $lfont -fill $lcolor
 }
 def Labelled label_xy {} {mset {x1 y1} [$self xy]; list [expr {$x1+$@ldx}] [expr {$y1+$@ldy}]}
+def Labelled label_anchor {} {return w}
+def Labelled label_font {} {list [lindex {courier helvetica times} $@fstyle] $@fs bold}
+def Labelled label_color {} {return $@lcol}
 
 #-----------------------------------------------------------------------------------#
 class_new Bang {BlueBox}
@@ -6371,7 +6394,7 @@ def Bang init {mess} {
 }
 def Bang bbox {} {
 	mset {x1 y1} [$self xy]
-	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@w]
+	list $x1 $y1 [expr {$x1+$@w}] [expr {$y1+$@w}]
 }
 def Bang draw {} {
 	super
@@ -6403,17 +6426,17 @@ def Toggle draw {} {
 	super
 	mset {x1 y1 x2 y2} [$self bbox]
 	set colour [parse_color $@bcol]
-	set t [expr int(($@w+29)/30)]
+	set t [expr {int(($@w+29)/30)}]
 	set fill [color_* [$self look bg] $colour]
-	set x3 [expr $x1+$t+2]; set y3 [expr $y1+$t+2]
-	set x4 [expr $x2-$t-2]; set y4 [expr $y2-$t-2]
+	set x3 [expr {$x1+$t+2}]; set y3 [expr {$y1+$t+2}]
+	set x4 [expr {$x2-$t-2}]; set y4 [expr {$y2-$t-2}]
 	if {$@on} {
 		set fill [parse_color $@fcol]
 	} {
 		set fill [color_* [$self look bg] [parse_color $@bcol]]
 	}
-	$self item X1 line [list $x3 $y3 [expr $x4+1] [expr $y4+1]] -width $t -fill $fill
-	$self item X2 line [list $x3 $y4 [expr $x4+1] [expr $y3-1]] -width $t -fill $fill
+	$self item X1 line [list $x3 $y3 [expr {$x4+1}] [expr {$y4+1}]] -width $t -fill $fill
+	$self item X2 line [list $x3 $y4 [expr {$x4+1}] [expr {$y3-1}]] -width $t -fill $fill
 }
 def Toggle unclick {x y f target} {}
 def Toggle click {x y f target} {