' Sliding puzzle game, with pictures.  Use keyboard or mouse. 
' Written in Rapid-Q by William Yu 

$TYPECHECK ON

DECLARE SUB CanvasPaint (Sender AS QCANVAS)
DECLARE SUB CanvasClick (Sender AS QCANVAS)
DECLARE SUB SplitPicture
DECLARE SUB ScrambleCanvas
DECLARE SUB InitCanvas
DECLARE SUB ExitItemClick
DECLARE SUB OpenItemClick
DECLARE SUB ScrambleItemClick
DECLARE SUB CheckForWin
DECLARE FUNCTION CheckValidMove (X AS INTEGER, Y AS INTEGER) AS INTEGER
DECLARE SUB FormKeyDown (Key AS WORD, Shift AS INTEGER)

CONST False = 0
CONST True = 1

DIM Bitmap AS QBitmap
DIM Piece(1 TO 16) AS QBitmap
DIM Canvas(1 TO 4, 1 TO 4) AS QCanvas
DIM NumMoves AS INTEGER
    NumMoves = 0

Bitmap.BMP = "PIC.BMP"   '-- Load a 200x200 bitmap 

CREATE Form AS QForm
  Caption = "Sliding Puzzle"
  Color = 0
  ClientHeight = 233
  ClientWidth = 197
  BorderStyle = 4        '-- Tool window 
  Center
  OnKeyDown = FormKeyDown
  CREATE MainMenu AS QMainMenu
    CREATE GameMenu AS QMenuItem
      Caption = "&Game"
      CREATE OpenItem AS QMenuItem
        Caption = "&New Picture..."
        OnClick = OpenItemClick
      END CREATE
      CREATE ScrambleItem AS QMenuItem
        Caption = "&Scramble"
        OnClick = ScrambleItemClick
      END CREATE
      CREATE BreakItem1 AS QMenuItem
        Caption = "-"
      END CREATE
      CREATE ExitItem AS QMenuItem
        Caption = "E&xit"
        OnClick = ExitItemClick
      END CREATE
    END CREATE
  END CREATE
  CREATE StatusBar AS QStatusBar
    SizeGrip = FALSE
    AddPanels "",""
    Panel(0).Width = 80
    Panel(0).Caption = " 0 Moves"
  END CREATE
END CREATE

SplitPicture
InitCanvas
ScrambleCanvas

Form.ShowModal

END

'----------------------------------------------------------------------- 

SUB FormKeyDown (Key AS WORD, Shift AS INTEGER)
  DIM X AS INTEGER, Y AS INTEGER, N AS INTEGER, Done AS INTEGER

  N = 0
  FOR Y = 1 TO 4
    FOR X = 1 TO 4
      N++
      IF Canvas(Y,X).Hint = "16" THEN
        Done = TRUE
        EXIT FOR
      END IF
    NEXT
    IF Done = TRUE THEN
      EXIT FOR
    END IF
  NEXT

  SELECT CASE Key
    CASE 27    '' ESC 
      Form.Close
    CASE IS = 37 AND X < 4   '' Left 
      IF CheckValidMove(X+1,Y) = TRUE THEN
        Canvas(Y,X+1).Repaint
        NumMoves++
        StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves"
        CheckForWin
      END IF
    CASE IS = 38 AND Y < 4   '' Up 
      IF CheckValidMove(X,Y+1) = TRUE THEN
        Canvas(Y+1,X).Repaint
        NumMoves++
        StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves"
        CheckForWin
      END IF
    CASE IS = 39 AND X > 1   '' Right 
      IF CheckValidMove(X-1,Y) = TRUE THEN
        Canvas(Y,X-1).Repaint
        NumMoves++
        StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves"
        CheckForWin
      END IF
    CASE IS = 40 AND Y > 1   '' Down 
      IF CheckValidMove(X,Y-1) = TRUE THEN
        Canvas(Y-1,X).Repaint
        NumMoves++
        StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves"
        CheckForWin
      END IF
  END SELECT
END SUB


SUB ScrambleCanvas
  DIM I AS INTEGER, J AS INTEGER
  DIM N AS INTEGER, M AS INTEGER
  DIM K AS INTEGER

  '-- Scrambles picture 
  RANDOMIZE
  FOR I = 1 TO 50
    J = INT(RND(4)+1)
    K = INT(RND(4)+1)
    N = INT(RND(4)+1)
    M = INT(RND(4)+1)
    SWAP Canvas(J,K).Hint, Canvas(M,N).Hint
  NEXT

  NumMoves = 0
  StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves"
END SUB

SUB InitCanvas
  DIM I AS INTEGER, J AS INTEGER
  DIM N AS INTEGER

  N = 0
  FOR I = 1 TO 4
    FOR J = 1 TO 4
      N++
      Canvas(I,J).Parent = Form
      Canvas(I,J).Hint = STR$(N)
      Canvas(I,J).Left = (J-1)*50
      Canvas(I,J).Top = (I-1)*50
      Canvas(I,J).Width = 49
      Canvas(I,J).Height = 49
      Canvas(I,J).OnPaint = CanvasPaint
      Canvas(I,J).OnClick = CanvasClick
    NEXT
  NEXT
END SUB

SUB SplitPicture
  DIM DRect AS QRect, SRect AS QRect
  DIM A AS INTEGER, Top AS INTEGER, Left AS INTEGER

  DRect.Top = 0
  DRect.Left = 0
  DRect.Right = 50
  DRect.Bottom = 50

  Top = 0
  Left = 0
  FOR A = 1 TO 15
    SRect.Top = Top
    SRect.Left = Left*50
    SRect.Right = SRect.Left+50
    SRect.Bottom = SRect.Top+50
    Piece(A).Height = 50
    Piece(A).Width = 50
    Piece(A).CopyRect(DRect, Bitmap, SRect)
    Left++
    IF A MOD 4 = 0 THEN
      Top += 50
      Left = 0
    END IF
  NEXT A
END SUB

SUB CanvasPaint (Sender AS QCANVAS)
  IF Sender.Hint <> "16" THEN
    Sender.Draw(0,0,Piece(VAL(Sender.Hint)).BMP)
    Sender.TextOut(11,11,Sender.Hint,0,-1)
    Sender.TextOut(10,10,Sender.Hint,&HFFFFFF,-1)
  END IF
END SUB

SUB CheckForWin
  DIM I AS INTEGER, J AS INTEGER, N AS INTEGER
  DIM Done AS INTEGER

  N = 0: Done = FALSE
  FOR I = 1 TO 4
    FOR J = 1 TO 4
      N++
      IF Canvas(I,J).Hint <> STR$(N) THEN
        Done = TRUE
        EXIT FOR
      END IF
    NEXT
    IF Done = TRUE THEN
      EXIT FOR
    END IF
  NEXT

  IF Done = FALSE THEN
    ShowMessage("Congratulations, you win!")
  END IF
END SUB

FUNCTION CheckValidMove(X AS INTEGER, Y AS INTEGER) AS INTEGER
  Result = FALSE
  SELECT CASE X
    CASE 1  '-- Far Left 
      IF Canvas(Y,X+1).Hint = "16" THEN
        SWAP Canvas(Y,X).Hint, Canvas(Y,X+1).Hint
        Canvas(Y,X+1).Repaint
        Result = TRUE
      END IF
      IF Y > 1 THEN
        IF Canvas(Y-1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint
          Canvas(Y-1,X).Repaint
          Result = TRUE
        END IF
      END IF
      IF Y < 4 THEN
        IF Canvas(Y+1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint
          Canvas(Y+1,X).Repaint
          Result = TRUE
        END IF
      END IF
    CASE 4  '-- Far Right 
      IF Canvas(Y,X-1).Hint = "16" THEN
        SWAP Canvas(Y,X).Hint, Canvas(Y,X-1).Hint
        Canvas(Y,X-1).Repaint
        Result = TRUE
      END IF
      IF Y > 1 THEN
        IF Canvas(Y-1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint
          Canvas(Y-1,X).Repaint
          Result = TRUE
        END IF
      END IF
      IF Y < 4 THEN
        IF Canvas(Y+1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint
          Canvas(Y+1,X).Repaint
          Result = TRUE
        END IF
      END IF
    CASE ELSE  '-- Middle 
      IF Canvas(Y,X-1).Hint = "16" THEN
        SWAP Canvas(Y,X).Hint, Canvas(Y,X-1).Hint
        Canvas(Y,X-1).Repaint
        Result = TRUE
      END IF
      IF Canvas(Y,X+1).Hint = "16" THEN
        SWAP Canvas(Y,X).Hint, Canvas(Y,X+1).Hint
        Canvas(Y,X+1).Repaint
        Result = TRUE
      END IF
      IF Y = 1 THEN
        IF Canvas(Y+1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint
          Canvas(Y+1,X).Repaint
          Result = TRUE
        END IF
      ELSEIF Y = 4 THEN
        IF Canvas(Y-1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint
          Canvas(Y-1,X).Repaint
          Result = TRUE
        END IF
      ELSE
        IF Canvas(Y-1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint
          Canvas(Y-1,X).Repaint
          Result = TRUE
        END IF
        IF Canvas(Y+1,X).Hint = "16" THEN
          SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint
          Canvas(Y+1,X).Repaint
          Result = TRUE
        END IF
      END IF
  END SELECT
END FUNCTION

SUB CanvasClick (Sender AS QCANVAS)
  DIM X AS INTEGER, Y AS INTEGER

  '-- Determine which canvas was clicked 
  SELECT CASE Sender.Left
    CASE 0  : X = 1
    CASE 50 : X = 2
    CASE 100: X = 3
    CASE 150: X = 4
  END SELECT
  SELECT CASE Sender.Top
    CASE 0  : Y = 1
    CASE 50 : Y = 2
    CASE 100: Y = 3
    CASE 150: Y = 4
  END SELECT

  '-- Check for a valid move... 

  IF CheckValidMove(X,Y) = TRUE THEN
    Canvas(Y,X).Repaint
    NumMoves++
    StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves"
    CheckForWin
  END IF
END SUB

SUB OpenItemClick
  DIM OpenDialog AS QOpenDialog
      OpenDialog.Filter = "*.BMP|*.BMP"

  IF OpenDialog.Execute THEN
    Bitmap.BMP = OpenDialog.FileName
    SplitPicture
    ScrambleCanvas
    Form.Repaint
  END IF
END SUB

SUB ScrambleItemClick
  ScrambleCanvas
  Form.Repaint
END SUB

SUB ExitItemClick
  Form.Close
END SUB