PROGRAM Hilbert2A     !Hilbert space filling curve
!translated from pascal, grid added
!ammended April 2004 by W.Van Duyn
SET MODE "color"
SET WINDOW 0,1199,0,903     !tuned to monitor with 1280 x 1024 res
SET BACKGROUND COLOR "white"
SET COLOR "black"
PRINT "Hilbert2A input size try 12,order try 6 "
INPUT h,n
CLEAR
SET COLOR "white"
FLOOD 1,1
SET COLOR MIX (100)0.9,0.9,0.9 !light gray
SET COLOR MIX (200)0.8,0.1,0.8 !light magenta
LET w=(2^n)-1     !w is the numeric width of curve
LET f=h*w     !f is the actual width of completed curve
LET x= (1200+f)/2     ! plot curve symmetrical with center of screen
LET y= (900+f)/2
CALL grid(w,h)
SET COLOR 200
CALL hilbertA(n,h,x,y)
END

SUB hilbertA(n,h,x,y)
IF n>0 THEN
CALL hilbertD(n-1,h,x,y)
CALL move1(h,x,y)
CALL hilbertA(n-1,h,x,y)
CALL move2(h,x,y)
CALL hilbertA(n-1,h,x,y)
CALL move3(h,x,y)
CALL hilbertB(n-1,h,x,y)
END IF
END SUB

SUB hilbertB(n,h,x,y)
IF n>0 THEN
CALL hilbertC(n-1,h,x,y)
CALL move4(h,x,y)
CALL hilbertB(n-1,h,x,y)
CALL move3(h,x,y)
CALL hilbertB(n-1,h,x,y)
CALL move2(h,x,y)
CALL hilbertA(n-1,h,x,y)
END IF
END SUB

SUB hilbertC(n,h,x,y)
IF n>0 THEN
CALL hilbertB(n-1,h,x,y)
CALL move3(h,x,y)
CALL hilbertC(n-1,h,x,y)
CALL move4(h,x,y)
CALL hilbertC(n-1,h,x,y)
CALL move1(h,x,y)
CALL hilbertD(n-1,h,x,y)
END IF
END SUB

SUB hilbertD(n,h,x,y)
IF n>0 THEN
CALL hilbertA(n-1,h,x,y)
CALL move2(h,x,y)
CALL hilbertD(n-1,h,x,y)
CALL move1(h,x,y)
CALL hilbertD(n-1,h,x,y)
CALL move4(h,x,y)
CALL hilbertC(n-1,h,x,y)
END IF
END SUB

SUB move1(h,x,y)
LET x2=x-h
LET y2=y
PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move2(h,x,y)
LET x2=x
LET y2=y-h
PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move3(h,x,y)
LET x2=x+h
LET y2=y
PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB move4(h,x,y)
LET x2=x
LET y2=y+h
PLOT x,y; x2,y2
LET x=x2
LET y=y2
END SUB

SUB grid(w,h)
SET COLOR 100
LET dxy=(w+1)*h
LET dx=600+h*(w+1)/2
LET dy=450+h*(w+1)/2
LET x1=x0
LET y1=y0
FOR i = 0 to w+1
PLOT x1+dx,y0+dy; x1+dx-dxy,y0+dy
PLOT x0+dx,y1+dy; x0+dx,y1+dy-dxy
LET x0=x0-h
LET y0=y0-h
NEXT i
END SUB