\ 4tH Hilbert curve - Copyright 2020 J.L. Bezemer
\ You can redistribute this file and/or modify it under
\ the terms of the GNU General Public License

\ See: https://en.wikipedia.org/wiki/Hilbert_curve

\ Based on this function call diagram:
\ hilbert(x+i1*lg, y+i1*lg, lg, i1, 1-i2)
\ hilbert(x+i2*lg, y+(1-i2)*lg, lg, i1, i2)
\ hilbert(x+(1-i1)*lg, y+(1-i1)*lg, lg, i1, i2)
\ hilbert(x+(1-i2)*lg, y+i2*lg, lg, 1-i1, i2)

include lib/graphics.4th

64 constant /width                     \ hilbert curve order^2
 9 constant /length                    \ length of a line

variable origin                        \ point of origin

aka r@  lg                             \ get parameters from return stack
aka r'@ i1                             \ so define some aliases
aka r"@ i2                             \ to make it a bit more readable

: origin! 65536 * + origin ! ;         ( n1 n2 --)
: origin@ origin @ 65536 /mod ;        ( -- n1 n2)

: hilbert                              ( x y lg i1 i2 --)
  >r >r >r lg 1 = if                   \ if lg equals 1
    rdrop rdrop rdrop origin@ 2swap    \ get point of origin
    /width swap - /length * >r /width swap - /length * r> 
    2dup origin! line                  \ save origin and draw line
  ;then

  r> 2/ >r                             \ divide lg by 2
  over over i1 lg * tuck + >r + r> lg i1 1 i2 - hilbert
  over over 1 i2 - lg * + swap i2 lg * + swap lg i1 i2 hilbert
  over over 1 i1 - lg * tuck + >r + r> lg i1 i2 hilbert
  i2 lg * + swap 1 i2 - lg * + swap r> 1 r> - r> hilbert
;

585 pic_width ! 585 pic_height !       \ set canvas size
color_image 255 whiteout blue          \ paint blue on white
0 dup origin!                          \ set point of origin
0 dup /width over dup hilbert          \ hilbert curve, order=8
s" ghilbert.ppm" save_image            \ save the image    
  
