180 lines
3.5 KiB
Plaintext
180 lines
3.5 KiB
Plaintext
Program ArtExample;
|
||
{
|
||
ART DEMONSTRATION PROGRAM Version 1.00A
|
||
|
||
This program demonstrates the use of color graphics
|
||
using TURBO PASCAL on the IBM PC and true compatibles
|
||
with a color graphics adapter.
|
||
|
||
INSTRUCTIONS
|
||
1. Compile and run this program using the TURBO.COM
|
||
compiler.
|
||
2. Type <ESC> to exit the program, any other key to
|
||
regenerate the screen.
|
||
}
|
||
|
||
const
|
||
MemorySize = 150;
|
||
|
||
var
|
||
X1, X2, Y1, Y2,
|
||
CurrentLine,
|
||
ColorCount,
|
||
IncrementCount,
|
||
DeltaX1, DeltaY1, DeltaX2, DeltaY2,
|
||
I, Color: integer;
|
||
Ch: char;
|
||
Line: array [1..MemorySize] of record
|
||
LX1, LY1: integer;
|
||
LX2, LY2: integer;
|
||
LColor: integer;
|
||
end;
|
||
|
||
procedure Check;
|
||
var
|
||
ch: char;
|
||
begin
|
||
writeln('This program will only work if you have the color graphics adapter installed');
|
||
write('Continue Y/N ');
|
||
repeat
|
||
read (Kbd,Ch)
|
||
until Upcase(Ch) in ['Y','N', #27];
|
||
if Upcase(Ch) in ['N', #27] then
|
||
Halt;
|
||
end;
|
||
|
||
procedure Init;
|
||
begin
|
||
for I := 1 to MemorySize do
|
||
with Line[I] do
|
||
begin
|
||
LX1 := 0;
|
||
LX2 := 0;
|
||
LY1 := 0;
|
||
LY2 := 0;
|
||
end;
|
||
X1 := 0;
|
||
Y1 := 0;
|
||
X2 := 0;
|
||
Y2 := 0;
|
||
CurrentLine := 1;
|
||
ColorCount := 0;
|
||
IncrementCount := 0;
|
||
Ch := ' ';
|
||
GraphColorMode;
|
||
Palette(2);
|
||
Color := 2;
|
||
gotoxy(1,25);
|
||
write('Press any key to regenerate, ESC to stop');
|
||
end;
|
||
|
||
procedure AdjustX(var X,DeltaX: integer);
|
||
var
|
||
TestX: integer;
|
||
begin
|
||
TestX := X+DeltaX;
|
||
if (TestX<1) or (TestX>320) then
|
||
begin
|
||
TestX := X;
|
||
DeltaX := -DeltaX;
|
||
end;
|
||
X := TestX;
|
||
end;
|
||
|
||
procedure AdjustY(var Y,DeltaY: integer);
|
||
var
|
||
TestY: integer;
|
||
begin
|
||
TestY := Y+DeltaY;
|
||
if (TestY<1) or (TestY>190) then
|
||
begin
|
||
TestY := Y;
|
||
DeltaY := -DeltaY;
|
||
end;
|
||
Y := TestY;
|
||
end;
|
||
|
||
procedure SelectNewColor;
|
||
begin
|
||
Color := Random(3)+1;
|
||
ColorCount := 5*(1+Random(10));
|
||
end;
|
||
|
||
procedure SelectNewDeltaValues;
|
||
begin
|
||
DeltaX1 := Random(7)-3;
|
||
DeltaX2 := Random(7)-3;
|
||
DeltaY1 := Random(7)-3;
|
||
DeltaY2 := Random(7)-3;
|
||
IncrementCount := 4*(1+Random(9));
|
||
end;
|
||
|
||
procedure SaveCurrentLine;
|
||
begin
|
||
with Line[CurrentLine] do
|
||
begin
|
||
LX1 := X1;
|
||
LY1 := Y1;
|
||
LX2 := X2;
|
||
LY2 := Y2;
|
||
LColor := Color;
|
||
end;
|
||
end;
|
||
|
||
procedure Regenerate;
|
||
var
|
||
I: integer;
|
||
begin
|
||
NoSound;
|
||
GraphColorMode;
|
||
Palette(2);
|
||
for I := 1 to MemorySize do
|
||
with Line[I] do
|
||
Draw(LX1,LY1,LX2,LY2,LColor);
|
||
gotoxy(1,25);
|
||
write('Press any key to continue, ESC to stop');
|
||
read(Kbd,Ch);
|
||
end;
|
||
|
||
procedure WanderingLines;
|
||
begin
|
||
repeat
|
||
repeat
|
||
with Line[CurrentLine] do
|
||
Draw(LX1,LY1,LX2,LY2,0);
|
||
|
||
if ColorCount=0 then SelectNewColor;
|
||
if IncrementCount=0 then SelectNewDeltaValues;
|
||
|
||
AdjustX(X1,DeltaX1);
|
||
AdjustY(Y1,DeltaY1);
|
||
AdjustX(X2,DeltaX2);
|
||
AdjustY(Y2,DeltaY2);
|
||
|
||
Draw(X1,Y1,X2,Y2,Color);
|
||
|
||
SaveCurrentLine;
|
||
|
||
CurrentLine := Succ(CurrentLine);
|
||
if CurrentLine>MemorySize then CurrentLine := 1;
|
||
ColorCount := Pred(ColorCount);
|
||
IncrementCount := Pred(IncrementCount);
|
||
until KeyPressed;
|
||
read(Kbd,Ch);
|
||
if Ch <> #27 then
|
||
begin
|
||
Regenerate;
|
||
gotoxy(1,25);
|
||
write('Press any key to regenerate, ESC to stop');
|
||
end;
|
||
until Ch = #27;
|
||
end;
|
||
|
||
begin
|
||
ClrScr;
|
||
Check;
|
||
Init;
|
||
WanderingLines;
|
||
TextMode;
|
||
end.
|
||
|