Spiffy caution edged window

Creates a window with a black-and-yellow striped frame around it.

When grabbed at this frame, the window can be dragged around the screen.

Zarutian 13. july 2005:


 #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 LightYellow

escargo 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 nw

PWQ 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 nw

Note on FWVM override prevents window from taking focus so it cannot receive key press events