'-------------------------------------------'
' Puzzle Challenge 1.0  for QBasic          '
'                                           '
' by WendelSoft                             '
'                                           '
'                                           '
' 02.11.2001 - 03.11.2001                   '
'                                           '
'-------------------------------------------'

DECLARE SUB Routine ()
DECLARE SUB Falling ()
DECLARE SUB MoveCursor (Dir%)
DECLARE SUB DrawPuzzle ()
DECLARE FUNCTION NewLine% ()
DECLARE SUB SearchDestroy ()
DECLARE SUB Delay (t AS DOUBLE)

RANDOMIZE TIMER
DEFINT A-Z

CONST Cima = 1, Baixo = 2, Direita = 3, Esquerda = 4
CONST Max = 5 * 60

DIM SHARED Lin AS INTEGER, Col AS INTEGER, GameOver AS INTEGER
DIM SHARED Puzzle(1 TO 10, 1 TO 6) AS INTEGER
DIM SHARED Check(1 TO 9, 1 TO 6) AS INTEGER
DIM SHARED Pts AS INTEGER, AddPts AS INTEGER
Lin = 1
Col = 1

COLOR 15, 1
WIDTH 40
CLS
LOCATE 1, 1
PRINT "/-------------\"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|             |"
PRINT "|-------------|"
PRINT "|             |"
PRINT "\-------------/"
MoveCursor -1
FOR i = 1 TO 5
   GameOver = NewLine
NEXT
DrawPuzzle
start! = TIMER
t! = TIMER
s! = 12
Score = 0
DO
   k$ = INKEY$
   d = 0
   SELECT CASE k$
      CASE CHR$(27): EXIT DO
      CASE CHR$(13)
         SWAP Puzzle(Lin, Col), Puzzle(Lin, Col + 1)
         DrawPuzzle
         Routine
      CASE CHR$(0) + "H": d = Cima
      CASE CHR$(0) + "P": d = Baixo
      CASE CHR$(0) + "M": d = Direita
      CASE CHR$(0) + "K": d = Esquerda
   END SELECT
   IF d > 0 THEN MoveCursor d
   IF TIMER - t! > s! THEN
      t! = TIMER
      GameOver = NewLine
      DrawPuzzle
      Routine
   END IF
   total = INT(Max - (TIMER - start!))
   LOCATE 19, 20: PRINT USING "##m ##s"; total \ 60; total MOD 60;
   LOCATE 20, 20: PRINT USING "######"; Pts;
LOOP UNTIL GameOver OR total = 0

SUB Delay (t AS DOUBLE)
t2! = TIMER: DO: LOOP UNTIL TIMER - t2! > t
END SUB

SUB DrawPuzzle
FOR i = 1 TO 10
   FOR j = 1 TO 6
      LOCATE 2 * i + 1 - (i = 10), 2 * j + 1
      SELECT CASE Puzzle(i, j)
         CASE 0: PRINT " ";
         CASE 1: PRINT "";
         CASE 2: PRINT "";
         CASE 3: PRINT "";
         CASE 4: PRINT "";
         CASE 5: PRINT "";
         CASE 6: PRINT "#";
         CASE 7: PRINT "!";
         CASE 9: PRINT "°";
      END SELECT
   NEXT
NEXT
END SUB

SUB Falling
ok = 0
DO
   ok = -1
   FOR i = 9 TO 2 STEP -1
      FOR j = 1 TO 6
         IF Puzzle(i, j) = 0 AND Puzzle(i - 1, j) > 0 THEN
            ok = 0
            SWAP Puzzle(i, j), Puzzle(i - 1, j)
         END IF
      NEXT
   NEXT
   IF ok THEN EXIT DO
   DrawPuzzle
   Delay .04
LOOP
END SUB

SUB MoveCursor (Dir)
IF Dir = 0 THEN EXIT SUB
LOCATE 2 * Lin, 2 * Col:         PRINT "     ";
LOCATE 2 * Lin + 1, 2 * Col:     PRINT " ";
LOCATE 2 * Lin + 1, 2 * Col + 2: PRINT " ";
LOCATE 2 * Lin + 1, 2 * Col + 4: PRINT " ";
LOCATE 2 * Lin + 2, 2 * Col:     PRINT "     ";

IF Dir = Cima THEN Lin = Lin - 1
IF Dir = Baixo THEN Lin = Lin + 1
IF Dir = Esquerda THEN Col = Col - 1
IF Dir = Direita THEN Col = Col + 1
IF Lin < 1 THEN Lin = 9
IF Lin > 9 THEN Lin = 1
IF Col < 1 THEN Col = 5
IF Col > 5 THEN Col = 1

LOCATE 2 * Lin, 2 * Col:         PRINT "/---\";
LOCATE 2 * Lin + 1, 2 * Col:     PRINT "|";
LOCATE 2 * Lin + 1, 2 * Col + 2: PRINT "|";
LOCATE 2 * Lin + 1, 2 * Col + 4: PRINT "|";
LOCATE 2 * Lin + 2, 2 * Col:     PRINT "\---/";
END SUB

FUNCTION NewLine
FOR j = 1 TO 6
   IF Puzzle(1, j) > 0 THEN NewLine = -1: EXIT FUNCTION
NEXT
FOR i = 1 TO 9
   FOR j = 1 TO 6
      Puzzle(i, j) = Puzzle(i + 1, j)
   NEXT
NEXT
DO
   FOR i = 1 TO 6
      DO: Puzzle(10, i) = INT(RND * 6) + 1: LOOP WHILE Puzzle(10, i) = Puzzle(9, i)
   NEXT
   FOR i = 2 TO 4
      IF Puzzle(10, i - 1) = Puzzle(10, i) AND Puzzle(10, i) = Puzzle(10, i + 1) THEN EXIT FOR
   NEXT
LOOP WHILE i < 5
NewLine = 0
END FUNCTION

SUB Routine
AddPts2 = 0
AddPts = 0
DO
   Falling
   SearchDestroy
   Pts = Pts + AddPts
   AddPts2 = AddPts2 - (AddPts > 0)
LOOP WHILE AddPts
IF AddPts > 1 THEN Pts = Pts + AddPts - 1
END SUB

SUB SearchDestroy
AddPts = 0
FOR i = 1 TO 9: FOR j = 1 TO 6: Check(i, j) = 0: NEXT j, i
FOR i = 1 TO 9
   c = Puzzle(i, 1): t = 1
   FOR j = 2 TO 6
      IF Puzzle(i, j) = c THEN
         t = t + 1
      ELSE
         IF c > 0 THEN
            IF t >= 3 THEN
               AddPts = AddPts + 2 * (t - 2) - 1
               FOR k = 1 TO t
                  IF Check(i, j - k) THEN AddPts = AddPts + 1
                  Check(i, j - k) = -1
               NEXT
            END IF
         END IF
         c = Puzzle(i, j)
         t = 1
      END IF
   NEXT
   IF t >= 3 AND c > 0 THEN
      AddPts = AddPts + 2 * (t - 2) - 1
      FOR k = 1 TO t
         IF Check(i, j - k) THEN AddPts = AddPts + 1
         Check(i, j - k) = -1
      NEXT
   END IF
NEXT
FOR j = 1 TO 6
   c = Puzzle(1, j): t = 1
   FOR i = 2 TO 9
      IF Puzzle(i, j) = c THEN
         t = t + 1
      ELSE
         IF c > 0 THEN
            IF t >= 3 THEN
               AddPts = AddPts + 2 * (t - 2) - 1
               FOR k = 1 TO t
                  IF Check(i - k, j) THEN AddPts = AddPts + 1
                  Check(i - k, j) = -1
               NEXT
            END IF
         END IF
         c = Puzzle(i, j)
         t = 1
      END IF
   NEXT
   IF t >= 3 AND c > 0 THEN
      AddPts = AddPts + 2 * (t - 2) - 1
      FOR k = 1 TO t
         IF Check(i - k, j) THEN AddPts = AddPts + 1
         Check(i - k, j) = -1
      NEXT
   END IF
NEXT
IF AddPts THEN
   FOR i = 1 TO 9
      FOR j = 1 TO 6
         IF Check(i, j) THEN Puzzle(i, j) = 9
      NEXT
   NEXT
   DrawPuzzle
   Delay .05
   FOR i = 1 TO 9
      FOR j = 1 TO 6
         IF Check(i, j) THEN Puzzle(i, j) = 0
      NEXT
   NEXT
   DrawPuzzle
END IF
END SUB