                               
               F.Fiala
                    


Di sogenannt Hilbert-Kurv wurd zu erste Ma vo Nikolau Wirt 
i seine Buc "Algorithmen+Datenstrukturen=Programme vorgestellt 
Diese Program enthl vie Prozeduren di sic gegenseiti auf
rufen Da war nich besonder leich z verstehen Ei Beispie f 
diese rekursiv Program zeig da PASCAL-Program 'Hilbert'.

Da folgend BASIC-Program HILB.BA vo Michae Ackerman bentz 
eine andere Algorithmus de di Entstehun de Hilbert-Kurve 
hhere Ordnun besse zeigt Da Program wurd au de Zeitschrif 
BYTŠ  Jun 8 entnomme un f IBM-PC-BASIà modifizier (vorhe 
APPLESOFT) 

Noc anschauliche wir da Programm wen e i PASCA geschriebe 
wird (Programm 'Hilb').

     1  GOTO 1000
     2  REM *************************
     3  REM *        HILBERT        *
     4  REM *                       *
     5  REM *  BY MICHAEL ACKERMAN  *
     6  REM *                       *
     7  REM *        8/27/85        *
     8  REM *  MODIFIED FOR IBM-PC  *
     9  REM *        8/31/86 FI     *
     10 REM *************************
     100 RDER = RDER - 1
     110 TURN =  - TURN
     120 TEMP = DY:DY =  - TURN * DX:DX = TURN * TEMP
     130  IF RDER > 0 THEN  GOSUB 100
     140 X = X + DX:Y = Y + DY: LINE -(X,Y)
     150 TURN =  - TURN
     160 TEMP = DY:DY =  - TURN * DX:DX = TURN * TEMP
     170  IF RDER > 0 THEN  GOSUB 100
     180 X = X + DX:Y = Y + DY: LINE -(X,Y)
     190  IF RDER > 0 THEN  GOSUB 100
     200 TEMP = DY:DY =  - TURN * DX:DX = TURN * TEMP
     210 TURN =  - TURN
     220 X = X + DX:Y = Y + DY: LINE -(X,Y)
     230  IF RDER > 0 THEN  GOSUB 100
     240 TEMP = DY:DY =  - TURN * DX:DX = TURN * TEMP
     250 TURN =  - TURN
     260 RDER = RDER + 1
     270  RETURN
     1000 COLOR 3,0,14: INPUT"ORDER <1-7>";RDER
     1010 SCREEN 1:COLOR 3,1,14
     1015 CLS:KEY OFF
     1020 DY = 192 / 2 ^ RDER
     1030 TURN =  - 1
     1040 DX = X = Y = 0
     1050  LINE (0,0)-(X,Y)
     1060  GOSUB 100
     1065  A$=INKEY$:IF A$="" THEN 1065
     1070  END
.pa
.fi elite
(*****************************************************************************)
program Hilb;
(*****************************************************************************)
type
     Drehungsart = (vorher,nachher);
const
     ORD:integer=3;
     DIR:integer=-1;(* Richtung des Zeichenstiftes *)
var
     dx,dy,         (* Weglngen in x- und y-Richtung *)
     x,y,           (* Aktuelle Zeichenposition *)
     i: integer;

procedure Zeichnen;
begin
     Draw (x,y,x+dx,y+dy,1);
     x := x+dx; y := y+dy;
end;

procedure Richtung (Drehung:Drehungsart);
var  Temp : integer;
begin
     if Drehung=vorher then DIR:=-DIR;
     Temp := dy; dy := -DIR*dx; dx := DIR*Temp;
     if Drehung=nachher then DIR:=-DIR
end;

procedure Hilb;
begin
  ORD := ORD-1;
  Richtung (vorher);  if ORD>0 then Hilb; Zeichnen;
  Richtung (vorher);  if ORD>0 then Hilb; Zeichnen;
  if ORD>0 then Hilb; Richtung (nachher); Zeichnen;
  if ORD>0 then Hilb; Richtung (nachher); 
  ORD := ORD+1;
end;

begin (* Hauptprogramm *)
     (* Anfangswerte *)
     dy := 1; for i:=1 to ORD do dy:=dy*2; 
     dy:=round(200/dy)-1; dx := 0; 
     x := 0; y := 0;
     GraphMode;
     Hilb;
     ReadLn;
     TextMode
end.
.fi schoen
.pa
.fi elite
(*****************************************************************************)
program hilbert;
(*****************************************************************************)

procedure graphics;                           external 'a:GRAPH.BIN';
procedure hires;                              external graphics[6];
procedure draw(x1,y1,x2,y2,color: integer);   external graphics[24];

const
    h0 = 512;
var i,h,x,y,x0,y0 : integer;
    xa, ya: integer;
    ch:char;
    n: integer;             { Rekursionstiefe 1..n }
    key: char;
    scale: real;

procedure rdraw(x1, y1, x2, y2, attr: integer);
begin
    draw(round(x1*scale),round(y1*scale),
         round(x2*scale),round(y2*scale),attr);
end;

procedure plot;
{ zieht von xa, ya (alte Koord.) nach x,y }
begin
    rdraw (xa, ya, 2*x, y, 1);
    xa := 2*x;
    ya := y;
end;

procedure b (i: integer); forward;
procedure c (i: integer); forward;
procedure d (i: integer); forward;

procedure a (i: integer);
begin
    if i > 0 then
    begin
        a (i-1); x := x+h; y := y-h; plot;
        b (i-1); x := x + 2*h; plot;
        d (i-1); x := x+h; y := y+h; plot;
        a (i-1);
    end;
end;

procedure b;
begin
    if i > 0 then
    begin
        b (i-1); x := x-h; y := y-h; plot;
        c (i-1); y := y - 2*h; plot;
        a (i-1); x := x+h; y := y-h; plot;
        b (i-1);
    end;
end;
.fi schoen
.pa
.fi elite
procedure c;
begin
    if i > 0 then
    begin
        c (i-1); x := x-h; y := y+h; plot;
        d (i-1); x := x - 2*h; plot;
        b (i-1); x := x-h; y := y-h; plot;
        c (i-1);
    end;
end;

procedure d;
begin
    if i > 0 then
    begin
        d (i-1); x := x+h; y := y+h; plot;
        a (i-1); y := y + 2*h; plot;
        c (i-1); x := x-h; y := y+h; plot;
        d (i-1);
    end;
end;

begin
    scale := 200 / h0;
    repeat
        clrscr;
        write('Anzahl der Durchlufe (1 ... 6): '); readln (n);
    until n < 7;
    hires;

    if n > 0 then begin
    i := 0; h := h0 div 4; x0 := 2*h; y0 := 3*h;
    repeat
        i := i+1; x0 := x0-h;
        h := h div 2; y0 := y0+h;
        x := x0; y := y0; rdraw (0,0,2*x,y,0);
        xa := 2*x; ya := y;
        a(i); x := x+h; y := y-h; plot;
        b(i); x := x-h; y := y-h; plot;
        c(i); x := x-h; y := y+h; plot;
        d(i); x := x+h; y := y+h; plot;
    until i >= n;
    end;
    write(chr(7));
    read(kbd, key);
end.
.fi schoen
.pa
