382 lines
9.0 KiB
Plaintext
382 lines
9.0 KiB
Plaintext
|
|
|||
|
|
{ Copyright (c) 1985, 88 by Borland International, Inc. }
|
|||
|
|
|
|||
|
|
program Arty;
|
|||
|
|
{ This program is a demonstration of the Borland Graphics Interface
|
|||
|
|
(BGI) provided with Turbo Pascal 5.0.
|
|||
|
|
|
|||
|
|
To run this program you will need the following files:
|
|||
|
|
|
|||
|
|
TURBO.EXE (or TPC.EXE)
|
|||
|
|
TURBO.TPL - The standard units
|
|||
|
|
GRAPH.TPU - The Graphics unit
|
|||
|
|
*.BGI - The graphics device drivers
|
|||
|
|
|
|||
|
|
Runtime Commands for ARTY
|
|||
|
|
-------------------------
|
|||
|
|
<B> - changes background color
|
|||
|
|
<C> - changes drawcolor
|
|||
|
|
<ESC> - exits program
|
|||
|
|
Any other key pauses, then regenerates the drawing
|
|||
|
|
|
|||
|
|
Note: If a /H command-line parameter is specified, the highest
|
|||
|
|
resolution mode will be used (if possible).
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
Crt, Graph;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
Memory = 100;
|
|||
|
|
Windows = 4;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
ResolutionPreference = (Lower, Higher);
|
|||
|
|
ColorList = array [1..Windows] of integer;
|
|||
|
|
|
|||
|
|
var
|
|||
|
|
Xmax,
|
|||
|
|
Ymax,
|
|||
|
|
ViewXmax,
|
|||
|
|
ViewYmax : integer;
|
|||
|
|
|
|||
|
|
Line: array [1..Memory] of record
|
|||
|
|
LX1,LY1: integer;
|
|||
|
|
LX2,LY2: integer;
|
|||
|
|
LColor : ColorList;
|
|||
|
|
end;
|
|||
|
|
X1,X2,Y1,Y2,
|
|||
|
|
CurrentLine,
|
|||
|
|
ColorCount,
|
|||
|
|
IncrementCount,
|
|||
|
|
DeltaX1,DeltaY1,DeltaX2,DeltaY2: integer;
|
|||
|
|
Colors: ColorList;
|
|||
|
|
Ch: char;
|
|||
|
|
BackColor:integer;
|
|||
|
|
GraphDriver, GraphMode : integer;
|
|||
|
|
MaxColors : word;
|
|||
|
|
MaxDelta : integer;
|
|||
|
|
ChangeColors: Boolean;
|
|||
|
|
|
|||
|
|
procedure Frame;
|
|||
|
|
begin
|
|||
|
|
SetViewPort(0, 0, Xmax, Ymax-(TextHeight('M')+4)-1,ClipOn);
|
|||
|
|
SetColor(MaxColors);
|
|||
|
|
Rectangle(0, 0, Xmax-1, (Ymax-(TextHeight('M')+4)-1)-1);
|
|||
|
|
SetViewPort(1, 1, Xmax-2, (Ymax-(TextHeight('M')+4)-1)-2,ClipOn);
|
|||
|
|
end { Frame };
|
|||
|
|
|
|||
|
|
procedure FullPort;
|
|||
|
|
{ Set the view port to the entire screen }
|
|||
|
|
begin
|
|||
|
|
SetViewPort(0, 0, Xmax, Ymax, ClipOn);
|
|||
|
|
end; { FullPort }
|
|||
|
|
|
|||
|
|
procedure MessageFrame(Msg:string);
|
|||
|
|
begin
|
|||
|
|
FullPort;
|
|||
|
|
SetColor(MaxColors);
|
|||
|
|
SetTextStyle(DefaultFont, HorizDir, 1);
|
|||
|
|
SetTextJustify(CenterText, TopText);
|
|||
|
|
SetLineStyle(SolidLn, 0, NormWidth);
|
|||
|
|
SetFillStyle(EmptyFill, 0);
|
|||
|
|
Bar(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
|
|||
|
|
Rectangle(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
|
|||
|
|
OutTextXY(Xmax div 2, Ymax-(TextHeight('M')+2), Msg);
|
|||
|
|
{ Go back to the main window }
|
|||
|
|
Frame;
|
|||
|
|
end { MessageFrame };
|
|||
|
|
|
|||
|
|
procedure WaitToGo;
|
|||
|
|
var
|
|||
|
|
Ch : char;
|
|||
|
|
begin
|
|||
|
|
MessageFrame('Press any key to continue... Esc aborts');
|
|||
|
|
repeat until KeyPressed;
|
|||
|
|
Ch := ReadKey;
|
|||
|
|
if Ch = #27 then begin
|
|||
|
|
CloseGraph;
|
|||
|
|
Writeln('All done.');
|
|||
|
|
Halt(1);
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
ClearViewPort;
|
|||
|
|
MessageFrame('Press a key to stop action, Esc quits.');
|
|||
|
|
end; { WaitToGo }
|
|||
|
|
|
|||
|
|
procedure TestGraphError(GraphErr: integer);
|
|||
|
|
begin
|
|||
|
|
if GraphErr <> grOk then begin
|
|||
|
|
Writeln('Graphics error: ', GraphErrorMsg(GraphErr));
|
|||
|
|
repeat until keypressed;
|
|||
|
|
ch := readkey;
|
|||
|
|
Halt(1);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure Init;
|
|||
|
|
var
|
|||
|
|
Err, I: integer;
|
|||
|
|
StartX, StartY: integer;
|
|||
|
|
Resolution: ResolutionPreference;
|
|||
|
|
s: string;
|
|||
|
|
begin
|
|||
|
|
Resolution := Lower;
|
|||
|
|
if paramcount > 0 then begin
|
|||
|
|
s := paramstr(1);
|
|||
|
|
if s[1] = '/' then
|
|||
|
|
if upcase(s[2]) = 'H' then
|
|||
|
|
Resolution := Higher;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
CurrentLine := 1;
|
|||
|
|
ColorCount := 0;
|
|||
|
|
IncrementCount := 0;
|
|||
|
|
Ch := ' ';
|
|||
|
|
GraphDriver := Detect;
|
|||
|
|
DetectGraph(GraphDriver, GraphMode);
|
|||
|
|
TestGraphError(GraphResult);
|
|||
|
|
case GraphDriver of
|
|||
|
|
CGA : begin
|
|||
|
|
MaxDelta := 7;
|
|||
|
|
GraphDriver := CGA;
|
|||
|
|
GraphMode := CGAC1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
MCGA : begin
|
|||
|
|
MaxDelta := 7;
|
|||
|
|
case GraphMode of
|
|||
|
|
MCGAMed, MCGAHi: GraphMode := MCGAC1;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
EGA : begin
|
|||
|
|
MaxDelta := 16;
|
|||
|
|
If Resolution = Lower then
|
|||
|
|
GraphMode := EGALo
|
|||
|
|
else
|
|||
|
|
GraphMode := EGAHi;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
EGA64 : begin
|
|||
|
|
MaxDelta := 16;
|
|||
|
|
If Resolution = Lower then
|
|||
|
|
GraphMode := EGA64Lo
|
|||
|
|
else
|
|||
|
|
GraphMode := EGA64Hi;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
HercMono : MaxDelta := 16;
|
|||
|
|
EGAMono : MaxDelta := 16;
|
|||
|
|
PC3270 : begin
|
|||
|
|
MaxDelta := 7;
|
|||
|
|
GraphDriver := CGA;
|
|||
|
|
GraphMode := CGAC1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
ATT400 : case GraphMode of
|
|||
|
|
ATT400C1,
|
|||
|
|
ATT400C2,
|
|||
|
|
ATT400Med,
|
|||
|
|
ATT400Hi :
|
|||
|
|
begin
|
|||
|
|
MaxDelta := 7;
|
|||
|
|
GraphMode := ATT400C1;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
VGA : begin
|
|||
|
|
MaxDelta := 16;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
InitGraph(GraphDriver, GraphMode, '');
|
|||
|
|
TestGraphError(GraphResult);
|
|||
|
|
SetTextStyle(DefaultFont, HorizDir, 1);
|
|||
|
|
SetTextJustify(CenterText, TopText);
|
|||
|
|
|
|||
|
|
MaxColors := GetMaxColor;
|
|||
|
|
BackColor := 0;
|
|||
|
|
ChangeColors := TRUE;
|
|||
|
|
Xmax := GetMaxX;
|
|||
|
|
Ymax := GetMaxY;
|
|||
|
|
ViewXmax := Xmax-2;
|
|||
|
|
ViewYmax := (Ymax-(TextHeight('M')+4)-1)-2;
|
|||
|
|
StartX := Xmax div 2;
|
|||
|
|
StartY := Ymax div 2;
|
|||
|
|
for I := 1 to Memory do with Line[I] do begin
|
|||
|
|
LX1 := StartX; LX2 := StartX;
|
|||
|
|
LY1 := StartY; LY2 := StartY;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
X1 := StartX;
|
|||
|
|
X2 := StartX;
|
|||
|
|
Y1 := StartY;
|
|||
|
|
Y2 := StartY;
|
|||
|
|
end; {init}
|
|||
|
|
|
|||
|
|
procedure AdjustX(var X,DeltaX: integer);
|
|||
|
|
var
|
|||
|
|
TestX: integer;
|
|||
|
|
begin
|
|||
|
|
TestX := X+DeltaX;
|
|||
|
|
if (TestX<1) or (TestX>ViewXmax) 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>ViewYmax) then begin
|
|||
|
|
TestY := Y;
|
|||
|
|
DeltaY := -DeltaY;
|
|||
|
|
end;
|
|||
|
|
Y := TestY;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure SelectNewColors;
|
|||
|
|
begin
|
|||
|
|
if not ChangeColors then exit;
|
|||
|
|
Colors[1] := Random(MaxColors)+1;
|
|||
|
|
Colors[2] := Random(MaxColors)+1;
|
|||
|
|
Colors[3] := Random(MaxColors)+1;
|
|||
|
|
Colors[4] := Random(MaxColors)+1;
|
|||
|
|
ColorCount := 3*(1+Random(5));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure SelectNewDeltaValues;
|
|||
|
|
begin
|
|||
|
|
DeltaX1 := Random(MaxDelta)-(MaxDelta Div 2);
|
|||
|
|
DeltaX2 := Random(MaxDelta)-(MaxDelta Div 2);
|
|||
|
|
DeltaY1 := Random(MaxDelta)-(MaxDelta Div 2);
|
|||
|
|
DeltaY2 := Random(MaxDelta)-(MaxDelta Div 2);
|
|||
|
|
IncrementCount := 2*(1+Random(4));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
procedure SaveCurrentLine(CurrentColors: ColorList);
|
|||
|
|
begin
|
|||
|
|
with Line[CurrentLine] do
|
|||
|
|
begin
|
|||
|
|
LX1 := X1;
|
|||
|
|
LY1 := Y1;
|
|||
|
|
LX2 := X2;
|
|||
|
|
LY2 := Y2;
|
|||
|
|
LColor := CurrentColors;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure Draw(x1,y1,x2,y2,color:word);
|
|||
|
|
begin
|
|||
|
|
SetColor(color);
|
|||
|
|
Graph.Line(x1,y1,x2,y2);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure Regenerate;
|
|||
|
|
var
|
|||
|
|
I: integer;
|
|||
|
|
begin
|
|||
|
|
Frame;
|
|||
|
|
for I := 1 to Memory do with Line[I] do begin
|
|||
|
|
Draw(LX1,LY1,LX2,LY2,LColor[1]);
|
|||
|
|
Draw(ViewXmax-LX1,LY1,ViewXmax-LX2,LY2,LColor[2]);
|
|||
|
|
Draw(LX1,ViewYmax-LY1,LX2,ViewYmax-LY2,LColor[3]);
|
|||
|
|
Draw(ViewXmax-LX1,ViewYmax-LY1,ViewXmax-LX2,ViewYmax-LY2,LColor[4]);
|
|||
|
|
end;
|
|||
|
|
WaitToGo;
|
|||
|
|
Frame;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure Updateline;
|
|||
|
|
begin
|
|||
|
|
Inc(CurrentLine);
|
|||
|
|
if CurrentLine > Memory then CurrentLine := 1;
|
|||
|
|
Dec(ColorCount);
|
|||
|
|
Dec(IncrementCount);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure CheckForUserInput;
|
|||
|
|
begin
|
|||
|
|
if KeyPressed then begin
|
|||
|
|
Ch := ReadKey;
|
|||
|
|
if Upcase(Ch) = 'B' then begin
|
|||
|
|
if BackColor > MaxColors then BackColor := 0 else Inc(BackColor);
|
|||
|
|
SetBkColor(BackColor);
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
if Upcase(Ch) = 'C' then begin
|
|||
|
|
if ChangeColors then ChangeColors := FALSE else ChangeColors := TRUE;
|
|||
|
|
ColorCount := 0;
|
|||
|
|
end
|
|||
|
|
else if Ch<>#27 then Regenerate;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure DrawCurrentLine;
|
|||
|
|
var c1,c2,c3,c4: integer;
|
|||
|
|
begin
|
|||
|
|
c1 := Colors[1];
|
|||
|
|
c2 := Colors[2];
|
|||
|
|
c3 := Colors[3];
|
|||
|
|
c4 := Colors[4];
|
|||
|
|
if MaxColors = 1 then begin
|
|||
|
|
c2 := c1; c3 := c1; c4 := c1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Draw(X1,Y1,X2,Y2,c1);
|
|||
|
|
Draw(ViewXmax-X1,Y1,ViewXmax-X2,Y2,c2);
|
|||
|
|
Draw(X1,ViewYmax-Y1,X2,ViewYmax-Y2,c3);
|
|||
|
|
if MaxColors = 3 then c4 := Random(3)+1; { alternate colors }
|
|||
|
|
Draw(ViewXmax-X1,ViewYmax-Y1,ViewXmax-X2,ViewYmax-Y2,c4);
|
|||
|
|
SaveCurrentLine(Colors);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure EraseCurrentLine;
|
|||
|
|
begin
|
|||
|
|
with Line[CurrentLine] do begin
|
|||
|
|
Draw(LX1,LY1,LX2,LY2,0);
|
|||
|
|
Draw(ViewXmax-LX1,LY1,ViewXmax-LX2,LY2,0);
|
|||
|
|
Draw(LX1,ViewYmax-LY1,LX2,ViewYmax-LY2,0);
|
|||
|
|
Draw(ViewXmax-LX1,ViewYmax-LY1,ViewXmax-LX2,ViewYmax-LY2,0);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
|
|||
|
|
procedure DoArt;
|
|||
|
|
begin
|
|||
|
|
SelectNewColors;
|
|||
|
|
repeat
|
|||
|
|
EraseCurrentLine;
|
|||
|
|
if ColorCount = 0 then SelectNewColors;
|
|||
|
|
|
|||
|
|
if IncrementCount=0 then SelectNewDeltaValues;
|
|||
|
|
|
|||
|
|
AdjustX(X1,DeltaX1); AdjustX(X2,DeltaX2);
|
|||
|
|
AdjustY(Y1,DeltaY1); AdjustY(Y2,DeltaY2);
|
|||
|
|
|
|||
|
|
if Random(5)=3 then begin
|
|||
|
|
x1 := (x1+x2) div 2; { shorten the lines }
|
|||
|
|
y2 := (y1+y2) div 2;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
DrawCurrentLine;
|
|||
|
|
Updateline;
|
|||
|
|
CheckForUserInput;
|
|||
|
|
until Ch=#27;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
Init;
|
|||
|
|
Frame;
|
|||
|
|
MessageFrame('Press a key to stop action, Esc quits.');
|
|||
|
|
DoArt;
|
|||
|
|
CloseGraph;
|
|||
|
|
RestoreCrtMode;
|
|||
|
|
Writeln('The End.');
|
|||
|
|
end.
|
|||
|
|
|