PROGRAM BOUNCY2;

(* Runs under CP/M v2.2 - Using Turbo Pascal 3 Compile BOUNCY2.PAS as a COM 
   file - Select 'O' for Compiler Options and select 'C' to COM file. Program
   will corrupt TP if Executed in Memory. *)

(* Original XOR Sprite Routine by Sean Mcmanus from ESD Advanced, adapted
   for use in CP/M by Arnoldemu & CP/M User *) 

const myball : array[0..17] of byte =
      ($08,$02,$00,$00,$30,$C0,$73,$EC,$73,$EC,
       $73,$EC,$73,$EC,$30,$C0,$00,$00);
      sprite : array[0..48] of byte =
       ($21,$00,$00,
        $11,$00,$00,
        $CD,$9B,$BE,
        $1D,$BC,
        $E5,
        $11,$00,$00,
        $EB,
        $4E,
        $23,
        $46,
        $23,
        $EB,
        $E1,
        $C5,
        $E5,
        $1A,
        $AE,
        $77,
        $23,
        $13,
        $10,$F9,
        $E1,
        $7C,
        $C6,$08,
        $67,
        $E6,$38,
        $20,$04,
        $01,$50,$C0,
        $09,
        $C1,
        $0D,
        $20,$E6,
        $C9);

(* Routines to setup ball sprite & Sprite Routine *)

var ball : array[0..17] of byte absolute $3FE0;

Procedure MemW(address,data :Integer); { Pokes 16bit Numbers to memory } 
begin
 Inline($E5/
        $D5/
        $ED/$5B/data/
        $2A/address/
        $73/
        $23/
        $72/
        $D1/
        $E1);
end;

Procedure SetupSprite; { Pokes Sprite Machine Code to memory }
var count : byte;
begin
 for count:=0 to 48 do
  begin
   mem[$3000+count]:=sprite[count];
  end;
end;

Procedure DisSprite(xpos,ypos,hh : integer); { Setup for Sprite Position & Display } 
begin
 memw($3001,ypos);
 memw($3004,xpos);
 memw($300D,hh);
 inline($CD/$00/$30);
end;

Procedure mode(mo:byte); { Screen Mode Routine }
 begin
   Inline($3A/mo/
          $CD/$9B/$BE/
          $0E/$BC);
 end;

Procedure TxtCurOff; { Turns off Text Cursor }
 begin
   Inline($CD/$9B/$BE/
          $84/$BB);
 end;

Procedure TxtCurOn; { Turns on Text Cursor }
 begin
   Inline($CD/$9B/$BE
          $81/$BB);
 end;

Procedure Draw(Xpos, Ypos : Integer); { Firmware Draw Absolute }
 begin
   Inline($2A/ypos/
          $ED/$5B/xpos/
          $CD/$9B/$BE/
          $F6/$BB);
 end;

Procedure Move(Xpos, Ypos : Integer); { Firmware Move absolute }
 begin
   Inline($2A/ypos/
          $ED/$5B/xpos/
          $CD/$9B/$BE/
          $C0/$BB);
 end;

Procedure resetcolor;  { Reset to Locomotive BASIC Colours } 
 begin
   Inline($CD/$9B/$BE/
          $02/$BC);
 end;

Procedure grapen(col:byte);  { Sets the Graphics Pen }
 begin
   Inline($3A/col/
          $CD/$9B/$BE/
          $DE/$BB);
 end;

Procedure Scr4000;  { Routine to shift 17k Screen to 4000h }
begin
 Inline($3E/$40/
        $CD/$9B/$BE/
        $08/$BC);
end;

Procedure ScrC000;  { Routine to shift 17k Screen to C000h }
begin
 Inline($3E/$C0/
        $CD/$9B/$BE/
        $08/$BC);
end;

Procedure Frame; { Wait Flyback - used to smooth Sprite Movement }
 begin
  Inline($CD/$9B/$BE/
          $19/$BD); 
 end;

Procedure SetupBall; { Moves Ball Sprite to known area in memory }
var count : byte;
begin
 for count:=0 to 17 do
  begin
   ball[count]:=myball[count];
  end;
end;

Procedure DrawBox; { Sets up a Graphic Box on Screen }
 Begin
 Grapen(2);
 Move(200,300);
 Draw(470,300);
 Draw(470,100);
 Draw(200,100);
 Draw(200,300);
 End;

Var Xpos, Xdir, Ypos, Ydir : integer;
    Width, Length : integer;

begin { Main Routine }
 SetupSprite;
 Setupball;
 ResetColor;
 Scr4000;
 Mode(1);
 DrawBox;
 Xpos:=150;
 Ypos:=100;
 Xdir:=1;
 Ydir:=-1;
 Repeat
  TxtCuroff;
  Xpos:=Xpos+Xdir;
  Ypos:=Ypos+Ydir;
  DisSprite(Xpos,Ypos,$3FE0); { XOR Sprite Routine }
  frame; { Removing frames will speed up this program } 
  frame; 
  frame; { Likewise Increasing them will slow routine down }
  DisSprite(Xpos,Ypos,$3FE0); { This removes sprite from that position }
 Case Xpos of
  230 : Xdir:=-1;
  101 : Xdir:=1;
 end;
 Case Ypos of
  149 : Ydir:=-1;
  58 : Ydir:=1;
 end;
  TxtCuroff;
 Until Keypressed;
  TxtCurOn;
  ScrC000;
  Mode(2);
End.