'===========================================================================
' Subject: ORDER! PUZZLE GAME                Date: 08-29-00 (21:15)       
' Author:  Tomer Filiba                      Code: PDS                    
' Origin:  flexibal@n2.com                 Packet: GAMES.ABC
'===========================================================================
' Graphite's
'             ORDER!       - The Ultimate Puzzle
'-------------------------------------------------
'
'   -Product:      Order!
'   -Category:     Games, Puzzle
'   -Platform:     DOS, QBX (QB 7.1)
'   -Version:      0.9 Beta
'   -Produced by:  Graphite Technologies (http://www.graphite-tech.com)
'   -Programmer:   Tomer Filiba (flexibal@n2.com)
'   -Conact:       Contact@Graphite-tech.com
'
'
'                    ====FOR QBX (QB 7.1)====
'
'
'   Version 1.0 A will use Future Lib, so the gfx will be good.
'
'
'
'                                                              -Tomer Filiba
'============================================================================
DECLARE SUB SolveDelay ()
DECLARE SUB About ()
DECLARE SUB AddButton (Name$, X%, Y%, Txt$)
DECLARE FUNCTION ButtonOptions% ()
DECLARE FUNCTION CheckButtons$ ()
DECLARE SUB CheckMoveable (Array%())
DECLARE SUB Deal (Array%())
DECLARE SUB DrawBoard (Array%())
DECLARE SUB Help ()
DECLARE SUB Init ()
DECLARE SUB MakeGUI ()
DECLARE SUB MouseFunc (Cmd$)
DECLARE SUB MousePos ()
DECLARE FUNCTION MoveBlock% (Array%())
DECLARE FUNCTION OnMouseOver% (X1%, Y1%, X2%, Y2%)
DECLARE SUB PlayGame (Array%())
DECLARE SUB RemoveButton (Name$)
DECLARE SUB Resize ()
DECLARE SUB SetGame ()
DECLARE SUB Solve ()
DECLARE SUB WinGame (Array%())

DEFINT A-Z
CONST True = 1, False = -1

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
DECLARE SUB InterruptX (IntNum AS INTEGER, inReg AS RegTypeX, outReg AS RegTypeX)

TYPE XMouse4Type
  X                  AS INTEGER
  Y                  AS INTEGER
  B                  AS INTEGER
  OX                 AS INTEGER
  OY                 AS INTEGER
  oB                 AS INTEGER
  Moved              AS INTEGER
  Exist              AS INTEGER
  Status             AS INTEGER '0=no change,1=changed to UP,2=changed to DOWN
END TYPE

TYPE InfoType
  X        AS INTEGER
  Y        AS INTEGER
  BoardX   AS INTEGER
  BoardY   AS INTEGER
  BG       AS INTEGER
  BC       AS INTEGER
  FC       AS INTEGER
  FontC    AS INTEGER
  Box      AS INTEGER
  Border   AS INTEGER
  Diagonal AS INTEGER
  Delay    AS INTEGER
END TYPE

TYPE OMSType
  TotalButtons AS INTEGER
END TYPE
TYPE ButtonType
  BName AS STRING * 8
  X     AS INTEGER
  Y     AS INTEGER
  Xs    AS INTEGER
  Ys    AS INTEGER
END TYPE
TYPE MoveableType
  A   AS INTEGER
  B   AS INTEGER
  C   AS INTEGER
  D   AS INTEGER
END TYPE

COMMON SHARED Info  AS InfoType, Moveable AS MoveableType, Regs AS RegTypeX, Mouse AS XMouse4Type
COMMON SHARED Counter AS LONG, OMSystem AS OMSType, SSS, SOL

REDIM SHARED Buttons(1 TO 1) AS ButtonType
REDIM SHARED Board(1 TO 1) AS INTEGER

CLS
SCREEN 12

SSS = True
Info.Diagonal = 3
Info.Box = 100 - (Info.Diagonal - 1) * 7
Info.Delay = 5
SetGame
PlayGame Board()

SUB About
 MouseFunc "hide"
 CLS
 DIM Text(1 TO 100) AS STRING
 Text(1) = "G R A P H I T E      T E C H N O L O G I E S"
 Text(5) = "                 P r e s e n t s:"
 Text(10) = "                      ORDER!"
 Text(12) = "               ThE UlTiMaTe PuZzLe!"
 Text(13) = STRING$(50, 205)
 Text(20) = "About:  ORDER!"
 Text(21) = "~~~~~~~~~~~~~~"
 Text(23) = "  Program info:"
 Text(24) = "    - By: Tomer Filiba  of  Graphite Technologies"
 Text(26) = "    - Game Version:   0.9 Beta"
 Text(27) = "    - Engine Version: 1.0"
 Text(28) = "    - Solver Version: 0.3"
 Text(30) = "  Interface:"
 Text(31) = "    Provided with Object Management Systen (OMS) Technologies"
 Text(32) = "    - OMS Version:    0.3"
 Text(35) = "  Contact Info:"
 Text(36) = "    - Graphite Technologies Website:"
 Text(37) = "        http://www.graphite-tech.com"
 Text(38) = "    - Email Graphite Technologies:"
 Text(39) = "        contact@graphite-tech.com"
 Text(40) = "    - Email Tomer Filiba:"
 Text(41) = "          flexibal@n2.com"
 Text(45) = "Created in QuickBASIC 7.1 (PDS), no special thanks, etc."
 Text(50) = "  The Ultimate Solver! My solver is the worst, I know."
 Text(51) = "  If you *just happen* to have a better one, plz let me know =)"
 Text(55) = "                                                                 :-[Tomer>"

 LOCATE 28
 FOR i = 1 TO 55
   LINE (0, 0)-(639, 479), 0, BF
   LOCATE 2
   FOR n = 0 TO 26
     PRINT Text(i + n)
   NEXT n
   FOR j = 1 TO 28
     LOCATE j, 80: PRINT CHR$(177)
   NEXT j
   LOCATE 1, 80: PRINT CHR$(24)
   LOCATE 28, 80: PRINT CHR$(25)
   LOCATE (i / 31) * 25 + 1, 80: PRINT CHR$(219)
   DO
    A$ = ""
    WHILE A$ = ""
     A$ = INKEY$
    WEND
    SELECT CASE A$
     CASE CHR$(27)
       EXIT FOR
     CASE CHR$(0) + "H"
       IF i > 1 THEN i = i - 2 ELSE i = i - 1
       EXIT DO
     CASE CHR$(0) + "P"
       IF i <= 31 THEN EXIT DO
     CASE ELSE: BEEP
    END SELECT
   LOOP
 NEXT i
 LINE (0, 0)-(639, 479), 15, BF
 MakeGUI
 oSSS = SSS
 SSS = False
 DrawBoard Board()
 SSS = oSSS
 MouseFunc "show"
END SUB

SUB AddButton (Name$, X, Y, Txt$)
 Name$ = LCASE$(Name$)
 P = False
 FOR i = 1 TO OMSystem.TotalButtons
   IF Name$ = RTRIM$(LTRIM$(Buttons(i).BName)) THEN P = i: EXIT FOR
 NEXT i
 IF P = False THEN
   FOR i = 1 TO OMSystem.TotalButtons
     IF RTRIM$(LTRIM$(Buttons(i).BName)) = "~~@" THEN P = i: EXIT FOR
   NEXT i
   OMSystem.TotalButtons = OMSystem.TotalButtons + 1
   IF P = False THEN
     P = OMSystem.TotalButtons
     REDIM PRESERVE Buttons(1 TO OMSystem.TotalButtons)  AS ButtonType
   END IF
 END IF

 nX = INT(X / 8)
 nY = INT(Y / 16)
 X = nX * 8 - 3
 Y = nY * 16 - 3
 w = LEN(Txt$) * 8 + 6
 L = 20

 Buttons(P).X = X
 Buttons(P).Y = Y
 Buttons(P).Xs = w
 Buttons(P).Ys = L
 Buttons(P).BName = Name$

 MouseFunc "hide"
 LINE (X, Y)-(X + w, Y + L), 0, BF
 LOCATE nY + 1, nX + 1: COLOR 15: PRINT Txt$
 LINE (X, Y)-(X + w, Y + L), 7, B
 LINE (X + 1, Y + 1)-(X + w - 1, Y + L - 1), 8, B
 MouseFunc "show"
END SUB

FUNCTION ButtonOptions
   ButtonOptions = True
   SELECT CASE CheckButtons
    CASE "exit"
      END
    CASE "about"
      About
    CASE "help"
      Help
    CASE "solve"
      IF SOL <> True THEN Solve
    CASE "resize"
      Resize
    CASE "new"
      SetGame
    CASE "solvet"
      SolveDelay
    CASE "sound"
      IF SSS = False THEN
        AddButton "sound", 524, 290, "Sound ON    "
        SSS = True
       ELSE
        AddButton "sound", 524, 290, "Sound OFF   "
        SSS = False
      END IF
    CASE ""
      ButtonOptions = False
   END SELECT
END FUNCTION

FUNCTION CheckButtons$
 FOR i = 1 TO OMSystem.TotalButtons
   IF OnMouseOver(Buttons(i).X, Buttons(i).Y, Buttons(i).X + Buttons(i).Xs, Buttons(i).Y + Buttons(i).Ys) = True AND Mouse.B = 1 THEN
     DIM BPic(Buttons(i).Xs * Buttons(i).Ys / 2 + 4)
     MouseFunc "hide"
     GET (Buttons(i).X, Buttons(i).Y)-(Buttons(i).X + Buttons(i).Xs, Buttons(i).Y + Buttons(i).Ys), BPic
     PUT (Buttons(i).X, Buttons(i).Y), BPic, PRESET
     MouseFunc "show"
     WHILE Mouse.B = 1
       IF OnMouseOver(Buttons(i).X, Buttons(i).Y, Buttons(i).X + Buttons(i).Xs, Buttons(i).Y + Buttons(i).Ys) = False THEN
         MouseFunc "hide"
         PUT (Buttons(i).X, Buttons(i).Y), BPic, PSET
         MouseFunc "show"
         CheckButtons = ""
         EXIT FUNCTION
       END IF
     WEND
     CheckButtons = LTRIM$(RTRIM$(Buttons(i).BName))
     MouseFunc "hide"
     PUT (Buttons(i).X, Buttons(i).Y), BPic, PSET
     MouseFunc "show"
     EXIT FOR
   END IF
 NEXT i
END FUNCTION

SUB CheckMoveable (Array())
 FOR i = 1 TO Info.Diagonal ^ 2
   IF Array(i) = 0 THEN n = i: EXIT FOR
 NEXT i
 IF n > Info.Diagonal THEN A = n - Info.Diagonal ELSE A = False
 IF n <= Info.Diagonal ^ 2 - Info.Diagonal THEN B = n + Info.Diagonal ELSE B = False
 IF n >= 2 THEN C = n - 1 ELSE C = False
 IF n <= Info.Diagonal ^ 2 - 1 AND n / Info.Diagonal <> INT(n / Info.Diagonal) THEN D = n + 1 ELSE D = False

 Moveable.A = A
 Moveable.B = B
 Moveable.C = C
 Moveable.D = D
END SUB

SUB Deal (Array())
 RANDOMIZE TIMER

 DO
   A = RND * (UBOUND(Array) - 1)
   OK = True
   FOR i = 1 TO P
     IF A = Array(i) THEN OK = False
   NEXT i
   IF OK = True THEN P = P + 1: Board(P) = A
   IF P = UBOUND(Array) THEN EXIT DO
 LOOP
END SUB

SUB DrawBoard (Array())
 B = Info.Border
 BC = Info.BC
 BG = Info.BG
 FC = Info.FC
 Xp = Info.BoardX
 Yp = Info.BoardY
 BSize = Info.Box

 MouseFunc "Hide"

 COLOR FC

 LINE (Xp - B, Yp - B)-(Xp + BSize * Info.Diagonal + B, Yp + BSize * Info.Diagonal + B), BG, BF
 LINE (Xp - B, Yp - B)-(Xp + BSize * Info.Diagonal + B, Yp + BSize * Info.Diagonal + B), BC, B

 n = 0
 FOR Y = 0 TO Info.Diagonal - 1
   FOR X = 0 TO Info.Diagonal - 1
     n = n + 1
     IF Array(n) > 0 THEN
       LINE (Xp + X * BSize, Yp + Y * BSize)-(Xp + X * BSize + BSize, Yp + Y * BSize + BSize), FC, BF
       LINE (Xp + X * BSize, Yp + Y * BSize)-(Xp + X * BSize + BSize, Yp + Y * BSize + BSize), BC, B
       LINE (Xp + X * BSize + 1, Yp + Y * BSize + 1)-(Xp + X * BSize + BSize - 1, Yp + Y * BSize + BSize - 1), BG, B
       LOCATE (Yp + Y * BSize) / 16 + 2, (Xp + X * BSize) / 8 + 3
       PRINT Array(n)
     END IF
   NEXT X
 NEXT Y
            IF SSS = True THEN
             SOUND 2000, 1
             SOUND 800, 1
            END IF

 MouseFunc "Show"
END SUB

SUB Help
 MouseFunc "hide"
 CLS
 DIM Text(1 TO 100) AS STRING
 Text(1) = "ORDER!      Version 1.0       By: Graphite Technologies"
 Text(3) = "                      H E L P:"
 Text(6) = "Well, simply move your mouse over the block, click them,"
 Text(7) = "and they will move to the free block beside - but only"
 Text(8) = "if the block you click is next to the free block. Otherwise"
 Text(9) = "you will here the very nice BEEP sound =)"
 Text(11) = "Click the Solve button to see a very very stupid solving"
 Text(12) = "method, the only I could think of. And, not only the most"
 Text(13) = "inseficiant method after randomly moving the blocks, it even"
 Text(14) = "cheats! So click it only if you are desprate =)"
 Text(16) = "So... enjoy and email me any improvements you may think of."
 Text(18) = "Also, see the About Section"

 LOCATE 28
 FOR i = 1 TO 18
   LINE (0, 0)-(639, 479), 0, BF
   LOCATE 2
   FOR n = 0 TO 26
     PRINT Text(i + n)
   NEXT n
   FOR j = 1 TO 28
     LOCATE j, 80: PRINT CHR$(177)
   NEXT j
   LOCATE 1, 80: PRINT CHR$(24)
   LOCATE 28, 80: PRINT CHR$(25)
   LOCATE (i / 18) * 25 + 1, 80: PRINT CHR$(219)
   DO
    A$ = ""
    WHILE A$ = ""
     A$ = INKEY$
    WEND
    SELECT CASE A$
     CASE CHR$(27)
       EXIT FOR
     CASE CHR$(0) + "H"
       IF i = 1 THEN i = 0
       IF i > 1 THEN i = i - 2
       EXIT DO
     CASE CHR$(0) + "P"
       IF i <= 18 THEN EXIT DO
     CASE ELSE: BEEP
    END SELECT
   LOOP
 NEXT i
 LINE (0, 0)-(639, 479), 15, BF
 MakeGUI
 oSSS = SSS
 SSS = False
 DrawBoard Board()
 SSS = oSSS
 MouseFunc "show"
END SUB

SUB Init
 Info.X = 500
 Info.Y = 480
 Info.BoardX = Info.X / 2 - Info.Box * Info.Diagonal / 2
 Info.BoardY = Info.Y / 2 - Info.Box * Info.Diagonal / 2
 Info.BG = 7
 Info.BC = 8
 Info.FC = 15
 Info.FontC = 0
 Info.Border = 2
 Counter = 0

 REDIM Board(1 TO Info.Diagonal ^ 2)  AS INTEGER

 Deal Board()
END SUB

SUB MakeGUI
 LINE (500, 0)-(639, 479), 0, BF
 AddButton "exit", 524, 50, "Exit        "
 AddButton "about", 524, 100, "About       "
 AddButton "new", 524, 150, "New Game    "
 AddButton "resize", 524, 180, "Resize Board"
 AddButton "help", 524, 210, "Help        "
 AddButton "solve", 524, 240, "Solve       "
 AddButton "solvet", 524, 320, "Solve Delay "
 IF SSS = True THEN AddButton "sound", 524, 290, "Sound ON    " ELSE AddButton "sound", 524, 290, "Sound OFF   "
 LOCATE 1, 1: PRINT SPACE$(80)
 LOCATE 1, 1
 COLOR 14
 PRINT "                            ORDER!         ";
 COLOR 8
 PRINT " The Ultimate Puzzle..."
END SUB

SUB MouseFunc (Cmd$)
Cmd$ = LCASE$(Cmd$)
fs = INSTR(1, Cmd$, " ")
IF fs = 0 THEN mfnc$ = MID$(Cmd$, 1) ELSE mfnc$ = MID$(Cmd$, 1, fs - 1)
SELECT CASE mfnc$
 CASE "init"
   Regs.Ax = 0
   InterruptX 51, Regs, Regs
   IF Regs.Ax THEN Mouse.Exist = True ELSE Mouse.Exist = False
 CASE "show"
   Regs.Ax = 1
   InterruptX 51, Regs, Regs
 CASE "hide"
   Regs.Ax = 2
   InterruptX 51, Regs, Regs
 CASE "put"
   cm1 = INSTR(fs + 1, Cmd$, ",")
   IF cm1 = 0 THEN EXIT SUB
   X1$ = MID$(Cmd$, fs + 1, cm1 - 1)
   Y1$ = MID$(Cmd$, cm1 + 1)
   Y = VAL(Y1$): X = VAL(X1$)
   Regs.Ax = 4: Regs.Bx = 0
   Regs.Cx = X: Regs.Dx = Y
   InterruptX 51, Regs, Regs
 CASE "range"
   cm1 = INSTR(fs + 1, Cmd$, ",")
   cm2 = INSTR(cm1 + 1, Cmd$, ",")
   cm3 = INSTR(cm2 + 1, Cmd$, ",")
   IF cm1 = 0 OR cm2 = 0 OR cm3 = 0 THEN EXIT SUB
   X1$ = MID$(Cmd$, fs + 1, cm1 - 1)
   Y1$ = MID$(Cmd$, cm1 + 1, cm2 - 1)
   X2$ = MID$(Cmd$, cm2 + 1, cm3 - 1)
   Y2$ = MID$(Cmd$, cm3 + 1)
   X1 = VAL(X1$): Y1 = VAL(Y1$): X2 = VAL(X2$): Y2 = VAL(Y2$)
   Regs.Ax = 7: Regs.Bx = 0
   Regs.Cx = X1: Regs.Dx = X2
   InterruptX 51, Regs, Regs
   Regs.Ax = 8: Regs.Bx = 0
   Regs.Cx = Y1: Regs.Dx = Y2
   InterruptX 51, Regs, Regs
 CASE "move"
   cm1 = INSTR(fs + 1, Cmd$, ",")
   IF cm1 = 0 THEN EXIT SUB
   X1$ = MID$(Cmd$, fs + 1, cm1 - 1)
   Y1$ = MID$(Cmd$, cm1 + 1)
   Yp = VAL(Y1$): Xp = VAL(X1$)
   Regs.Ax = 3: Regs.Bx = 0
   Regs.Cx = Y: Regs.Dx = Y
   InterruptX 51, Regs, Regs
   IF X - Xp <= 0 THEN s1 = 1 ELSE s1 = -1
   IF Y - Yp <= 0 THEN s2 = 1 ELSE s2 = -1
   xx = X: yy = Y
   DO
    IF xx <> Xp THEN xx = xx + s1
    IF yy <> Yp THEN yy = yy + s2
    IF (xx = Xp AND yy = Yp) THEN EXIT DO
    Regs.Ax = 4: Regs.Bx = 0
    Regs.Cx = xx: Regs.Dx = yy
    InterruptX 51, Regs, Regs
    SOUND 0, .1
   LOOP
 CASE "speed"
   cm1 = INSTR(fs + 1, Cmd$, ",")
   IF cm1 = 0 THEN EXIT SUB
   X1$ = MID$(Cmd$, fs + 1, cm1 - 1)
   Y1$ = MID$(Cmd$, cm1 + 1)
   Y = VAL(Y1$): X = VAL(X1$)
   IF Y = 0 OR X = 0 THEN EXIT SUB
   Regs.Ax = 15: Regs.Bx = 0
   Regs.Cx = Y: Regs.Dx = Y
   InterruptX 51, Regs, Regs
 CASE "/speed"
   Regs.Ax = 15: Regs.Bx = 0
   Regs.Cx = 8: Regs.Dx = 9
   InterruptX 51, Regs, Regs
END SELECT
END SUB

SUB MousePos
  Mouse.OX = Mouse.X: Mouse.OY = Mouse.Y: Mouse.oB = Mouse.B
  Regs.Ax = 3
  InterruptX &H33, Regs, Regs
  B = Regs.Bx
  X = Regs.Cx
  Y = Regs.Dx
  Mouse.B = B: Mouse.X = X: Mouse.Y = Y
  IF Mouse.OX <> Mouse.X OR Mouse.OY <> Mouse.Y THEN Mouse.Moved = True ELSE Mouse.Moved = False
  IF Mouse.B = Mouse.oB THEN Mouse.Status = 0
  IF Mouse.B = 0 AND Mouse.oB <> 0 THEN Mouse.Status = 1
  IF Mouse.B <> 0 AND Mouse.oB = 0 THEN Mouse.Status = 2
END SUB

FUNCTION MoveBlock (Array())
 Xp = Info.BoardX
 Yp = Info.BoardY
 BSize = Info.Box

 DO
   n = 0
   FOR Y = 0 TO Info.Diagonal - 1
     FOR X = 0 TO Info.Diagonal - 1
       n = n + 1
       IF Array(n) > 0 THEN
         X1 = Xp + X * BSize
         Y1 = Yp + Y * BSize
         X2 = X1 + BSize
         Y2 = Y1 + BSize
                                                                               
         IF OnMouseOver(X1, Y1, X2, Y2) = True AND Mouse.B = 1 THEN M = n: EXIT DO
       END IF
     NEXT X
   NEXT Y
 LOOP UNTIL 0 = 0

 FOR i = 1 TO Info.Diagonal ^ 2
   IF Array(i) = 0 THEN Zero = i: EXIT FOR
 NEXT i

 FOR i = 1 TO Info.Diagonal ^ 2
   IF i = M THEN
     IF i = Moveable.A OR i = Moveable.B OR i = Moveable.C OR i = Moveable.D THEN
       SWAP Array(Zero), Array(i)
       MoveBlock = True
       EXIT FUNCTION
      ELSE
       IF SSS = True THEN BEEP
     END IF
   END IF
 NEXT i
 MoveBlock = False
END FUNCTION

FUNCTION OnMouseOver (X1, Y1, X2, Y2)   'True of False
 MousePos
 IF Mouse.X >= X1 AND Mouse.X <= X2 AND Mouse.Y >= Y1 AND Mouse.Y <= Y2 THEN OnMouseOver = True ELSE OnMouseOver = False
END FUNCTION

SUB PlayGame (Array())
 MouseFunc "show"

 oSSS = SSS
 SSS = False
 DrawBoard Array()
 SSS = oSSS
 DO
   CheckMoveable Array()
   WinGame Array()
   IF MoveBlock(Array()) = True THEN
     DrawBoard Array()
     Counter = Counter + 1
     LOCATE 29, 66: PRINT "Moves:"; Counter; "   ";
   END IF

   A = ButtonOptions
 LOOP

 MouseFunc "Hide"
END SUB

SUB RemoveButton (Name$)
 P = False
 FOR i = 1 TO OMSystem.TotalButtons
   IF LCASE$(Name$) = LCASE$(RTRIM$(LTRIM$(Buttons(i).BName))) THEN P = i: EXIT FOR
 NEXT i
 IF P = False THEN EXIT SUB
 IF P < OMSystem.TotalButtons THEN
   FOR i = P TO OMS.TotalButtons - 1
     Buttons(i) = Buttons(i + 1)
   NEXT i
   REDIM PRESERVE Buttons(1 TO OMSystem.TotalButtons - 1) AS ButtonType
 END IF
 OMSystem.TotalButtons = OMSystem.TotalButtons - 1
END SUB

SUB Resize
 MouseFunc "hide"
 LINE (100, 100)-(400, 250), 0, BF
 LINE (100, 100)-(400, 250), 7, B
 MouseFunc "show"
 LOCATE 8, 16: COLOR 15: PRINT "Click + or - to change board size"
 AddButton "+", 370, 150, "+"
 AddButton "-", 370, 180, "-"
 AddButton "ok", Info.X / 2 - 16, 230, " OK "
      LOCATE 11, 36
      PRINT "Size:"; Info.Diagonal
 MouseFunc "show"
 Min = 2
 Max = 8
 DO
   SELECT CASE CheckButtons
    CASE "+"
      IF Info.Diagonal < Max THEN Info.Diagonal = Info.Diagonal + 1
      LOCATE 11, 36
      PRINT "Size:"; Info.Diagonal
    CASE "-"
      IF Info.Diagonal > Min THEN Info.Diagonal = Info.Diagonal - 1
      LOCATE 11, 36
      PRINT "Size:"; Info.Diagonal
    CASE "ok"
     Info.Box = 100 - (Info.Diagonal - 1) * 7
     EXIT DO
    CASE ""
    CASE ELSE
      BEEP
   END SELECT
 LOOP
 RemoveButton "+"
 RemoveButton "-"
 RemoveButton "ok"
 SetGame
END SUB

SUB RndSolve (Array())
 DO
ReDraw1:
   B = RND * 4
   FOR i = 1 TO Info.Diagonal ^ 2
     IF Array(i) = 0 THEN Zero = i: EXIT FOR
   NEXT i
  
   CheckMoveable Array()

   oi = i
   SELECT CASE B
     CASE 1, 0
       i = Moveable.A
     CASE 2
       i = Moveable.B
     CASE 3
       i = Moveable.C
     CASE 4
       i = Moveable.D
     CASE ELSE
       i = Moveable.D
   END SELECT
   IF i = False OR oi = i THEN GOTO ReDraw1
   SWAP Array(Zero), Array(i)
   DrawBoard Array()

   A = ButtonOptions
   t! = TIMER: WHILE t! + .5 > TIMER: WEND
 LOOP
END SUB

SUB SetGame
 MouseFunc "hide"
 LINE (0, 0)-(639, 479), 15, BF
 Init
 MakeGUI
 oSSS = SSS
 SSS = False
 DrawBoard Board()
 SSS = oSSS
 MouseFunc "show"
END SUB

SUB Solve
 DIM OBoard(1 TO UBOUND(Board))
 r! = Info.Delay / 10
 AddButton "solve", 524, 240, "Stop Solve  "
 SOL = True

 DO
   FOR i = Info.Diagonal ^ 2 TO 1 STEP -1
     FOR n = 1 TO i
       CheckMoveable Board()
       FOR h = 1 TO UBOUND(Board)
         OBoard(h) = Board(h)
       NEXT h
       IF Board(i) < Board(n) THEN
          IF Board(i) > 0 THEN
             FOR g = 1 TO Info.Diagonal ^ 2
              IF Board(g) = 0 THEN Z = g: EXIT FOR
             NEXT g
             SWAP Board(n), Board(Z)
             Counter = Counter + 1: DrawBoard Board()
             LOCATE 29, 66: PRINT "Moves:"; Counter; "   ";
             t! = TIMER
             WHILE t! + r! > TIMER
               IF ButtonOptions = True THEN EXIT DO
             WEND
             SWAP Board(n), Board(i)
             U = True
             Counter = Counter + 1: DrawBoard Board()
             LOCATE 29, 66: PRINT "Moves:"; Counter; "   ";
             t! = TIMER
             WHILE t! + r! > TIMER
               IF ButtonOptions = True THEN EXIT DO
             WEND
             EXIT FOR
           ELSE
             SWAP Board(i), Board(UBOUND(Board))
             U = False
             FOR h = 1 TO UBOUND(Board)
               IF OBoard(h) <> Board(h) THEN U = True
             NEXT h
             IF U = True THEN Counter = Counter + 1: DrawBoard Board()
             LOCATE 29, 66: PRINT "Moves:"; Counter; "   ";
             t! = TIMER
             WHILE t! + r! > TIMER
               IF ButtonOptions = True THEN EXIT DO
             WEND
          END IF
         ELSE
       END IF
       IF ButtonOptions = True THEN EXIT DO

       Win = True
       FOR k = 1 TO Info.Diagonal ^ 2 - 1
         IF Board(k) <> k THEN Win = False: EXIT FOR
       NEXT k
       IF Win = True AND Counter > 0 THEN
         MouseFunc "hide"
         FOR k = 1 TO 150
           LINE (Info.X / 2 - k, Info.Y / 2 - k / 2)-(Info.X / 2 + k, Info.Y / 2 + k / 2), 0, B
           LINE (Info.X / 2 - k - 1, Info.Y / 2 - k / 2 - 1)-(Info.X / 2 + k + 1, Info.Y / 2 + k / 2 + 1), 7, B
           LINE (Info.X / 2 - k - 2, Info.Y / 2 - k / 2 - 2)-(Info.X / 2 + k + 2, Info.Y / 2 + k / 2 + 2), 8, B
           SOUND 0, .1
         NEXT k
         LOCATE 14, 20
         A$ = "I won... in" + STR$(Counter) + " moves"
         PRINT A$
         MouseFunc "show"
         Counter = 0
         DO: LOOP UNTIL ButtonOptions = True
         EXIT DO
       END IF
     NEXT n
   NEXT i
 LOOP
 AddButton "solve", 524, 240, "Solve       "
 SOL = False
END SUB

SUB SolveDelay
 MouseFunc "hide"
 LINE (100, 100)-(400, 250), 0, BF
 LINE (100, 100)-(400, 250), 7, B
 MouseFunc "show"
 LOCATE 8, 16: COLOR 15: PRINT "Click + or - to change solve-delay"
 AddButton "+", 370, 150, "+"
 AddButton "-", 370, 180, "-"
 AddButton "ok", Info.X / 2 - 16, 230, " OK "
      LOCATE 11, 35
      PRINT "Delay:"; Info.Delay / 10
 MouseFunc "show"
 Min = 0
 Max = 10
 DO
   SELECT CASE CheckButtons
    CASE "+"
      IF Info.Delay < Max THEN Info.Delay = Info.Delay + 1
      LOCATE 11, 35
      PRINT "Delay:"; Info.Delay / 10
    CASE "-"
      IF Info.Delay > Min THEN Info.Delay = Info.Delay - 1
      LOCATE 11, 35
      PRINT "Delay:"; Info.Delay / 10
    CASE "ok"
      EXIT DO
    CASE ""
    CASE ELSE
      BEEP
   END SELECT
 LOOP
 RemoveButton "+"
 RemoveButton "-"
 RemoveButton "ok"
 LINE (0, 0)-(639, 479), 15, BF
 MakeGUI
 oSSS = SSS
 SSS = False
 DrawBoard Board()
 SSS = oSSS
 MouseFunc "show"
END SUB

SUB WinGame (Array())
   Win = True
   FOR i = 1 TO Info.Diagonal ^ 2 - 1
     IF Array(i) <> i THEN Win = False: EXIT FOR
   NEXT i
   IF Win = True AND Counter > 0 THEN
     MouseFunc "hide"
     FOR i = 1 TO 150
       LINE (Info.X / 2 - i, Info.Y / 2 - i / 2)-(Info.X / 2 + i, Info.Y / 2 + i / 2), 0, B
       LINE (Info.X / 2 - i - 1, Info.Y / 2 - i / 2 - 1)-(Info.X / 2 + i + 1, Info.Y / 2 + i / 2 + 1), 7, B
       LINE (Info.X / 2 - i - 2, Info.Y / 2 - i / 2 - 2)-(Info.X / 2 + i + 2, Info.Y / 2 + i / 2 + 2), 8, B
       SOUND 0, .1
     NEXT i
     LOCATE 14, 20
     A$ = "You won... in" + STR$(Counter) + " moves"
     PRINT A$
     MouseFunc "show"
     Counter = 0
     DO: LOOP UNTIL ButtonOptions = True
   END IF
END SUB