#IS: mætti gera: 7 hluta tölustafi í rauðum útlínum
#EN: migth do: 7 segmented numbers in red outlines
#EN: to move the window about drag an edge.
proc mkimage0 {offset} {
set a #000000
set b #FFFF00
cautionEdge put [list \
[list $a $a $a $b $b $b $a $a $a $b $b $b ] \
[list $b $a $a $a $b $b $b $a $a $a $b $b ] \
[list $b $b $a $a $a $b $b $b $a $a $a $b ] \
[list $b $b $b $a $a $a $b $b $b $a $a $a ] \
[list $a $b $b $b $a $a $a $b $b $b $a $a ] \
[list $a $a $b $b $b $a $a $a $b $b $b $a ] \
[list $a $a $a $b $b $b $a $a $a $b $b $b ] \
[list $b $a $a $a $b $b $b $a $a $a $b $b ] \
[list $b $b $a $a $a $b $b $b $a $a $a $b ] \
[list $b $b $b $a $a $a $b $b $b $a $a $a ] \
[list $a $b $b $b $a $a $a $b $b $b $a $a ] \
[list $a $a $b $b $b $a $a $a $b $b $b $a ] \
]
}HJG Maybe the definition of the stripe-pattern could be made more compact with lrepeat ?PWQ '19 Jul 05, I have two options for borders, the offset'' parameter is to allow recreating the images to animate the frame. Like the -dash offset used for marching ants. proc mkimage1 {offset} {
# This makes the diagonal stripes
set a #000000
set b #FFFF00
foreach - {1 2 3 4 5 6 7 8 9 10 11 12} {
set out {}
foreach -- {1 2 3 4 5 6 7 8 9 10 11 12} {
lappend out [expr {$offset % 12 < 6 ? $a : $b}]
incr offset
}
lappend data $out
incr offset
}
cautionEdge put $data
}
proc mkimage2 {offset} {
# Makes alternating blocks.
set a #000000
set b #FFFF00
foreach x {0 1 2 3 4 5 6 7 8 9 10 11 11} {
set out {}
foreach y {0 1 2 3 4 5 6 7 8 9 10 11 11} {
set bool [expr {(2 * ($x > 5) + ($y > 5) + $offset) % 4}]
lappend out [expr {($bool == 0 || $bool == 3) ? $a : $b}]
}
lappend data $out
}
cautionEdge put $data
}
image create photo cautionEdge
mkimage0 0
#mkimage1 0
#mkimage2 0
canvas .can -width [expr 26 * 12] -height [expr 19 * 12]
.can configure -highlightthickness 0
wm overrideredirect . 1
pack .can
proc range {start end {delta 1}} {
set res [list]
for {set i $start} { $i <= $end } { incr i $delta } { lappend res $i }
set res
}
foreach x [range 0 25] {
.can create image [expr $x * 12] 0 -image cautionEdge -anchor nw \
-tags [list cautionEdge cautionEdge[set x]x0 ]
.can create image [expr $x * 12] 216 -image cautionEdge -anchor nw \
-tags [list cautionEdge cautionEdge[set x]x18 ]
}
foreach y [range 1 17] {
.can create image 0 [expr $y * 12] -image cautionEdge -anchor nw \
-tags [list cautionEdge cautionEdge0x[set y] ]
.can create image 300 [expr $y * 12] -image cautionEdge -anchor nw \
-tags [list cautionEdge cautionEdge25x[set y] ]
}
set draggin 0
.can bind cautionEdge <ButtonPress-1> { set draggin [list 1 %X %Y] }
.can bind cautionEdge <Motion> {
if {[lindex $draggin 0]} {
set tmp [split [wm geometry .] "+"]
set oldx [lindex $draggin 1]
set oldy [lindex $draggin 2]
set x [expr [lindex $tmp 1] - ($oldx - %X) ]
set y [expr [lindex $tmp 2] - ($oldy - %Y) ]
#wm geometry . "312x228+[set x]+[set y]"
# Leave window size alone, just move it
wm geometry . "+$x+$y"
set draggin [list 1 %X %Y]
}
}
.can bind cautionEdge <ButtonRelease-1> { set draggin 0 }
.can configure -background LightYellowescargo 13 Jul 2005 - Just so you can quit it... bind all <Key-q> { exit }
.can create text 110 80 -text "Press Q to quit" -anc nwPWQ 15 Jul 05, Lets cut down on the number of images needed to render the border. pack .can -expand 1 -fill both ;# make sure canvas is as big as window
bind .can <Configure> "DoOutline"
proc DoOutline {} {
set iw [image width cautionEdge]
set ih [image height cautionEdge]
set w [winfo width .can]
set h [winfo height .can]
image create photo topbot -width $w -height $ih
topbot copy cautionEdge -to 0 0 $w $ih
.can delete cautionEdge
.can create image 0 0 -image topbot -anchor nw -tag cautionEdge
.can create image 0 $h -image topbot -anchor sw -tag cautionEdge
image create photo leftright -width $iw -height [expr {$h - 2 * $ih}]
leftright copy cautionEdge -to 0 0 $iw [expr {$h - 2 * $ih}]
.can create image 0 $ih -image leftright -anchor nw -tag cautionEdge
.can create image $w $ih -image leftright -anchor ne -tag cautionEdge
}
# Add some clicks to animate size and see border is redrawn.
bind all <Shift-1> { exit }
bind all <Shift-3> { wm geometry . "400x300" }
bind all <3> { wm geometry . "600x400" }
.can create text 110 100 -text "Press Shift-1 to quit" -anc nw
.can create text 110 120 -text "Press <3> to enlarge window" -anc nw
.can create text 110 140 -text "Press <Shift-3> to shrink window" -anc nwNote on FWVM override prevents window from taking focus so it cannot receive key press events
