'********************************************************
'********* Programme cr‚‚ par Christian Hoffmann ********
'********* E-Mail: jemaf@free.fr                 ********
'********* t‚l‚charg‚ sur le site jemaf.free.fr  ********
'********************************************************

DECLARE SUB Choixauto ()
DECLARE FUNCTION calcpoints! (xt!, ct!)
DECLARE FUNCTION auto! ()
DECLARE SUB Choix ()
DECLARE SUB FIN (col!())
DECLARE SUB aide ()
DECLARE FUNCTION mizajour! (tabl!(), tabl1!(), points!)
DECLARE SUB verif (tabl!(), tabl1!(), points!)
DECLARE SUB affiche (tabl!(), tabl1!(), maxi!())
DECLARE FUNCTION clavier! (k$)
DECLARE SUB affcol (x!, y!, c1!, c2!, c3!)
DECLARE SUB init ()
RANDOMIZE TIMER

DIM SHARED col(1 TO 6): col(1) = 7: col(2) = 9: col(3) = 10: col(4) = 12: col(5) = 13: col(6) = 14
DIM SHARED tabl(1 TO 18, 1 TO 6)
DIM SHARED tabl1(1 TO 18, 1 TO 6)
DIM SHARED maxi(1 TO 6) '1e case libre
DIM SHARED Mode, colpos, colauto, x, xauto, c1, c2, c3

TIMER ON
debut = TIMER
i = 0: DO: i = i + 1: LOOP UNTIL TIMER - debut >= .5
t = i * 2
TIMER STOP


Choix
init

FOR i = 1 TO 6: maxi(i) = 18: NEXT i

KEY(1) ON
ON KEY(1) GOSUB help

c1 = col(RND * 5 + 1) 'couleur possibles: 7,9,10,12,13,14
c2 = col(RND * 5 + 1)
c3 = col(RND * 5 + 1)
points = 0

DO
        IF Mode = 2 THEN Choixauto
        x = 4  ' 1 <= x <= 6
        y = 1  '-1 <= y <= 18
        colpos = 0

        c1b = col(RND * 5 + 1)
        c2b = col(RND * 5 + 1)
        c3b = col(RND * 5 + 1)

        COLOR c3b: LOCATE 10, 70: PRINT "ÛÛÛ"
        COLOR c2b: LOCATE 11, 70: PRINT "ÛÛÛ"
        COLOR c1b: LOCATE 12, 70: PRINT "ÛÛÛ"

        DO

                affcol x, y, c1, c2, c3 'x=abs., y=ord. carr‚ bas, c1=coul. carr‚ bas
                IF points < 500 THEN tempo1 = t * 4 ELSE tempo1 = t * 3
                IF Mode = 2 THEN tempo1 = tempo1 / 2
               
                FOR tempo = 1 TO tempo1
               
                SELECT CASE Mode
                        CASE 1:
                                k$ = INKEY$: IF k$ <> "" THEN act = clavier(k$)
                        CASE 2:
                                IF tempo MOD tempo1 = 0 THEN act = auto
                        END SELECT

                        IF act > 0 THEN
                        affcol x, y, 0, 0, 0
                        SELECT CASE act
                                CASE 1: IF x <= 1 THEN x = 1 ELSE IF maxi(x - 1) >= y THEN x = x - 1
                                CASE 3: IF x >= 6 THEN x = 6 ELSE IF maxi(x + 1) >= y THEN x = x + 1
                                CASE 5: c4 = c1: c1 = c2: c2 = c3: c3 = c4: colpos = (colpos + 1) MOD 3
                                CASE 2: y = maxi(x)
                        END SELECT
                        affcol x, y, c1, c2, c3
                        act = 0
                        END IF
                NEXT tempo


                IF y < maxi(x) THEN affcol x, y, 0, 0, 0
                y = y + 1

        LOOP UNTIL y > maxi(x)

        IF y <= 3 THEN FIN col()

        tabl(maxi(x), x) = c1: tabl(maxi(x) - 1, x) = c2: tabl(maxi(x) - 2, x) = c3
        maxi(x) = maxi(x) - 3

        DO
        verif tabl(), tabl1(), points
        'affiche tabl(), tabl1(), maxi()
        LOOP UNTIL mizajour(tabl(), tabl1(), points) = 0

        FOR j = 1 TO 6
        i = 0
        l = 0
        DO
        i = i + 1
        IF i > 18 THEN l = 1 ELSE IF tabl(i, j) > 0 THEN l = 1
        LOOP UNTIL l = 1
        maxi(j) = i - 1
        NEXT j

        c1 = c1b: c2 = c2b: c3 = c3b

LOOP

help: aide
RETURN

SUB affcol (x, y, c1, c2, c3)

IF y >= 3 THEN LOCATE 4 + y - 2, 28 + 3 * x: COLOR c3: PRINT "ÛÛÛ"
IF y >= 2 THEN LOCATE 4 + y - 1, 28 + 3 * x: COLOR c2: PRINT "ÛÛÛ"
IF y >= 1 THEN LOCATE 4 + y, 28 + 3 * x: COLOR c1: PRINT "ÛÛÛ"

END SUB

SUB affiche (tabl(), tabl1(), maxi())

COLOR 15
FOR j1 = 1 TO 6
LOCATE 22, 3 + 3 * j1: PRINT maxi(j1)
FOR i = 1 TO 18
LOCATE 2 + i, 3 + 3 * j1: PRINT tabl(i, j1)
LOCATE 2 + i, 53 + 3 * j1: PRINT tabl1(i, j1)
NEXT i
NEXT j1

END SUB

SUB aide

SCREEN 9, , 1, 1
CLS

LOCATE 4, 30: PRINT "***  Aide … columns  ***"
LOCATE 7, 5: PRINT "Le jeu consiste … aligner au moins 3 couleurs identiques"
LOCATE 11, 10: PRINT "- Pour cela, d‚placez-vous avec les touches Gauche ou Droite"
LOCATE 14, 10: PRINT "- Pour faire tourner les couleurs, utilisez la touche Haut"
LOCATE 17, 10: PRINT "- Pour faire tomber la piŠce, utilisez la touche Bas"
LOCATE 21, 5: PRINT "A partir de 500 points, la vitesse acc‚lŠre."

DO: k$ = INKEY$: LOOP UNTIL k$ = CHR$(13)

SCREEN 9, , 0, 0

END SUB

FUNCTION auto

IF x < xauto THEN auto = 3
IF x > xauto THEN auto = 1
IF x = xauto THEN IF colauto > colpos THEN auto = 5 ELSE auto = 0


END FUNCTION

FUNCTION calcpoints (xt, ct) 'xtest et couleur test


DIM tablt(-1 TO 20, -1 TO 8)
DIM colt(1 TO 3)
DIM pointt


FOR i = -1 TO 20
        FOR j = -1 TO 8
                IF j >= 1 AND j <= 6 AND i >= 1 AND i <= 18 THEN
                        tablt(i, j) = tabl(i, j)
                ELSE
                        tablt(i, j) = 1
                END IF
        NEXT j
NEXT i


SELECT CASE ct
        CASE 0: colt(1) = c1: colt(2) = c2: colt(3) = c3
        CASE 1: colt(1) = c2: colt(2) = c3: colt(3) = c1
        CASE 2: colt(1) = c3: colt(2) = c1: colt(3) = c2
END SELECT


tablt(maxi(xt), xt) = colt(1): tablt(maxi(xt) - 1, xt) = colt(2): tablt(maxi(xt) - 2, xt) = colt(3)


pointt = 0

FOR i = 1 TO 3

        IF tablt(maxi(xt) - i + 1 - 1, xt - 1) = colt(i) THEN
                pointt = pointt + 2
                IF tablt(maxi(xt) - i + 1 - 2, xt - 2) = colt(i) OR tablt(maxi(xt) - i + 1 + 1, xt + 1) = colt(i) THEN pointt = pointt + 8
                IF tablt(maxi(xt) - i + 1 - 2, xt - 2) = 0 OR tablt(maxi(xt) - i + 1 + 1, xt + 1) = 0 THEN pointt = pointt + 4
        END IF

        IF tablt(maxi(xt) - i + 1, xt - 1) = colt(i) THEN
                pointt = pointt + 2
                IF tablt(maxi(xt) - i + 1, xt - 2) = colt(i) OR tablt(maxi(xt) - i + 1, xt + 1) = colt(i) THEN pointt = pointt + 8
                IF tablt(maxi(xt) - i + 1, xt - 2) = 0 OR tablt(maxi(xt) - i + 1, xt + 1) = 0 THEN pointt = pointt + 4
        END IF
       
        IF tablt(maxi(xt) - i + 1 + 1, xt - 1) = colt(i) THEN
                pointt = pointt + 2
                IF tablt(maxi(xt) - i + 1 + 2, xt - 2) = colt(i) OR tablt(maxi(xt) - i + 1 - 1, xt + 1) = colt(i) THEN pointt = pointt + 8
                IF tablt(maxi(xt) - i + 1 + 2, xt - 2) = 0 OR tablt(maxi(xt) - i + 1 - 1, xt + 1) = 0 THEN pointt = pointt + 4
        END IF

        IF tablt(maxi(xt) - i + 1 + 1, xt) = colt(i) THEN
                pointt = pointt + 2
                IF tablt(maxi(xt) - i + 1 + 2, xt) = colt(i) OR tablt(maxi(xt) - i + 1 - 1, xt) = colt(i) THEN pointt = pointt + 8
                IF tablt(maxi(xt) - i + 1 + 2, xt) = 0 OR tablt(maxi(xt) - i + 1 - 1, xt) = 0 THEN pointt = pointt + 4
        END IF
       
        IF tablt(maxi(xt) - i + 1 + 1, xt + 1) = colt(i) THEN
                pointt = pointt + 2
                IF tablt(maxi(xt) - i + 1 + 2, xt + 2) = colt(i) OR tablt(maxi(xt) - i + 1 - 1, xt - 1) = colt(i) THEN pointt = pointt + 8
                IF tablt(maxi(xt) - i + 1 + 2, xt + 2) = 0 OR tablt(maxi(xt) - i + 1 - 1, xt - 1) = 0 THEN pointt = pointt + 4
        END IF
       
        IF tablt(maxi(xt) - i + 1, xt + 1) = colt(i) THEN
                pointt = pointt + 2
                IF tablt(maxi(xt) - i + 1, xt + 2) = colt(i) OR tablt(maxi(xt) - i + 1, xt - 1) = colt(i) THEN pointt = pointt + 8
                IF tablt(maxi(xt) - i + 1, xt + 2) = 0 OR tablt(maxi(xt) - i + 1, xt - 1) = 0 THEN pointt = pointt + 4
        END IF
       
        IF tablt(maxi(xt) - i + 1 - 1, xt + 1) = colt(i) THEN
                pointt = pointt + 2
                IF tablt(maxi(xt) - i + 1 - 2, xt + 2) = colt(i) OR tablt(maxi(xt) - i + 1 + 1, xt - 1) = colt(i) THEN pointt = pointt + 8
                IF tablt(maxi(xt) - i + 1 - 2, xt + 2) = 0 OR tablt(maxi(xt) - i + 1 + 1, xt - 1) = 0 THEN pointt = pointt + 4
        END IF

NEXT i

calcpoints = pointt + INT(maxi(xt) / 5)


END FUNCTION

SUB Choix

CLS : SCREEN 9, 0, 0: COLOR 15, 0

COLOR 13: LOCATE 5, 30: PRINT "COLUMNS For QBasic"
COLOR 15: LOCATE 8, 33:  PRINT "Modes de jeu"

LOCATE 11, 31: PRINT "1 : Jouer"
LOCATE 12, 31: PRINT "2 : D‚monstration"
LOCATE 15, 31: PRINT "Votre choix ? "

DO: k$ = INKEY$: LOOP UNTIL k$ = "1" OR k$ = "2"

SELECT CASE k$
        CASE "1": Mode = 1
        CASE "2": Mode = 2
END SELECT

LOCATE 15, 45: PRINT k$

SLEEP 1


END SUB

SUB Choixauto

DIM parmi(1 TO 18, 2)


max = 0
maxp = 0
xauto = 0
FOR i = 1 TO 6
        FOR j = 0 TO 2
       
                pointt = calcpoints(i, j)

                IF pointt > max THEN maxp = 0
                IF pointt >= max THEN maxp = maxp + 1: parmi(maxp, 0) = i: parmi(maxp, 1) = j: max = pointt
                
        NEXT j
NEXT i


maxrnd = INT(RND * maxp) + 1
xauto = parmi(maxrnd, 0)
colauto = parmi(maxrnd, 1)


END SUB

FUNCTION clavier (k$)

SELECT CASE k$
        CASE CHR$(0) + "K":  'gauche
                clavier = 1
        CASE CHR$(0) + "M":  'droite
                clavier = 3
        CASE CHR$(0) + "H":  'haut
                clavier = 5
        CASE CHR$(0) + "P":  'bas
                clavier = 2
        CASE ELSE: clavier = 0
END SELECT

END FUNCTION

SUB FIN (col())

FOR j = 1 TO 6: FOR i = 18 TO 3 STEP -3
c1 = col(RND * 5 + 1)
c2 = col(RND * 5 + 1)
c3 = col(RND * 5 + 1)
affcol j, i, c1, c2, c3
FOR k = 1 TO 5000: NEXT k
NEXT i: NEXT j

COLOR 15
LOCATE 11, 32: PRINT STRING$(16, 176)
LOCATE 12, 32: PRINT STRING$(2, 176) + " GAME  OVER " + STRING$(2, 176)
LOCATE 13, 32: PRINT STRING$(16, 176)

SLEEP

END

END SUB

SUB init

CLS : SCREEN 9, 0, 0

COLOR 10: LOCATE 2, 32: PRINT "*** COLUMNS ***"

larg = 18
haut = 18

COLOR 15
FOR i = 1 TO haut
LOCATE 4 + i, 30: PRINT CHR$(219) + SPACE$(larg) + CHR$(219)
NEXT i
LOCATE , 30: PRINT STRING$(larg + 2, CHR$(219))

COLOR 13: LOCATE 7, 58: PRINT "Points : 0"
LOCATE 10, 58: PRINT "Prochain :"

COLOR 8: LOCATE 24, 70: PRINT "(F1=Help)";

COLOR 15

END SUB

FUNCTION mizajour (tabl(), tabl1(), points)

k1 = 0

FOR i = 18 TO 3 STEP -1: FOR j = 1 TO 6
IF tabl1(i, j) = -1 THEN
k1 = 1
tabl1(i, j) = 1
IF tabl1(2, j) = -1 THEN tabl1(2, j) = 1
IF tabl1(1, j) = -1 THEN tabl1(1, j) = 1
IF i > 3 THEN
affcol j, i, 0, tabl(i - 1, j), tabl(i - 2, j)
ELSE
affcol j, i, 0, tabl(i - 1, j) * (1 - tabl1(i - 1, j)), tabl(i - 2, j) * (1 - tabl1(i - 2, j))
END IF
END IF
NEXT j: NEXT i

FOR i = 1 TO 20000: NEXT i

FOR i = 18 TO 3 STEP -1: FOR j = 1 TO 6
IF tabl1(i, j) = 1 THEN
affcol j, i, tabl(i, j), tabl(i - 1, j), tabl(i - 2, j)
END IF
NEXT j: NEXT i

FOR i = 1 TO 20000: NEXT i

FOR i = 18 TO 3 STEP -1: FOR j = 1 TO 6
IF tabl1(i, j) = 1 THEN
affcol j, i, 0, tabl(i - 1, j), tabl(i - 2, j)
END IF
NEXT j: NEXT i

COLOR 13: LOCATE 7, 66: PRINT points

DO
k = 0
FOR j = 1 TO 6: FOR i = 18 TO 2 STEP -1
IF tabl1(i, j) = 1 OR k = j THEN
k = j
IF i > 3 THEN
affcol j, i, tabl(i - 1, j), tabl(i - 2, j), tabl(i - 3, j)
ELSE
IF i = 3 THEN
affcol j, i, tabl(i - 1, j), tabl(i - 2, j), 0
END IF
END IF
tabl(i, j) = tabl(i - 1, j): tabl1(i, j) = tabl1(i - 1, j)
END IF
NEXT i
IF k = j THEN tabl(1, j) = 0: tabl1(1, j) = 0
NEXT j
LOOP UNTIL k = 0

mizajour = k1

END FUNCTION

SUB verif (tabl(), tabl1(), points)

' HORIZONTAL

FOR i = 1 TO 18
FOR j = 1 TO 4
c = tabl(i, j)
IF c > 0 THEN
IF tabl(i, j + 1) = c AND tabl(i, j + 2) = c THEN
k = 0
points = points + 10
DO
tabl1(i, j + k) = -1
IF k > 3 THEN points = points + 20
k = k + 1
IF j + k > 6 THEN l = 1 ELSE IF tabl(i, j + k) <> c THEN l = 1 ELSE l = 0
LOOP UNTIL l = 1
END IF
END IF
NEXT j: NEXT i


' VERTICAL

FOR i = 1 TO 16
FOR j = 1 TO 6
c = tabl(i, j)
IF c > 0 THEN
IF tabl(i + 1, j) = c AND tabl(i + 2, j) = c THEN
k = 0
points = points + 10
DO
tabl1(i + k, j) = -1
IF k > 3 THEN points = points + 20
k = k + 1
IF i + k > 18 THEN l = 1 ELSE IF tabl(i + k, j) <> c THEN l = 1 ELSE l = 0
LOOP UNTIL l = 1
END IF
END IF
NEXT j: NEXT i

' DIAGONAL BAS

FOR i = 1 TO 16
FOR j = 1 TO 4
c = tabl(i, j)
IF c > 0 THEN
IF tabl(i + 1, j + 1) = c AND tabl(i + 2, j + 2) = c THEN
k = 0
points = points + 10
DO
tabl1(i + k, j + k) = -1
IF k > 3 THEN points = points + 20
k = k + 1
IF j + k > 6 OR i + k > 18 THEN l = 1 ELSE IF tabl(i + k, j + k) <> c THEN l = 1 ELSE l = 0
LOOP UNTIL l = 1
END IF
END IF
NEXT j: NEXT i

' DIAGONAL HAUT

FOR i = 3 TO 18
FOR j = 1 TO 4
c = tabl(i, j)
IF c > 0 THEN
IF tabl(i - 1, j + 1) = c AND tabl(i - 2, j + 2) = c THEN
k = 0
points = points + 10
DO
tabl1(i - k, j + k) = -1
IF k > 3 THEN points = points + 20
k = k + 1
IF j + k > 6 OR i - k < 1 THEN l = 1 ELSE IF tabl(i - k, j + k) <> c THEN l = 1 ELSE l = 0
LOOP UNTIL l = 1
END IF
END IF
NEXT j: NEXT i




END SUB