home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l039 / 1.img / EXAMPLEX / ART.PAS next >
Encoding:
Pascal/Delphi Source File  |  1985-03-18  |  3.5 KB  |  180 lines
  1. Program ArtExample;
  2. {
  3.           ART DEMONSTRATION PROGRAM  Version 1.00A
  4.  
  5.      This program demonstrates the use of color graphics
  6.      using TURBO PASCAL on the IBM PC and true compatibles
  7.      with a color graphics adapter.
  8.  
  9.      INSTRUCTIONS
  10.      1.  Compile and run this program using the TURBO.COM
  11.          compiler.
  12.      2.  Type <ESC> to exit the program, any other key to
  13.          regenerate the screen.
  14. }
  15.  
  16. const
  17.   MemorySize = 150;
  18.  
  19. var
  20.   X1, X2, Y1, Y2,
  21.   CurrentLine,
  22.   ColorCount,
  23.   IncrementCount,
  24.   DeltaX1, DeltaY1, DeltaX2, DeltaY2,
  25.   I, Color: integer;
  26.   Ch: char;
  27.   Line: array [1..MemorySize] of record
  28.                                    LX1, LY1: integer;
  29.                                    LX2, LY2: integer;
  30.                                    LColor:  integer;
  31.                                  end;
  32.  
  33. procedure Check;
  34. var
  35.   ch: char;
  36. begin
  37.   writeln('This program will only work if you have the color graphics adapter installed');
  38.   write('Continue Y/N ');
  39.   repeat
  40.     read (Kbd,Ch)
  41.   until Upcase(Ch) in ['Y','N', #27];
  42.   if Upcase(Ch) in ['N', #27] then
  43.     Halt;
  44. end;
  45.  
  46. procedure Init;
  47. begin
  48.   for I := 1 to MemorySize do
  49.   with Line[I] do
  50.   begin
  51.     LX1 := 0;
  52.     LX2 := 0;
  53.     LY1 := 0;
  54.     LY2 := 0;
  55.   end;
  56.   X1 := 0;
  57.   Y1 := 0;
  58.   X2 := 0;
  59.   Y2 := 0;
  60.   CurrentLine := 1;
  61.   ColorCount := 0;
  62.   IncrementCount := 0;
  63.   Ch := ' ';
  64.   GraphColorMode;
  65.   Palette(2);
  66.   Color := 2;
  67.   gotoxy(1,25);
  68.   write('Press any key to regenerate, ESC to stop');
  69. end;
  70.  
  71. procedure AdjustX(var X,DeltaX: integer);
  72. var
  73.   TestX: integer;
  74. begin
  75.   TestX := X+DeltaX;
  76.   if (TestX<1) or (TestX>320) then
  77.   begin
  78.     TestX := X;
  79.     DeltaX := -DeltaX;
  80.   end;
  81.   X := TestX;
  82. end;
  83.  
  84. procedure AdjustY(var Y,DeltaY: integer);
  85. var
  86.   TestY: integer;
  87. begin
  88.   TestY := Y+DeltaY;
  89.   if (TestY<1) or (TestY>190) then
  90.   begin
  91.     TestY := Y;
  92.     DeltaY := -DeltaY;
  93.   end;
  94.   Y := TestY;
  95. end;
  96.  
  97. procedure SelectNewColor;
  98. begin
  99.   Color := Random(3)+1;
  100.   ColorCount := 5*(1+Random(10));
  101. end;
  102.  
  103. procedure SelectNewDeltaValues;
  104. begin
  105.   DeltaX1 := Random(7)-3;
  106.   DeltaX2 := Random(7)-3;
  107.   DeltaY1 := Random(7)-3;
  108.   DeltaY2 := Random(7)-3;
  109.   IncrementCount := 4*(1+Random(9));
  110. end;
  111.  
  112. procedure SaveCurrentLine;
  113. begin
  114.   with Line[CurrentLine] do
  115.   begin
  116.     LX1 := X1;
  117.     LY1 := Y1;
  118.     LX2 := X2;
  119.     LY2 := Y2;
  120.     LColor := Color;
  121.   end;
  122. end;
  123.  
  124. procedure Regenerate;
  125. var
  126.   I: integer;
  127. begin
  128.   NoSound;
  129.   GraphColorMode;
  130.   Palette(2);
  131.   for I := 1 to MemorySize do
  132.     with Line[I] do
  133.       Draw(LX1,LY1,LX2,LY2,LColor);
  134.   gotoxy(1,25);
  135.   write('Press any key to continue, ESC to stop');
  136.   read(Kbd,Ch);
  137. end;
  138.  
  139. procedure WanderingLines;
  140. begin
  141.   repeat
  142.     repeat
  143.       with Line[CurrentLine] do
  144.         Draw(LX1,LY1,LX2,LY2,0);
  145.  
  146.       if ColorCount=0 then SelectNewColor;
  147.       if IncrementCount=0 then SelectNewDeltaValues;
  148.  
  149.       AdjustX(X1,DeltaX1);
  150.       AdjustY(Y1,DeltaY1);
  151.       AdjustX(X2,DeltaX2);
  152.       AdjustY(Y2,DeltaY2);
  153.  
  154.       Draw(X1,Y1,X2,Y2,Color);
  155.  
  156.       SaveCurrentLine;
  157.  
  158.       CurrentLine := Succ(CurrentLine);
  159.       if CurrentLine>MemorySize then CurrentLine := 1;
  160.       ColorCount := Pred(ColorCount);
  161.       IncrementCount := Pred(IncrementCount);
  162.     until KeyPressed;
  163.     read(Kbd,Ch);
  164.     if Ch <> #27 then
  165.     begin
  166.       Regenerate;
  167.       gotoxy(1,25);
  168.       write('Press any key to regenerate, ESC to stop');
  169.     end;
  170.   until Ch = #27;
  171. end;
  172.  
  173. begin
  174.   ClrScr;
  175.   Check;
  176.   Init;
  177.   WanderingLines;
  178.   TextMode;
  179. end.
  180.