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 := 2H; 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 ;