DOSBox видео FAQ - быстрая настройка

{
   Адоптация кода из SWAG
   Автор модуля : http://www.trsek.com  03.08.1997
   Адаптация    : >Quiet Snow< 2024г.
   Внешний вид джойстика  :  PlayStation 1 
   Тип джойстика в DOSBox :  4Axis
 
   Ремаппинг в DOSBox( ремаппинг делается через CTRL+F1 ):
     Axis 1/2
     1  : L1
     2  : L2
     Y- : вверх
     Y+ : вниз
     X- : налево
     X+ : напарво
 
     Axis 3/4
     3  : R1
     4  : R2
     Y- : Треугольник   (китайск:Y)
     Y+ : Крест         (китайск:A)
     X- : Квадрат       (китайск:X)
     X+ : Круг          (китайск:B)
}
USES DOS, CRT, JOYSTICK;
Var
 
 JoyLf,  JoyRg  : Boolean;
 JoyUp,  JoyDn  : Boolean;
 JoyLf2, JoyRg2 : Boolean;
 JoyUp2, JoyDn2 : Boolean;
 JoyL1, JoyL2, JoyR1, JoyR2: Boolean;
 
 Procedure GetJoyALL;
 Var
  XA, YA : WORD;
  XB, YB : WORD;
 Begin
   ReadJoyA(XA, YA);
   ReadJoyB(XB, YB);
 
  IF XA < 64 THEN BEGIN; JoyLf := True; END ELSE BEGIN JoyLf := False; END;
  IF XA > 191 THEN BEGIN; JoyRg := True; END ELSE BEGIN JoyRg := False; END;
  IF YA < 64 THEN BEGIN; JoyUp := True; END ELSE BEGIN JoyUp := False; END;
  IF YA > 191 THEN BEGIN; JoyDn := True; END ELSE BEGIN JoyDn := False; END;
 
  IF XB < 64 THEN BEGIN; JoyLf2 := True; END ELSE BEGIN JoyLf2 := False; END;
  IF XB > 191 THEN BEGIN; JoyRg2 := True; END ELSE BEGIN JoyRg2 := False; END;
  IF YB < 64 THEN BEGIN; JoyUp2 := True; END ELSE BEGIN JoyUp2 := False; END;
  IF YB > 191 THEN BEGIN; JoyDn2 := True; END ELSE BEGIN JoyDn2 := False; END;
  JoyL1 :=  ButtonA1;
  JoyL2 :=  ButtonA2;
  JoyR1 :=  ButtonB1;
  JoyR2 :=  ButtonB2;
 End;
 
BEGIN
 
 CLRSCR;
 
 REPEAT
 
   GetJoyALL;
 
   GOTOXY(5, 2);  WRITE ('     L1  :', JoyL1:5);
   GOTOXY(5, 3);  WRITE ('     L2  :', JoyL2:5);
   GOTOXY(5, 4);  WRITE ('     R1  :', JoyR1:5);
   GOTOXY(5, 5);  WRITE ('     R2  :', JoyR2:5);
 
   GOTOXY(5, 7);  WRITE ('      L  :', JoyLf:5);
   GOTOXY(5, 8);  WRITE ('      R  :', JoyRg:5);
   GOTOXY(5, 9);  WRITE ('      U  :', JoyUp:5);
   GOTOXY(5, 10); WRITE ('      D  :', JoyDn:5);
 
   GOTOXY(5, 12); WRITE ('Triangle :', JoyUp2:5);
   GOTOXY(5, 13); WRITE ('   Cross :', JoyDn2:5);
   GOTOXY(5, 14); WRITE ('  Square :', JoyLf2:5);
   GOTOXY(5, 15); WRITE ('    Ring :', JoyRg2:5);
 
 UNTIL KeyPressed;
END.

{ 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.