PROGRAM BOUNCY2;

(* Corre bajo CP/M v2.2 - Compilar BOUNCY2.PAS a archivo COM usando Turbo
   Pascal 3 - Selecciona 'O' para 'compiler Options' y selecciona 'C'
   para archivo COM. El programa corrompera TP si se corre en Memoria. *)

(* Rutina Original de Sprite XOR por Sean Mcmanus desde ESD Advanced,
   adaptado para usar en CP/M por Arnoldemu y 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);

(* Rutinas que establecen el sprite de la bola y la rutina Sprite *)

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

Procedure MemW(address,data :Integer); { Pokea numeros de 16bit en memoria } 
begin
 Inline($E5/
        $D5/
        $ED/$5B/data/
        $2A/address/
        $73/
        $23/
        $72/
        $D1/
        $E1);
end;

Procedure SetupSprite; { Pokea Codigo Maquina Sprite en memoria }
var count : byte;
begin
 for count:=0 to 48 do
  begin
   mem[$3000+count]:=sprite[count];
  end;
end;

Procedure DisSprite(xpos,ypos,hh : integer); { Posiciona Sprite y lo Muestra } 
begin
 memw($3001,ypos);
 memw($3004,xpos);
 memw($300D,hh);
 inline($CD/$00/$30);
end;

Procedure mode(mo:byte); { Rutina Modo de Pantalla }
 begin
   Inline($3A/mo/
          $CD/$9B/$BE/
          $0E/$BC);
 end;

Procedure TxtCurOff; { Desactiva el Cursor }
 begin
   Inline($CD/$9B/$BE/
          $84/$BB);
 end;

Procedure TxtCurOn; { Activa el Cursor de Texto}
 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;  { Resetea a Colores de Locomotive BASIC } 
 begin
   Inline($CD/$9B/$BE/
          $02/$BC);
 end;

Procedure grapen(col:byte);  { Establece la Pluma de Graficos }
 begin
   Inline($3A/col/
          $CD/$9B/$BE/
          $DE/$BB);
 end;

Procedure Scr4000;  { Rutina que cambia la pantalla 17k a 4000h }
begin
 Inline($3E/$40/
        $CD/$9B/$BE/
        $08/$BC);
end;

Procedure ScrC000;  { Rutina que cambia la pantalla 17k a C000h }
begin
 Inline($3E/$C0/
        $CD/$9B/$BE/
        $08/$BC);
end;

Procedure Frame; { Wait Flyback - suaviza el movimiento del Sprite }
 begin
  Inline($CD/$9B/$BE/
          $19/$BD); 
 end;

Procedure SetupBall; { Mueve Sprite Bola a area conocida de memoria }
var count : byte;
begin
 for count:=0 to 17 do
  begin
   ball[count]:=myball[count];
  end;
end;

Procedure DrawBox; { Establece una Caja Grafica en Pantalla }
 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); { Rutina XOR Sprite }
  frame; { Eliminar frames para acelerar el programa } 
  frame; 
  frame; { o aumentarlas para ralentizar la rutina }
  DisSprite(Xpos,Ypos,$3FE0); { Elimina el sprite de esa posicion }
 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.