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 to exit the program, any other key to regenerate the screen. MODIFIED by Kent Cedola to use EGA Graphic Primitives. } const MemorySize = 200; 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; {$I GPPARMS.P } {$I GPINIT.P } {$I GPTERM.P } {$I GPCOLOR.P } {$I GPMOVE.P } {$I GPLINE.P } {$I GPVIEWPO.P } procedure Check; var ch: char; begin GPPARMS; if GDTYPE <> 5 then begin ClrScr; Writeln('Enhanced Graphic Adapter and Display not found!'); Halt(1); end; if GDMEMORY = 64 then begin ClrScr; Writeln('This program works much better with 128k or more EGA memory!'); Writeln; Writeln(' Hit any key to continue...'); Read(KBd,Ch); end; end; procedure Init; begin GPINIT; GPVIEWPORT(50,50,300,300); 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 := ' '; GPCOLOR(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>GDMAXCOL - 1) 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> GDMAXROW - 32) then begin TestY := Y; DeltaY := -DeltaY; end; Y := TestY; end; procedure SelectNewColor; begin Color := Random(GDMAXPAL-1)+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; GPINIT; for I := 1 to MemorySize do with Line[I] do begin GPCOLOR(LColor); GPMOVE(LX1,LY1); GPLINE(LX2,LY2); end; 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 begin GPCOLOR(Black); GPMOVE(LX1,LY1); GPLINE(LX2,LY2); end; if ColorCount=0 then SelectNewColor; if IncrementCount=0 then SelectNewDeltaValues; AdjustX(X1,DeltaX1); AdjustY(Y1,DeltaY1); AdjustX(X2,DeltaX2); AdjustY(Y2,DeltaY2); GPCOLOR(Color); GPMOVE(X1,Y1); GPLINE(X2,Y2); 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.