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 and Y <= Y2) or (Y1 >= Y2 and Y >= Y2) or (X1 <= X2 and X <= X2) or (X1 >= X2 and 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