home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TURBO.ZIP / ART.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  2.8 KB  |  153 lines
  1.  
  2. const
  3.   Memory = 150;
  4.  
  5. var
  6.   Line:  array [1..Memory] of record
  7.                                 LX1,LY1: integer;
  8.                                 LX2,LY2: integer;
  9.                                 LColor:  integer;
  10.                               end;
  11.   X1,X2,Y1,Y2,
  12.   CurrentLine,
  13.   ColorCount,
  14.   IncrementCount,
  15.   DeltaX1,DeltaY1,DeltaX2,DeltaY2,
  16.   I,Color:            integer;
  17.   Ch: char;
  18.  
  19.  
  20. procedure Check;
  21. var
  22.   Ch: char;
  23. begin
  24.   writeln('This program will only work if you have the color graphics adapter installed');
  25.   write('Continue Y/N ');
  26.   repeat read (Kbd,Ch)  until Upcase(Ch) in ['Y','N'];
  27.   if Upcase(Ch)='N' then Halt;
  28. end;
  29.  
  30.  
  31.  
  32. procedure Init;
  33. begin
  34.   for I:=1 to Memory do
  35.   with Line[I] do
  36.   begin
  37.     LX1:=0; LX2:=0;
  38.     LY1:=0; LY2:=0;
  39.   end;
  40.   X1:=0; Y1:=0; X2:=0; Y2:=0;
  41.   CurrentLine:=1;
  42.   ColorCount:=0;
  43.   IncrementCount:=0;
  44.   Ch:=' ';
  45. end;
  46.  
  47. procedure AdjustX(var X,DeltaX: integer);
  48. var
  49.   TestX: integer;
  50. begin
  51.   TestX:=X+DeltaX;
  52.   if (TestX<1) or (TestX>320) then
  53.   begin
  54.     TestX:=X;
  55.     DeltaX:=-DeltaX;
  56.   end;
  57.   X:=TestX;
  58. end;
  59.  
  60. procedure AdjustY(var Y,DeltaY: integer);
  61. var
  62.   TestY: integer;
  63. begin
  64.   TestY:=Y+DeltaY;
  65.   if (TestY<1) or (TestY>190) then
  66.   begin
  67.     TestY:=Y;
  68.     DeltaY:=-DeltaY;
  69.   end;
  70.   Y:=TestY;
  71. end;
  72.  
  73. procedure SelectNewColor;
  74. begin
  75.   Color:=Random(3)+1;
  76.   ColorCount:=5*(1+Random(10));
  77. end;
  78.  
  79. procedure SelectNewDeltaValues;
  80. begin
  81.   DeltaX1:=Random(7)-3;
  82.   DeltaX2:=Random(7)-3;
  83.   DeltaY1:=Random(7)-3;
  84.   DeltaY2:=Random(7)-3;
  85.   IncrementCount:=4*(1+Random(9));
  86. end;
  87.  
  88.  
  89. procedure SaveCurrentLine;
  90. begin
  91.   with Line[CurrentLine] do
  92.   begin
  93.     LX1:=X1;
  94.     LY1:=Y1;
  95.     LX2:=X2;
  96.     LY2:=Y2;
  97.     LColor:=Color;
  98.   end;
  99. end;
  100.  
  101.  
  102. procedure Regenerate;
  103. var
  104.   I: integer;
  105. begin
  106.   NoSound;
  107.   GraphColorMode; Palette(2);
  108.   for I:=1 to Memory do with Line[I] do Draw(LX1,LY1,LX2,LY2,LColor);
  109.   gotoxy(1,25);
  110.   write('Press any key to continue, ESC to stop');
  111.   read(Kbd,Ch);
  112. end;
  113.  
  114. begin
  115.   Check;
  116.   Init;
  117.   GraphColorMode;
  118.   Palette(2);
  119.   Color:=2;
  120.   gotoxy(1,25);
  121.   write('Press any key to regenerate, ESC to stop');
  122.   repeat
  123.     with Line[CurrentLine] do Draw(LX1,LY1,LX2,LY2,0);
  124.  
  125.     if ColorCount=0 then SelectNewColor;
  126.     if IncrementCount=0 then SelectNewDeltaValues;
  127.  
  128.     AdjustX(X1,DeltaX1); AdjustX(X2,DeltaX2);
  129.     AdjustY(Y1,DeltaY1); AdjustY(Y2,DeltaY2);
  130.  
  131.     Draw(X1,Y1,X2,Y2,Color);
  132.  
  133.     SaveCurrentLine;
  134.  
  135.     CurrentLine:=Succ(CurrentLine);
  136.     if CurrentLine>Memory then CurrentLine:=1;
  137.     ColorCount:=Pred(ColorCount); IncrementCount:=Pred(IncrementCount);
  138.  
  139.     if KeyPressed then
  140.     begin
  141.       read(Kbd,Ch);
  142.       if Ch<>#27 then
  143.       begin
  144.         Regenerate;
  145.         gotoxy(1,25);
  146.         write('Press any key to regenerate, ESC to stop');
  147.       end;
  148.     end;
  149.   until Ch=#27;
  150.   TextMode;
  151. end.
  152.  
  153.