DP Tool Club 8/CDASC08.ISO/NEWS/439/TETRISCK/QBASIC

Text File | 1993-10-07 | 8KB | 326 lines

DECLARE SUB debut ()
DECLARE SUB lignes ()
DECLARE SUB ajoute ()
DECLARE SUB nouvelle ()
DECLARE SUB copie ()
DECLARE FUNCTION essaie! (x AS INTEGER, Y AS INTEGER)
DECLARE SUB surveille ()
DECLARE SUB chargeen ()
DECLARE SUB tourne (n AS INTEGER)
DECLARE SUB effaceen (x AS INTEGER, Y AS INTEGER)
DECLARE SUB videen ()
DECLARE SUB decor ()
DECLARE SUB tire ()
DECLARE SUB afficheen (x AS INTEGER, Y AS INTEGER)




DIM SHARED jeu(15, 20)
DIM SHARED en(4, 4)
DIM SHARED es(4, 4)

COMMON SHARED xpos AS INTEGER, ypos AS INTEGER, compteur AS LONG, fini AS INTEGER, score AS INTEGER


debut
fini = 0
decor
tire
        nouvelle
        DO WHILE fini = 0

                surveille

                IF compteur / 6 = INT(compteur / 6) OR ypos = 18 THEN
                        copie
                        r = essaie(xpos, ypos + 1)

                        IF r = 0 THEN

                                ajoute
                                lignes
                                nouvelle



                        END IF


                END IF
                compteur = compteur + 1

        LOOP

END

SUB afficheen (x AS INTEGER, Y AS INTEGER)

        FOR i = 0 TO 3
                FOR j = 0 TO 3
                        xn = (xpos + j) * 2 + 26
                        IF en(j, i) THEN
                                LOCATE i + ypos + 3, xn
                                PRINT "██"
                        END IF
                NEXT j
        NEXT i

END SUB

SUB ajoute

        FOR i = 0 TO 3
                FOR j = 0 TO 3
                        IF en(i, j) THEN jeu(xpos + i, ypos + j) = en(i, j)
                NEXT j
        NEXT i

END SUB

SUB chargeen

        FOR i = 0 TO 3
                FOR j = 0 TO 3
                        en(i, j) = es(i, j)
                NEXT j
        NEXT i

END SUB

SUB copie

        FOR i = 0 TO 3
                FOR j = 0 TO 3
                        es(i, j) = en(i, j)
                NEXT j
        NEXT i

END SUB

SUB debut

        CLS
        PRINT "Tetris"
        PRINT "Version programmée par"
        PRINT "Thibault JAMME, 1993"
        PRINT
        PRINT "Appuyez sur une touche"

        i$ = ""
        DO WHILE LEN(i$) = 0
                i$ = INKEY$
                h = RND(1)
        LOOP

END SUB

SUB decor

        CLS

        FOR i = 1 TO 20
                LOCATE i + 1, 25
                PRINT "│                              │"
        NEXT i
        LOCATE 22, 25
        PRINT "└──────────────────────────────┘"

END SUB

SUB effaceen (x AS INTEGER, Y AS INTEGER)

        FOR i = 0 TO 3
                FOR j = 0 TO 3
                        xn = (xpos + j) * 2 + 26
                        IF en(j, i) THEN
                                LOCATE i + Y + 3, xn
                                PRINT "  "
                        END IF
                NEXT j
        NEXT i

END SUB

FUNCTION essaie (xn AS INTEGER, yn AS INTEGER)

        retour = 1
        FOR i = 0 TO 3
                FOR j = 0 TO 3


                        IF es(i, j) THEN

                                IF xn + i >= 15 THEN retour = 0
                                IF yn + j >= 19 THEN retour = 0

                                IF xn + i < 0 THEN retour = 0
                                IF yn + j < 0 THEN retour = 0

                                IF retour THEN IF jeu(xn + i, yn + j) THEN retour = 0
                        END IF
                NEXT j
        NEXT i

        IF retour <> 0 THEN
                effaceen xpos, ypos
                xpos = xn
                ypos = yn
                chargeen
                afficheen xpos, ypos
        END IF

        essaie = retour

END FUNCTION

SUB lignes

        LOCATE 1, 1
        FOR i = 0 TO 18
                total = 0
                FOR j = 0 TO 14
                        total = total + jeu(j, i)
                NEXT j

                IF total = 15 THEN

                        score = score + 100
                        LOCATE 1, 1
                        PRINT "["; score; "]  ";

                        PRINT i

                        FOR l = i TO 1 STEP -1

                                FOR c = 0 TO 14
                                        sa = jeu(c, l - 1)
                                        jeu(c, l) = sa
                                        LOCATE l + 3, c * 2 + 26

                                        IF sa = 1 THEN PRINT "██" ELSE PRINT "  "
                                NEXT c

                                LOCATE 2, 26
                                PRINT "thib                            "
                                FOR c = 0 TO 14
                                        jeu(c, 0) = 0
                                NEXT c


                        NEXT l

                END IF
        NEXT i
END SUB

SUB nouvelle

        compteur = 0
        xpos = INT(RND(1) * 10)
        ypos = 0
        tire   'remplit en avec une des 7 briques possibles
        afficheen xpos, ypos

END SUB

SUB surveille


                i$ = INKEY$
                car = -1
                IF LEN(i$) THEN car = ASC(i$)
                IF car = 0 THEN car = ASC(RIGHT$(i$, 1))

                IF car = 13 THEN
                        tourne 1
                        r = essaie(xpos, ypos)
                END IF

                IF car = 8 THEN
                        tourne 2
                        r = essaie(xpos, ypos)
                END IF

                IF car = 27 THEN fini = 1


                copie


                IF car = 77 THEN r = essaie(xpos + 1, ypos)
                IF car = 75 THEN r = essaie(xpos - 1, ypos)
                IF car = 80 THEN r = essaie(xpos, ypos + 1)


END SUB

SUB tire
        videen   ' pour vider "en"

        n = INT(RND(1) * 7)

        IF n = 0 THEN
                en(0, 2) = 1: en(0, 3) = 1
                en(1, 2) = 1: en(1, 3) = 1
        END IF

        IF n = 1 THEN
                en(0, 3) = 1: en(1, 3) = 1: en(2, 3) = 1
                en(2, 2) = 1
        END IF

        IF n = 2 THEN
                en(0, 3) = 1: en(1, 3) = 1: en(2, 3) = 1
                en(1, 2) = 1
        END IF

        IF n = 3 THEN
                en(0, 3) = 1: en(1, 3) = 1
                en(2, 3) = 1: en(3, 3) = 1
        END IF

        IF n = 4 THEN
                en(0, 0) = 1
                en(0, 1) = 1: en(1, 1) = 1: en(2, 1) = 1
        END IF

        IF n = 5 THEN
                en(0, 1) = 1: en(1, 1) = 1
                en(1, 2) = 1: en(2, 2) = 1
        END IF

        IF n = 6 THEN
                en(0, 2) = 1: en(1, 2) = 1
                en(1, 1) = 1: en(2, 1) = 1
        END IF

        REM Tirer un nombre au hasard pour faire une rotation!

END SUB

SUB tourne (n AS INTEGER)

        FOR i = 0 TO 3
                FOR j = 0 TO 3
                        nx = j
                        ny = i
                        IF n = 2 THEN ny = 3 - ny
                        IF n = 1 THEN nx = 3 - nx
                        es(nx, ny) = en(i, j)
                NEXT j
        NEXT i

END SUB

SUB videen

        FOR i = 0 TO 3
                FOR j = 0 TO 3
                        en(i, j) = 0
                NEXT j
        NEXT i

END SUB