'===========================================================================
' Subject: GRAPHICAL MOUSE GRID              Date: Unknown Date           
' Author:  Unknown Author(s)                 Code: QB, PDS, VB            
' Origin:  FidoNet QUIK_BAS Echo           Packet: MOUSE.ABC
'===========================================================================
'
'                            G r i d  .  B a s
'           VBDOS/PDS/QB Code to Demonstrate Code Interaction
'                          with Mouse Clicks
'  
'               Program Quits on press of the <ESC> Key.

' NOTE: Make sure to Load in the Default Quick Library using "/L"
' when running this code...

' |========================================================================|
' | Note:  This  code  was  actually written  under VBDOS. While _all_ of  |
' | the  Interrupt Calls  would have worked under QB with just INTERRUPT,  |
' | _some_ of the Calls wouldn't have worked in VBDOS (or PDS Far Strings) |
' | without INTERRUPTX.  I Figured just  sticking to one type of Interrupt |
' | Call (IntX),  would  be easiest,  least confusing,  and most portable. |
' |========================================================================|

' Define the Constants used for Button Clicks..
  CONST Raised% = 0: CONST Depressed% = NOT Raised%

' =============================| Functions |==============================
' Draws a ScreenFull of Square Grids
  DECLARE FUNCTION DrawGrid% ()

' Runs all the Routines in this Module
  DECLARE FUNCTION RunGridDemo% ()

' Checks for Existance (sp) of Mouse Driver
  DECLARE FUNCTION HaveMouse% ()

' ============================| SubRoutines |=============================
' Generic Mouse Driver
  DECLARE SUB Mouse (M0, M1, M2, M3)
'
' Displays Mouse Cursor
  DECLARE SUB MouseShow ()
'
' Hides Mouse Cursor
  DECLARE SUB MouseHide ()

' Draws a Graphical Mouse Cursor
  DECLARE SUB MouseCursor ()

' Polls for KeyPress or MouseClick
  DECLARE SUB GetEvents ()

' Draws Individual Grid Elements
  DECLARE SUB DrawButton (XPos%, YPos%, State)

' Draws Depressed/Released Button
  DECLARE SUB ClickButton (M2, M3, M1)

' ============================| Variables |=============================
' Define the type needed for INTERUPTX call..
  TYPE RegTypeX
  ax    AS INTEGER
  bx    AS INTEGER
  cx    AS INTEGER
  Dx    AS INTEGER
  bp    AS INTEGER
  si    AS INTEGER
  di    AS INTEGER
  flags AS INTEGER
  ds    AS INTEGER
  es    AS INTEGER
  END TYPE

' DIM the Interrupt TYPE ..
  DIM SHARED Regs AS RegTypeX
 
' Define the Grid Data as Shared
  DIM SHARED GridRows%, GridCols%, GridLength%, GridHeight%
  DIM SHARED RowOffset%, GridEndX%, ColOffset%, GridEndY%

' Define Grid Error Handler Return Variable as Shared
  DIM SHARED Abort%
  
' ===================| Module Level Demo Code |=====================
  ' Set Up the Size of The Grid, before We Start the Routine..
  ' Start with your Original Configuration - an 8*8 box,
  ' in a 48*48 Grid ...
    GridRows% = 48: GridCols% = 48
    GridLength% = 8: GridHeight% = 8

  ' Call the Main Routine
    Success% = RunGridDemo%

 ' Or UNREM the lines below to try - looks like a SpreadSheet, and
 ' even though it runs off the Screen, you can still depress
 ' the buttons ...
   ' GridRows% = 6: GridCols% = 6
   ' GridLength% = 135: GridHeight% = 30
   ' Success% = RunGridDemo%

    SCREEN 0, , 0, 0: SYSTEM

' =================| Module Level Error Handler |==================
ErrorHandler:
   SCREEN 0, , 0, 0   ' Back to Text Mode ...

   SELECT CASE ERR
   CASE 5           ' "Illegal Function Call" - Bad Screen Mode ?
    ErrMsg$ = "You Must have a VGA to run this program"
   CASE 6        ' OverFlow - Probable Too Large a Grid Square for Mem.
    ErrMsg$ = "Your Individual Grid Size is too Large for Memory."
   CASE 32766    ' Grid won't fit On Screen
    ErrMsg$ = "Grid Dimension(s) will not fit On Screen."
   CASE 32767    ' No Mouse Present
    ErrMsg$ = "There is no Mouse Present to run this Demo."
   CASE ELSE
     ErrMsg$ = "Unknown Error."
   END SELECT

   L% = LEN(ErrMsg$)           ' Get Length of Error Message
   LOCATE 15, (80 - L%) \ 2: PRINT ErrMsg$  ' Center the Message
   LOCATE 17, 31: PRINT "Aborting Program."

   Abort% = -1                 ' Set ABORT Flag
   RESUME NEXT                 ' Return to Calling Routine


' ========================| Mouse Cursor Data |============================
  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

SUB ClickButton (M2, M3, M1)
   ' Computes Button Top and Left withing Grid, then
   ' Automatically Calls the DrawBox Routine with the correct
   ' (Raised or Depressed) Parameter
   ' M2 - X Location of Mouse Click, returned from Mouse Call
   ' M3 - Y Location of Mouse Click, returned from Mouse Call
   ' M1 - Whether Mouse Button is Depressed : returned from Mouse Call

    XOffsetIntoGrid% = M2 - RowOffset% - 1 ' Incremental Distance from
    YOffsetIntoGrid% = M3 - ColOffset% - 1 ' the Top/Left Edges of Grid

    XGrid% = XOffsetIntoGrid% \ GridLength%  ' Compute Which Individual
    YGrid% = YOffsetIntoGrid% \ GridHeight%   ' Grid Unit was Clicked
    
    XLocation% = (XGrid% * GridLength%) + RowOffset%  ' Left Edge of Button
    YLocation% = (YGrid% * GridHeight%) + ColOffset%  ' Top Edge of Button

    MouseHide                               ' Hide Mouse
    DrawButton XLocation%, YLocation%, M1   ' Draw the Button
    MouseShow                               ' Show the Mouse

END SUB

SUB DrawButton (XPos%, YPos%, State)
    ' Draws an Individual Button in the Grid,
    ' in either the Raised, or Derpressed, Condition
    ' Parameters: XPos% : Pixel Pos of Left Edge of Box
    '             YPos% : Pixel Pos of Top Edge of Box
    '             State : Either Raised, or Depressed

    IF State THEN           ' Just Switch the "Foreground"
      Fg% = 8: Bg% = 15     ' and "BackGround" Colors (shading)
    ELSE                    ' to simulate either a Raised or
      Fg% = 15: Bg% = 8     ' a Depressed State
    END IF

   ' Now Draw the Individual Button
    LINE (XPos%, YPos%)-(XPos% + GridLength% - 1, YPos% + GridHeight% - 1), 7, BF
    LINE (XPos%, YPos% + GridHeight% - 1)-(XPos%, YPos%), Fg%
    LINE -(XPos% + GridLength% - 1, YPos%), Fg%
    LINE -(XPos% + GridLength% - 1, YPos% + GridHeight% - 1), Bg%
    LINE -(XPos% + 1, YPos% + GridHeight% - 1), Bg%

END SUB

FUNCTION DrawGrid%
  ' Draws a Screen Full of Grids dependent on Variables Assigned
  ' at the Module Level.
  '          -=  Shared variables used are as Follows: =-
  ' GridRows% : Number of Grids along the Horizontal Plane
  ' GridCols% : Number of Grids along Vertical Plane
  ' GridLength% : Length of Grid in Current Screen Size
  ' GridHeight: Height of Individual Grid in Current Screen Size..
  
  ' Compute where to Center the Grid on the Horizontal ...
    RowBytes% = GridRows% * GridLength%     ' Pixels in each Row
    RowOffset% = (640 - RowBytes%) \ 2  ' Left Edge of Grid
    GridEndX% = RowOffset% + (GridRows% * GridLength%)

  ' Compute Where to Center the Grid on the Vertical ...
    ColBytes% = GridCols% * GridHeight%      ' Pixels in each Column
    ColOffset% = (480 - ColBytes%) \ 2  ' Top Edge of Grid
    GridEndY% = ColOffset% + (GridCols% * GridHeight%)

  ' Check to see if Grid will _reasonably_ fit OnScreen..
  ' (Don't want an entire Grid off screem , but Clipping is OK..
    ON ERROR GOTO ErrorHandler:
    IF RowOffset% < -GridLength% OR ColOffset% < -GridHeight% THEN
      ERROR 32766
      EXIT FUNCTION
    END IF
     IF Abort% THEN DrawGrid% = 0: EXIT FUNCTION

  ' Draw a Simple BackDrop for Our Grids ...
    LINE (RowOffset% - (GridLength% \ 2), ColOffset% - (GridHeight% \ 2))-(GridEndX% + (GridLength% \ 2), GridEndY% + (GridHeight% \ 2)), 7, BF
  
  ' And Run a Loop, Drawing the Boxes OnScreen
    FOR YAxis% = 0 TO GridCols% - 1
      FOR XAxis% = 0 TO GridRows% - 1
        XDatum% = RowOffset% + (XAxis% * GridLength%)
        YDatum% = ColOffset% + (YAxis% * GridHeight%)
        DrawButton XDatum%, YDatum%, Raised%
      NEXT XAxis%
    NEXT YAxis%

END FUNCTION

SUB GetEvents
   ' Loops constantly, polling for either a Mouse Click,
   ' or Aborts on an <ESC> KeyPress.

  DO
   ' Check for Mouse Click Event
     M0 = 3: M1 = 0: M2 = 0: M3 = 0          ' Initialize Ax  Reg only ...
     Mouse M0, M1, M2, M3     ' Call Mouse Interrupt

   ' We don't care which button was Clicked, so just see if
   ' the Bx Register (the Value returned in the "M1" Variable)
   ' has a value other than "0".
    IF M1 THEN          ' Yep, Button was Clicked - is it in our Grid ?
      IF M2 >= RowOffset% AND M2 <= GridEndX% THEN    ' In Horz Grid ?
        IF M3 >= ColOffset% AND M3 <= GridEndY% THEN  ' In Vert Grid
          X1 = M2: Y1 = M3
          ClickButton X1, Y1, M1               ' Yep - Hilight Button
           DO
             M0 = 3: M1 = 0: M2 = 0: M3 = 0    ' Loop until Released
             Mouse M0, M1, M2, M3              ' Call Mouse Interrupt
           LOOP UNTIL M1 = 0
           ClickButton X1, Y1, M1
        END IF
       END IF
    END IF
  
  ' And Check for an <ESC> Key KeyPress...
    a$ = INKEY$
    IF a$ = CHR$(27) THEN Quit% = -1

  LOOP UNTIL Quit%

  
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)
  ' Calls interrupt &H33 to invoke Mouse Functions in the MS Mouse Driver.

  Regs.ax = M0: Regs.bx = M1: Regs.cx = M2: Regs.Dx = M3
  CALL INTERRUPT(&H33, Regs, Regs)
  M0 = Regs.ax: M1 = Regs.bx: M2 = Regs.cx: M3 = Regs.Dx

END SUB

SUB MouseCursor
  ' Reads in DATA for Mouse Cursor, Draws Mouse Cursor
  ' Using INT&H33 / 9

  ' Read in Graphical Mouse Cursor Data
    FOR i% = 1 TO 32                     ' Run a Loop thru the DATA
      READ Wrd%                          ' Read in Integer Data
      MMsk$ = MMsk$ + MKI$(Wrd%)         ' Translate to BYTEs
    NEXT i%
    READ Hotx, Hoty                      ' Cursor HotSpot

  ' Now For the Interrupt call ..
    Regs.ax = 9: Regs.bx = Hotx: Regs.cx = Hoty
    Regs.Dx = SADD(MMsk$)   ' Use with all Basics ..

  ' Next Line not neeeded for QB, (Optional for PDS ??)
  ' But using it gives Far String Support.
    Regs.es = VARSEG(MMsk$)  ' Need InterruptX for this One ..

    CALL INTERRUPTX(&H33, Regs, Regs)

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

FUNCTION RunGridDemo%
  ' Sets Up Program - Returns TRUE if all went right

  ' First, Check for VGA ..
    ON ERROR GOTO ErrorHandler:
     SCREEN 12
    ON ERROR GOTO 0
    IF Abort% THEN RunGridDemo% = 0: EXIT FUNCTION
  
  ' Blank the Screen while Drawing ..
    OUT &H3C4, 1: Cmr% = INP(&H3C5): OUT &H3C5, Cmr% OR &H20
  
  ' We've Got VGA, Now Draw the Grids ..
    Success% = DrawGrid%
  
  ' Turn the Screen back On ..
    OUT &H3C4, 1: Cmr% = INP(&H3C5): OUT &H3C5, Cmr% AND &HDF

  ' Check for Error AFTER We turn the Screen Back on...
    IF Abort% THEN RunGridDemo% = 0: EXIT FUNCTION

  ' Check for Mouse ...
    IF HaveMouse = 1 THEN           ' The Rodent is IN ..
      Mouse 0, 0, 0, 0              ' Initialize Mouse
      MouseCursor                   ' Draw "Pointing Hand"
      MouseShow                     ' Show Mouse Cursor
    ELSE
      ON ERROR GOTO ErrorHandler:
        ERROR 32767                 ' Invoke own Error
      ON ERROR GOTO 0
      RunGridDemo% = 0: EXIT FUNCTION
  END IF

  ' Now Just hang around, waiting for Something to Happen ..
    GetEvents

  ' If we Made it to here, everything's OK ...
    RunGridDemo% = -1
    MouseHide

END FUNCTION