home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / JOYSTICK.ZIP / JOYSTICK.PAS
Encoding:
Pascal/Delphi Source File  |  1986-03-18  |  3.5 KB  |  104 lines
  1. PROGRAM JOYSTICK;
  2.  
  3.  
  4. (*
  5. WRITTEN BY JAMES P. MCADAMS - 25 DECEMBER 1984
  6.  
  7. PROGRAM DEMONSTRATING THE USE OF TURBO PASCAL TO ACCESS THE
  8. IBM-PC GAME CONTROL ADAPTER. THE TWO FUNCTION CALLS ARE EACH
  9. COMPLETE IN ITSELF. EITHER ONE OR BOTH CAN BE MOVED TO ANY
  10. PROGRAM THAT NEEDS THE USE OF JOYSTICKS OR PADDLES.
  11. *)
  12.  
  13.  
  14.  
  15. VAR
  16. I: INTEGER;
  17. TEMP: BYTE;
  18.  
  19.  
  20.    FUNCTION BUTTON_PRESSED (WHICH_ONE: CHAR): BOOLEAN;
  21.    (* RETURN TRUE IF THE BUTTON IS PRESSED *)
  22.    CONST
  23.       JOYPORT = $201; (* LOCATION OF THE GAME PORT *)
  24.    VAR
  25.       MASK: BYTE;
  26.    BEGIN
  27.    IF NOT (WHICH_ONE IN ['A'..'D']) THEN WHICH_ONE := 'A';
  28.    CASE WHICH_ONE OF
  29.       'A': MASK := 16;
  30.       'B': MASK := 32;
  31.       'C': MASK := 64;
  32.       'D': MASK := 128;
  33.       END;
  34.    BUTTON_PRESSED := (PORT [JOYPORT] AND MASK) = 0;
  35.    END; (* BUTTON_PRESSED *)
  36.  
  37.  
  38.    FUNCTION JOYSTICK_POS (WHICH_ONE: CHAR): INTEGER;
  39.    (*
  40.    WITH A KRAFT JOYSTICK, VALUES RETURNED ARE IN THE RANGE 4 TO ABOUT
  41.    140. IF YOUR MACHINE RUNS FASTER THAN A STANDARD IBM-PC OR IF YOU
  42.    MODIFY YOUR GAME ADAPTER CARD WITH BIGGER CAPACITORS, YOU WILL
  43.    GET LARGER COUNTS AND YOU MUST MODIFY "MAXCOUNT".
  44.  
  45.    CALLING A JOYSTICK THAT IS NOT IN USE OR ONE THAT HAS GONE
  46.    OVER-RANGE (COUNT REACHED MAXCOUNT) YIELDS A VALUE OF 0.
  47.    *)
  48.    CONST
  49.       MAXCOUNT =  200; (* MODIFY THIS IF YOU CAN GET LONGER COUNTS     *)
  50.       JOYPORT  = $201; (* FOR INFORMATION ONLY: LOC OF GAME INPUT PORT *)
  51.    VAR
  52.       COUNTER: INTEGER;
  53.       MASK: BYTE;
  54.    BEGIN
  55.    IF NOT (WHICH_ONE IN ['A'..'D']) THEN WHICH_ONE := 'A';
  56.    CASE WHICH_ONE OF
  57.       'A': MASK := 1;
  58.       'B': MASK := 2;
  59.       'C': MASK := 4;
  60.       'D': MASK := 8;
  61.       END;
  62.    (*
  63.    THIS ASSEMBLY CODE CAUSES THE CX REGISTER TO COUNT DOWN FROM "MAXCOUNT"
  64.    TOWARD ZERO. WHEN CX REACHES ZERO OR WHEN THE ONE-SHOT ON THE GAME
  65.    ADAPTER TIMES OUT, THE LOOPING STOPS AND "COUNTER" IS ASSIGNED THE NUMBER
  66.    OF COUNTS THAT TOOK PLACE. MAXCOUNT SHOULD BE CHOSEN SO THAT CX NEVER
  67.    REACHES 0 SO THAT THE USABLE RANGE OF THE JOYSTICK WILL NOT BE LIMITED.
  68.    *)
  69.    INLINE (
  70.       $B9/MAXCOUNT/       (*       MOV CX,MAXCOUNT INITIALIZE DOWN-COUNTER *)
  71.       $BA/JOYPORT/        (*       MOV DX,JOYPORT  PORT ADDR OF JOYSTICKS  *)
  72.       $8A/$A6/MASK/       (*       MOV AH,MASK[BP] MASK FOR DESIRED 1-SHOT *)
  73.       $EE/                (*       OUT DX,AL       START THE ONE-SHOTS     *)
  74.       $EC/                (* READ: IN  AL,DX       READ THE ONESHOTS       *)
  75.       $84/$C4/            (*      TEST AL,AH       CHECK DESIRED ONE-SHOT  *)
  76.       $E0/$FB/            (*    LOOPNZ READ        REPEAT UNTIL TIMED OUT  *)
  77.       $89/$8E/COUNTER);   (*       MOV COUNTER[BP],CX  THIS MAKES CX AVAIL-*)
  78.                           (*                           ABLE TO TURBO       *)
  79.    IF COUNTER = 0
  80.       THEN JOYSTICK_POS := 0 (* OVER-RANGE OR NOT IN USE *)
  81.       ELSE JOYSTICK_POS := MAXCOUNT - COUNTER;
  82.    END; (* JOYSTICK_POS *)
  83.  
  84.  
  85. BEGIN    (***** DEMO PROGRAM - MAIN CODE *****)
  86. CLRSCR;
  87. GOTOXY (1, 2);
  88. WRITELN ('JOYSTICKS':10, 'BUTTONS':10);
  89. WRITE   ('A':5, 'B':5, 'A':5, 'B':5);
  90.  
  91. WHILE TRUE DO (* PRESS CTRL C TO STOP THE PROGRAM *)
  92.    BEGIN
  93.    GOTOXY (1, 5);
  94.    WRITE (JOYSTICK_POS ('A'):5, JOYSTICK_POS ('B'):5);
  95.    IF BUTTON_PRESSED ('A')
  96.       THEN WRITE ('PRES':5)
  97.       ELSE WRITE ('UP':5);
  98.    IF BUTTON_PRESSED ('B')
  99.       THEN WRITE ('PRES':5)
  100.       ELSE WRITE ('UP':5);
  101.    END;
  102. END.
  103.  
  104.