Program GBA;
{$R-,S-,M 60000,0,30000
  Para probar comunicacion a la GBA
  Escrito por JM Da Silva.
  Empezado Oct 2004

}


Uses CRT,DOS;
Var tituloactual:string;
Var mensaje,caracter:string;
Var x,i:integer;
Var contador:integer;
var Old1Cint,Oldlptint:Procedure;               { Linkage To Old 1C Interrupt   }
var eqbar:array[0..10] of byte;
var xd,ACC:byte;
var lcdram:array[0..80] of char;


Type
    song=Record
    artista,titulo,album,estilo:string;
end;
Var cancion:song;



FUNCTION GetCharC( X,Y :WORD; VAR Attrib:BYTE ) :CHAR;
VAR
   Ofs :WORD;
BEGIN
                        { NOTE: Change the Segment from $B800 }                        {       to $B000 for MonoChrome.      }
  Ofs := ((Y-1) * 160) + ((X SHL 1) - 1);
  Attrib := MEM[$B800:Ofs];
  GetCharC := CHR( MEM[$B800:Ofs-1] );
END;

Function ReadCharThingy(x, y : Word) : Word; Assembler;
  Asm
   dec   x
   dec   y

   mov   ax,y
   mov   cl,5
   shl   ax,cl
   mov   si,ax
   mov   cl,2
   shl   ax,cl
   add   si,ax
   shl   x,1
   add   si,x
   mov   ax,0b800h
   push  ds
   mov   ds,ax
   lodsw
   pop   ds
 End;

FUNCTION GetChar( X,Y :WORD) :CHAR;
var b:byte;
  begin
    getchar := getcharc(x,y,b);
{    getchar := chr(readcharthingy(x,y));}
  end;



Procedure Cancion_actual;
Var
x,y,p:integer;
text:string;
Begin
     y:=4;
     text:='';
     for x:=34 to 79 do
     begin
         text:=text+GetChar(x,y);
     end;
     p:=Pos(' - ',text);
     if (p=0) then p:=length(text) div 2;
     cancion.artista:=copy(text,1,p)+'*******';
     cancion.titulo:=copy(text,p+3,length(text)-(p+3))+'*********';
{
     y:=5;
     text:='';
     for x:=34 to 79 do
         text:=text+GetChar(x,y);
     p:=Pos('[',text);

     if (p>0) then cancion.album:=copy(text,1,p);
     if (p>length(cancion.album)) then cancion.estilo:=copy(text,p+1,length(text)-1);}


End;


Procedure eqbars;
  var
     pp,max,bar,alto:byte;
begin
     max:=20;
     for bar:=1 to max do
         eqbar[bar]:=0;
     for bar:=0 to max do
     begin
         for alto:=15 downto 1 do
         begin
             if (GetChar(bar,alto)<>chr(186)){ and (eqbar[bar]=0)} then
             begin
                pp:=((bar mod 2))*15+1;
                eqbar[bar div 2]:=eqbar[bar div 2]+(15-alto)*pp;
                alto:=1;
             end;
         end;
     end;
end;


Procedure enviar_byte(dato:integer);
 Var lpt:word;
 Var x,i,retardo:integer;

Begin

     lpt:=$378;
     {encender clock}
     Port[lpt+2]:=Port[lpt+2] and $FE;
     {WriteLn(Chr(dato));}
     i:=128;
     for x:=7 downto 0 do
     begin

          {apagar clock}
          Port[lpt+2]:=Port[lpt+2] or $01;
          {enviar bit MSB primero}
          if (dato and i)=0 then
             Port[lpt+2]:=Port[lpt+2] or $02
          else
             Port[lpt+2]:=Port[lpt+2] and $FD;
          i:=i div 2;

          {delay(1);}
          for retardo:=1 to 350 do {350}

          {encender clock}
          Port[lpt+2]:=Port[lpt+2] and $FE;
          {delay(1);}
          for retardo:=1 to 150 do

     end;

End;



Procedure espectrum;
Var x:integer;
Begin
    eqbars;
    enviar_byte(9); {tama¤o}
    enviar_byte(10); {comando}
    for x:=1 to 8 do
    begin
        enviar_byte(eqbar[x]);
    end;
end;

Procedure datocancion;
Var x:integer;
var dat:byte;
Begin


    enviar_byte(15);
    enviar_byte(20);
    for x:=1 to 14 do
    begin
        dat:=Ord(cancion.artista[x]);
        if (dat<32) then dat:=49;
        enviar_byte(dat);
    end;

    enviar_byte(15);
    enviar_byte(21);
    for x:=1 to 14 do
    begin
        dat:=Ord(cancion.titulo[x]);
        if (dat<32) then dat:=49;
        enviar_byte(dat);
    end;
End;



Procedure lptint;Interrupt;
Var
x:integer;
Begin

 Port[$378+2]:=Port[$378+2] xor $01;
 {
 lcdram[ACC]:=Chr(Port[$378]);
 ACC:=ACC+1;

 Port[$378+2]:=Port[$378+2] or $10;
 }
 Port[$20]:=$20;

{ Inline($9C);                             { Pushf - Push Flags           }
{ Oldlptint;                                { Link Old 1C Procedure        }
End;



Procedure refresco;Interrupt;
Var
P,P2:byte;
begin





      if ACC>1 then
      Begin
        gotoxy(1,30);
        for p:=1 to ACC do
         write(lcdram[p]);
        ACC:=0;
      End;


{
     P:=Port[$378];
     P2:=Port[$378+2];
     if ((P2 and $01)=$01) then
     begin
        gotoxy(xd,30);
        write(Chr(Port[$378]));
        xd:=xd+1;
        if xd>70 then xd:=1;
     end;

    espectrum;
    contador:=contador+1;
    if (contador>17) then
    begin
        contador:=0;
        Cancion_actual;
        if (not (tituloactual=cancion.titulo)) then datocancion;
        tituloactual:=cancion.titulo;
     end;
 }
 Inline($9C);                             { Pushf - Push Flags           }
 Old1Cint;                                { Link Old 1C Procedure        }

end;

Procedure refresco2;
begin

    espectrum;
    contador:=contador+1;
    if (contador>6) then
    begin
        contador:=0;
        Cancion_actual;
        if (not (tituloactual=cancion.titulo)) then datocancion;
        tituloactual:=cancion.titulo;
     end;

end;



BEGIN

  Contador:=0;
  xd:=1;
  ACC:=0;

  Port[$378+2]:=Port[$378+2] or $10;
  Port[$21]:=Port[$21] and $7F;

{  espectrum;}

{
CLRSCR;
for x:=1 to 5 do
writeln('ESTO ES UNA PRUEBA DE LA CANCION duncan dhu        - Ella y el');

  Cancion_actual;
  datocancion;
  writeln(cancion.titulo);
  writeln(cancion.artista);

  REPEAT
        refresco2;
  UNTIL KEYPRESSED;
}
  Getintvec($0F ,@Oldlptint);
  Setintvec($0F ,@lptint);
{
  Getintvec($1C ,@Old1Cint);
  Setintvec($1C ,@refresco);

  Keep(0);                     { Terminate And Stay Resident - Tsr   }



END.