Qbasicnews.com
September 17, 2019, 05:55:58 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Tetris game for Mech :)  (Read 3227 times)
Meg
Ancient QBer
****
Posts: 483


« on: July 04, 2003, 03:15:05 PM »

Since you said you loved Tetris, here's an ancient prog. I wrote back when I was like 16 or so..

*peace*


Meg.

Code:
DECLARE SUB Makesound ()
DECLARE SUB WriteHiScores ()
DECLARE SUB CheckHighScores ()
DECLARE SUB DrawNextPiece ()
DECLARE SUB DrawScore ()
DECLARE SUB WriteTetris ()
DECLARE SUB CheckRowDrop ()
DECLARE SUB Rotate.P7 ()
DECLARE SUB Rotate.P6 ()
DECLARE SUB Rotate.P5 ()
DECLARE SUB Rotate.P4 ()
DECLARE SUB RotatePiece ()
DECLARE SUB Rotate.P2 ()
DECLARE SUB Rotate.P3 ()
DECLARE SUB NewPiece ()
DECLARE SUB EraseBlock ()
DECLARE SUB MainProgram ()
DECLARE SUB EndProgram ()
DECLARE SUB PlayAgain ()
DECLARE SUB MovePiece ()
DECLARE SUB LoadPiece ()
DECLARE SUB DrawPiece ()
DECLARE SUB ErasePiece ()
DECLARE SUB MovePieceRight ()
DECLARE SUB MovePieceLeft ()
DECLARE SUB DrawBlock ()
DECLARE SUB Initialize ()
DECLARE SUB DrawScreen ()
DECLARE SUB Pause ()

COMMON SHARED BlockX, BlockY, BlockColor, NextPiece, Speed
COMMON SHARED Dead, Quit, Piece, OldT, Facing, Score
DIM SHARED S(0 TO 11, 0 TO 14)     'Screen Layout
DIM SHARED SC(10, 13)              'Screen Colors
DIM SHARED BX(4)                   'Block Coordinate-X
DIM SHARED BY(4)                   'Block Coordinate-Y
DIM SHARED NBX(4)                  'Next Block Coordinate-X
DIM SHARED NBY(4)                  'Next Block Coordinate-Y
DIM SHARED Winner$(10)             'Winner's Name
DIM SHARED WinScore(10)            'Winner's Score

DO
     CLEAR
     CALL Initialize
     CALL DrawScreen
     CALL MainProgram
     CALL PlayAgain
LOOP UNTIL Quit = 1
CALL EndProgram
CALL Pause
END

SUB CheckHighScores
     OPEN "HISCORES.TET" FOR INPUT AS #1
          FOR Temp = 1 TO 10
               INPUT #1, Winner$(Temp)
               INPUT #1, WinScore(Temp)
          NEXT Temp
     CLOSE #1

     FOR Temp = 1 TO 10
          IF Score > WinScore(Temp) THEN
               CLS
               CALL DrawScreen
               FOR Switch = 10 TO Temp STEP -1
                    Winner$(Switch) = Winner$(Switch - 1)
                    WinScore(Switch) = WinScore(Switch - 1)
               NEXT Switch
               LOCATE 5, 11
               PRINT "You have taken place"; Temp; "!!"
               LOCATE 6, 11
               INPUT "What is your name? ", Winner$(Temp)
               WinScore(Temp) = Score
               EXIT FOR
          END IF
     NEXT Temp

     OPEN "HISCORES.TET" FOR OUTPUT AS #1
          FOR Temp = 1 TO 10
               PRINT #1, Winner$(Temp)
               PRINT #1, WinScore(Temp)
          NEXT Temp
     CLOSE #1
END SUB

SUB CheckRowDrop
     FOR Y = 13 TO 2 STEP -1
          Blank = 0
          FOR x = 1 TO 10
               IF S(x, Y) = 0 THEN
                    Blank = 1
               END IF
          NEXT x

          IF Blank = 0 THEN
               Rows = Rows + 1
               FOR TempY = Y TO 2 STEP -1
                    FOR TempX = 1 TO 10
                         BlockX = TempX
                         BlockY = TempY
                         CALL EraseBlock
                         S(TempX, TempY) = S(TempX, TempY - 1)
                         SC(TempX, TempY) = SC(TempX, TempY - 1)
                         IF S(TempX, TempY) = 1 THEN
                              BlockColor = SC(TempX, TempY)
                              CALL DrawBlock
                         END IF
                    NEXT TempX
               NEXT TempY
               FOR TempX = 1 TO 10
                    S(TempX, 1) = 0
                    SC(TempX, 1) = 0
                    BlockX = TempX
                    BlockY = 1
                    CALL EraseBlock
               NEXT TempX
               Y = Y + 1
          END IF
     NEXT Y
   
     IF Rows > 0 THEN
          SELECT CASE Rows
               CASE 1
                    Score = Score + 50
               CASE 2
                    Score = Score + 100
               CASE 3
                    Score = Score + 200
               CASE 4
                    Score = Score + 500
                    CALL WriteTetris
          END SELECT
          CALL DrawScore
     END IF
END SUB

SUB DrawBlock
     TempBlockX = BlockX * 34 - 24
     TempBlockY = BlockY * 34 - 23
     LINE (TempBlockX, TempBlockY)-(TempBlockX + 33, TempBlockY + 33), BlockColor, BF
     LINE (TempBlockX, TempBlockY)-(TempBlockX, TempBlockY + 33), 8
     LINE (TempBlockX, TempBlockY + 33)-(TempBlockX + 33, TempBlockY + 33), 8
     LINE (TempBlockX + 1, TempBlockY)-(TempBlockX + 1, TempBlockY + 32), 8
     LINE (TempBlockX + 1, TempBlockY + 32)-(TempBlockX + 33, TempBlockY + 32), 8
END SUB

SUB DrawNextPiece
     SELECT CASE NextPiece
          CASE 1
               NBX(1) = 5
               NBY(1) = 1
               NBX(2) = 6
               NBY(2) = 1
               NBX(3) = 5
               NBY(3) = 2
               NBX(4) = 6
               NBY(4) = 2
          CASE 2
               NBX(1) = 5
               NBY(1) = 1
               NBX(2) = 4
               NBY(2) = 1
               NBX(3) = 6
               NBY(3) = 1
               NBX(4) = 7
               NBY(4) = 1
          CASE 3
               NBX(1) = 5
               NBY(1) = 2
               NBX(2) = 4
               NBY(2) = 1
               NBX(3) = 4
               NBY(3) = 2
               NBX(4) = 6
               NBY(4) = 2
          CASE 4
               NBX(1) = 5
               NBY(1) = 2
               NBX(2) = 6
               NBY(2) = 1
               NBX(3) = 6
               NBY(3) = 2
               NBX(4) = 4
               NBY(4) = 2
          CASE 5
               NBX(1) = 5
               NBY(1) = 1
               NBX(2) = 6
               NBY(2) = 1
               NBX(3) = 5
               NBY(3) = 2
               NBX(4) = 4
               NBY(4) = 2
          CASE 6
               NBX(1) = 5
               NBY(1) = 1
               NBX(2) = 4
               NBY(2) = 1
               NBX(3) = 5
               NBY(3) = 2
               NBX(4) = 6
               NBY(4) = 2
          CASE 7
               NBX(1) = 5
               NBY(1) = 2
               NBX(2) = 5
               NBY(2) = 1
               NBX(3) = 4
               NBY(3) = 2
               NBX(4) = 6
               NBY(4) = 2
     END SELECT
     LINE (389, 191)-(572, 309), 0, BF
     FOR Temp = 1 TO 4
          BlockX = NBX(Temp) + 9
          BlockY = NBY(Temp) + 6
          BlockColor = NextPiece
          CALL DrawBlock
     NEXT Temp
END SUB

SUB DrawPiece
     FOR Temp = 1 TO 4
          BlockColor = Piece
          BlockX = BX(Temp)
          BlockY = BY(Temp)
          CALL DrawBlock
     NEXT Temp
END SUB

SUB DrawScore
     LOCATE 4, 46: PRINT "SCORE:"; Score
     SELECT CASE Score
          CASE IS > 13000
               Speed = .1
          CASE IS > 7000
               Speed = .2
          CASE IS > 3000
               Speed = .3
          CASE IS > 1000
               Speed = .4
     END SELECT
END SUB

SUB DrawScreen
     LINE (0, 0)-(639, 479), 1, B
     LINE (9, 9)-(351, 454), 8, B
     LINE (388, 190)-(573, 310), 8, B
     LOCATE 2, 46
     PRINT " TETRIS by Megan Berry: 10/19/96."
     LOCATE 11, 46: PRINT "          Next Piece"
END SUB

SUB EndProgram
     SCREEN 0
     CLS
     PRINT "Thanks for playing Tetris by Megan Berry."
     PRINT "Come back later!"
END SUB

SUB EraseBlock
     TempBlockX = BlockX * 34 - 24
     TempBlockY = BlockY * 34 - 23
     LINE (TempBlockX, TempBlockY)-(TempBlockX + 33, TempBlockY + 33), 0, BF
END SUB

SUB ErasePiece
     FOR Temp = 1 TO 4
          BlockX = BX(Temp)
          BlockY = BY(Temp)
          CALL EraseBlock
     NEXT Temp
END SUB

SUB Initialize
   
     CALL Exist("HISCORES.TET" + CHR$(0), FileExists%)
     IF NOT FileExists% THEN
          OPEN "HISCORES.TET" FOR OUTPUT AS #1
               FOR Temp = 1 TO 10
                    PRINT #1, ""
                    PRINT #1, 0
               NEXT Temp
          CLOSE #1
     END IF
   
     RANDOMIZE TIMER
     SCREEN 12
     CLS
     COLOR 15
     Speed = .5
     FOR x = 0 TO 11
          FOR Y = 0 TO 14
               IF x = 0 OR x = 11 OR Y = 0 OR Y = 14 THEN
                    S(x, Y) = 1
               END IF
          NEXT Y
     NEXT x
     CALL DrawScore
END SUB

SUB LoadPiece
     SELECT CASE Piece
          CASE 1
               BX(1) = 5
               BY(1) = 1
               BX(2) = 6
               BY(2) = 1
               BX(3) = 5
               BY(3) = 2
               BX(4) = 6
               BY(4) = 2
          CASE 2
               BX(1) = 5
               BY(1) = 1
               BX(2) = 4
               BY(2) = 1
               BX(3) = 6
               BY(3) = 1
               BX(4) = 7
               BY(4) = 1
          CASE 3
               BX(1) = 5
               BY(1) = 2
               BX(2) = 4
               BY(2) = 1
               BX(3) = 4
               BY(3) = 2
               BX(4) = 6
               BY(4) = 2
          CASE 4
               BX(1) = 5
               BY(1) = 2
               BX(2) = 6
               BY(2) = 1
               BX(3) = 6
               BY(3) = 2
               BX(4) = 4
               BY(4) = 2
          CASE 5
               BX(1) = 5
               BY(1) = 1
               BX(2) = 6
               BY(2) = 1
               BX(3) = 5
               BY(3) = 2
               BX(4) = 4
               BY(4) = 2
          CASE 6
               BX(1) = 5
               BY(1) = 1
               BX(2) = 4
               BY(2) = 1
               BX(3) = 5
               BY(3) = 2
               BX(4) = 6
               BY(4) = 2
          CASE 7
               BX(1) = 5
               BY(1) = 2
               BX(2) = 5
               BY(2) = 1
               BX(3) = 4
               BY(3) = 2
               BX(4) = 6
               BY(4) = 2
     END SELECT
     Facing = 1
END SUB

SUB MainProgram
     Piece = INT(RND * 7) + 1
     NextPiece = INT(RND * 7) + 1
     CALL LoadPiece
     CALL DrawPiece
     CALL DrawNextPiece
     OldT = TIMER + Speed
     DO
          DO
               C$ = UCASE$(INKEY$)
          LOOP UNTIL C$ <> "" OR TIMER > OldT
          IF TIMER > OldT THEN
               CALL MovePiece
               OldT = TIMER + Speed
          END IF
          SELECT CASE MID$(C$, 2, 1)
               CASE "M"
                    CALL MovePieceRight
               CASE "K"
                    CALL MovePieceLeft
               CASE "P"
                    CALL MovePiece
                    Score = Score + 1
                    CALL DrawScore
                    OldT = TIMER + Speed
          END SELECT
          IF C$ = " " THEN
               CALL RotatePiece
          END IF
     LOOP UNTIL Dead = 1 OR C$ = "Q"
END SUB

SUB Makesound
FOR x = 1000 TO 300 STEP -500
    SOUND x, .03
NEXT x
END SUB

SUB MovePiece
     FOR Temp = 1 TO 4
          IF S(BX(Temp), BY(Temp) + 1) = 1 THEN
               CantMove = 1
          END IF
     NEXT Temp

     IF CantMove = 0 THEN
          CALL ErasePiece
          FOR Temp = 1 TO 4
               BY(Temp) = BY(Temp) + 1
          NEXT Temp
          CALL DrawPiece
     ELSE
          CALL Makesound
          CALL ClrKbd
          FOR Temp = 1 TO 4
               S(BX(Temp), BY(Temp)) = 1
               SC(BX(Temp), BY(Temp)) = BlockColor
          NEXT Temp
          Score = Score + 10
          CALL DrawScore
          CALL CheckRowDrop
          CALL NewPiece
     END IF
END SUB

SUB MovePieceLeft
     FOR Temp = 1 TO 4
          IF S(BX(Temp) - 1, BY(Temp)) = 1 THEN
               CantMove = 1
          END IF
     NEXT Temp

     IF CantMove = 0 THEN
          CALL ErasePiece
          FOR Temp = 1 TO 4
               BX(Temp) = BX(Temp) - 1
          NEXT Temp
          CALL DrawPiece
     END IF
END SUB

SUB MovePieceRight
     FOR Temp = 1 TO 4
          IF S(BX(Temp) + 1, BY(Temp)) = 1 THEN
               CantMove = 1
          END IF
     NEXT Temp

     IF CantMove = 0 THEN
          CALL ErasePiece
          FOR Temp = 1 TO 4
               BX(Temp) = BX(Temp) + 1
          NEXT Temp
          CALL DrawPiece
     END IF
END SUB

SUB NewPiece
     Piece = NextPiece
     CALL LoadPiece
     CALL DrawPiece
     NextPiece = INT(RND * 7) + 1
     CALL DrawNextPiece
   
     FOR Temp = 1 TO 4
          IF S(BX(Temp), BY(Temp)) THEN
               Dead = 1
          END IF
     NEXT Temp
END SUB

SUB Pause
     DO
     LOOP UNTIL INKEY$ <> ""
END SUB

SUB PlayAgain
     CALL CheckHighScores
     CALL WriteHiScores
     CLS
     CALL DrawScreen
     LOCATE 12, 10: PRINT "       GAME OVER!"
     LOCATE 14, 10: PRINT "Do you want to play again?"
     DO
          C$ = UCASE$(INKEY$)
     LOOP UNTIL C$ = "Y" OR C$ = "N"
     IF C$ = "N" THEN
          Quit = 1
     END IF
END SUB

SUB Rotate.P2
     SELECT CASE Facing
          CASE 1
               IF S(BX(1), BY(1) + 2) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1), BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 1
                    BY(2) = BY(2) - 1
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) - 2
                    BY(4) = BY(4) + 2
                    CALL DrawPiece
                    Facing = 2
               END IF
          CASE 2
               IF BX(3) < 9 THEN
                    IF S(BX(3) - 1, BY(3)) = 0 AND S(BX(3) + 1, BY(3)) = 0 AND S(BX(3) + 2, BY(3)) = 0 THEN
                         CALL ErasePiece
                         BX(1) = BX(1) + 1
                         BY(1) = BY(1) + 1
                         BX(2) = BX(2) + 2
                         BY(2) = BY(2) + 2
                         BX(3) = BX(3)
                         BY(3) = BY(3)
                         BX(4) = BX(4) - 1
                         BY(4) = BY(4) - 1
                         CALL DrawPiece
                         Facing = 3
                    END IF
               END IF
          CASE 3
               IF S(BX(1), BY(1) + 1) = 0 AND S(BX(1), BY(1) - 1) = 0 AND S(BX(1), BY(1) - 2) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 1
                    BY(2) = BY(2) + 1
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) + 2
                    BY(4) = BY(4) - 2
                    CALL DrawPiece
                    Facing = 4
               END IF
          CASE 4
               IF BX(3) > 2 THEN
                    IF S(BX(3) - 2, BY(3)) = 0 AND S(BX(3) - 1, BY(3)) = 0 AND S(BX(3) + 1, BY(3)) = 0 THEN
                         CALL ErasePiece
                         BX(1) = BX(1) - 1
                         BY(1) = BY(1) - 1
                         BX(2) = BX(2) - 2
                         BY(2) = BY(2) - 2
                         BX(3) = BX(3)
                         BY(3) = BY(3)
                         BX(4) = BX(4) + 1
                         BY(4) = BY(4) + 1
                         CALL DrawPiece
                         Facing = 1
                    END IF
               END IF
          END SELECT
END SUB

SUB Rotate.P3
     SELECT CASE Facing
          CASE 1
               IF S(BX(1) + 1, BY(1) - 1) = 0 AND S(BX(1), BY(1) - 1) = 0 AND S(BX(1), BY(1) + 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 2
                    BY(2) = BY(2)
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) - 1
                    BY(4) = BY(4) + 1
                    CALL DrawPiece
                    Facing = 2
               END IF
          CASE 2
               IF S(BX(1) + 1, BY(1)) = 0 AND S(BX(1) + 1, BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1)) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2)
                    BY(2) = BY(2) + 2
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) - 1
                    BY(4) = BY(4) - 1
                    CALL DrawPiece
                    Facing = 3
               END IF
          CASE 3
               IF S(BX(1), BY(1) - 1) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1) + 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 2
                    BY(2) = BY(2)
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) + 1
                    BY(4) = BY(4) - 1
                    CALL DrawPiece
                    Facing = 4
               END IF
          CASE 4
               IF S(BX(1) + 1, BY(1)) = 0 AND S(BX(1) - 1, BY(1)) = 0 AND S(BX(1) - 1, BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2)
                    BY(2) = BY(2) - 2
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) + 1
                    BY(4) = BY(4) + 1
                    CALL DrawPiece
                    Facing = 1
               END IF
     END SELECT
END SUB

SUB Rotate.P4
     SELECT CASE Facing
          CASE 1
               IF S(BX(1) + 1, BY(1) + 1) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1), BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2)
                    BY(2) = BY(2) + 2
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) + 1
                    BY(4) = BY(4) - 1
                    CALL DrawPiece
                    Facing = 2
               END IF
          CASE 2
               IF S(BX(1) + 1, BY(1)) = 0 AND S(BX(1) - 1, BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1)) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 2
                    BY(2) = BY(2)
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) + 1
                    BY(4) = BY(4) + 1
                    CALL DrawPiece
                    Facing = 3
               END IF
          CASE 3
               IF S(BX(1), BY(1) - 1) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2)
                    BY(2) = BY(2) - 2
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) - 1
                    BY(4) = BY(4) + 1
                    CALL DrawPiece
                    Facing = 4
               END IF
          CASE 4
               IF S(BX(1) + 1, BY(1) - 1) = 0 AND S(BX(1) + 1, BY(1)) = 0 AND S(BX(1) - 1, BY(1)) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 2
                    BY(2) = BY(2)
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) - 1
                    BY(4) = BY(4) - 1
                    CALL DrawPiece
                    Facing = 1
               END IF
     END SELECT
END SUB

SUB Rotate.P5
     SELECT CASE Facing
          CASE 1
               IF S(BX(1), BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1)) = 0 AND S(BX(1) - 1, BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 1
                    BY(2) = BY(2) + 1
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4)
                    BY(4) = BY(4) - 2
                    CALL DrawPiece
                    Facing = 2
               END IF
          CASE 2
               IF S(BX(1) + 1, BY(1) - 1) = 0 AND S(BX(1), BY(1) - 1) = 0 AND S(BX(1) - 1, BY(1)) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 1
                    BY(2) = BY(2) - 1
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) + 2
                    BY(4) = BY(4)
                    CALL DrawPiece
                    Facing = 3
               END IF
          CASE 3
               IF S(BX(1) + 1, BY(1) + 1) = 0 AND S(BX(1) + 1, BY(1)) = 0 AND S(BX(1), BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 1
                    BY(2) = BY(2) - 1
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4)
                    BY(4) = BY(4) + 2
                    CALL DrawPiece
                    Facing = 4
               END IF
          CASE 4
               IF S(BX(1) + 1, BY(1)) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1) + 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 1
                    BY(2) = BY(2) + 1
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) - 2
                    BY(4) = BY(4)
                    CALL DrawPiece
                    Facing = 1
               END IF
     END SELECT
END SUB

SUB Rotate.P6
     SELECT CASE Facing
          CASE 1
               IF S(BX(1), BY(1) - 1) = 0 AND S(BX(1) - 1, BY(1)) = 0 AND S(BX(1) - 1, BY(1) + 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 1
                    BY(2) = BY(2) - 1
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) - 2
                    BY(4) = BY(4)
                    CALL DrawPiece
                    Facing = 2
               END IF
          CASE 2
               IF S(BX(1) + 1, BY(1)) = 0 AND S(BX(1), BY(1) - 1) = 0 AND S(BX(1) - 1, BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 1
                    BY(2) = BY(2) + 1
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4)
                    BY(4) = BY(4) - 2
                    CALL DrawPiece
                    Facing = 3
               END IF
          CASE 3
               IF S(BX(1) + 1, BY(1) - 1) = 0 AND S(BX(1) + 1, BY(1)) = 0 AND S(BX(1), BY(1) + 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 1
                    BY(2) = BY(2) + 1
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) + 2
                    BY(4) = BY(4)
                    CALL DrawPiece
                    Facing = 4
               END IF
          CASE 4
               IF S(BX(1) + 1, BY(1) + 1) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1)) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 1
                    BY(2) = BY(2) - 1
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4)
                    BY(4) = BY(4) + 2
                    CALL DrawPiece
                    Facing = 1
               END IF
     END SELECT
END SUB

SUB Rotate.P7
     SELECT CASE Facing
          CASE 1
               IF S(BX(1) + 1, BY(1)) = 0 AND S(BX(1), BY(1) - 1) = 0 AND S(BX(1), BY(1) + 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 1
                    BY(2) = BY(2) + 1
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) - 1
                    BY(4) = BY(4) + 1
                    CALL DrawPiece
                    Facing = 2
               END IF
          CASE 2
               IF S(BX(1) + 1, BY(1)) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1) - 1, BY(1)) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 1
                    BY(2) = BY(2) + 1
                    BX(3) = BX(3) + 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) - 1
                    BY(4) = BY(4) - 1
                    CALL DrawPiece
                    Facing = 3
               END IF
          CASE 3
               IF S(BX(1) - 1, BY(1) - 1) = 0 AND S(BX(1), BY(1) + 1) = 0 AND S(BX(1), BY(1) - 1) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) - 1
                    BY(2) = BY(2) - 1
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) + 1
                    BX(4) = BX(4) + 1
                    BY(4) = BY(4) - 1
                    CALL DrawPiece
                    Facing = 4
               END IF
          CASE 4
               IF S(BX(1) - 1, BY(1)) = 0 AND S(BX(1), BY(1) - 1) = 0 AND S(BX(1) + 1, BY(1)) = 0 THEN
                    CALL ErasePiece
                    BX(1) = BX(1)
                    BY(1) = BY(1)
                    BX(2) = BX(2) + 1
                    BY(2) = BY(2) - 1
                    BX(3) = BX(3) - 1
                    BY(3) = BY(3) - 1
                    BX(4) = BX(4) + 1
                    BY(4) = BY(4) + 1
                    CALL DrawPiece
                    Facing = 1
               END IF
     END SELECT
END SUB

SUB RotatePiece
     SELECT CASE Piece
          CASE 2
               CALL Rotate.P2
          CASE 3
               CALL Rotate.P3
          CASE 4
               CALL Rotate.P4
          CASE 5
               CALL Rotate.P5
          CASE 6
               CALL Rotate.P6
          CASE 7
               CALL Rotate.P7
     END SELECT
END SUB

SUB WriteHiScores
     CLS
     CALL DrawScreen
     LOCATE 7, 13: PRINT "TETRIS HIGH SCORERS"
     LOCATE 10, 3: PRINT " #"; TAB(8); "Name"; TAB(33); "Score"
     OPEN "HISCORES.TET" FOR INPUT AS #1
          FOR Temp = 1 TO 10
               INPUT #1, Winner$(Temp)
               INPUT #1, WinScore(Temp)
               IF WinScore(Temp) > 0 THEN
                    LOCATE 11 + Temp, 3
                    PRINT Temp; TAB(8); Winner$(Temp); TAB(33); WinScore(Temp)
               ELSE
                    LOCATE 11 + Temp, 3
                    PRINT Temp
               END IF
          NEXT Temp
     CLOSE #1
     CALL Pause
END SUB

SUB WriteTetris
     W$ = "TETRIS!!"
     FOR Temp = 1 TO LEN(W$)
          LOCATE 9, 46
          COLOR 15
          PRINT W$
          LOCATE 9, 45 + Temp
          COLOR 1
          PRINT MID$(W$, Temp, 1)
          FOR t = 1 TO 1000: NEXT t
     NEXT Temp
     FOR Temp = LEN(W$) TO 1 STEP -1
          LOCATE 9, 46
          COLOR 15
          PRINT W$
          LOCATE 9, 45 + Temp
          COLOR 1
          PRINT MID$(W$, Temp, 1)
          FOR t = 1 TO 1000: NEXT t
     NEXT Temp
     LOCATE 9, 46
     PRINT "        "
     COLOR 15
END SUB
Logged
Meg
Ancient QBer
****
Posts: 483


« Reply #1 on: July 04, 2003, 03:16:38 PM »

I realize that you need ADVBAS for the FileExists call.  Just remove the check, and always open the file for output in the Initialize sub.

*peace*

Meg.
Logged
Ninkazu
Been there, done that
*****
Posts: 1169



WWW
« Reply #2 on: July 04, 2003, 03:43:06 PM »

For me?? You shouldn't have Wink
Logged

am an asshole. Get used to it.
Mech1031
Na_th_an
*****
Posts: 1536



WWW
« Reply #3 on: July 04, 2003, 03:44:21 PM »

*my peeps*

I'll try your game later, right now im on the road. (hotel).  But thanks.  now i have something to look forward to when i get back.
Logged

the mind is a beautiful thing, use it and make the world a more beautiful place.
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!