'===========================================================================
' Subject: HEX-ALIGN 4X4 PUZZEL               Date: 08-06-96 (21:22)       
'  Author: Jonathan Leger                     Code: QB, QBasic, PDS        
'  Origin: leger@mail.dtx.net               Packet: GAMES.ABC
'===========================================================================
DEFINT A-Z

DECLARE SUB Center (s$, l%)
DECLARE SUB PlayPuzzel ()
DECLARE SUB ShowPuzzel ()
DECLARE SUB LoadPuzzel ()
DECLARE SUB CheckHighScore (move.count%)
DECLARE FUNCTION CheckPuzzel ()

DECLARE SUB ABSOLUTE (var1%, var2%, var3%, var4%, var5%, var6%, offset%)

'== BEGIN HEADER ==
'mouse constants
CONST LB = &H1      'constant for left button
CONST RB = &H2      'constant for right button
CONST CB = &H4      'constant for center button
CONST DC = &H8      'constant for double click (reserved for next release)
'mouse control functions
DECLARE FUNCTION mouse.enable% ()
DECLARE SUB mouse.disable ()
DECLARE SUB mouse.show ()
DECLARE SUB mouse.hide ()
DECLARE FUNCTION mouse.loadGCR$ (filename$)
DECLARE FUNCTION mouse.loadTCR$ (filename$)
'sets
DECLARE SUB mouse.setpos (x%, y%)
DECLARE SUB mouse.setlimit (x1%, y1%, x2%, y2%)
DECLARE SUB mouse.setspeed (speed.x%, speed.y%)  'limit: -32,768 to 32,767
DECLARE SUB mouse.setGCR (data$)
DECLARE SUB mouse.setTCR (data$)
'gets
DECLARE SUB mouse.get (x%, y%, buttons%)
DECLARE SUB mouse.getpos (x%, y%)
DECLARE SUB mouse.getmovement (x%, y%)
DECLARE SUB mouse.getlastdown (mouse.constant%, x%, y%)
DECLARE SUB mouse.getlastup (mouse.constant%, x%, y%)
DECLARE FUNCTION mouse.getbutton% ()
'shift state constants
CONST shift = &H3
CONST CTRL = &H4
CONST ALT = &H8
'shift state function
DECLARE FUNCTION shift.getstate% ()
'== END HEADER ==

IF NOT mouse.enable THEN
   PRINT "This program requires a mouse."
   END
END IF

mouse.show

CONST TRUE = -1
CONST FALSE = NOT TRUE

DIM SHARED puzzel(1 TO 16), pcos(1 TO 16, 1 TO 2), high.score, move.count

PlayPuzzel

SUB Center (s$, l)

string.size = LEN(s$)
per.loc = INSTR(1, s$, "%%")
DO UNTIL per.loc = 0
   string.size = string.size - 3
   per.loc = INSTR(per.loc + 1, s$, "%%")
LOOP

LOCATE l, ((80 - string.size) / 2)

per.loc = INSTR(1, s$, "%%")
DO UNTIL per.loc = 0
   left.string$ = LEFT$(s$, per.loc - 1)
   string.color = VAL("&H" + MID$(s$, per.loc + 2, 1))
   right.string$ = RIGHT$(s$, LEN(s$) - per.loc - 2)
   s$ = right.string$
   PRINT left.string$;
   COLOR string.color
   per.loc = INSTR(1, s$, "%%")
LOOP
PRINT right.string$;

END SUB

SUB CheckHighScore (move.count)

hsfile = FREEFILE
OPEN "puzzel.hsc" FOR BINARY AS hsfile

IF LOF(hsfile) = 0 THEN
   CLOSE hsfile
   OPEN "puzzel.hsc" FOR OUTPUT AS hsfile
   move.count = move.count XOR 32767
   PRINT #1, move.count
   CLOSE hsfile
ELSE
   CLOSE hsfile
   OPEN "puzzel.hsc" FOR INPUT AS hsfile
   INPUT #hsfile, high.score
   high.score = high.score XOR 32767
   IF move.count < high.score THEN
      CLOSE hsfile
      OPEN "puzzel.hsc" FOR OUTPUT AS hsfile
      move.count = move.count XOR 32767
      PRINT #1, move.count
   END IF
   CLOSE hsfile
END IF

END SUB

FUNCTION CheckPuzzel

FOR piece = 1 TO 15
   IF puzzel(piece) <> piece THEN
      CheckPuzzel = FALSE
      EXIT FUNCTION
   END IF
NEXT piece

CheckPuzzel = TRUE

END FUNCTION

SUB LoadPuzzel

puzzel$ = "123456789ABCDEF"

RANDOMIZE TIMER

FOR piece = 1 TO 15
   ploc = INT(RND * LEN(puzzel$)) + 1
   temp$ = MID$(puzzel$, ploc, 1)
   puzzel$ = LEFT$(puzzel$, ploc - 1) + RIGHT$(puzzel$, LEN(puzzel$) - ploc)
   puzzel(piece) = VAL("&H" + temp$)
NEXT piece

piece = 0
FOR y = 1 TO 4
   FOR x = 1 TO 4
      piece = piece + 1
      pcos(piece, 1) = 27 + (x * 5)
      pcos(piece, 2) = 9 + ((y - 1) * 2)
   NEXT x
NEXT y

puzzel(16) = 0

hsfile = FREEFILE
OPEN "puzzel.hsc" FOR BINARY AS hsfile

IF LOF(hsfile) = 0 THEN
   CLOSE hsfile
   OPEN "puzzel.hsc" FOR OUTPUT AS hsfile
   PRINT #1, 32767 XOR 32767
   high.score = 32767
   CLOSE hsfile
ELSE
   CLOSE hsfile
   OPEN "puzzel.hsc" FOR INPUT AS hsfile
   INPUT #1, high.score
   high.score = high.score XOR 32767
   CLOSE hsfile
END IF

END SUB

DEFSNG A-Z
'Disable mouse.
'EXAMPLE:
'  enabled% = mouse.enable  'enable mouse
'  mouse.show               'show mouse
'  a$ = INPUT$(1)           'pause
'  mouse.disable            'disable mouse
SUB mouse.disable
  SHARED mouse.exist AS INTEGER
  IF mouse.exist THEN
    mouse.hide
    mouse.exist = 0
  END IF
END SUB

'Enable mouse for usage. Must be run before any mouse functions (other than
'cursor-loading functions) or none will work.
'RETURN:
'  -1 (&hFFFF) if mouse found, else 0.
'EXAMPLE:
'  IF NOT mouse.enable THEN PRINT "No mouse" ELSE PRINT "Mouse found"
FUNCTION mouse.enable%
  SHARED mouse.exist AS INTEGER

  'store machine language data
  SHARED mouse.asm$
  mouse.asm$ = ""
  mouse.asm$ = mouse.asm$ + CHR$(&H55)                            'push bp
  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&HE5)               'mov  bp, sp
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)   'mov  bx, [bp+0e]
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H7)                'mov  ax, [bx]
  mouse.asm$ = mouse.asm$ + CHR$(&H50)                            'push ax
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)   'mov  bx, [bp+0c]
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H7)                'mov  cx, [ax]
  mouse.asm$ = mouse.asm$ + CHR$(&H50)                            'push ax
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)   'mov  bx, [bp+0a]
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&HF)                'mov  cx, [bx]
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'mov  bx, [bp+08]
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H17)               'mov  dx, [bx]
'  mouse.asm$ = mouse.asm$ + CHR$(&H1E)                            'push ds
'  mouse.asm$ = mouse.asm$ + CHR$(&H7)                             'pop  es
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'mov  bx, [bp+06]
  mouse.asm$ = mouse.asm$ + CHR$(&H8E) + CHR$(&H7)                'mov  es, [bx]
  mouse.asm$ = mouse.asm$ + CHR$(&H5B)                            'pop  bx
  mouse.asm$ = mouse.asm$ + CHR$(&H58)                            'pop  ax
  mouse.asm$ = mouse.asm$ + CHR$(&HCD) + CHR$(&H33)               'int  33h
  mouse.asm$ = mouse.asm$ + CHR$(&H53)                            'push bx
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)   'mov  bx, [bp+0e]
  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H7)                'mov  [bx], ax
  mouse.asm$ = mouse.asm$ + CHR$(&H58)                            'pop  ax
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)   'mov  bx, [bp+0c]
  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H7)                'mov  [bx], ax
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)   'mov  bx, [bp+0a]
  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&HF)                'mov  [bx], cx
  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'mov  bx, [bp+08]
  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H17)               'mov  [bx], dx
  mouse.asm$ = mouse.asm$ + CHR$(&H5D)                            'pop  bp
  mouse.asm$ = mouse.asm$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0)    'retf 10

  'initialize and check mouse existance
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  ax% = 0
  DEF SEG = mouse.asmseg%
  CALL ABSOLUTE(dummy%, ax%, 0, 0, 0, 0, mouse.asmoff%)
  DEF SEG
  mouse.exist = ax%

  mouse.enable = mouse.exist
END FUNCTION

'Gets mouse status (coordinates and button status.)
'COMMENT:
'* Coordinates are in pixels, even if the screen is in text mode.
'INPUT:
'* x% = integer variable to store x coordinate
'* y% = integer variable to store y coordinate
'* buttons% = integer variable to store buttons status where:
'  * buttons% becomes LB if left button is pressed
'  * buttons% becomes RB if right button is pressed
'  * buttons% becomes CB if center buttons is pressed
'  * or combination (left button and right button makes buttons% = LB + RB)
'    including double clicks (ie - LB + DC).
'* LB, RB, and CB are mouse constants found in the main module.
'EXAMPLE:
'  CLS
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    mouse.get x%, y%, buttons%
'    LOCATE 1, 1: PRINT USING "####  ####  ####"; x%; y%; buttons%
'  LOOP WHILE INKEY$ = ""
'  mouse.disable
SUB mouse.get (x%, y%, buttons%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H3, bx%, x%, y%, 0, mouse.asmoff%)
    DEF SEG
  END IF
  buttons% = 0
  IF bx% AND &H1 THEN buttons% = buttons% OR LB
  IF bx% AND &H2 THEN buttons% = buttons% OR RB
  IF bx% AND &H4 THEN buttons% = buttons% OR CB
END SUB

'Gets the status of mouse buttons.
'COMMENT:
'* Using mouse.get() function is recommended instead when using both
'  mouse.getbutton() and mouse.getpos() functions.
'RETURN:
'* An integer value:
'  * LB for Left Button
'  * RB for Right Button
'  * CB for Center Button (if any)
'  * or combination (left button and right button makes buttons% = LB + RB)
'    including double clicks (ie - LB + DC).
'* LB, RB, and CB are mouse constants found in the main module.
'EXAMPLE:
'  CLS
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    buttons% = mouse.getbutton
'    LOCATE 1, 1: PRINT USING "####"; buttons%
'  LOOP WHILE INKEY$ = ""
'  mouse.disable
FUNCTION mouse.getbutton%
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H3, bx%, 0, 0, 0, mouse.asmoff%)
    DEF SEG
  END IF
  ret% = 0
  IF bx% AND &H1 THEN ret% = ret% OR LB
  IF bx% AND &H2 THEN ret% = ret% OR RB
  IF bx% AND &H4 THEN ret% = ret% OR CB
  mouse.getbutton% = ret%
END FUNCTION

'Gets the last coordinate where a mouse button was pressed
'COMMENT:
'* Coordinates are in pixels, even if the screen is in text mode.
'INPUT:
'* mouse.constant% is a mouse constant of LB (left button), RB (right
'  button), or CB (center button) for button press check. No combination
'  allowed. Any values other than LB, RB, and CB will default to LB.
'* x% and y% are the variables to store x and y corrdinates where the mouse
'  button was pressed.
'EXAMPLE:
'  CLS
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    mouse.getlastdown LB, x%, y%
'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%
'  LOOP WHILE INKEY$ = ""
'  mouse.disable
SUB mouse.getlastdown (mouse.constant%, x%, y%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    SELECT CASE mouse.constant%
      CASE LB: button% = 0
      CASE RB: button% = 1
      CASE CB: button% = 2
      CASE ELSE: button% = 0
    END SELECT
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H5, button%, cx%, dx%, 0, mouse.asmoff%)
    DEF SEG
    x% = cx%
    y% = dx%
  END IF
END SUB

'Gets the last coordinate where a mouse button was released
'COMMENT:
'* Coordinates are in pixels, even if the screen is in text mode.
'INPUT:
'* mouse.constant% is a mouse constant of LB (left button), RB (right
'  button), or CB (center button) for button release check. No combination
'  allowed.
'* x% and y% are the variables to store x and y corrdinates where the mouse
'  button was released.
'EXAMPLE:
'  CLS
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    mouse.getlastup LB, x%, y%
'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%
'  LOOP WHILE INKEY$ = ""
'  mouse.disable
SUB mouse.getlastup (mouse.constant%, x%, y%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    SELECT CASE mouse.constant%
      CASE LB: button% = 0
      CASE RB: button% = 1
      CASE CB: button% = 2
      CASE ELSE: button% = 0
    END SELECT
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H6, button%, cx%, dx%, 0, mouse.asmoff%)
    DEF SEG
    x% = cx%
    y% = dx%
  END IF
END SUB

'Gets the movement of the mouse since last call
'COMMENT:
'* Coordinates are in pixels, even if the screen is in text mode.
'INPUT:
'* x% and y% are variables to store the horizontal and vertical movements,
'  respectively.
'* Right and Down are positives, Left and Up are negatives
'EXAMPLE:
'  CLS
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    mouse.getmovement x%, y%
'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%
'    SLEEP 1
'  LOOP WHILE INKEY$ = ""
'  mouse.disable
SUB mouse.getmovement (x%, y%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &HB, 0, cx%, dx%, 0, mouse.asmoff%)
    DEF SEG
    x% = cx%
    y% = dx%
  END IF
END SUB

'Gets mouse coordinates.
'COMMENT:
'* Coordinates are in pixels, even if the screen is in text mode.
'COMMENT:
'* Using mouse.get() function is recommended instead when using both
'  mouse.getpos() and mouse.getbutton() functions.
'INPUT:
'* x% = integer variable to store x coordinate
'* y% = integer variable to store y coordinate
'EXAMPLE:
'  CLS
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    mouse.getpos x%, y%
'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%
'  LOOP WHILE INKEY$ = ""
'  mouse.disable
SUB mouse.getpos (x%, y%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H3, 0, x%, y%, 0, mouse.asmoff%)
    DEF SEG
    x% = (x% / 8) + 1
    y% = (y% / 8) + 1
  END IF
END SUB

'Hides mouse cursor
'EXAMPLE:
'  enabled% = mouse.enable  'enable mouse
'  mouse.show               'show mouse
'  a$ = INPUT$(1)           'pause
'  mouse.hide               'hide mouse
'  a$ = INPUT$(1)           'pause
'  mouse.disable            'disable mouse
SUB mouse.hide
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  SHARED mouse.visible AS INTEGER
  IF mouse.exist AND mouse.visible THEN
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H2, 0, 0, 0, 0, mouse.asmoff%)
    DEF SEG
    mouse.visible = 0
  END IF
END SUB

'Loads the graphics cursor
'COMMENT:
'* Requies MS Mouse driver version 3.0 or compatible
'INPUT:
'* filename$ is the file name to input the graphics cursor's data from.
'* If filename$ has no extention, it defaults to .GCR (Graphics CuRsor)
'  extention.
'RETURN:
'* Returns the graphics cursor data in the string form.
'EXAMPLE:
'  SCREEN 9   'requires EGA or better
'  enabled% = mouse.enable
'  mouse.show
'  data$ = mouse.loadGCR$("cursor.gcr")
'  mouse.setGCR data$
FUNCTION mouse.loadGCR$ (filename$)
  IF INSTR(filename$, ".") = 0 THEN filename$ = filename$ + ".GCR"

  filenumber% = FREEFILE
  OPEN filename$ FOR BINARY AS filenumber%
    strn$ = SPACE$(3)
    GET #filenumber%, 1, strn$
    IF strn$ = "GCR" THEN
      strn$ = SPACE$(69)
      GET #filenumber%, 1, strn$
    ELSE strn$ = ""
    END IF
  CLOSE filenumber%
  mouse.loadGCR$ = strn$
END FUNCTION

'Loads the text cursor
'COMMENT:
'* Requies MS Mouse driver version 3.0 or compatible
'INPUT:
'* filename$ is the file name to input the graphics cursor's data from.
'* If filename$ has no extention, it defaults to .TCR (Text CuRsor) extention.
'RETURN:
'* Returns the text cursor data in the string form.
'EXAMPLE:
'  enabled% = mouse.enable
'  mouse.show
'  data$ = mouse.loadTCR$("cursor.tcr")
'  mouse.setTCR data$
FUNCTION mouse.loadTCR$ (filename$)
  IF INSTR(filename$, ".") = 0 THEN filename$ = filename$ + ".TCR"
 
  filenumber% = FREEFILE
  OPEN filename$ FOR BINARY AS filenumber%
    strn$ = SPACE$(3)
    GET #filenumber%, 1, strn$
    IF strn$ = "TCR" THEN
      strn$ = SPACE$(8)
      GET #filenumber%, 1, strn$
    ELSE strn$ = ""
    END IF
  CLOSE filenumber%
  mouse.loadTCR$ = strn$
END FUNCTION

'Changes the graphics cursor
'COMMENT:
'* Requies MS Mouse driver version 3.0 or compatible
'INPUT:
'* data$ is the graphics cursor data gotten from a file using the function
'  mouse.loadGCR().
'EXAMPLE:
'  SCREEN 9   'requires EGA or better
'  enabled% = mouse.enable
'  mouse.show
'  data$ = mouse.loadGCR$("cursor.gcr")
'  mouse.setGCR data$
SUB mouse.setGCR (data$)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist AND LEN(data$) = 69 AND LEFT$(data$, 3) = "GCR" THEN
    'get hotx value
    hotxstr$ = MID$(data$, 68, 1)
    DEF SEG = VARSEG(hotxstr$)
    bx% = PEEK(SADD(hotxstr$))
    DEF SEG
    'get hoty value
    hotystr$ = MID$(data$, 69, 1)
    DEF SEG = VARSEG(hotystr$)
    cx% = PEEK(SADD(hotystr$))
    DEF SEG
    'get image shape values
    dx% = SADD(data$) + 3
    es% = VARSEG(data$)
    'execute
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H9, bx%, cx%, dx%, es%, mouse.asmoff%)
    DEF SEG
  END IF
END SUB

'Sets a "boxed" area for the mouse to move around. It cannot go beyond.
'COMMENT:
'* Coordinates are in pixels, even if the screen is in text mode.
'INPUT:
'* (x1%, y1%) is the top-left coordinate of the box.
'* (x2%, y2%) is the bottom-right coordinate of the box.
'EXAMPLE:
'  enabled% = mouse.enable
'  mouse.show
'  mouse.setlimit 50, 50, 300, 100
'  a$ = INPUT$(1)  'wait for a key
'  mouse.disable
SUB mouse.setlimit (x1%, y1%, x2%, y2%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    cx% = x1%
    dx% = x2%
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H7, 0, cx%, dx%, 0, mouse.asmoff%)
    DEF SEG
    cx% = y1%
    dx% = y2%
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H8, 0, cx%, dx%, 0, mouse.asmoff%)
    DEF SEG
  END IF
END SUB

'Moves the mouse position to (x%, y%)
'COMMENT:
'* Coordinates are in pixels, even if the screen is in text mode.
'NOTES:
'* The inputted values, x% and y%, must be in "pixels", not in "blocks", even
'  in text mode.
'EXAMPLE:
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    mouse.setpos 100, 100
'    SLEEP 1
'  LOOP WHILE INKEY$ = ""
'  mouse.disable
SUB mouse.setpos (x%, y%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    cx% = x%
    dx% = y%
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H4, 0, cx%, dx%, 0, mouse.asmoff%)
    DEF SEG
  END IF
END SUB

'Changes the mouse speed
'COMMENT:
'* This interrupt service actually sets the ratio between mickey (the small-
'  est movement the mouse can detect) and the pixels.  This function does
'  some calculations to make it simulate a speed setting interrupt service.
'   There is aactually a speed setting interrupt service, but it is available
'  to MS Mouse Driver version 6.0 and compatibles so I didn't want to do
'  that.  All the functions in this QBASIC functions are MS Mouse Driver ver-
'  sion 1.0 and compatible with the exception of graphics cursor setting
'  functions and text cursor setting functions.
'INPUT:
'* x% is the new horizontal mouse speed
'* y% is the new vertical mouse speed
'* The minimum value is -32,768 (go backwards) and the maximum value is
'  32,767, same as the minimum and the maximum value limit of integers.
'EXAMPLE:
'  enabled% = mouse.enable
'  mouse.show
'  mouse.setspeed &H7FFF, &H7FFF
'  a$ = INPUT$(1)  'wait for a key
'  mouse.disable
SUB mouse.setspeed (x%, y%)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  IF mouse.exist THEN
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &HF, 0, (x% XOR &H7FFF), (y% XOR &H7FFF), 0, mouse.asmoff%)
    DEF SEG
  END IF
END SUB

'Changes the text cursor
'COMMENT:
'* Requies MS Mouse driver version 3.0 or compatible
'INPUT:
'* data$ is the text cursor data gotten from a file using the function
'  mouse.loadTCR().
'EXAMPLE:
'  enabled% = mouse.enable
'  mouse.show
'  data$ = mouse.loadTCR$("cursor.tcr")
'  mouse.setTCR data$
SUB mouse.setTCR (data$)
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
 
  IF NOT (mouse.exist AND LEN(data$) = 8 AND LEFT$(data$, 3) = "TCR") THEN EXIT SUB
 
  'get cursor type value
  cursortype$ = MID$(data$, 4, 1)
  DEF SEG = VARSEG(cursortype$)
  bx% = PEEK(SADD(cursortype$))
  DEF SEG
  'get arg1 value
  arg1h$ = MID$(data$, 5, 1)
  DEF SEG = VARSEG(arg1h$)
  argh% = PEEK(SADD(arg1h$))
  DEF SEG
  arg1l$ = MID$(data$, 6, 1)
  DEF SEG = VARSEG(arg1l$)
  argl% = PEEK(SADD(arg1l$))
  DEF SEG
  cx% = (argh% AND &H7F) * &H100 + argl%
   IF argh% AND &H80 THEN cx% = cx% OR &H8000
  'get arg2 value
  arg2h$ = MID$(data$, 7, 1)
  DEF SEG = VARSEG(arg2h$)
  argh% = PEEK(SADD(arg2h$))
  DEF SEG
  arg2l$ = MID$(data$, 8, 1)
  DEF SEG = VARSEG(arg2l$)
  argl% = PEEK(SADD(arg2l$))
  DEF SEG
  dx% = (argh% AND &H7F) * &H100 + argl%
   IF argh% AND &H80 THEN dx% = dx% OR &H8000
  'execute
  DEF SEG = mouse.asmseg%
  CALL ABSOLUTE(dummy%, &HA, bx%, cx%, dx%, 0, mouse.asmoff%)
  DEF SEG
END SUB

'Shows the mouse. Must have been enabled first.
'EXAMPLE:
'  enabled% = mouse.enable  'enable mouse
'  mouse.show               'show mouse
'  a$ = INPUT$(1)           'pause
'  mouse.disable            'disable mouse
SUB mouse.show
  SHARED mouse.exist AS INTEGER
  SHARED mouse.asm$
  mouse.asmseg% = VARSEG(mouse.asm$)
  mouse.asmoff% = SADD(mouse.asm$)
  SHARED mouse.visible AS INTEGER
  IF mouse.exist AND NOT mouse.visible THEN
    DEF SEG = mouse.asmseg%
    CALL ABSOLUTE(dummy%, &H1, 0, 0, 0, 0, mouse.asmoff%)
    DEF SEG
    mouse.visible = 1
  END IF
END SUB

DEFINT A-Z
SUB PlayPuzzel

SCREEN 0
WIDTH 80, 25
CLS

LoadPuzzel

COLOR 10
Center "%%9[ %%FHex%%B-%%FAlign %%9]", 1
COLOR 7: LOCATE 10, 8: PRINT "Turn"
COLOR 9: LOCATE 11, 5: PRINT "(";
COLOR 11: PRINT "S";
COLOR 9: PRINT ")";
COLOR 7: PRINT "ound OFF"
COLOR 8: LOCATE 12, 1: PRINT "[";
COLOR 4: PRINT "Right Mouse Click";
COLOR 8: PRINT "]"

LOCATE 3, 1: COLOR 3
PRINT "[ The object of the game is to put all of the hexidecimal numbers in numerical ]"
PRINT "[ order (1 2 3 4 5 6 7 8 9 A B C D E F) in the fewest number of moves possible ]";

COLOR 8

t$ = CHR$(218) + STRING$(20, 196) + CHR$(191)
m$ = CHR$(179) + STRING$(20, " ") + CHR$(179)
b$ = CHR$(192) + STRING$(20, 196) + CHR$(217)

LOCATE 8, 29: PRINT t$
FOR y = 9 TO 16
   LOCATE y, 29: PRINT m$
NEXT y
LOCATE 16, 29: PRINT b$

ShowPuzzel

last.error# = TIMER
last.sound.change# = TIMER
last.error.loc = 0
move.count = 0
sound.on = TRUE

DO

   mouse.getpos mouse.x, mouse.y
   button = mouse.getbutton
   move.okay = FALSE
   in.grid = FALSE

   IF (button = 2 OR (mouse.x >= 5 AND mouse.x <= 7 AND mouse.y = 11 AND button = 1)) AND (TIMER - last.sound.change# > .25) THEN
      last.sound.change# = TIMER
      IF sound.on THEN
         sound.on = FALSE
         SCREEN , , , 1
         mouse.hide
         COLOR 7
         LOCATE 11, 13: PRINT "ON "
         PCOPY 1, 0
         mouse.show
      ELSE
         sound.on = TRUE
         mouse.hide
         SCREEN , , , 1
         COLOR 7
         LOCATE 11, 13: PRINT "OFF"
         PCOPY 1, 0
         mouse.show
      END IF
   END IF

   key$ = INKEY$
   IF key$ <> "" THEN
      SELECT CASE key$
            CASE CHR$(27)
               EXIT DO
            CASE "s", "S"
               IF sound.on THEN
                  sound.on = FALSE
                  SCREEN , , , 1
                  mouse.hide
                  COLOR 7
                  LOCATE 11, 13: PRINT "ON "
                  PCOPY 1, 0
                  mouse.show
               ELSE
                  sound.on = TRUE
                  mouse.hide
                  SCREEN , , , 1
                  COLOR 7
                  LOCATE 11, 13: PRINT "OFF"
                  PCOPY 1, 0
                  mouse.show
               END IF
            CASE CHR$(0) + CHR$(75)    'Left key
            CASE CHR$(0) + CHR$(77)    'Right key
            CASE CHR$(0) + CHR$(72)    'Up key
            CASE CHR$(0) + CHR$(80)    'Down key
      END SELECT
   ELSE
      FOR piece = 1 TO 16
         IF (mouse.x >= pcos(piece, 1) - 1 AND mouse.x <= pcos(piece, 1) + 1) AND (mouse.y = pcos(piece, 2) AND button = 1) THEN
            in.grid = TRUE
            IF piece > 1 THEN
               IF puzzel(piece - 1) = 0 AND NOT (piece MOD 4 = 1) THEN
                  puzzel(piece - 1) = puzzel(piece)
                  puzzel(piece) = 0
                  IF sound.on THEN
                     FOR z = 100 TO 500 STEP 100
                        SOUND 100 + z, .5
                     NEXT z
                  END IF
                  move.okay = TRUE
                  last.error# = TIMER
                  move.count = move.count + 1
                  ShowPuzzel
                  EXIT FOR
               END IF
            END IF
            IF piece < 16 THEN
               IF puzzel(piece + 1) = 0 AND piece MOD 4 THEN
                  puzzel(piece + 1) = puzzel(piece)
                  puzzel(piece) = 0
                  IF sound.on THEN
                     FOR z = 100 TO 500 STEP 100
                        SOUND 100 + z, .5
                     NEXT z
                  END IF
                  move.okay = TRUE
                  last.error# = TIMER
                  move.count = move.count + 1
                  ShowPuzzel
                  EXIT FOR
               END IF
            END IF
            IF piece < 13 THEN
               IF puzzel(piece + 4) = 0 THEN
                  puzzel(piece + 4) = puzzel(piece)
                  puzzel(piece) = 0
                  IF sound.on THEN
                     FOR z = 100 TO 500 STEP 100
                        SOUND 100 + z, .5
                     NEXT z
                  END IF
                  move.okay = TRUE
                  last.error# = TIMER
                  move.count = move.count + 1
                  ShowPuzzel
                  EXIT FOR
               END IF
            END IF
            IF piece > 4 THEN
               IF puzzel(piece - 4) = 0 THEN
                  puzzel(piece - 4) = puzzel(piece)
                  puzzel(piece) = 0
                  IF sound.on THEN
                     FOR z = 100 TO 500 STEP 100
                        SOUND 100 + z, .5
                     NEXT z
                  END IF
                  move.okay = TRUE
                  last.error# = TIMER
                  move.count = move.count + 1
                  ShowPuzzel
                  EXIT FOR
               END IF
            END IF
         END IF
         IF puzzel(piece) = 0 AND (mouse.x >= pcos(piece, 1) - 1 AND mouse.x <= pcos(piece, 1) + 1) AND (mouse.y = pcos(piece, 2) AND button = 1) THEN
            move.okay = TRUE
         END IF
      NEXT piece
 
      IF sound.on THEN
         IF NOT move.okay AND button = 1 AND NOT in.grid THEN
            IF (TIMER - last.error# >= .25) THEN
               SOUND 100, 3
               last.error# = TIMER
            END IF
         ELSEIF NOT move.okay AND button = 1 AND in.grid THEN
            IF (TIMER - last.error# >= .25) THEN
               FOR z = 500 TO 1000 STEP 50
                  SOUND 500 + z, .1
               NEXT z
               FOR z = 500 TO 1000 STEP 50
                  SOUND 500 + z, .1
               NEXT z
               last.error# = TIMER
            END IF
         END IF
      END IF

   END IF

   IF CheckPuzzel = TRUE THEN
      SCREEN , , , 1
      COLOR 15
      Center "You've won!", 19
      CheckHighScore move.count
      END
   END IF

LOOP

END SUB

DEFSNG A-Z
'Gets shift state.
'RETURN:
'* 0 if no shift key pressed
'* ALT if Alt key pressed
'* CTRL if Ctrl key pressed
'* SHIFT if Shift key pressed
'* These may be in combination.  For example, if Ctrl-Alt is pressed, then
'  return is CTRL + ALT.
'* ALT, CTRL, and SHIFT are shift constants defined in the main module.
'EXAMPLE:
'  CLS
'  enabled% = mouse.enable
'  mouse.show
'  DO
'    mouse.get x%, y%, buttons%
'    shiftstate% = shift.getstate%
'    IF buttons% THEN
'      LOCATE 1, 1: PRINT SPACE$(79); : LOCATE 1, 1
'      SELECT CASE shiftstate%
'        CASE 0: PRINT "Mouse button was pressed without any shift keys."
'        CASE ALT: PRINT "Mouse button and Alt key pressed."
'        CASE CTRL: PRINT "Mouse button and Ctrl key pressed."
'        CASE SHIFT: PRINT "Mouse button and Shift key pressed."
'      END SELECT
'    END IF
'  LOOP WHILE INKEY$ = ""
FUNCTION shift.getstate%
  DEF SEG = 0
  state% = PEEK(&H417) AND &HF
  DEF SEG
  IF (state% AND &H3) THEN state% = (state% OR &H3)
  shift.getstate% = state%
END FUNCTION

DEFINT A-Z
SUB ShowPuzzel

mouse.hide

PCOPY 0, 1
SCREEN , , 1

COLOR 3
piece = 0
FOR y = 1 TO 4
   FOR x = 1 TO 4
      piece = piece + 1
      LOCATE pcos(piece, 2), pcos(piece, 1) - 1
      IF puzzel(piece) = 0 THEN
         COLOR 7
         PRINT "[þ] "
         COLOR 3
      ELSE
         COLOR 3
         PRINT "[";
         COLOR 11
         PRINT HEX$(puzzel(piece));
         COLOR 3
         PRINT "] "
      END IF
   NEXT x
NEXT y

LOCATE 23, 20
COLOR 14: PRINT "Best Score:";
COLOR 12: PRINT high.score

LOCATE 23, 45
COLOR 15: PRINT "Your Score:";
COLOR 11: PRINT move.count

PCOPY 1, 0
SCREEN , , , 0

mouse.show

END SUB