Courbe de Hilbert 2D

 

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 left

Pour une version plus sophistiquée voir L-system 2D.


Catégorie Mathématiques