[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    (*
      From: Christian Ramsvik
      Subj: bounce    v1.0
    Origin: Hatlane Point #9 (2:211/10.9)

    HI!  Got a bouncing procedure a while ago.  It bounces a ball, and you can
    increase speed in X- and Y-axis by pressing the arrow keys.  I'm sure you can
    extract what you need from this one:

      From: John Howard  jh
      Subj: bounce    v1.1
    Origin: Synergy (1:280/66)
    Upgraded to vary the ball size with / and *.  Compass directions use keypad in
    numlock mode or UIOJKNM, keys.  The speed can be changed in each direction.
    The gravity effect can vary with + and - keys.  Status report dialog box when
    either space or 0 key pressed.  Press 0 again will stop all motion.  Press
    keypad_5 will halt display and requires pressing ESCape key to continue.  A
    period will reset the ball to default size.
    *)

    program Bounce;
    uses Crt, Graph;
    {-$DEFINE solid}
    {-$DEFINE bubble}
    { jh
    const
         MinBalls = 1;
         MaxBalls = 2;
    }
    type
        TImage = record
                   XPos,                   {x}       {horizontal position}
                   YPos    : Integer;      {y}       {vertical position}
                   XSpeed,                 {dx}      {actually a velocity}
                   YSpeed  : Integer;      {dy}      {actually a velocity}
                   XAccel,                 {ddx}     {jh unused acceleration}
                   YAccel  : Integer;      {ddy}     {jh unused acceleration}

                   Radius  : Byte;         {Ball}
                 end;

    var
       Ch     : Char;
       Gd, Gm : Integer;
       Image  : {array [MinBalls..MaxBalls] of} TImage;   {jh}
       FullSpeed,                                         {jh}
       HalfSpeed : Integer;           { = FullSpeed div 2}
       {BallNumber : byte;}                               {jh}

    { ******************* DRAW IMAGE ********************* }
    procedure DrawImage;
    begin
       SetColor( White );
    {$IFDEF solid}
       SetFillStyle( SolidFill, White );
    {$ELSE}
       SetFillStyle( HatchFill, White );
    {$ENDIF}

       with Image do
       begin
    {$IFDEF bubble}
          Circle( XPos, YPos, Radius );              {jh Soap bubble}
    {$ELSE}
          PieSlice( XPos, YPos, 0, 360, Radius );    {jh Pattern ball}
    {$ENDIF}
       end;
    end;

    { ******************* REMOVE IMAGE ******************** }
    procedure RemoveImage;
    begin
       SetColor( Black );
    {$IFDEF solid}
       SetFillStyle( SolidFill, Black );
    {$ELSE}
       SetFillStyle( HatchFill, Black );
    {$ENDIF}

       with Image do
       begin
    {$IFDEF bubble}
          Circle( XPos, YPos, Radius );              {jh Soap bubble}
    {$ELSE}
          PieSlice( XPos, YPos, 0, 360, Radius );    {jh Pattern ball}
    {$ENDIF}
       end;
    end;

    { ******************* UPDATE SPEED ******************** }
    procedure UpdateSpeed;

             function IntToStr(I: Longint): String;
             { convert any integer to a string }
             var  S: string[11];
             begin
               Str(I,S);
               IntToStr := S;
             end;
    begin
       while KeyPressed do
       begin
         Ch := ReadKey;
         Ch := Upcase(Ch);
         case Ch of  { Change speed with keypad numbers }
    {jh Note: Keypad_5 causes a halt until escape key pressed}

             '.': Image.Radius := 16;                   {Default}
             '/': Image.Radius := Image.Radius shr 1;   {Reduce}
             '*': Image.Radius := Image.Radius shl 1;   {Enlarge}
             '+': begin
                    Inc(FullSpeed);
                    HalfSpeed := FullSpeed div 2;
                  end;
             '-': begin
                    Dec(FullSpeed);
                    HalfSpeed := FullSpeed div 2;
                  end;
             '8','I': Dec( Image.YSpeed, FullSpeed );   {N upwards}
             '2','M': Inc( Image.YSpeed, FullSpeed );   {S downwards}
             '4','J': Dec( Image.XSpeed, FullSpeed );   {W leftwards}
             '6','K': Inc( Image.XSpeed, FullSpeed );   {E rightwards}
             '0',' ': begin                             {Report statistics}
                        SetColor( White );
                        SetFillStyle( SolidFill, White );
                        Rectangle(8,8,8+160,8+56);                      {box}
                        SetViewPort(8,8,8+160,8+56, ClipOff);           {dialog}
                        OutTextXY(2,2, '<ENTER> resumes');
                        OutTextXY(2,2+8,  'x = ' + IntToStr(Image.XPos));
                        OutTextXY(2,2+16, 'y = ' + IntToStr(Image.YPos));
                        OutTextXY(2,2+24, 'dx = '+ IntToStr(Image.XSpeed));
                        OutTextXY(2,2+32, 'dy = '+ IntToStr(Image.YSpeed));
                        OutTextXY(2,2+40, 'Full Speed = '+ IntToStr(FullSpeed));

                        Ch := ReadKey;                 {repeat until keypressed}
                        ClearViewPort;
                        SetViewPort(0,0,GetMaxX,GetMaxY, ClipOn);       {window}
                        Rectangle(0,0,GetMaxX,GetMaxY);                 {border}
                        if (Ch = '0') then              {Stop motion}
                         begin
                           Image.XSpeed := 0;
                           Image.YSpeed := 0;
                         end;
                      end;
             '7','U': begin                      {NW}
                        Dec(Image.XSpeed, HalfSpeed);
                        Dec(Image.YSpeed, HalfSpeed);
                      end;
             '9','O': begin                      {NE}
                        Inc(Image.XSpeed, HalfSpeed);
                        Dec(Image.YSpeed, HalfSpeed);
                      end;
             '1','N': begin                      {SW}
                        Dec(Image.XSpeed, HalfSpeed);
                        Inc(Image.YSpeed, HalfSpeed);
                      end;
             '3',',': begin                      {SE}
                        Inc(Image.XSpeed, HalfSpeed);
                        Inc(Image.YSpeed, HalfSpeed);
                      end;

         end;  {case}
       end;
       Inc( Image.YSpeed, HalfSpeed );  { Gravitation }  {jh Just so it can vary}
    end;

    { ****************** UPDATE POSITIONS ****************** }
    procedure UpdatePositions;
    begin
       Inc( Image.XPos, Image.XSpeed );
       Inc( Image.YPos, Image.YSpeed );
    end;

    { ****************** CHECK COLLISION ******************* }
    procedure CheckCollision;
    begin
       with Image do
       begin
          if ( XPos - Radius ) <= 0 then  { Hit left wall }
             begin
             XPos   := Radius +1;
             XSpeed := -Trunc( XSpeed *0.9 );
             end;

          if ( XPos + Radius ) >= GetMaxX then { Hit right wall }
             begin
             XPos   := GetMaxX -Radius -1;
             XSpeed := -Trunc( XSpeed *0.9 );
             end;

          if ( YPos -Radius ) <= 0 then  { Hit roof }
             begin
             YPos   := Radius +1;
             YSpeed := -Trunc( YSpeed *0.9 );
             end;

          if ( YPos +Radius ) >= GetMaxY then { Hit floor }
             begin
             YPos   := GetMaxY -Radius -1;
             YSpeed := -Trunc( YSpeed *0.9 );
             end;
       end;
    end;

    { ********************* PROGRAM ************************ }

    BEGIN
       FullSpeed := 10;
       HalfSpeed := FullSpeed div 2;
       with Image do
       begin
          XPos   := 30;
          YPos   := 30;
          XSpeed := FullSpeed;
          YSpeed :=  0;
          XAccel :=  0;             {jh unused}
          YAccel := 10;             {jh unused}

          Radius := 16;             {arbitrary}
       end;

       Gd := Detect;
       InitGraph( Gd, Gm, '');            {BGI drivers in Current Work Dir (CWD)}
       Gd := GraphResult;
       if (Gd <> grOK) then
         begin
           Gd := Detect;
           InitGraph( Gd, Gm, '\TURBO\TP\');     {BGI drivers in default directory}
         end;
       Rectangle( 0, 0, GetMaxX, GetMaxY );                 {border}
       SetViewPort( 0, 0, GetMaxX, GetMaxY, ClipOn );       {window}

       repeat
          DrawImage;
          Delay( 30 );    {milliseconds Frame delay}
          RemoveImage;

          UpdateSpeed;
          UpdatePositions;
          CheckCollision;
       until Ch = Chr( 27 );

       CloseGraph;
    END.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]