Category : Pascal Source Code
Archive   : XGRAPH.ZIP
Filename : ZOO2.PAS
{ endpoints. }
{ }
{ Warning, This demo can have habit forming effects!, some programmers }
{ have given up lots of useful hours to stare at the pretty patterns in }
{ the screen. }
{ }
{ Written by Abe Achkinazi on May 1986. Curve type "sines" thanks to }
{ and idea by Roderick Young. }
{ Modified to use Extended Graphics Routines in September 1986. }
{ }
{ Permission to distribute, change, mutilate and learn from this }
{ program is granted. }
{ }
program zoo(input,output);
{$I Xgraph.pas}
label ErrorExit;
const
max_point = 60; { Controls the number of points }
{ per curve }
x1 = 0; y1 = 1; x2 = 2; y2 = 3; { constants used to access array }
{ 'points' }
type
{ Some the possible paths for the curves }
curve_type = ( sines, sines2, random1, planar, square1, general );
{ Common data structure for all animal-curves }
list_type = record
{ Reseed constant }
reseed : integer;
{ Time slice variables }
slice_const, slice_counter : integer;
{ Window descriptor }
top_x, top_y, length, width : integer;
{ Maintain track of previous points }
points : array [0..3, 0..max_point] of integer;
last_point : integer;
start : integer;
{ curve related parameters }
case what_path: curve_type of
sines, sines2
: ( omega : array [0..3] of real;
increment, delta_increment : real );
random1 : ( x1_temp, y1_temp, x2_temp, y2_temp,
rx1, ry1, rx2, ry2: real );
planar : ( steps : integer;
x, y, px1, py1, dx1, dy1, px2, py2,
dx2, dy2 : integer;
border : integer );
square1 : ( sq1_steps : integer );
general : ( parms : array [0..5] of real )
end;
var
GrfData : GraphicsData;
Regs : VidRegs;
BlitParms : BlitParm;
{ Actual curves variables }
list, list2, list3, list4, list5 : list_type;
{ Frame buffer size variables }
OneThird, OneHalf, TwoThird : integer;
ScreenMode : integer;
function GetMode(var ScreenMode: integer):boolean;
{
Function to check if a parameter was passed and if its valid.
}
var
Code : integer;
begin
if (ParamCount < 1) or (ParamCount > 1) then GetMode := false
else begin { At least has some parameter see if its legal }
Val(ParamSTR(1), ScreenMode, Code);
if Code <> 0 then GetMode := false
else if ScreenMode in [Video320x200BW, Video320x200Color, Video640x200,
VideoEGA320x200, VideoEGA640x200, VideoEGA640x350Mono, VideoEGA640x350Color,
VideoMulti640x400, VideoMulti320x400]
then GetMode := true
else GetMode := false;
end;
end; { of GetMode }
function previous_point( i, last_point : integer ): integer;
begin
if i = 0 then previous_point := last_point;
end;
function next_point(i, last_point : integer ): integer;
begin
next_point := (i+1) mod (last_point+1);
end;
procedure draw_border(list : list_type);
begin
with list, Regs do begin
ax:=VidLine shl 8 + $78 { white solid line };
cx:=top_x; dx:=top_y; si:=top_x + width; di:=top_y;
Intr(VideoInt, Regs);
cx:=top_x + width; dx:=top_y; si:=top_x + width;
di:=top_y + length; Intr(VideoInt, Regs);
cx:=top_x + width; dx:=top_y + length; si:=top_x;
di:=top_y + length; Intr(VideoInt, Regs);
cx:=top_x; dx:=top_y + length; si:=top_x; di:=top_y;
Intr(VideoInt, Regs);
end;
end;
procedure clear_window(list : list_type);
begin
with list, BlitParms do begin
{ Clear the currently selected window }
Regs.ax := VidBlit shl 8; Regs.bx := $000F;
Regs.ds := seg(BlitParms); Regs.si := ofs(BlitParms);
DestOffset := ofs(GrfData); DestSegment := seg(GrfData);
SrcOffset := ofs(GrfData); SrcSegment := seg(GrfData);
RectOrigenX := top_x*GrfData.BitPixelDensity; RectOrigenY := top_y;
RectCornerX := (top_x+width)*GrfData.BitPixelDensity;
RectCornerY := top_y+length;
PointX := RectOrigenX; PointY := RectOrigenY;
Opcode := Blit0; TextOp := TextS;
{ Inline($CC); }
Intr(VideoInt, Regs);
end;
end;
procedure draw_line( list: list_type );
var i,j,k : integer;
begin
with list, Regs do begin
case what_path of
sines, planar, square1: begin
i := next_point(start, last_point); { Calculate next line to be used }
{ Erase the last line in the list }
ax:=VidLine shl 8+$7F {Back Solid Line };
cx:=points[x1,i]; dx:=points[y1,i]; si:=points[x2,i]; di:=points[y2,i];
Intr(VideoInt, Regs);
{ draw the current line }
{ Pick color and pattern base on table pos.}
ax:=VidLine shl 8+(Start mod 15+1)*8+(Start mod 7);
cx:=points[x1,start]; dx:=points[y1,start]; si:=points[x2,start];
di:=points[y2,start]; Intr(VideoInt, Regs); end;
sines2 : begin
i := next_point(start, last_point);
k := next_point(i, last_point);
j := previous_point(start, last_point);
ax:=VidLine shl 8+(i mod 15+1)*8 { Pick color base on table pos.};
cx:=points[x1,i]; dx:=points[y1,i]; si:=points[x1,k];
di:=points[y1,k]; Intr(VideoInt, Regs);
cx:=points[x2,i]; dx:=points[y2,i]; si:=points[x2,k];
di:=points[y2,k]; Intr(VideoInt, Regs);
end;
random1: begin
i := next_point(start, last_point); { Calculate next line to be used }
{ Erase the last line in the list }
ax:=VidLine shl 8+$7F {Back Solid Line };
cx:=points[x1,i]; dx:=points[y1,i]; si:=points[x2,i]; di:=points[y2,i];
Intr(VideoInt, Regs);
{ draw the current line }
{ Pick color and pattern base on table pos.}
ax:=VidLine shl 8+(Start mod 15+1)*8+(Start mod 7);
cx:=points[x1,start]; dx:=points[y1,start]; si:=points[x2,start];
di:=points[y2,start]; Intr(VideoInt, Regs); end
end; { of what_curve case }
end;
end;
{ Used by Random1 curve path, it reverses direction in the x-sense }
function oppx(border : integer; list : list_type): integer;
begin
with list do case border of
0, 2 : oppx := top_x + random(width);
1 : oppx := top_x + random(width);
3 : oppx := top_x + random(width)
end;
end;
{ Used by Random1 curve path, it reverses direction in the y-sense }
function oppy(border : integer; list : list_type): integer;
begin
with list do case border of
0 : oppy := top_y + random(length);
1,3 : oppy := top_y + random(length);
2 : oppy := top_y + random(length);
end;
end;
function adjx(var border : integer; list : list_type): integer;
begin
with list do case border of
0, 2: if random(2)=0 then begin
border := 3;
adjx := (top_x+1) + random(width-2); end
else begin
border := 1;
adjx := (top_x+1) + random(width-2); end;
1, 3: begin
if random(2) = 0 then border := 2
else border := 0;
adjx := (top_x+1) + random(width-2);
end
end;
end;
function adjy(border: integer; list: list_type): integer;
begin
adjy := (list.top_y+1) + random(list.length-2);
end;
{ Calculates what is the next set of points for the curve path }
procedure calc (var list : list_type);
begin
with list do begin
case what_path of
sines, sines2 : begin
increment := increment + delta_increment;
points[x1,start] :=
(top_x+1) + round(((sin(omega[x1]*increment)+1.0) / 2.0) * (width-2));
points[y1,start] :=
(top_y+1) + round(((sin(omega[y1]*increment)+1.0) / 2.0) * (length-2));
points[x2,start] :=
(top_x+1) + round(((sin(omega[x2]*increment)+1.0) / 2.0) * (width-2));
points[y2,start] :=
(top_y+1) + round(((sin(omega[y2]*increment)+1.0) / 2.0) * (length-2));
end;
random1 : begin
x1_temp := ((random * 2.0) - 1.0) / 10.0;
y1_temp := ((random * 2.0) - 1.0) / 10.0;
x2_temp := ((random * 2.0) - 1.0) / 10.0;
y2_temp := ((random * 2.0) - 1.0) / 10.0;
rx1 := rx1 + x1_temp;
if rx1 > 1.0 then rx1 := 1.0
else if rx1 < 0.0 then rx1 := 0.0;
ry1 := ry1 + y1_temp;
if ry1 > 1.0 then ry1 := 1.0
else if ry1 < 0.0 then ry1 := 0.0;
rx2 := rx2 - x2_temp;
if rx2 > 1.0 then rx2 := 1.0
else if rx2 < 0.0 then rx2 := 0.0;
ry2 := ry2 - y2_temp;
if ry2 > 1.0 then ry2 := 1.0
else if ry2 < 0.0 then ry2 := 0.0;
points[x1,start] := (top_x+1) + round(rx1 * (width-2));
points[y1,start] := (top_y+1) + round(ry1 * (length-2));
points[x2,start] := (top_x+1) + round(rx2 * (width-2));
points[y2,start] := (top_y+1) + round(ry2 * (length-2));
end;
square1: begin end;
planar: begin
if steps = 0 then begin
steps := 7 + random(5);
x := px1; y := py1; px2 := px1; py2 := py1;
dx2 := (oppx(border, list) - x) div steps;
dy2 := (oppy(border, list) - y) div steps;
dx1 := (adjx(border, list) - x) div steps;
dy1 := (adjy(border, list) - y) div steps;
end;
px1 := px1 + dx1; py1 := py1 + dy1;
px2 := px2 + dx2; py2 := py2 + dy2;
points[x1,start] := px1; points[y1,start] := py1;
points[x2,start] := px2; points[y2,start] := py2;
steps := steps - 1;
end
end;
end;
end;
{ Fills up the curve's queues with new points, and initializes all }
{ other variables needed for this curve. }
procedure Seed( var list : list_type;
dummy_x, dummy_y, wide, tall : integer;
curve : curve_type );
var i : integer;
begin
with list do begin
{ Initialize window }
top_x := dummy_x; top_y := dummy_y; length := tall; width := wide;
draw_border(list);
{ Initialize Path related parameters }
what_path := curve;
case what_path of
sines, sines2: begin
omega[x1] := Random;
omega[y1] := Random;
omega[x2] := Random;
omega[y2] := Random;
increment := 0; delta_increment := 0.2;
last_point := 15 + random(5);
end;
random1: begin
rx1 := random; ry1 := random;
rx2 := random; ry2 := random;
last_point := 10 + random(5);
end;
square1: begin end;
planar: begin
border := random(4);
px1 := top_x + random(width);
py1 := top_y + random(length);
last_point := 10 + random(15);
steps := 0;
end
end; { of case curve }
{ Initialize point array }
start := 0;
for i := 0 to (last_point+1) do begin
start := next_point(list.start,list.last_point);
calc(list);
end;
{ Initialize time slice variables }
slice_const := 0;
slice_counter := 0;
reseed := 100 + random(200);
end; { of with list }
end; { of Seed }
{ Performs one step of the given curve. It takes care of all }
{ housekeeping issues such as adjusting curves timers and reseeding }
{ if needed. }
procedure Step(var list: list_type);
begin
list.slice_counter := list.slice_counter - 1;
if list.slice_counter <= 0 then begin
Calc(list);
Draw_line(list);
list.start := next_point(list.start, list.last_point);
list.slice_counter := list.slice_const;
end;
list.reseed := list.reseed - 1;
if list.reseed = 0 then begin
clear_window(list);
Seed(list, list.top_x, list.top_y, list.width, list.length, list.what_path);
end;
end; { of Step }
function Trim( n :integer):integer;
{
Function to guarantee that the result is always byte aligned on the
right (always ends in bit 7).
}
begin
if (n mod 8) <> 6 then Trim := (n div 8) * 8 - 2
else Trim := n;
end;
function Clip( n : integer):integer;
{
Function to gurantee that the result is always byte align on the
left (always ends in bit 0).
}
begin
if (n mod 8) <> 0 then Clip := (n div 8) * 8
else Clip := n;
end;
begin
Regs.ax := VidSetMode shl 8 + 03; Intr(VideoInt, Regs); { Clear Screen in Alpha }
{ Check to make sure that video extensions are installed }
Regs.ax := VidID * 256; Regs.bx := 0; Intr(VideoInt, Regs);
if Regs.bx = 0 then begin
Writeln('Extended Graphics functions not installed.');
writeln('Hit return to exit');
readln;
goto ErrorExit;
end;
{ See if user passed legal parameter }
if not GetMode(ScreenMode) then begin
writeln('Usage: Zoo2 x');
writeln('where x is a legal graphics mode number from this list:');
writeln;
writeln(' 4) is CGA 320x200');
writeln(' 5) CGA 320x200');
writeln(' 6) CGA 640x200');
writeln('13) EGA 320x200');
writeln('14) EGA 640x200');
writeln('15) EGA 640x350 Monochrome');
writeln('16) EGA 640x350 Color');
writeln('20) HP-Multimode 640x400');
writeln('21) HP-Multimode 320x400');
goto ErrorExit;
end;
{ introduction }
writeln(' There are an infinite number of pairs of points in a plane.');
writeln(' This programs shows some of the strange fauna that exists');
writeln(' based on the relationship between two points:');
writeln;
writeln(' Squiggle - Seems to like to turn an twist in a smooth path.');
writeln;
writeln(' Lissajous - Ever seen the TV series "The Outer Limits" ?. Look');
writeln(' at the source code, the relation between Squiggle');
writeln(' and Lissajous is interesting.');
writeln;
writeln(' Planes - Triangular planes turning this way and that ...');
writeln;
writeln(' Random - What can I say, when all else fails go for the old');
writeln(' and faithfull random number generator.');
writeln;
writeln(' written by Abe Achkinazi, May 1 1986.');
writeln(' Updated to support color and multiple video adapters');
writeln(' on August 6, 1986. Squiggles is based on a program');
writeln(' written by Roderick Young.');
writeln;
writeln('Hit
writeln('
readln;
GraphInit(GrfData, ScreenMode);
with GrfData do begin
OneThird := (MaxX - MinX + 1) div 3;
TwoThird := (MaxX - MinX + 1) div 3 + (MaxX - MinX + 1) mod 3;
OneHalf := (MaxY - MinY + 1) div 2;
{ Initialize the different animals. }
Seed(list, Clip(MinX), MinY, Trim(OneThird-1), OneHalf-1, sines2);
Seed(list2, Clip(OneThird), MinY, Trim(TwoThird-1), MaxY, sines);
Seed(list3, Clip(OneThird+TwoThird), MinY, Trim(OneThird-1), OneHalf-1, planar);
Seed(list4, Clip(MinX), OneHalf, Trim(OneThird-1), OneHalf-1, random1);
Seed(list5, Clip(OneThird+TwoThird), OneHalf, Trim(OneThird-1), OneHalf-1, sines2);
{ Now go around and around given each a chance to perform }
repeat
Step(list);
Step(list2);
Step(list3);
Step(list4);
Step(list5);
until KeyPressed;
end;
{ if using extended modes turn off same way }
if ScreenMode in [20, 21] then begin
Regs.ax := VidExtendedFunctions shl 8+5; Regs.bx := 3 end
else
Regs.ax := VidSetMode shl 8 + 3;
Intr(VideoInt, Regs);
ErrorExit:; { Falls to here when there is an error }
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/