' Columns game demo for Rapid-Q (Linux/Unix) by William Yu
' Take a look at the Windows version, very few changes were made.
' If you're not sure what keys are supported, you can look them up
' /usr/include/X11/keysymdef.h
' Or wherever it happens to be on your system.
' Just replace "0x" with "&H"
'
' ie.  #define XK_Left       0xFF51
' replace with XK_Left = &HFF51

$APPTYPE GUI

DECLARE SUB Paint
DECLARE SUB PaintNextGem

CONST False = 0
CONST True = 1
CONST NumFieldX = 6
CONST NumFieldY = 13

TYPE GemType
  Color1 AS INTEGER
  Color2 AS INTEGER
  Color3 AS INTEGER
END TYPE

DIM Form AS QForm
DIM Field AS QCanvas, NextField AS QCanvas
DIM Timer1 AS QTimer
DIM X AS INTEGER, Y AS INTEGER
DIM Interval AS INTEGER
DIM Grid(-2 TO NumFieldY+1, 1 TO NumFieldX) AS INTEGER

DIM Colours(1 TO 7) AS INTEGER
DIM Gem AS GemType, NextGem AS GemType


'' NOTE: If you're using 256 colors as your default Windows display,
''       Try modifying these values, they may not display correctly.

Colours(1) = &HFF0000  '' Blue
Colours(2) = &H00FF00  '' Green
Colours(3) = &H0000FF  '' Red
Colours(4) = &HFF00FF  '' Purple
Colours(5) = &H30FFFF  '' Yellow
Colours(6) = &HFFFF30  '' Cyan
Colours(7) = &H2099FF  '' Orange

SUB ChooseNextGem
  NextGem.Color1 = Colours(RND(7) + 1)
  NextGem.Color2 = Colours(RND(7) + 1)
  NextGem.Color3 = Colours(RND(7) + 1)
END SUB

SUB ChooseGem
  Gem.Color1 = NextGem.Color1
  Gem.Color2 = NextGem.Color2
  Gem.Color3 = NextGem.Color3
  ChooseNextGem
END SUB

SUB InitGrid
  FOR I = -2 TO NumFieldY+1
    FOR J = 1 TO NumFieldX
      Grid(I, J) = 0
    NEXT
  NEXT
END SUB

FUNCTION MatchVertical (GridX AS INTEGER) AS INTEGER
'' Checks for vertical matches relative to GridX

  MatchVertical = False
  Correct = Grid(-2, GridX)
  IF Correct = 0 THEN
    Correct = -1
  END IF
  Match = 0
  StartMatch = 0

  FOR Y1 = -2 TO NumFieldY              '' Simple up/down search
    IF Grid(Y1, GridX) = Correct THEN
      IF Match = 0 THEN
        StartMatch = Y1
      END IF
      Match = Match + 1
    ELSE                                '' Not correctly matching
      IF Match < 3 THEN
        Match = 1
        StartMatch = Y1
        Correct = Grid(Y1, GridX)
        IF Correct = 0 THEN
          Correct = -1
        END IF
      ELSE
        GOSUB VertMatched
        EXIT FUNCTION
'        Match = 1
'        StartMatch = Y1
'        Correct = Grid(Y1, GridX)
'        IF Correct = 0 THEN
'          Correct = -1
'        END IF
      END IF
    END IF
  NEXT
  IF Match > 2 THEN
    GOSUB VertMatched
  END IF
  EXIT FUNCTION

  VertMatched:
    FOR I = StartMatch TO StartMatch + Match - 1
      Grid(I, GridX) = -1
      Field.Paint((GridX-1)*20+5,(I-1)*20+18, 0, &HFFFFFF)
    NEXT
    FOR I = StartMatch+Match-1 TO -2+Match STEP -1
      Grid(I, GridX) = Grid(I-Match, GridX)
    NEXT
    FOR I = -2+Match TO -2 STEP -1
      Grid(I, GridX) = 0
    NEXT
    Paint
    MatchVertical = True
  RETURN
END FUNCTION

FUNCTION MatchHorizontal (GridY AS INTEGER) AS INTEGER
'' Checks for horizontal matches relative to GridY

  MatchHorizontal = False
  Correct = Grid(GridY, 1)
  IF Correct = 0 THEN
    Correct = -1
  END IF
  Match = 0
  StartMatch = 0

  FOR X1 = 1 TO NumFieldX              '' Simple up/down search
    IF Grid(GridY, X1) = Correct THEN
      IF Match = 0 THEN
        StartMatch = X1
      END IF
      Match = Match + 1
    ELSE                                '' Not correctly matching
      IF Match < 3 THEN
        Match = 1
        StartMatch = X1
        Correct = Grid(GridY, X1)
        IF Correct = 0 THEN
          Correct = -1
        END IF
      ELSE
        GOSUB HorzMatched
        EXIT FUNCTION
'        Match = 1
'        StartMatch = Y1
'        Correct = Grid(Y1, GridX)
'        IF Correct = 0 THEN
'          Correct = -1
'        END IF
      END IF
    END IF
  NEXT
  IF Match > 2 THEN
    GOSUB HorzMatched
  END IF
  EXIT FUNCTION

  HorzMatched:
    FOR I = StartMatch TO StartMatch + Match-1
      Grid(GridY, I) = 0
      Field.Paint((I-1)*20+5,(GridY-1)*20+18, 0, &HFFFFFF)
    NEXT
    FOR I = GridY TO -1 STEP -1
      FOR J = StartMatch TO Match+StartMatch -1
        SWAP Grid(I, J), Grid(I-1, J)
      NEXT
    NEXT
'    FOR I = -2+Match TO -2 STEP -1
'      Grid(GridY, I) = 0
'    NEXT
    Paint
    MatchHorizontal = True
  RETURN
END FUNCTION


SUB DrawGem
  Field.Rectangle(X,Y,X+20,Y+20,&HFFFFFF)
  Field.FillRect(X+1,Y+1,X+19,Y+19,Gem.Color1)
  Field.Rectangle(X,Y+20,X+20,Y+40,&HFFFFFF)
  Field.FillRect(X+1,Y+21,X+19,Y+39,Gem.Color2)
  Field.Rectangle(X,Y+40,X+20,Y+60,&HFFFFFF)
  Field.FillRect(X+1,Y+41,X+19,Y+59,Gem.Color3)
END SUB

SUB Timer1Over
  IF (Y MOD 20 = 0) AND Grid(Y/20+4, X/20+1) <> 0 THEN
      Grid(Y / 20+3, X / 20+1) = Gem.Color3
      Grid(Y / 20+2, X / 20+1) = Gem.Color2
      Grid(Y / 20+1, X / 20+1) = Gem.Color1
      MatchVertical(X/20+1)
      MatchHorizontal(Y/20+3)
      MatchHorizontal(Y/20+2)
      MatchHorizontal(Y/20+1)
      IF Grid(0, X/20+1) <> 0 THEN
        Timer1.Enabled = False
        ShowMessage("Game Over")
        EXIT SUB
      ELSE
        Y = -50
        X = 40
        ChooseGem
        PaintNextGem
      END IF
  ELSE
    IF Y < 20*(NumFieldY-3) THEN
      Field.FillRect(X,Y,X+20,Y+60, 0)
      Y = Y + 10
    ELSE
      Grid(Y / 20+3, X / 20+1) = Gem.Color3
      Grid(Y / 20+2, X / 20+1) = Gem.Color2
      Grid(Y / 20+1, X / 20+1) = Gem.Color1
      MatchVertical(X/20+1)
      MatchHorizontal(Y/20+3)
      MatchHorizontal(Y/20+2)
      MatchHorizontal(Y/20+1)
      Y = -50
      X = 40
      ChooseGem
      PaintNextGem
    END IF
  END IF
    
  Timer1.Interval = Interval
  DrawGem
END SUB

SUB KeyDown (Key AS Word, Shift AS INTEGER)
  SELECT CASE Key
    CASE &HFF1B    '' ESC
      Form.Close
    CASE IS = &HFF51 AND X > 0   '' Left
      IF Grid(INT((Y-10)/20)+4, X/20) = 0 THEN
        Field.FillRect(X,Y,X+20,Y+60, 0)
        X=X-20
        DrawGem
      END IF
    CASE &HFF52    '' Up
      'Field.FillRect(X+1,Y+1,X+20,Y+60, 0)
      C = Gem.Color1
      Gem.Color1 = Gem.Color3
      Gem.Color3 = Gem.Color2
      Gem.Color2 = C
      DrawGem
    CASE IS = &HFF53 AND X < 20*(NumFieldX-1)   '' Right
      IF Grid(INT((Y-10)/20)+4, X/20+2) = 0 THEN
        Field.FillRect(X,Y,X+20,Y+60, 0)
        X=X+20
        DrawGem
      END IF
    CASE IS = &HFF54 AND Y < 20*(NumFieldY-3)   '' Down
      Timer1Over
  END SELECT
END SUB

SUB Paint
  '' Whenever the form gets hidden, we have to repaint the form once
  '' it's visible again.

  FOR I = 0 TO NumFieldY * 20 STEP 20
    FOR J = 0 TO NumFieldX*20-1 STEP 20
      IF Grid(I/20+1,J/20+1) <> 0 THEN
        Field.FillRect(J+1,I+1,J+19,I+19,Grid(I/20+1,J/20+1))
        Field.Rectangle(J,I,J+20,I+20,&HFFFFFF)
      ELSE
        Field.FillRect(J+1,I+1,J+20,I+20,0)
      END IF
    NEXT
  NEXT
END SUB

SUB PaintNextGem
  NextField.Rectangle(5,5,25,25,&HFFFFFF)
  NextField.FillRect(6,6,24,24,NextGem.Color1)
  NextField.Rectangle(5,25,25,45,&HFFFFFF)
  NextField.FillRect(6,26,24,44,NextGem.Color2)
  NextField.Rectangle(5,45,25,65,&HFFFFFF)
  NextField.FillRect(6,46,24,64,NextGem.Color3)
END SUB

Form.Center
Form.ClientWidth = NumFieldX * 20 + 100
Form.ClientHeight = NumFieldY * 20

Interval = 300
Y = -50
X = 40
InitGrid

Field.Parent = Form
Field.Color = 0
Field.Width = NumFieldX * 20+1
Field.Height = NumFieldY * 20
Field.OnPaint = Paint

NextField.Parent = Form
NextField.Color = 0
NextField.Left = Field.Width + 20
NExtField.Top = 20
NextField.Width = 30
NextField.Height = 20*4-10
NextField.OnPaint = PaintNextGem

RANDOMIZE

ChooseNextGem
ChooseGem

Timer1.Interval = Interval
Timer1.OnTimer = Timer1Over

Form.Caption = "Columns Game (Linux)"
Form.OnKeyDown = KeyDown
Form.ShowModal
