'MOUSCURS.BAS  by Dr. Warren G. Lieuallen    v 3.1    3/3/91
'  a program to "automate" drawing a graphic mouse cursor
'  allows copying of cursor mask to screen mask, and clearing of either,
'  automatic screen mask "expansion", user-definable hot-spot, on-screen
'  representation of mouse on foreground and background, saving of
'  either entire sub-program or only DATA, supports full-color and
'  all screen modes!, loading of saved cursors

DEFINT A-Z
OPTION BASE 1
'DECLARE FUNCTION QExist (filname$)
DECLARE FUNCTION Dir$ (filename$)
DECLARE SUB CopyIt ()
DECLARE SUB ClearIt (x)
DECLARE SUB Active ()
DECLARE SUB DeActive ()
DECLARE SUB Expand ()
DECLARE SUB NewMousCurs ()
DECLARE SUB EndIt (x, ctype)
DECLARE SUB NewCursMask ()

' Define Variable type for Interrupt
TYPE RegType
     ax    AS INTEGER
     bx    AS INTEGER
     cx    AS INTEGER
     dx    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     flags AS INTEGER
END TYPE

DIM reg AS RegType, MousCurs&(32), CursMask(16, 32), CrsMsk&(64)
DIM SHARED ratx!, raty!
DECLARE SUB INTERRUPT (intnum, reg1 AS RegType, reg2 AS RegType)

FOR i = 1 TO 16
   FOR j = 1 TO 16
      CursMask(i, j) = -2             'Initialize masks to blanks
      CursMask(i, j + 16) = 1
   NEXT j
NEXT i

FOR i = 17 TO 32
   MousCurs&(i) = 65535
NEXT i
hotx = 5: hoty = 0

'CALL QCrtMode(ctype, ccols)
CLS : PRINT : PRINT "Enter graphics type:"
PRINT : PRINT "1. Hercules"
PRINT "2. CGA"
PRINT "3. EGA"
PRINT "4. VGA"
PRINT : INPUT ctype

IF ctype = 1 THEN
   DEF SEG = &H40
   POKE &H49, 6                        'Adjustment for Hercules screen
   DEF SEG
END IF

reg.ax = 0
CALL INTERRUPT(&H33, reg, reg)         'Reset driver and read status
IF reg.ax = 0 THEN GOTO nomouse

SELECT CASE ctype
   CASE 1                              'Hercules
      SCREEN 3
      ratx! = 1: raty! = 1
      sx = 9: sy = 14
   CASE 2                              'CGA?
      SCREEN 2
      ratx! = 640 / 720: raty! = 200 / 348
      sx = 8: sy = 8
   CASE 3                              'EGA?
      SCREEN 9
      ratx! = 640 / 720: raty! = 350 / 348
      sx = 8: sy = 14
   CASE 4                              'VGA
      SCREEN 12
      ratx! = 640 / 720: raty! = 398 / 348
      sx = 8: sy = 16
   CASE ELSE
      PRINT : PRINT "Maybe you should select one of the supported graphics modes!"
      PRINT : PRINT "Please try again."
      END
END SELECT

q1 = INT(635 * ratx!): q2 = INT(167 * raty!): q3 = INT(656 * ratx!)

FOR i = 1 TO 32
   READ wrd
   Msk$ = Msk$ + MKI$(wrd)
NEXT i

reg.ax = 9
reg.bx = 5: reg.cx = 0
reg.dx = SADD(Msk$)
CALL INTERRUPT(&H33, reg, reg)      'Define graphic cursor

reg.ax = 4
reg.cx = 270 * ratx!: reg.dx = 150 * raty!
CALL INTERRUPT(&H33, reg, reg)      'Position mouse cursor

reg.ax = 1
CALL INTERRUPT(&H33, reg, reg)      'Show mouse cursor

IF ctype > 2 THEN COLOR 15
LOCATE 1, 13: PRINT "Mouse Cursor Design Tool   by Dr. Warren G. Lieuallen"
LINE (90 * ratx!, 13 * raty!)-(600 * ratx!, 13 * raty!)
IF ctype > 2 THEN COLOR 14
LOCATE 19, 40: PRINT "Expand"
LOCATE 20, 21: PRINT "-> Copy ->"
LOCATE 21, 4: PRINT "   Clear                            Clear"
LOCATE 22, 61: PRINT "Activate Cursor": LOCATE 23, 60: PRINT "DeActivate Cursor"
LOCATE 24, 5: PRINT "Save Data      Save Program      Load Cursor     Exit";
IF ctype > 2 THEN COLOR 7
LOCATE 2, 21: PRINT "Dec."; TAB(27); "Hex": LOCATE 2, 54: PRINT "Dec."; TAB(60); "Hex"
LOCATE 9, 71: PRINT "Custom": LOCATE 10, 71: PRINT "Cursor": LOCATE 11, 69: PRINT "Appearance"
LOCATE 20, 3: PRINT "(Cursor Mask)": LOCATE 20, 36: PRINT "(Screen Mask)"

IF ctype > 2 THEN COLOR 12
LINE (6 * ratx!, 26 * raty!)-(155 * ratx!, 252 * raty!), , B   'Box around cursor mask
LINE (303 * ratx!, 26 * raty!)-(453 * ratx!, 252 * raty!), , B 'Box around screen mask
IF ctype > 2 THEN COLOR 7
LINE (q1 - 2, q2 - 2)-(q3 - 2, q2 + 18), , B'Box around cursor-shape
LINE (q3 - 2, q2 - 2)-(q3 + 18, q2 + 18), , BF'Inverse box

FOR i = 0 TO 15
   LOCATE i + 3, 2
   FOR j = 0 TO 15
      PRINT ".";
   NEXT j
   LOCATE i + 3, 35
   FOR j = 0 TO 15
      PRINT "1";
   NEXT j
NEXT i


FOR i = 1 TO 16
   LOCATE 2 + i, 21
   PRINT "0"; TAB(27); "0"
   LOCATE 2 + i, 54
   PRINT "65535"; TAB(60); "FFFF"
NEXT i
reg.ax = 3

DO
   CALL INTERRUPT(&H33, reg, reg)   'Position and button status
  
   IF reg.bx = 1 THEN               'Left Button pressed
      x = reg.cx \ sx + 1: y = reg.dx \ sy + 1
      'LOCATE 22, 20: PRINT y; ","; x
      IF y = 19 THEN CALL Expand: CALL NewMousCurs
      IF y = 20 THEN CALL CopyIt: CALL NewMousCurs
      IF y = 21 THEN CALL ClearIt(x): CALL NewMousCurs
      IF y = 22 THEN CALL Active: reg.ax = 3
      IF y = 23 THEN CALL DeActive: reg.ax = 3
      IF y = 24 THEN CALL EndIt(x, ctype): reg.ax = 3
      IF y < 3 OR y > 18 THEN GOTO toobig
      IF x < 2 OR x > 50 THEN GOTO toobig
      IF x > 17 AND x < 35 THEN GOTO toobig
      IF x > 34 THEN x = x - 17
      reg.ax = 2: CALL INTERRUPT(&H33, reg, reg)   'Hide cursor
      CursMask(y - 2, x - 1) = NOT CursMask(y - 2, x - 1)
     
      IF x < 18 THEN
         LOCATE y, x: PRINT CHR$(48 + (CursMask(y - 2, x - 1)))
      ELSE
         LOCATE y, x + 17: PRINT CHR$(48 + (CursMask(y - 2, x - 1)))
      END IF
     
      reg.ax = 1: CALL INTERRUPT(&H33, reg, reg)   'Show cursor
      reg.ax = 3
     
      CALL NewMousCurs
  
   ELSEIF reg.bx = 2 THEN         'Right button pressed
      hotx = reg.cx \ sx - 1: hoty = reg.dx \ sy - 2
      IF hotx < 0 OR hotx > 16 THEN GOTO toobig
      IF hoty < 0 OR hoty > 16 THEN GOTO toobig
      CursMask(hoty + 1, hotx + 1) = NOT CursMask(hoty + 1, hotx + 1)
     
      reg.ax = 2: CALL INTERRUPT(&H33, reg, reg)   'Hide cursor
      LOCATE hoty + 3, hotx + 2: PRINT CHR$(88 + 40 * (CursMask(hoty + 1, hotx + 1) = -2))
      reg.ax = 1: CALL INTERRUPT(&H33, reg, reg)   'Show cursor
      reg.ax = 3
    
      CALL NewMousCurs
  
   END IF
toobig:
LOOP

END

nomouse:
SCREEN 0
PRINT : PRINT "  Sorry, but the program REQUIRES a mouse."
PRINT : PRINT "    Press any key to exit...."
WHILE INKEY$ = "": WEND
END

DATA &HF3FF
DATA &HE1FF
DATA &HE1FF
DATA &HE1FF
DATA &HE07F
DATA &HE00F
DATA &HE001
DATA &H8000
DATA &H0000
DATA &H0000
DATA &H0000
DATA &H0000
DATA &H0000
DATA &H0000
DATA &H8001
DATA &HC003

DATA &H0C00
DATA &H1200
DATA &H1200
DATA &H1200
DATA &H1380
DATA &H1270
DATA &H124E
DATA &H7249
DATA &H9249
DATA &H9001
DATA &H9001
DATA &H8001
DATA &H8001
DATA &H8001
DATA &H4002
DATA &H3FFC

SUB Active
SHARED reg AS RegType, MousCurs&(), hotx, hoty

   FOR i = 17 TO 32
      CMsk$ = CMsk$ + MID$(MKL$(MousCurs&(i)), 1, 2)
   NEXT i
   FOR i = 1 TO 16
      CMsk$ = CMsk$ + MID$(MKL$(MousCurs&(i)), 1, 2)
   NEXT i

   reg.ax = 9
   reg.bx = hotx: reg.cx = hoty
   reg.dx = SADD(CMsk$)
   CALL INTERRUPT(&H33, reg, reg)      'Define custom graphic cursor

END SUB

SUB ClearIt (x)
SHARED CursMask(), MousCurs&()

   IF x < 20 THEN
      FOR i = 1 TO 16
         FOR j = 1 TO 16
            CursMask(i, j) = -2
         NEXT j
         MousCurs&(i) = 0
      NEXT i
     
      FOR y = 3 TO 18
         FOR x = 1 TO 16
            LOCATE y, x + 1: PRINT CHR$(48 + (CursMask(y - 2, x)))
         NEXT x
      NEXT y

   ELSE
      FOR i = 1 TO 16
         FOR j = 1 TO 16
            CursMask(i, j + 16) = 1
         NEXT j
         MousCurs&(i + 16) = 65535
      NEXT i
      FOR y = 3 TO 18
         FOR x = 17 TO 32
            LOCATE y, x + 18: PRINT CHR$(48 + (CursMask(y - 2, x)))
         NEXT x
      NEXT y

   END IF

END SUB

SUB CopyIt
SHARED CursMask(), MousCurs&()

   FOR i = 1 TO 16
      MousCurs&(i + 16) = 0
      FOR j = 1 TO 16
         CursMask(i, j + 16) = NOT CursMask(i, j)
      NEXT j
   NEXT i
  
   FOR y = 3 TO 18
      FOR x = 17 TO 32
         LOCATE y, x + 18: PRINT CHR$(48 + (CursMask(y - 2, x)))
      NEXT x
   NEXT y

END SUB

SUB DeActive
SHARED Msk$, reg AS RegType

   reg.ax = 9
   reg.bx = 5: reg.cx = 0
   reg.dx = SADD(Msk$)
   CALL INTERRUPT(&H33, reg, reg)

END SUB

SUB EndIt (x, ctype)
SHARED MousCurs&(), reg AS RegType, hotx, hoty

   reg.ax = 2: CALL INTERRUPT(&H33, reg, reg)   'Hide cursor
   IF x < 35 THEN
      CLOSE #1
      i = 1
      IF x > 17 THEN filname$ = "CURSORn.BAS" ELSE filname$ = "CURSORn.BI"
namefile:
      MID$(filname$, 7) = CHR$(i + 48)
      'IF NOT QExist(filname$ + CHR$(0)) THEN i = i + 1: GOTO namefile
      IF LEN(Dir$(filname$)) THEN i = i + 1: GOTO namefile
      OPEN filname$ FOR OUTPUT AS #1
      PRINT #1, "'Custom Graphic Mouse Cursor Routine  by Dr. Warren G. Lieuallen"
      IF x > 17 THEN
         PRINT #1, "TYPE RegType             'Variable for CALL Interrupt"
         PRINT #1, "     ax    AS INTEGER"
         PRINT #1, "     bx    AS INTEGER"
         PRINT #1, "     cx    AS INTEGER"
         PRINT #1, "     dx    AS INTEGER"
         PRINT #1, "     bp    AS INTEGER"
         PRINT #1, "     si    AS INTEGER"
         PRINT #1, "     di    AS INTEGER"
         PRINT #1, "     flags AS INTEGER"
         PRINT #1, "END TYPE"
         PRINT #1, "DIM reg AS RegType"
         PRINT #1, "DECLARE SUB Interrupt (intnum%, reg1 AS RegType, reg2 AS RegType)"
         IF ctype = 0 THEN
            PRINT #1,
            PRINT #1, "   DEF SEG = &H40"
            PRINT #1, "   POKE &H49, 6"
            PRINT #1, "   DEF SEG"
         END IF
         PRINT #1, "reg.ax = 0"
         PRINT #1, "CALL Interrupt(&H33, reg, reg)         'Reset driver and read status"
         PRINT #1, "IF reg.ax = 0 THEN END                 'No mouse driver found"
         PRINT #1,
         PRINT #1, "FOR i = 1 TO 32"
         PRINT #1, "   READ wrd%"
         PRINT #1, "   MMsk$ = MMsk$ + MKI$(wrd%)"
         PRINT #1, "NEXT i"
         PRINT #1, "READ hotx,hoty"
         PRINT #1,
         PRINT #1, "' *** Add appropriate SCREEN statement here ***"
         PRINT #1,
         PRINT #1, "reg.ax = 9"
         PRINT #1, "reg.bx = hotx: reg.cx = hoty"
         PRINT #1, "reg.dx = SADD(MMsk$)"
         PRINT #1, "CALL Interrupt(&H33, reg, reg)    'Define graphic cursor"
         PRINT #1, "reg.ax = 1"
         PRINT #1, "CALL Interrupt(&H33, reg, reg)    'Show mouse cursor"
         PRINT #1,
         LOCATE 25, 21: PRINT filname$;
      ELSE LOCATE 25, 5: PRINT filname$;
      END IF
      FOR i = 17 TO 32
         PRINT #1, "DATA &H"; HEX$(MousCurs&(i))
      NEXT i
      PRINT #1,
      FOR i = 1 TO 16
         PRINT #1, "DATA &H"; HEX$(MousCurs&(i))
      NEXT i
      PRINT #1,
      PRINT #1, "DATA"; hotx
      PRINT #1, "DATA"; hoty
      PRINT #1, "' ------ End of cursor routine ------"
      CLOSE #1
  
   ELSEIF x < 53 THEN
      LOCATE 23, 38: INPUT "FileName"; filname$
      CLOSE #1
      OPEN filname$ FOR INPUT AS #1
      i = 17
      DO UNTIL i = 33
         LINE INPUT #1, cdata$
         IF MID$(cdata$, 1, 5) = "DATA " THEN
            MousCurs&(i) = VAL(MID$(cdata$, 6))
            IF MousCurs&(i) < 0 THEN MousCurs&(i) = MousCurs&(i) + 65536
            i = i + 1
         END IF
      LOOP
      i = 1
      DO UNTIL i = 17
         LINE INPUT #1, cdata$
         IF MID$(cdata$, 1, 5) = "DATA " THEN
            MousCurs&(i) = VAL(MID$(cdata$, 6))
            IF MousCurs&(i) < 0 THEN MousCurs&(i) = MousCurs&(i) + 65536
            i = i + 1
         END IF
      LOOP
      LINE INPUT #1, cdata$
      LINE INPUT #1, cdata$: hotx = VAL(MID$(cdata$, 6))
      LINE INPUT #1, cdata$: hoty = VAL(MID$(cdata$, 6))
      CLOSE #1
      'IF i <> 32 THEN BEEP: LOCATE 23, 38: PRINT "Error Reading File": SLEEP 2
      LOCATE 23, 38: PRINT SPACE$(22)
      CALL NewCursMask
      CALL NewMousCurs

   ELSE
      SCREEN 0: CLS : END
   END IF
   reg.ax = 1: CALL INTERRUPT(&H33, reg, reg)   'Show cursor

END SUB

SUB Expand
SHARED CursMask(), MousCurs&()

   FOR i = 1 TO 16
      FOR j = 1 TO 16
         IF CursMask(i, j) = 1 THEN
            FOR a = -1 TO 1
               FOR B = -1 TO 1
                  IF i + a > 0 AND i + a < 17 AND j + B > 0 AND j + B < 17 THEN
                     IF CursMask(i + a, j + 16 + B) = 1 THEN
                        CursMask(i + a, j + 16 + B) = -2
                        LOCATE i + a + 2, j + 16 + B + 18: PRINT "."
                        PRESET (q3 + j, q2 + i)
                     END IF
                  END IF
               NEXT B
            NEXT a
         END IF
      NEXT j
   NEXT i

END SUB

SUB NewCursMask
SHARED CursMask(), MousCurs&(), hotx, hoty

   'Rebuilds CursMask() from loaded MousCurs&()
   FOR i = 1 TO 16
      FOR j = 1 TO 16
         CursMask(i, j) = -2
         IF MousCurs&(i) AND 2 ^ (16 - j) THEN
            CursMask(i, j) = 1
         END IF
         LOCATE i + 2, j + 1: PRINT CHR$(48 + (CursMask(i, j)))
      NEXT j
   NEXT i

   FOR i = 1 TO 16
      FOR j = 17 TO 32
         CursMask(i, j) = -2
         IF MousCurs&(i + 16) AND 2 ^ (32 - j) THEN
            CursMask(i, j) = 1
         END IF
         LOCATE i + 2, j + 18: PRINT CHR$(48 + (CursMask(i, j)))
      NEXT j
   NEXT i

   LOCATE hoty + 3, hotx + 2: PRINT CHR$(88 + 40 * (CursMask(hoty + 1, hotx + 1) = -2))

END SUB

SUB NewMousCurs
SHARED MousCurs&(), CursMask(), CrsMsk&(), q1, q2, q3

   'rebuilds MousCurs&() based on CursMask values
   FOR i = 1 TO 16
      MousCurs&(i) = 0: MousCurs&(i + 16) = 65535
      FOR j = 1 TO 16
         IF CursMask(i, j) = 1 THEN MousCurs&(i) = MousCurs&(i) + (2 ^ (16 - j) * (SGN(CursMask(i, j))))
      NEXT j

      FOR j = 17 TO 32
         IF CursMask(i, j) = -2 THEN MousCurs&(i + 16) = MousCurs&(i + 16) + (2 ^ (32 - j) * (SGN(CursMask(i, j))))
      NEXT j
   NEXT i
  
   FOR i = 1 TO 16
      LOCATE 2 + i, 20
      PRINT MousCurs&(i); TAB(27); HEX$(MousCurs&(i)); "   "
      LOCATE 2 + i, 53
      PRINT MousCurs&(i + 16); TAB(60); HEX$(MousCurs&(i + 16)); "   "
   NEXT i

   FOR i = 1 TO 16
      FOR j = 1 TO 16
         IF CursMask(i, j + 16) > 0 THEN PSET (q3 + j - 1, q2 + i - 1), 7 ELSE PRESET (q3 + j - 1, q2 + i - 1)
         IF CursMask(i, j) > 0 THEN PSET (q1 + j - 1, q2 + i - 1), 15 ELSE PRESET (q1 + j - 1, q2 + i - 1)
      NEXT j
   NEXT i
  
   GET (q1, q2)-(q1 + 15, q2 + 15), CrsMsk&
   PUT (q3, q2), CrsMsk&, XOR

END SUB