#

Joystick

Driver TSR per joystick analogici
 
{$M 1024,0,0}
{$S-}

program joystick;
{ Driver per joystick analogico }

uses Dos;

{ Procedura di stampa delle stringhe senza utilizzo delle
  funzioni di libreria che comporterebbero l'installazione
  residente della system unit }


procedure writestr(s : string);  assembler;
asm
  push  ds
  lds   si, s
  cld
  lodsb
  xor   ah, ah
  xchg  cx, ax
  mov   ah, 40h
  mov   bx, 0001
  mov   dx, si
  int   21h
  pop   ds
end;

{ Procedura principale di lettura che restituisce il
  counter del bit specificato }


function read_stick(n : word) : word;  assembler;
asm
  xor  bx, bx
  mov  cx, n
  mov  dx, 0201h
  out  dx, al
@@loop:
  in   al, dx
  test al, cl
  jz   @@quit
  inc  bx
  jnz  @@loop

@@quit:
  mov ax, bx
end;

procedure wait_stick(n : word);  assembler;
asm
  mov  cx, n
  mov  dx, 0201h
@@loop:
  in   al, dx
  test al, cl
  jnz  @@loop
end;

{ Restituisce in AX e BX le coordinate X e Y; in CX lo stato dei pulsanti }

procedure read_joy(var a,b,c : word);
begin
if (a and 1) = 0 then begin
  a := read_stick(1);
  if a <> 0 then begin
    c := (port[$0201] and $30) shr 4;
    wait_stick(2);
    b := read_stick(2);
    end;
  end
else begin
  a := read_stick(4);
  if a <> 0 then begin
    c := (port[$0201] and $C0) shr 6;
    wait_stick(8);
    b := read_stick(8);
    end;
  end;
end;

procedure banner(var a,b,c : word);
var st : word;
begin
writestr(#13#10'CASASOFT High Resolution Joystick Driver V. 0.03'#13#10);
writestr('(c) 1992 Roberto Ceccarelli - All rights reserved'#13#10#10);

writestr('   Joystick A : ');
a := 0;
read_joy(a,b,c);
if a = 0 then begin
  st := 0;
  writestr('Not Installed'#13#10);
  end
else begin
  st := 1;
  writestr('Ready'#13#10);
  end;

writestr('   Joystick B : ');
a := 1;
read_joy(a,b,c);
if a = 0 then writestr('Not Installed'#13#10)
else begin
  st := st + 2;
  writestr('Ready'#13#10);
  end;

a := $0003;
b := $cd01;
c := st;
writestr(#10);
end;

{$F+}
procedure NewIntF1(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
interrupt;

begin
case ax and $ff00 of
   0 : banner(ax,bx,cx);
   $100 : read_joy(ax,bx,cx);
   end;
end;

procedure End_Resident;
begin
end;
{$F-}

var size,a,b,c : word;

procedure dohelp;
begin
halt(0);
end;

begin
banner(a,b,c);
if (paramstr(1) = '/?') then dohelp;
writestr('Warning: this is a alpha test release!'#13#10);
setintvec($F1,addr(newIntF1));
writestr('Installed with interrupt 0xF1'#13#10#10);

{ Rilascia Environment }

asm
  mov ax, PrefixSeg
  mov es, ax
  mov bx, es:[002ch]
  mov es, bx
  mov ah, 49h
  int 21h
end;

{ Installa Residente }

size := succ(ofs(End_Resident) div 16) + 16;
asm
  mov ax, 3100h
  mov dx, size
  int 21h
end;

end.
Inizio pagina
Home page
 
Creative Commons  License BY-NC-SA
Ove non diversamente specificato i contenuti del sito sono rilasciati con licenza Creative Commons BY-NC-SA 4.0 

Copyright © 2007-2020 The Strawberry Field - Roberto Ceccarelli