One classical application of plane-filling curves is the "Peano method" of Mathematical Big Game Hunting [1].
##+##########################################################################
#
# hilbert.tcl -- draws the Hilbert Curve
# by Keith Vetter
#
package require Tk
array set S {lvl 0 color black connect 1}
array set DIRS {E {S E E N} N {W N N E} S {E S S W} W {N W W S}}
array set QTRS {E {1 2 3 4} N {3 2 1 4} S {1 4 3 2} W {3 4 1 2}}
array set XY {E {l t r t r b l b} N {r b r t l t l b}
W {r b l b l t r t} S {l t l b r b r t}}
proc DoDisplay {} {
global S
wm title . TkHilbert
pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
-side right -fill both -ipady 5
pack [frame .top -relief raised -bd 2] -side top -fill x
pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1
canvas .c -relief raised -borderwidth 0 -height 500 -width 500 -bg cyan
label .msg -textvariable S(msg) -bd 2 -bg white -relief ridge
pack .msg -side bottom -fill both -in .screen
pack .c -side top -expand 1 -fill both -in .screen
set colors {red orange yellow green blue cyan purple violet white}
lappend colors [lindex [.c config -bg] 3] black
foreach color $colors {
radiobutton .top.b$color -width 1 -padx 0 -pady 0 -bg $color \
-variable S(color) -value $color -command ReColor
bind .top.b$color <3> [list .c config -bg $color]
}
eval pack [winfo children .top] -side left -fill y
DoCtrlFrame
ReColor
update
trace variable S(draw) w Tracer
bind .sLevel <ButtonRelease-1> {if {! $S(draw)} DrawHilbertA}
}
proc DoCtrlFrame {} {
frame .ctrl.top
scale .sLevel -from 0 -to 7 -label Level -variable S(lvl) -relief ridge \
-orient horizontal -highlightthickness 0
.sLevel configure -font "[font actual [.sLevel cget -font]] -weight bold"
button .draw -text "Redraw Curve" -command DrawHilbertA -bd 4
button .clear -text "Clear Curve" -command {.c delete all} -bd 4
button .stop -text "Stop Drawing" -command {set S(draw) 0} -bd 4
.draw configure -font "[font actual [.draw cget -font]] -weight bold"
.clear configure -font [.draw cget -font]
.stop configure -font [.draw cget -font]
image create bitmap ::img::up -data {
#define up_width 11
#define up_height 9
static char up_bits = {
0x00, 0x00, 0x20, 0x00, 0x70, 0x00, 0xf8, 0x00, 0xfc, 0x01, 0xfe,
0x03, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00
}}
image create bitmap ::img::down -data {
#define down_width 11
#define down_height 9
static char down_bits = {
0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe, 0x03, 0xfc, 0x01, 0xf8,
0x00,0x70, 0x00, 0x20, 0x00, 0x00, 0x00
}}
button .up -image ::img::up -command {UpDown 1}
button .down -image ::img::down -command {UpDown -1}
checkbutton .connect -text "Show Connections" -variable S(connect) \
-relief raised -command ShowConnectors
button .about -text About -command About
grid .ctrl.top -in .ctrl -row 0 -sticky news
grid .sLevel .up -in .ctrl.top -row 0 -sticky news
grid ^ .down -in .ctrl.top -row 1 -sticky news
grid .draw -in .ctrl -row 21 -sticky ew
grid .clear -in .ctrl -row 22 -sticky ew
grid .stop -in .ctrl -row 23 -sticky ew -pady 10
grid .connect -in .ctrl -row 101 -sticky ew
grid .about -in .ctrl -row 102 -sticky ew
grid rowconfigure .ctrl 10 -minsize 10
grid rowconfigure .ctrl 20 -minsize 10
grid rowconfigure .ctrl 50 -weight 1
grid configure .up -ipadx 5
grid configure .down -ipadx 5
}
##+##########################################################################
#
# Tracer -- traces the S(draw) variable and activates widgets accordingly
#
proc Tracer {var1 var2 op} {
global S
set ww {.up .down .connect .draw .clear}
if {$S(draw) == 0} { ;# Turning off drawing
.stop config -state disabled
.sLevel config -state normal -fg [lindex [.sLevel config -fg] 3]
foreach w $ww { $w config -state normal}
} else {
.stop config -state normal
.sLevel config -state disabled -fg [.up cget -disabledforeground]
foreach w $ww { $w config -state disabled}
}
}
##+##########################################################################
#
# DrawHilbert -- sets up the state and draws the Hilbert curve
#
proc DrawHilbertA {} {after 1 DrawHilbert}
proc DrawHilbert {{lvl {}}} {
global S
if {$lvl == {}} { set lvl $S(lvl) } else { set S(lvl) $lvl }
.c delete all
set S(draw) 1
set S(first) {}
set S(ccolor) [expr {$S(connect) ? $S(color) : [.c cget -bg]}]
set S(width) [expr {$lvl <= 4 ? (25 - 5*$lvl) : 8 - $lvl}]
set n [expr {int(pow(4,$lvl+1) - 1)}]
set S(msg) "Hilbert Curve Level $lvl ($n edges)"
Hilbert [GetStartBox] E $lvl
set S(draw) 0
set S(first) {}
if {! $::S(connect)} {.c lower connect}
}
##+##########################################################################
#
# UpDown -- draws the curve one level up or down from current
#
proc UpDown {dlvl} {
global S
if {$dlvl < 0 && $S(lvl) == 0} return
if {$dlvl > 0 && $S(lvl) >= [.sLevel cget -to]} return
incr S(lvl) $dlvl
DrawHilbert
}
##+##########################################################################
#
# Hilbert -- draws a specified level Hilbert curve
#
proc Hilbert {box dir lvl} {
global S DIRS QTRS
if {! $S(draw)} return
if {$lvl == 0} {
Hilbert0 $box $dir
return
}
set lvl2 [expr {$lvl - 1}]
foreach quarter $QTRS($dir) newDir $DIRS($dir) {
set b2 [QuarterBox $box $quarter]
Hilbert $b2 $newDir $lvl2
}
if {$lvl >= 4} update
}
##+##########################################################################
#
# Hilbert0 -- draws the most basic hilbert curve inside $box facing $dir
#
proc Hilbert0 {box dir} {
global S XY
set xy $S(first) ;# Possibly connect to last
set xy {}
foreach {l t r b} [ShrinkBox $box] break
foreach i $XY($dir) { ;# Walk coord list for this dir
lappend xy [set $i]
}
if {$S(first) != ""} {
.c create line [concat $S(first) [lrange $xy 0 1]] -width $S(width) \
-tag {hilbert connect} -fill $S(ccolor)
}
.c create line $xy -tag hilbert -width $S(width) -fill $S(color) \
-capstyle round
set S(first) [lrange $xy end-1 end] ;# So next connects w/ this one
}
##+##########################################################################
#
# GetStartBox -- returns coordinates of the area to draw our shape in
#
proc GetStartBox {} {
return [list 9 9 [expr {[winfo width .c]-9}] [expr {[winfo height .c]-9}]]
}
##+##########################################################################
#
# ShrinkBox -- shrinks a box to 1/4 of it's size
#
proc ShrinkBox {box} {
foreach {l t r b} $box break
set dx [expr {($r - $l) / 4.0}]
set dy [expr {($b - $t) / 4.0}]
set l [expr {$l + $dx}] ; set r [expr {$r - $dx}]
set t [expr {$t + $dy}] ; set b [expr {$b - $dy}]
return [list $l $t $r $b]
}
##+##########################################################################
#
# QuarterBox -- Returns coordinates of 1 of the 4 quadrants of BOX.
# 1 = up/left, 2 = up/right, 3 = lower/right, 4 = lower/left
#
proc QuarterBox {box corner} {
foreach {l t r b} $box break
set hx [expr {($r - $l) / 2.0}]
set hy [expr {($b - $t) / 2.0}]
if {$corner == 1} { ;# Upper left
set r [expr {$r - $hx}]
set b [expr {$b - $hy}]
} elseif {$corner == 2} { ;# Upper right
set l [expr {$l + $hx}]
set b [expr {$b - $hy}]
} elseif {$corner == 3} { ;# Lower right
set l [expr {$l + $hx}]
set t [expr {$t + $hy}]
} elseif {$corner == 4} { ;# Lower left
set r [expr {$r - $hx}]
set t [expr {$t + $hy}]
}
return [list $l $t $r $b]
}
proc ShowConnectors {} {
if {$::S(connect)} {
.c itemconfig connect -fill $::S(color)
} else {
.c itemconfig connect -fill [.c cget -bg]
.c lower connect
}
}
proc ReColor {} {
global S
.c itemconfig hilbert -fill $::S(color)
if {! $::S(connect)} {.c itemconfig connect -fill [.c cget -bg]}
}
proc About {} {
set msg "TkHilbert\nby Keith Vetter, Feb 2003\n\n"
append msg "Draws the Hilbert Curve.\n\n"
append msg "This curve was discovered by David Hilbert in 1891 and\n"
append msg "was one of the first plane-filling curves ever found."
tk_messageBox -title "About TkHilbert" -message $msg
}
################################################################
DoDisplay
DrawHilbert