begin;
comment
THE SERPINSKI (SP?) CURVE. A SIMPLE DEMO...
;
integer N, H0;
N := 2;
comment RECURSION DEEP
;
H0 := 32;
comment 'WINDOW' WIDTH / HEIGHT (POWER OF 2)
;
begin;
integer I, H, X, Y, X0, Y0;
integer PENY, PENX;
Boolean array SCR[0 : H0, 0 : H0];
procedure SERP;
begin;
I := 0;
H := H0 ÷ 4;
X0 := 2
H;
Y0 := 3
H;
DOLOOP: I := I + 1;
X0 := X0 - H;
H := H ÷ 2;
Y0 := Y0 + H;
X := X0;
Y := Y0;
SETPEN;
A(I);
X := X + H;
Y := Y - H;
MOVEPEN;
B(I);
X := X - H;
Y := Y - H;
MOVEPEN;
C(I);
X := X - H;
Y := Y + H;
MOVEPEN;
D(I);
X := X + H;
Y := Y + H;
MOVEPEN;
if I < N then goto DOLOOP;
end ;
procedure A(I);
value I;
integer I;
begin;
if I > 0 then begin;
A(I - 1);
X := X + H;
Y := Y - H;
MOVEPEN;
B(I - 1);
X := X + 2
H;
MOVEPEN;
D(I - 1);
X := X + H;
Y := Y + H;
MOVEPEN;
A(I - 1);
end ;
end ;
procedure B(I);
value I;
integer I;
begin;
if I > 0 then begin;
B(I - 1);
X := X - H;
Y := Y - H;
MOVEPEN;
C(I - 1);
Y := Y - 2
H;
MOVEPEN;
A(I - 1);
X := X + H;
Y := Y - H;
MOVEPEN;
B(I - 1);
end ;
end ;
procedure C(I);
value I;
integer I;
begin;
if I > 0 then begin;
C(I - 1);
X := X - H;
Y := Y + H;
MOVEPEN;
D(I - 1);
X := X - 2
H;
MOVEPEN;
B(I - 1);
X := X - H;
Y := Y - H;
MOVEPEN;
C(I - 1);
end ;
end ;
procedure D(I);
value I;
integer I;
begin;
if I > 0 then begin;
D(I - 1);
X := X + H;
Y := Y + H;
MOVEPEN;
A(I - 1);
Y := Y + 2
H;
MOVEPEN;
C(I - 1);
X := X - H;
Y := Y + H;
MOVEPEN;
D(I - 1);
end ;
end ;
procedure SETPEN;
begin;
PENX := X;
PENY := Y;
end ;
procedure XLINE(Y, X, DX);
value Y, X, DX;
integer Y, X, DX;
begin;
integer I;
for I := 0 step 1 until DX do
SCR[Y, X + I] := true;
end ;
procedure YLINE(X, Y, NY);
value X, Y, NY;
integer X, Y, NY;
begin;
integer J;
for J := 0 step 1 until NY do
SCR[Y + J, X] := true;
end ;
procedure DRLINE(Y1, X1, Y2, X2);
value Y1, X1, Y2, X2;
integer Y1, X1, Y2, X2;
begin;
integer I, J, DX, DY;
real SY, SX, Y, X;
DY := Y2 - Y1;
DX := X2 - X1;
if ABS(DY) > ABS(DX) then begin;
SY := SIGN(DY);
SX := SIGN(DX)
ABS(DX ÷ DY);
end else begin;
SY := SIGN(DY)
ABS(DY ÷ DX);
SX := SIGN(DX);
end ;
Y := Y1;
X := X1;
DOLOOP: SCR[Y, X] := true;
Y := Y + SY;
X := X + SX;
if (Y1
Y2
Y
Y2)
(Y1
Y2
Y
Y2)
(X1
X2
X
X2)
(X1
X2
X
X2) then goto DOLOOP;
end ;
procedure MOVEPEN;
begin;
integer procedure MIN(X, Y);
value X, Y;
integer X, Y;
if X < Y then MIN := X else MIN := Y;
if PENX = X then YLINE(X, MIN(Y, PENY), ABS(Y - PENY)) else if PENY = Y then XLINE(Y, MIN(X, PENX), ABS(X - PENX)) else DRLINE(PENY, PENX, Y, X);
PENX := X;
PENY := Y;
end ;
comment
THIS IS THE MAIN PROGRAM:
;
begin;
integer I, J;
comment CLEANUP THE SCREEN
;
for J := 0 step 1 until H0 do
for I := 0 step 1 until H0 do
SCR[J, I] := false;
SERP;
comment PRINT THE SCREEN
;
for J := 0 step 1 until H0 do
begin;
for I := 0 step 1 until H0 do
if SCR[J, I] then WRITE("##") else WRITE(" ");
OUTSYMBOL(1, "\N", 0);
end ;
end ;
end ;
end ;