GS (20120728) Dessin 2D d'une courbe de Hilbert [1] par appel récursif.
# hilbert2d.tcl
# Author: Gerard Sookahet
# Date: 28 Jul 2012
# Description: 2D recursive space filling Hilbert curve
bind all <Escape> {exit}
proc Hilbert2d {x0 y0 x1 x2 y1 y2 n} {
global l
if {$n <= 0} {
lappend l [expr {$x0 + ($x1 + $y1)/2}] [expr {$y0 + ($x2 + $y2)/2}]
} else {
set X1 [expr {$x1/2}]
set X2 [expr {$x2/2}]
set Y1 [expr {$y1/2}]
set Y2 [expr {$y2/2}]
set n_1 [expr {$n - 1}]
Hilbert2d $x0 $y0 $Y1 $Y2 $X1 $X2 $n_1
Hilbert2d [expr {$x0+$X1}] [expr {$y0+$X2}] $X1 $X2 $Y1 $Y2 $n_1
Hilbert2d [expr {$x0+$X1+$Y1}] [expr {$y0+$X2+$Y2}] $X1 $X2 $Y1 $Y2 $n_1
Hilbert2d [expr {$x0+$X1+$y1}] [expr {$y0+$X2+$y2}] \
[expr {-1*$Y1}] [expr {-1*$Y2}] [expr {-1*$X1}] [expr {-1*$X2}] $n_1
}
}
proc Reset {} {
global step l
.c delete all
set l {}
set step 2
}
proc Draw {H step} {
global l
.c delete all
set l {}
set width 2
if {$step <= 0} {set step 1}
if {$step >= 6} {set width 1}
Hilbert2d 0 0 $H 0 0 $H $step
.c create line $l -fill blue -width $width
}
wm geometry . +100+1
set H 512
set step 2
pack [canvas .c -width $H -height $H -bg white]
set f1 [frame .f1 -relief ridge -borderwidth 2]
pack $f1 -fill x
label $f1.l1 -text Step
entry $f1.e1 -width 4 -textvariable step
button $f1.bu -text Run -width 6 -bg blue -fg white -command {Draw $H $step}
button $f1.bc -text Reset -width 6 -bg blue -fg white -command Reset
button $f1.bq -text Quit -width 6 -bg blue -fg white -command exit
eval pack [winfo children $f1] -side leftPour une version plus sophistiquée voir L-system 2D.