diff options
Diffstat (limited to 'desiredata')
| -rw-r--r-- | desiredata/src/desire.tk | 43 |
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} { |