Program for use joystick in pascal

{ JOYSTICK.PAS                                                      }
{ Unit v ktorom je vsetko co potrebujete pre pracu s joystickom.    }
{                                                                   }
{ Datum:03.08.1997                             http://www.trsek.com }
 
unit joystick;
 
interface
 
procedure ReadJoyA( var XAxis,YAxis : word );   { kde sa nachadza A }
procedure ReadJoyB( var XAxis,YAxis : word );	{ kde sa nachadza B }
function ButtonA1 : boolean;                    { stlacene tlacitko 1 }
function ButtonA2 : boolean;                    { stlacene tlacitko 2 }
function ButtonB1 : boolean;                    { stlacene tlacitko 3 }
function ButtonB2 : boolean;			{ stlacene tlacitko 4 }
function JoystickPressent : boolean;		{ Existuje joystick }
 
implementation
 
uses Dos;
 
type ReadJoyProc = procedure ( a,b : byte; var c,d:word );
     ButtonFunc = function ( a:byte ):boolean;
 
var ReadJoy : ReadJoyProc;
    Button : ButtonFunc;
    Reg : Registers;
 
function NewBIOS : boolean;
var DecadeChar : char absolute $f000:$fffb;
    YearChar : char absolute $f000:$fffc;
begin
 { an optimistic view of software life }
 NewBIOS:=(DecadeChar in ['9','0']) or ((DecadeChar='8') and (YearChar in ['4'..'9']));
end;
 
{$F+}
 
procedure OldReadJoy( xbit,ybit:byte; var XAxis,YAxis:word );
begin
 inline(
  $ba/$01/$02/		{ mov dx,201h		;load dx with joystick port adress }
  $c4/$be/>XAxis/	{ les di,XAxis[bp]	;load es with segment and di w/offset }
  $8a/$66/<xbit/	{ mov ah,xbit[bp]	;set appropriate bit in ah }
  $e8/$0c/$00/		{ call SUBR }
  $c4/$be/>YAxis/       { les di,YAxis[bp] }
  $8a/$66/<ybit/	{ mov ah,ybit[bp]	;set appropriate bit in ah }
  $e8/$02/$00/		{ call SUBR }
  $eb/$1d/		{ jump short END	;we're don }
  			{ SUBR:			;first wait, if necessary, until }
                        {			;relevant bit is 0: }
  $b9/$ff/$ff/		{ mov cx,0ffffh		;fill cx to the brim }
  $ec/			{ WAIT: in al,dx	;get input from port 201h }
  $84/$e0/		{ test al,ah		;is the relevant bit 0 yet? }
  $e0/$fb/		{ loopne WAIT		;if not, go back to wait }
  $b9/$ff/$ff/		{ mov cx,0ffffh		;fill cx to the brim again }
  $fa/			{ cli			;disable interrupts }
  $ee/			{ out dx,al		;nudge port 201h }
  $ec/			{ AGAIN: in al,dx	;get input from port 201h }
  $84/$e0/		{ test al,ah		;is the relevant bit 0 yet? }
  $e0/$fb/		{ loopne again		;if not, go back to AGAIN }
  $fb/			{ sti			;reenable interrupts }
  $f7/$d9/		{ neg cx		;negative cx }
  $81/$c1/$ff/$ff/	{ add cx,0ffffh		;add offffh back value in cx }
  $26/			{ es:			;segment override }
  $89/$0d/		{ mov [di],cx		;store value of cx in location }
  			{			;of relevant variable }
  $c3);			{ ret }
end;	{ OldReadJoy }
 
procedure NewReadJoy ( which, meaningless:byte; var XAxis,YAxis:word );
begin
 Reg.ah:=$84;
 Reg.dx:=1;
 intr($15,Reg);
 if (which=1) then begin
   XAxis:=Reg.ax;
   YAxis:=Reg.bx;
  end
  else begin
   XAxis:=Reg.cx;
   YAxis:=Reg.dx;
  end;
end;
 
function OldButton (mask:byte) : boolean;
begin
 OldButton:=((port[$201] and mask)=0);
end;
 
function NewButton(mask:byte) : boolean;
begin
 Reg.ah:=$84;
 Reg.dx:=0;
 intr($15,reg);
 NewButton:=((Reg.al and mask)=0);
end;
 
{$F-}
 
procedure ReadJoyA( var XAxis,YAxis:word );
begin
 ReadJoy(1,2,XAxis,YAxis);
end;
 
procedure ReadJoyB( var XAxis,YAxis:word );
begin
 ReadJoy(4,8,XAxis,YAxis);
end;
 
function ButtonA1 : boolean;
begin
 ButtonA1:=button($10);
end;
 
function ButtonA2 : boolean;
begin
 ButtonA2:=button($20);
end;
 
function ButtonB1 : boolean;
begin
 ButtonB1:=button($40);
end;
 
function ButtonB2 : boolean;
begin
 ButtonB2:=button($80);
end;
 
function JoystickPressent : boolean;
begin
 intr($11,Reg);
 JoystickPressent:=((Reg.ax and $1000) <> 0);
end;
 
begin
 if NewBIOS then begin		{ pouzi novu rutinu pre BIOS }
    ReadJoy:=NewReadJoy;
    Button:=NewButton;
   end
   else begin			{ inac stara rutina }
    ReadJoy:=OldReadJoy;
    Button:=OldButton;
   end;
end.