'===========================================================================
' Subject: GRAPHICAL MOUSE CURSORS DEMO       Date: 03-08-96 (00:13)       
'  Author: Brian Roche                        Code: QB, PDS, VBDOS         
'  Origin: FidoNet QUIK_BAS Echo            Packet: MOUSE.ABC
'===========================================================================
'
'           M e e s e s  .  B a s      from B. Roche
'
'              Demonstrates Graphical Mouse Cursors
'             Translated over from VBDOS Program
'     Make sure to enter Environment with /L for Interrupt Support

'   Currently set up to run *AS IS* in QB ..REM/UNREM the appropriate
'                   spots to use Far Strings ..

'    Multiple Versions of some Cursors are given because some look
'          Better on White BG, some better on Black BG


DECLARE FUNCTION HaveMouse% ()      ' Checks to See if Driver Installed
DECLARE SUB PrintR (A$, X%, Y%, StepX%, StepY%, CO%, BackGround%, Shadow%)
        ' Prints Text in Graphics Mode 12
DECLARE SUB ChangeCursor (A$)       ' Changes Graphics Mouse Cursor
DECLARE SUB Mouse (M0, M1, M2, M3)  ' Mouse Driver
DECLARE SUB MouseShow ()            ' Displays Mouse Cursor
DECLARE SUB MouseHide ()            ' Hides Mouse Cursor


 ' $INCLUDE: 'QB.BI'         ' Use for QB45 (Keep at least One REM here!)
 REM '$INCLUDE: 'VBDOS.BI'
 ' Use 'VBDOS.BI' for VBDOS, 'QBX.BI' for PDS

DIM Regs AS RegType          ' Interrupt needed for Regular Mouse Routines,
                             ' QB also uses Interrupt for Mouse
                             ' Cursor Routines
REM 'DIM RegsX AS RegTypeX   ' InterruptX needed for PDS/VBDOS
                             ' Far Strings, but both Interrupt calls
                             ' Still needed for QBX/VBDOS


ON ERROR GOTO NOVGA:         ' Make sure we've got VGA ..
 SCREEN 12
ON ERROR GOTO 0

  ' Now Blank the Monitor while Drawing the Screen ..
  OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% OR &H20
  LINE (0, 0)-(640, 480), 7, BF     ' Use a White backGround
  LINE (320, 20)-(600, 305), 0, BF  ' Black "Window" to also check Cursors

 ' Yeah, I know using DATA statements is not an example of
 ' Programming Virtuosity, but this is just Demo code ...
 FOR I% = 1 TO 14
  READ Prompt$
  Prompt$ = CHR$(I% + 64) + ") " + Prompt$
  PrintR Prompt$, 25, I% * 20 + 5, 8, 0, 15, 7, 1
 NEXT

 Prompt$ = "Q) Quit program."
 PrintR Prompt$, 25, 305, 8, 0, 15, 7, 1

 Prompt$ = "Press the Letter of the Cursor you want, or <Q> to Quit."
 PrintR Prompt$, 45, 400, 8, 0, 11, 7, 1
 Prompt$ = ""


  ' Now that the screen is Drawn, Turn the Screen back on..
  OUT &H3C4, 1: CMR% = INP(&H3C5): OUT &H3C5, CMR% AND &HDF

  ' And Check for the Rodent ...
 IF HaveMouse% THEN               ' Check For Mouse Driver
   Mouse 0, 0, 0, 0               ' Initialize Mouse
   MouseShow                      ' Show Mouse Cursor
 ELSE
   SCREEN 0
   LOCATE 15, 28: PRINT "You need a Mouse for a Mouse Cursor Program, Silly!"
   WHILE INKEY$ = "": WEND
   SYSTEM
 END IF


 ' Now Run a Loop, Checking Input, and Change the Mouse Cursor accordingly ..
  DO
    DO: A$ = INKEY$: LOOP UNTIL LEN(A$)
    A$ = UCASE$(A$)
    IF A$ = "Q" THEN
      MouseHide
      SCREEN 0, , 0, 0: SYSTEM
    END IF
    IF A$ >= "A" AND A$ <= "N" THEN ChangeCursor A$
  LOOP


NOVGA:    ' VGA Error Trap
  SCREEN 0, , 0, 0
  LOCATE 15, 25: PRINT "You Must have a VGA to run this program"
  SYSTEM


' Menu Data ...
DATA "Bulls Eye Cursor #1","Bulls Eye Cursor #2"
DATA "Hour Glass Cursor #1","Hour Glass Cursor #2"
DATA "Hour Glass Cursor #3", "Hour Glass Cursor #4"
DATA "Hour Glass Cursor #5","Stop Watch Cursor"
DATA "Smiley Face Cursor", "Smiley Face Cursor #2"
DATA "Cross Hair Cursor", "Cross Hair Cursor #2"
DATA "Pointing Hand Cursor","Pointing Hand Cursor #2"


'---------------- Start of Mouse Cursor Data ----------------
BullsEye1:
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HFFFF,&H8001,&H8001,&H8001,&H8FF1,&H8811,&H8811,&H8811
DATA &H8811,&H8811,&H8811,&H8FF1,&H8001,&H8001,&H8001,&HFFFF
DATA 7,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
BullsEye2:
DATA &H0,&H0,&H0,&H0,&HFF0,&HFF0,&HFF0,&HFF0
DATA &HFF0,&HFF0,&HFF0,&HFF0,&H0,&H0,&H0,&H0
DATA &H0,&H7FFE,&H7FFE,&H6006,&H6006,&H6006,&H6006,&H6006
DATA &H6006,&H6006,&H6006,&H6006,&H6006,&H7FFE,&H7FFE,&H0
DATA 7,8
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
HourGlass1:
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HFFFF,&H2004,&H2004,&H2004,&H1008,&H990,&H420,&H240
DATA &H240,&H420,&H810,&H1008,&H2084,&H2144,&H22A4,&HFFFF
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
HourGlass2:
DATA &H0,&HDFFB,&HDFFB,&HDFFB,&HEFF7,&HF66F,&HFBDF,&HFDBF
DATA &HFDBF,&HFBDF,&HF7EF,&HEFF7,&HDF7B,&HDE3B,&HDC1B,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
HourGlass3:
DATA &H0,&HC003,&HC003,&HC003,&HE007,&HF00F,&HF81F,&HFC3F
DATA &HFC3F,&HF81F,&HF00F,&HE007,&HC003,&HC003,&HC003,&H0
DATA &H400,&H1FF8,&H1FF8,&H1FF8,&HC30,&H660,&H3C0,&H180
DATA &H180,&H3C0,&H7E0,&HFF0,&H1E78,&H1C38,&H1818,&H0
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
HourGlass4:
DATA &H0,&H8001,&H8001,&H8001,&HA185,&HB00D,&HB81D,&HBC3D
DATA &HBC3D,&HB81D,&HB00D,&HA005,&H8181,&H83C1,&H87E1,&H0
DATA &H0,&H1FF8,&H1FF8,&H1FF8,&HC30,&H660,&H3C0,&H180
DATA &H180,&H3C0,&H7E0,&HFF0,&H1E78,&H1DB8,&H1FF8,&H0
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
StopWatch:
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &H3000,&H63E0,&HDC18,&H1004,&H2002,&H2602,&H4301,&H4181
DATA &H40C1,&H4081,&H4081,&H2082,&H2082,&H1004,&HC18,&H3E0
DATA 1 ,1
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
Smiley1:
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HE70,&H1FE8,&H3C3C,&H381C,&H6006,&H8422,&H8421,&H8001
DATA &H8181,&H9011,&H4822,&H43C2,&H2004,&H100C,&H399C,&H700E
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
Smiley2:
DATA &HE70,&H1FE8,&H3C3C,&H381C,&H6006,&H8422,&H8421,&H8421
DATA &H8001,&H9191,&H4812,&H4422,&H23C4,&H1008,&H399C,&H700E
DATA &HF18F,&HE017,&HC3C3,&HC7E3,&H9FF9,&H7BDD,&H7BDE,&H7BDE
DATA &H7FFE,&H6E6E,&HB7ED,&HBBDD,&HDC3B,&HEFF7,&HC663,&H8FF1
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
CrossHair1:
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF,&HFFFF
DATA &H100,&H100,&H100,&H100,&H100,&H100,&H100,&H100
DATA &HFFFE,&H100,&H100,&H100,&H100,&H100,&H100,&H100
DATA 7 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
CrossHair2:
DATA &HFFFF,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&H1
DATA &H101,&H1,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F,&HFC7F
DATA &H0,&H0,&H100,&H100,&H100,&H100,&H100,&H0
DATA &H7C7C,&H0,&H100,&H100,&H100,&H100,&H100,&H0
DATA 7 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
Hand1:
DATA &HF3FF,&HEDFF,&HEDFF,&HEC7F,&HED8F,&HEDB1,&HEDB6,&H8DB6
DATA &H6DB6,&H6FFE,&H6FFE,&H7FFE,&H7FFE,&H7FFE,&HBFFD,&HC003
DATA &HC00,&H1200,&H1200,&H1380,&H1270,&H124E,&H1249,&H7249
DATA &H9249,&H9001,&H9001,&H8001,&H8001,&H8001,&H4002,&H3FFC
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

'---------------- Start of Mouse Cursor Data ----------------
Hand2:
DATA &HF3FF,&HE1FF,&HE1FF,&HE07F,&HE00F,&HE001,&HE000,&H8000
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H8001,&HC003
DATA &H0,&HC00,&HC00,&HC00,&HD80,&HDB0,&HDB6,&HDB6
DATA &H6DB6,&H6FFE,&H6FFE,&H7FFE,&H7FFE,&H7FFE,&H3FFC,&H0
DATA 5 ,0
'------------------ End of Mouse Cursor Data ------------------

SUB ChangeCursor (A$)
  DIM Regs AS RegType          ' Use for QB45 Near Strings
  REM DIM Regs as RegTypeX     ' Use for QBX/VBDOS Far Strings

  ' Assigns Custom Cursor Shape Depending on String Passed.
  ' Use RegType in QB; need ES Register for PDS/VBDOS Far String support.

  SELECT CASE A$
  CASE "A"
     RESTORE BullsEye1:
  CASE "B"
     RESTORE BullsEye2:
  CASE "C"
     RESTORE HourGlass1:
  CASE "D"
     RESTORE HourGlass2:
  CASE "E"
     RESTORE HourGlass3:
  CASE "F"
     RESTORE HourGlass4:
  CASE "G"
     RESTORE HourGlass4:
  CASE "H"
     RESTORE StopWatch:
  CASE "I"
     RESTORE Smiley1:
  CASE "J"
     RESTORE Smiley2:
  CASE "K"
     RESTORE CrossHair1:
  CASE "L"
     RESTORE CrossHair2:
  CASE "M"
     RESTORE Hand1:
  CASE "N"
     RESTORE Hand2:
  CASE "Q:"
     SCREEN 0, , 0, 0
     CLS : SYSTEM
  CASE ELSE
     EXIT SUB
  END SELECT

  '====================================================================
  ' Below is the part you're most interested in. I read it in as a
  ' String * 1 (BYTE) .. 16 Bytes for the Cursor Mask, 16 Bytes for
  ' the Screen Mask, and the last two Integers the location of the Cursor
  ' Hot Spot - the Point actually referenced in Mouse Coordinates.

  ' Read in Graphical Mouse Cursor Data
  FOR I% = 1 TO 32
    READ Wrd%
    MMsk$ = MMsk$ + MKI$(Wrd%)         ' Cursor Graphical Data
  NEXT I%
  READ Hotx, Hoty                      ' Cursor HotSpot

  ' Now For the Interrupt call ..
  ' Use Function 9 from Int 33 ..
  Regs.ax = 9: Regs.bx = Hotx: Regs.cx = Hoty
  Regs.dx = SADD(MMsk$)   ' Use with ALL Basics ..

  ' Next Line not needed for QB, (Optional for PDS ??), needed for VBDOS
  ' But using it stores Data as a Far String.
  REM Regs.es = SSEG(MMsk$)  ' Need InterruptX for this One ..

  INTERRUPT &H33, Regs, Regs        ' Call QB45 Near string Interrupt
  REM INTERRUPTX &H33, Regs,Regs    ' Call VBDOS/PDS Far String Interrupt
END SUB

FUNCTION HaveMouse%
  ' Checks to see if Mouse is Installed
  DEF SEG = 0
  MouseSegment& = 256& * PEEK(207) + PEEK(206)
  MouseOffset& = 256& * PEEK(205) + PEEK(204)

  DEF SEG = MouseSegment&
  IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THEN
    HaveMouse% = 0
  ELSE
    HaveMouse% = 1
  END IF
  DEF SEG
END FUNCTION

SUB Mouse (M0, M1, M2, M3) STATIC
  ' Note: VBDOS will move the "STATIC" in front of this SUB Name.
  ' If you then go back into QB, you'll have to manually put the "STATIC"
  ' back at the end of the Sub Declaration, or generate an Error.

  ' M0 = 0 : Initialize the Rodent
  '      1 - Show Mouse
  '      2 - Hide Mouse
  '      3 - Mouse Location/Button Status

  DIM Regs AS RegType           ' Use for ALL Basic's ..
  ' Calls interrupt &H33 to invoke mouse functions in the MS Mouse Driver.

  Regs.ax = M0: Regs.bx = M1: Regs.cx = M2: Regs.dx = M3
  INTERRUPT &H33, Regs, Regs              ' Use for ALL Basic's ..
  M0 = Regs.ax: M1 = Regs.bx: M2 = Regs.cx: M3 = Regs.dx
END SUB

SUB MouseHide                   ' Hides Mouse cursor
  Mouse 2, 0, 0, 0
END SUB

SUB MouseShow                   ' Shows mouse Cursor
  Mouse 1, 0, 0, 0
END SUB

SUB PrintR (A$, X%, Y%, StepX%, StepY%, CO%, BackGround%, Shadow%)
  ' Prints Graphical Chars from Rom Data Table
  ' A$ Param is string to print
  ' X%=Graphics Horz pixel Position
  ' Y%=Graphics Vert pixel Position
  ' StepX% and StepY% control size of chars
  ' CO%= Foreground color
  ' BackGround%= BackGround Color
  ' Shadow% is a Boolean for Shadow enabling

  ExtX% = StepX%: ExtY% = StepY%
  DEF SEG = &HFFA6        ' ROM Segment for Character Shape Tables
  FOR I% = 1 TO LEN(A$)
    Addr% = 8 * ASC(MID$(A$, I%)) + 14     'Address character shape table
    IF BackGround% THEN                    'Color background
    IF BackGround% = 256 THEN BG% = FALSE ELSE BG% = BackGround%
    IF I% = LEN(A$) THEN ExtX% = FALSE: ExtY% = FALSE
    LINE (X%, Y%)-(X% + 7 + ExtX%, Y% + 7 + ExtY%), BG%, BF
    END IF
    FOR J% = 0 TO 7
    Mask% = PEEK(Addr% + J%) * 128
    IF Shadow% THEN
    LINE (X% + 9, Y% + J% + 2)-(X% + 2, Y% + J% + 2), 0, , Mask%
    END IF
   LINE (X% + 7, Y% + J%)-(X%, Y% + J%), CO%, , Mask%
  NEXT
  X% = X% + ExtX%
  Y% = Y% + ExtY%
  NEXT
  DEF SEG                 'Back to DGROUP
END SUB