'===========================================================================
' Subject: JOYSTICK LIBRARY                   Date: 08-30-00 (14:48)       
'  Author: Jeremiah Hyde                      Code: QB, QBasic, PDS        
'  Origin: fishoffire@yahoo.com             Packet: KEYBOARD.ABC
'===========================================================================
'PPPPPP
'PP  PP
'PP  PP rr rrr   oooo   ggg gg rr rrr  aaaa   mm  mm    eeee   rr rrr   zzzzzz
'PPPPP   rrr rr oo  oo gg  gg   rrr rr    aa  mmmmmmm  ee  ee   rrr rr  z  zz
'PP      rr  rr oo  oo gg  gg   rr  rr aaaaa  mmmmmmm  eeeeee   rr  rr    zz
'PP      rr     oo  oo  ggggg   rr    aa  aa  mm m mm  ee       rr       zz  z
'PP     rrrr     oooo      gg  rrrr    aaaaa  mm   mm   eeee   rrrr     zzzzzz
'                        ggggg                            (  /\__________/\  )
'                                                          \(^ @___..___@ ^)/
'  ###########                                              /\ (\/\/\/\/) /\
'  # ___ ___ #   RRRRR          lll          !!   !!       /  \(/\/\/\/\)/  \ 
'  { (0) (0) }   RR  RR          ll         !!!! !!!!     (    """"""""""    )
'  |    P    |   RR  RR uu  uu   ll  zzzzzz !!!! !!!!     \      _____      /
'   \ \___/ /    RRRRR  uu  uu   ll  z  zz  !!!! !!!!     (     /(   )\     )
'    \_____/     RR RR  uu  uu   ll    zz    !!   !!      _)   (_V) (V_)   (_
' Jeremiah "BJ"  RR  RR uu  uu   ll   zz  z              (V)(V)(V)   (V)(V)(V)
'     Hyde       RR  RR  uuu uu llll zzzzzz  !!   !!          My dog Smokey,
'                                                            aka Stupid Mutt
'
' This code released under the GNU General Public License. This means you
' can use it, compile it, pass it around, modify it, WHATEVER! However,
' if you do this, I will expect notification and a copy of whatever you've
' done, unless it's a virus, or breaking into the CIA, etc.
'                                                    Jeremiah "BJ" Hyde
'E-Mail me at: fishoffire@yahoo.com                fishoffire Industries:
' Visit me at: www.fishoffire.com                     Your source for
'                                                    EVERYTHING QBasic
'Note:
' This code has been tested on my machines:
'   ASUS TX97x WOA: AMD K6-266, 160MB RAM, 20.5 GB HD, 15" PnP(SVGA+) Monitor,
'       Win98 DOSBox
'   AT&T Globalyst 520: Intel 486 DX 66mhz, 19MB RAM, 14" SVGA Monitor,
'       Win95 DOSBox
'   Compaq Deskpro 4/33i: Intel 386 33mhz, 4MB RAM, 14" SVGA Monitor,
'       MS-DOS 6.22/Win3.11
' and has run correctly under those environments. However, no guarantee,
' warranty, or any other declaration of safety, etc. is offered. If your
' computer system is taken over by smurfs, or the ROM is RAMed, or
' anything else of a detrimental nature happens to your PC as a result
' of this code, I am *not* responsible for it. The full burden of blame
' rests squarely on your shoulders.(Of course, if something GOOD happens to
' your computer as a result of this code, well, obviously, I did it!)
' -------------
' In other words: You're on your own, pal!

' This piece of code is one of the simplest joystick libraries out there.
' Not only does it handle 4 buttons, a rudder, AND a 4-position hat-switch,
' but it is about a bajillion times faster than QB's STRIG and STICK commands.
' At least, on my PCs it is. Anyway, I figure its more useful as a tutorial
' or learning code, than as a finished product to drop into your game.

' BTW: If you want to use this in a commercial program email me
' and we'll talk.

' Okay, enough chatter, time to get to the CODE!!!

DEFINT A-Z      ' Ahh, the holy DEFINT command!

' At last! Clear, fast(?) and simple joystick routines!
DECLARE SUB jsCalibrate ()          ' Yes, I think we know what calibrating
                                    ' is. And yes, you DO have to call it
                                    ' before jsGet%(). However, jsGetRaw% is
                                    ' fine to call whenever.
DECLARE FUNCTION jsGet% (Value%)    ' Hmm...Lemme guess what this does...Well
                                    ' DUHH! It gets values from the joystick!
                                    ' Value%=0 | return buttons as bitfield
                                    '       =1 | return X-coordinate(values
                                    '          | scaled from -100 to 100)
                                    '       =2 | return Y-coordinate(values
                                    '          | scaled from -100 to 100)
                                    '       =3 | return Z-coordinate(values
                                    '          | scaled from -100 to 100)
                                    '       =4 | return hat-switch. 0=center,
                                    '          | 1=up,2=right,3=down,4=left
DECLARE FUNCTION jsGetRaw% (Value%) ' This, obviously, returns the raw data
                                    ' straight from the joystick. Use this if
                                    ' you don't want to calibrate, or you
                                    ' just can't stand my coordinate scheme.

' The joystick port! There should never be any reason to change this.
' At least, I can't think of any. On a different port, all kinds of
' NASTY things could happen(ex: low-level hard-drive formatting).
CONST jsPort = &H201    ' This can be anything from &H200 to &H207. It doesn't
                        ' seem to make any difference.

' The value to send to the port! When you write to the joystick port,
' the lower nybble of data from the port remain set for as many port
' reads as the value of that particular coordinate. So, you read until
' a bit goes dead, and the number of reads is the value of that coordinate.
' This CONST is only here because someday, I might find a stick that
' requires a particular value to read say, its Q-coordinate, or the other
' 16 positions on its hat-switch.
CONST jsInitVal = 0

' These variables are used by jsGet%, to scale the values from the
' joystick to a 100x100 playing area, and to calibrate the hat switch.
' They are all set by jsCalibrate, and could be used in conjungtion(sp?!?!)
' with jsGetRaw% to make your own jsGet%
DIM SHARED jsCenterX%   ' Center X
DIM SHARED jsCenterY%   ' Center Y
DIM SHARED jsCenterZ%   ' Center Rudder

DIM SHARED jsMaxX%      '\
DIM SHARED jsMinX%      ' \
DIM SHARED jsMaxY%      '  \__Limits
DIM SHARED jsMinY%      '  /
DIM SHARED jsMaxZ%      ' /
DIM SHARED jsMinZ%      '/

DIM SHARED jsHatUp%     '\
DIM SHARED jsHatRight%  ' \__Hat switch positions
DIM SHARED jsHatDown%   ' /
DIM SHARED jsHatLeft%   '/

DIM SHARED jsDeadZone%  ' How much the stick can move
                        ' without the program noticing.

' Ahh, the unholy demo. This demo should be deleted within seconds of
' your downloading this file. It was used only for me to ensure I had
' it all right, and displays all the current values from the joystick
CLS
jsCalibrate ' Calibrate the joystick. No NASTY comments about my anti-GUI.
CLS
DO          ' The main loop. Read the values, print 'em, then do it again.
    LOCATE 1, 1
    PRINT "Buttons: ";
        tmpBtn% = jsGet%(0)
        IF tmpBtn% AND 1 THEN PRINT "<A>  ";  ELSE PRINT " A   ";
        IF tmpBtn% AND 2 THEN PRINT "<B>  ";  ELSE PRINT " B   ";
        IF tmpBtn% AND 4 THEN PRINT "<C>  ";  ELSE PRINT " C   ";
        IF tmpBtn% AND 8 THEN PRINT "<D>  ";  ELSE PRINT " D   ";
        PRINT ""
    PRINT "  X-Pos: "; jsGet%(1); "   "
    PRINT "  Y-Pos: "; jsGet%(2); "   "
    PRINT " Rudder: "; jsGet%(3); "   "
    PRINT "  HatSw: "; jsGet%(4)
    ' There should probably be a delay loop here, but
    ' I never had any need for it. Also, if your computer
    ' is slow enough, the read from the joystick will be
    ' more than enough of a drag
LOOP UNTIL INKEY$ = CHR$(27)

SUB jsCalibrate
jsDeadZone% = 6

PRINT "Center joystick, and press <Enter>."
GOSUB Pause
jsCenterX% = jsGetRaw%(1)
jsCenterY% = jsGetRaw%(2)
jsCenterZ% = jsGetRaw%(3)

PRINT "Move joystick all the way to the top-left corner, and press <Enter>"
GOSUB Pause
jsMinX% = jsGetRaw%(1)
jsMinY% = jsGetRaw%(2)

PRINT "Move joystick all the way to the bottom-right corner, and press <Enter>"
GOSUB Pause
jsMaxX% = jsGetRaw%(1)
jsMaxY% = jsGetRaw%(2)

PRINT "Does your joystick have a Z-axis(rudder)? ";
DO: key$ = UCASE$(INKEY$): LOOP UNTIL key$ = "Y" OR key$ = "N"
PRINT key$
IF key$ = "Y" THEN
    PRINT "Move the rudder all the way to the left, and press <Enter>"
    GOSUB Pause
    jsMinZ% = jsGetRaw%(3)
  
    PRINT "Move the rudder all the way to the right, and press <Enter>"
    GOSUB Pause
    jsMaxZ% = jsGetRaw%(3)
END IF

PRINT "Does your joystick have a hat-switch? ";
DO: key$ = UCASE$(INKEY$): LOOP UNTIL key$ = "Y" OR key$ = "N"
PRINT key$
IF key$ = "Y" THEN
    PRINT "Move the hat-switch to the top, and press <Enter>"
    GOSUB Pause
    jsHatUp% = jsGetRaw%(4)
   
    PRINT "Move the hat-switch to the right, and press <Enter>"
    GOSUB Pause
    jsHatRight% = jsGetRaw%(4)
   
    PRINT "Move the hat-switch to the bottom, and press <Enter>"
    GOSUB Pause
    jsHatDown% = jsGetRaw%(4)
   
    PRINT "Move the hat-switch to the left, and press <Enter>"
    GOSUB Pause
    jsHatLeft% = jsGetRaw%(4)
END IF
PRINT "Joystick succesfully calibrated!"

EXIT SUB

Pause:
DO: LOOP UNTIL INKEY$ = ""          ' Clear keyboard
DO: LOOP UNTIL INKEY$ = CHR$(13)    ' Wait for <Enter>
RETURN

END SUB

FUNCTION jsGet% (Value%)
' Return a current joystick value
' Value%=
' ------------------------------------
' 0, return buttons as bitfield
'       <A> = 1, <B> = 2, <C> = 4, <D> = 8
' 1, return current X-position. X is scaled from -100 to 100,
'   to make things easier.
' 2, return current Y-position. Y is scaled from -100 to 100.
' 3, return current Z-position(rudder). Z is scaled from -100 to 100.
' 4, return current hat-switch position. Returns 0=Center, 1=Up, 2=Right,
'   3=Down, 4=Left.

SELECT CASE Value%
    CASE 0  ' Buttons
        jsGet% = jsGetRaw%(0)' Get buttons as bit-field. 1=A, 2=B, 4=C, 8=D
   
    CASE 1  ' X-Position
        X% = jsGetRaw%(1) - jsCenterX%
        IF X% < 0 THEN
            X% = (X% / (jsCenterX% - jsMinX%)) * 100
        ELSE
            X% = (X% / (jsMaxX% - jsCenterX%)) * 100
        END IF
        IF ABS(X%) <= jsDeadZone% THEN X% = 0
        jsGet% = X%
   
    CASE 2  ' Y-Position
        Y% = jsGetRaw%(2) - jsCenterY%
        IF Y% < 0 THEN
            Y% = -(Y% / (jsCenterY% - jsMinY%)) * 100
        ELSE
            Y% = -(Y% / (jsMaxY% - jsCenterY%)) * 100
        END IF
        IF ABS(Y%) <= jsDeadZone% THEN Y% = 0
        jsGet% = Y%
   
    CASE 3  ' Z-Position, rudder
        Z% = jsGetRaw%(3) - jsCenterZ%
        IF Z% < 0 THEN
            Z% = (Z% / (jsCenterZ% - jsMinZ%)) * 100
        ELSE
            Z% = (Z% / (jsMaxZ% - jsCenterZ%)) * 100
        END IF
        IF ABS(Z%) <= jsDeadZone% THEN Z% = 0
        jsGet% = Z%
   
    CASE 4  ' Hat-switch
        tmpHat% = jsGetRaw%(4)
        Hat% = 0
       
        ' IF tmpHat% IS WITHIN 5 OF jsHatUp% THEN Hat% = 1
        ' IF tmpHat% IS . . .
        IF (((tmpHat% + 5) > jsHatUp%) AND ((tmpHat% - 5) < jsHatUp%)) THEN Hat% = 1
        IF (((tmpHat% + 5) > jsHatRight%) AND ((tmpHat% - 5) < jsHatRight%)) THEN Hat% = 2
        IF (((tmpHat% + 5) > jsHatDown%) AND ((tmpHat% - 5) < jsHatDown%)) THEN Hat% = 3
        IF (((tmpHat% + 5) > jsHatLeft%) AND ((tmpHat% - 5) < jsHatLeft%)) THEN Hat% = 4
        jsGet% = Hat%

    CASE ELSE
        ERROR 5
END SELECT
END FUNCTION

FUNCTION jsGetRaw% (Value%)
' Returns the current position of the joystick.
' This is RAW, straight from port &H200.
' Coord%=0, return buttons as a bitfield
' Coord%=1, return X-coord
' Coord%=2, return Y-coord
' Coord%=3, return Z-coord
' Coord%=4, return hat-switch
' Anything else, return -1
SELECT CASE Value%
    CASE 0
        tmp% = INP(jsPort)
        tmp% = ((NOT (tmp% \ 16)) AND 15)
        Coord% = tmp%
    CASE 1
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 1 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 1) = 0
    CASE 2
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 2 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 2) = 0
    CASE 3
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 4 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 4) = 0
    CASE 4
        OUT jsPort, jsInitVal
        DO
            tmp% = INP(jsPort)
            IF tmp% AND 8 THEN Coord% = Coord% + 1
        LOOP UNTIL (tmp% AND 8) = 0
    CASE ELSE
        Coord% = -1
END SELECT
jsGetRaw% = Coord%
END FUNCTION