home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISPEED1.LZH / GRAFDEMO / BOUNCER.PAS next >
Pascal/Delphi Source File  |  1991-07-02  |  4KB  |  171 lines
  1. Program Bouncer;
  2.  
  3. Uses EasyGraf;
  4.  
  5. { Filename: Bouncer.pas       }
  6. { Coder   : Jacob V. Pedersen }
  7. { Coded   : 4-8-1990          }
  8. { Purpose : Example           }
  9.  
  10. { The mouse is not shown if you enter .TOS in the OPTIONS/Linker dialog }
  11.  
  12. { Runtime commands are:
  13.  
  14.         [+] Increaces the size of the tail.
  15.         [-] Decreaces the size of the tail.
  16.         [C] Clears the screen.
  17.         [F] Freezes the program.
  18.         [ ] Set cleanup of tail to On/Off               }
  19.  
  20. Const
  21.         AbsMax  = 200;                      { Max. number of lines. }
  22. Var
  23.         Brain   : Array[1..AbsMax, 1..4] OF Integer;
  24.         Maxs,
  25.         Coors   : Array[1..4] OF Integer;
  26.         Direcs  : Array[1..4] OF Boolean;
  27.         Cur_Max : Integer;                  { Current max. lines. }
  28.         Drawn   : Integer;                  { Number of drawn lines. }
  29.         CleanUp : Boolean;
  30.  
  31.  
  32.  
  33. Procedure DelargeTail;
  34. Begin
  35.   If (Cur_Max > 1) AND (CleanUp) THEN
  36.     Begin
  37.       LineColor(0);
  38.       Line(Brain[1,1],Brain[1,2],Brain[1,3],Brain[1,4]);
  39.       Dec(Drawn);
  40.       Dec(Cur_Max);
  41.       Move(Brain[2],Brain[1],8*Drawn);
  42.     End;
  43. End; { DelargeTail }
  44.  
  45.  
  46. Procedure EnlargeTail;
  47. Begin
  48.   If (Cur_Max < AbsMax) THEN
  49.     Inc(Cur_Max);
  50. End; { EnlargeTail }
  51.  
  52.  
  53. Procedure CheckTail;
  54. Begin
  55.   If (Drawn > Cur_Max) THEN
  56.     Begin
  57.       If (CleanUp) THEN
  58.         Begin
  59.           LineColor(0);
  60.           Line(Brain[1,1],Brain[1,2],Brain[1,3],Brain[1,4]);
  61.           Move(Brain[2],Brain[1],8*Cur_Max);
  62.         End;
  63.       Dec(Drawn);
  64.     End;
  65. End; { CheckTail }
  66.  
  67.  
  68. Procedure CalculateCoors;
  69. Var
  70.         X : Byte;
  71.  
  72. Function CheckMax : Boolean;
  73. Begin
  74.   If (Coors[x] = Maxs[x]) and (Direcs[x]) then
  75.    Begin
  76.      Direcs[x] := False;
  77.      CheckMax := True;
  78.    End
  79.  ELSE
  80.    CheckMax := False;
  81. End; { CheckMax }
  82.  
  83.  
  84. Procedure MakeMin;
  85. Begin
  86.   If (Coors[x] = 0) and Not Direcs[x] then
  87.     Direcs[x] := True;
  88. End; { MakeMin }
  89.  
  90.  
  91. Procedure Adjust;
  92. Begin
  93.   If (X = 1) then
  94.     Begin
  95.       If (Direcs[x]) then
  96.         Begin If (Odd(Coors[2])) then Inc(Coors[1]); End
  97.       ELSE
  98.         Dec(Coors[x]);
  99.     End
  100.   ELSE
  101.     If (Direcs[x]) then Inc(Coors[x]) else Dec(Coors[x]);
  102. End; { Adjust }
  103.  
  104. Begin
  105.   For X := 1 to 4 DO
  106.     Begin
  107.       If (CheckMax) then
  108.       ELSE
  109.         MakeMin;
  110.       Adjust;
  111.     End;
  112. End; { CalculateCoors }
  113.  
  114.  
  115. Procedure StartValues;
  116. Var X : Byte;
  117. Begin
  118.   Maxs[1] := MaxX;
  119.   Maxs[2] := MaxY;
  120.   Maxs[3] := maxX;
  121.   Maxs[4] := MaxY;
  122.   For X := 1 to 4 DO
  123.     Begin
  124.       Coors[x] := Random(Maxs[x]);
  125.       Direcs[x] := Odd(Random(20));
  126.     End;
  127.   Drawn   := 0;
  128.   Cur_Max := 1;
  129.   CleanUp := TRUE;
  130. End; { StartValues }
  131.  
  132.  
  133. Procedure Lets_Bounce;
  134. Var
  135.         Dummy : Char;
  136.  Begin
  137.   StartValues;
  138.   Repeat
  139.     CalculateCoors;
  140.     LineColor(Random(MaxColor+1));
  141.     Line(Coors[1],Coors[2],Coors[3],Coors[4]);
  142.     Inc(Drawn);
  143.     CheckTail;
  144.     If (KeyPressed) THEN
  145.       Repeat
  146.         CASE UpCase(ReadKey) OF
  147.           '+' : EnlargeTail;
  148.           '-' : DelargeTail;
  149.           ' ' : Begin
  150.                   If (CleanUp = False) THEN
  151.                     ClearDevice;
  152.                   CleanUp := NOT(CleanUp);
  153.                 End;
  154.           'C' : ClearDevice;
  155.           'F' : Dummy := ReadKey;
  156.           ELSE Exit;
  157.         END;
  158.       Until (Not(KeyPressed));
  159.     Move( Coors, Brain[Drawn], 8 );
  160.   Until False;
  161. End; { Lets_Bounce }
  162.  
  163.  
  164. BEGIN { main }
  165.   Randomize;
  166.   InitGraphics;
  167.   ClearDevice;
  168.   Lets_Bounce;
  169.   DeInitGraphics
  170. END.
  171.