07-04-2003, 11:15 PM
Since you said you loved Tetris, here's an ancient prog. I wrote back when I was like 16 or so..
*peace*
Meg.
*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