Tetris GOLD in GW-BASIC, listed 03-05-2005

   10 ' tetris05.bas - FreeWare 2005 - Eric F. Tchong
   20 GOTO 120
   30 SAVE"tetris05",A:LIST-120
   40 GOTO 980  ' left  arrow move block
   50 GOTO 1000 ' rotate block
   60 GOTO 1030 ' right arrow move block
   70 GOTO 1050 ' adjust rotate
   80 GOTO 1120 ' print block
   90 GOTO 1140 ' blank block
  100 GOTO 1160 ' stats + empty line(s)
  110 GOTO 1320 ' get key
  120 SCREEN 0,1:WIDTH 40:KEY OFF:COLOR 12,0
  130 CLS:CLEAR:DEFINT A-Z:E$=CHR$(219):DEFSTR Q:Q=MKI$(0)
  140 PRINT "**************************************"
  150 PRINT "*       Tetris Gold is written       *"
  160 PRINT "*          in GW-BASIC 3.23          *"
  170 PRINT "* by Dutch programmer Sjoerd Verweij *"
  180 PRINT "*  Eric Tchong fixed the typo's and  *"
  190 PRINT "*    remodeled the source listing.   *"
  200 PRINT "**************************************":COLOR 15:PRINT
  210 PRINT "  ";CHR$(27);" = move left     ";CHR$(26);" = move right"
  220 PRINT "  ";CHR$(25);" = move down     ";CHR$(24);" = rotate block"
  230 PRINT "  Spacebar = drop block    P = pause"
  240 PRINT "       Esc = the panic button"
  250 PRINT:COLOR 11
  260 PRINT "  Press any key to start the game...":GOSUB 110:CLS:COLOR 15
  270 PRINT "Score",,,,"Line",," 0",,"Next",,,,,,,,,,"Level",," 0"

  280 ' print vertical bars
  290 FOR I=1 TO 23
  300  LOCATE I,13:PRINT E$;:COLOR 0
  310  PRINT STRING$(12,E$);:COLOR 15
  320  PRINT E$;
  330 NEXT
  340 PRINT " Stats","TETRIS Gold ";STRING$(14,E$);" FreeWare 2005";
  350 READ N ' N=7
  360 DIM P$(N,4),R(N,4,4,4),EQ(N),H(N,4),B(N,4),A(24),M(N),F$(3),D(3),C(4)

  370 ' initialize data values
  380 FOR I=1 TO 3:READ F$(I),D(I):NEXT ' double 150 triple 300 tetris 900
  390 FOR I=1 TO 4:READ C(I):NEXT ' C(I) 28  219  29  31
  400 FOR H=1 TO N
  410  READ W$:EQ(H)=LEN(W$)/16
  420  FOR I=1 TO EQ(H)
  430   READ K$
  440   RANDOMIZE-TIMER*RND
  450   FOR G=1 TO LEN(K$)
  460    P$(H,I)=P$(H,I)+CHR$(C(VAL(MID$(K$,G,1)))) ' assemble 19 shapes
  470   NEXT
  480   FOR J=1 TO 4
  490    IF (INSTR(MID$(W$,(I-1)*16+(J-1)*4+1,4),"1")>0) THEN H(H,I)=H(H,I)+1
  500    FOR K=1 TO 4
  510     C$=MID$(W$,(I-1)*16+(J-1)*4+K,1)
  520     R(H,I,J,K)=VAL(C$)
  530     IF C$="1" AND B(H,I)<K THEN B(H,I)=K
  540    NEXT
  550   NEXT
  560  NEXT
  570 NEXT
  580 T#=1.5:RANDOMIZE-TIMER:B1=5

  590 ' main program
  600 B=B1:X=2:Y=6:S=1:GOSUB 90          ' blank block
  610 B2=B:B1=INT(RND*N)+1:B=B1:GOSUB 80 ' print block
  620 B=B2:Y=0:X=20
  630 SC!=SC!+EQ(B)*INT(RND*15)          ' increase score
  640 COLOR 15:LOCATE 2,1:PRINT SC!;:M(B)=M(B)+1
  650 IF M(B)/5=M(B)\5 AND M(B)<100 THEN COLOR B:LOCATE 23-M(B)/5,B+27:PRINT E$;

  660 ' get players move
  670 Y=Y+1:T1!=TIMER:GOSUB 80           ' print block
  680 WHILE T1!+T#>TIMER ' Z=9 end or spacebar Z=4 Esc
  690  Z$=INKEY$:IF LEN(Z$)>1 THEN Z=ASC(RIGHT$(Z$,1))-70 ELSE Z=ASC(Z$+CHR$(0))-23
  700  IF Z=9 THEN O=0:U=S:W=X:V=Y-1:WHILE O=0:V=V+1:GOSUB 70:WEND:Y=V-1:T1!=T1!-3
  710  IF Z=10 THEN T1!=T1!-3 ' down arrow move
  720  IF Z=5 THEN GOSUB 40 ELSE IF Z=2 THEN GOSUB 50 ELSE IF Z=7 THEN GOSUB 60
  730  IF Z=4 THEN 960 ' Esc to exit immediately (the boss is watching you)
  740  IF Z=57 OR Z=89 THEN GOSUB 110 ' pause to relax
  750 WEND
  760 U=S:V=Y+1:W=X:GOSUB 70:IF O=0 THEN 670 ' go next move
  770 ON (Y>1)+1 GOTO 920 ' game over!
  780 GOSUB 80 ' print block
  790 FOR I=0 TO H(B,S)-1
  800  FOR J=0 TO B(B,S)-1
  810   A(Y+I)=A(Y+I)+R(B,S,I+1,J+1)*(2^(X+J-14))
  820  NEXT
  830 NEXT:M=0
  840 FOR H=Y TO 23
  850  IF A(H)=4095 THEN GOSUB 100:M=M+1:SC!=SC!+INT(RND*100)
  860 NEXT:IF M<2 THEN 600
  870 COLOR 15:LOCATE 15,1:PRINT F$(M-1); ' double, triple, tetris
  880 SC!=SC!+D(M-1):NU!=TIMER            ' 150,    300,    900,   bonus
  890 WHILE TIMER<NU!+1.25:WEND
  900 LOCATE 15,1:PRINT SPC(10);:GOTO 600 ' go main program

  910 ' game over
  920 SOUND 2000,2
  930 LOCATE 19,1:COLOR 14,0:PRINT "Game over!
  940 LOCATE 20,1:PRINT "Try again?":I$=INPUT$(1)
  950 IF I$="y" OR I$="Y" THEN RUN
  960 COLOR 7,0:SCREEN 2:SCREEN 0:CLS:END

  970 ' left arrow move block
  980 U=S:V=Y:W=X-1:GOSUB 70:X=X+(O=0):GOSUB 80:RETURN

  990 ' rotate block
 1000 U=S+1:IF U>EQ(B) THEN U=1
 1010 V=Y:W=X:GOSUB 70:S=-(O=0)+(S AND (S<EQ(B) OR O=1)):GOSUB 80:RETURN

 1020 ' right arrow move block
 1030 U=S:V=Y:W=X+1:GOSUB 70:X=X-(O=0):GOSUB 80:RETURN

 1040 ' adjust rotate
 1050 GOSUB 90:O=-(W>27-B(B,S))-(W<14)
 1060 FOR I=0 TO H(B,U)-1
 1070  FOR J=0 TO B(B,U)-1
 1080  IF R(B,U,I+1,J+1)=1 AND SCREEN(V+I,W+J,1)>0 THEN O=1
 1090  NEXT
 1100 NEXT:RETURN

 1110 ' print colored block
 1120 COLOR B:LOCATE Y,X:PRINT P$(B,S);:COLOR 15:RETURN

 1130 ' blank block
 1140 COLOR 0:LOCATE Y,X:PRINT P$(B,S);:COLOR 15:RETURN

 1150 ' stats + empty line(s)
 1160 D=D+1
 1170 FOR I=H TO 2 STEP-1:A(I)=A(I-1)
 1180  FOR J=14 TO 25:LOCATE I,J
 1190   COLOR SCREEN(I-1,J,1):PRINT E$;
 1200  NEXT
 1210 NEXT:SOUND 1000,1:LOCATE 4,1:COLOR 15:PRINT D;
 1220 IF D/20=D\20 THEN T#=T#*.7:SOUND 2000,2:L=L+1:LOCATE 11,1:PRINT L
 1230 ON (L>3 AND D/15=D\15)+1 GOTO 1300
 1240 FOR I=2 TO 23
 1250  FOR J=14 TO 25:LOCATE I,J
 1260   COLOR SCREEN(I+1,J,1):PRINT E$;
 1270  NEXT:A(I)=A(I+1)
 1280 NEXT:SOUND 100,1:COLOR 0
 1290 LOCATE 23,14:IF L<8 THEN PRINT STRING$(12,E$);
 1300 RETURN

 1310 ' get key
 1320 LSET Q=MKI$(0)
 1330 WHILE CVI(Q)=0:MID$(Q,1)=INKEY$:WEND:RETURN

 1340 ' data
 1350 DATA 7,DOUBLE,150,TRIPLE,300,TETRIS,900,28,219,29,31
 1360 DATA 1100110000000000,2243322
 1370 DATA 11110000000000001000100010001000,2222,2432432432
 1380 DATA 0100111000000000100011001000000011100100000000000100110001000000
 1390 DATA 12433222,243224332,2224332,1243322432
 1400 DATA 1110100000000000110001000100000000101110000000001000100011000000
 1410 DATA 22243332,22432432,1124333222,24324322
 1420 DATA 1110001000000000010001001100000010001110000000001100100010000000
 1430 DATA 222432,1243243322,243222,224332432
 1440 DATA 01101100000000001000110001000000,122433322,24322432
 1450 DATA 11000110000000000100110010000000,224322,12433224332

 1460 ' In october 1992 Mr. Sjoerd Verweij published a GW-BASIC listing
 1470 ' of this game. Unfortunately it did not work due to bugs. I left this
 1480 ' program untouched for many years until I saw the game "BLOKKEN" on
 1490 ' BVN television (Is a combined Dutch/Belgium TV on the cable). It looks
 1500 ' familiar to this tetris game but more in a quiz form. The last few weeks
 1510 ' I started to fix the good old source listing. After hours of debugging
 1520 ' I streamlined the listing and ended up in one of the best game written in
 1530 ' GW-BASIC by Mr. Sjoerd Verweij. Thanks - March 5, 2005