aboutsummaryrefslogtreecommitdiff
path: root/desiredata
diff options
context:
space:
mode:
Diffstat (limited to 'desiredata')
-rw-r--r--desiredata/src/desire.tk43
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} {