' "Tin Tik Rin" Project Q BASIC ' http://tintik.at.infoseek.co.jp/pqb/ '(C)Tintik 2004 DEFLNG A: DEFINT B-Y: DEFSNG Z DEF FNrnd (n) = INT(RND * n) + 1 CONST iMEM = 500 DIM XS(iMEM), YS(iMEM) CONST xMAX = 320, yMAX = 200 ilevel = 1 LLTITLE: SCREEN 13 COLOR 10: PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT PRINT " ***** * * * * * * **** * *" PRINT " * ** * * * * ** * * *" PRINT " ***** * * * ***** ** **** *" PRINT " * * ** * * * ** * *" PRINT " ***** * * * * * * **** *" PRINT : PRINT COLOR 15: PRINT " Level:"; ilevel GOSUB LLSTAGE await = 0: ztime = TIMER WHILE ztime > TIMER - 5 await = await + 1: PSET (1, 1), 0 WEND await = await / 500 PRINT : PRINT : PRINT TAB(2); " Wait for PC spec="; await i$ = INPUT$(1) LLRESTART: ilevel = 5: idtail = 100: ascore = 200 LLINIT: CLS : RANDOMIZE TIMER itime = 2000 + ilevel * 200: iloop = 0: iscore = 0 ipoint = 0: iturn = 0: icol = 60 itail = idtail + ilevel * 20 FOR i = 0 TO iMEM: XS(i) = 0: YS(i) = 0: NEXT flag = 1 ' = 1: Reached on point ' = 2: You Died ' = 3: ' = 4: ' = 8: To next level GOSUB LLSTAGE ''''''''''''''''''''''''''''''''''''''''''''''''''' START: WHILE (flag < 2) LLRND: IF flag = 1 THEN WHILE flag > 0 xp = FNrnd(xMAX - 6) + 3: yp = FNrnd(yMAX - 15) + 12 flag = 0 SELECT CASE ilevel CASE 1: IF ABS(yp - yMAX / 2) < 2 THEN IF xp > 60 - 1 AND xp < xMAX - 60 + 1 THEN flag = 1 END IF CASE 2: IF ABS(yp - (yMAX - 60) / 2) < 2 AND xp > 60 AND xp < xMAX - 40 THEN flag = 1 IF ABS(yp - (yMAX + 60) / 2) < 2 AND xp > 40 AND xp < xMAX - 60 THEN flag = 1 CASE 3: IF ABS(yp - (yMAX - 60) / 2) < 2 AND xp > 50 AND xp < xMAX - 50 THEN flag = 1 IF ABS(yp - (yMAX + 60) / 2) < 2 AND xp > 50 AND xp < xMAX - 50 THEN flag = 1 IF ABS(xp - xMAX / 2) < 2 AND yp > 40 AND yp < yMAX - 40 THEN flag = 1 CASE 4: IF ABS(yp - yMAX / 2) < 2 AND xp < xMAX * 2 / 3 THEN flag = 1 IF ABS(xp - xMAX / 3) < 2 AND yp > yMAX / 2 AND yp < yMAX - 30 THEN flag = 1 IF ABS(yp - 70) < 2 AND xp > 50 AND xp < xMAX - 50 THEN flag = 1 CASE 5: IF ABS(xp - xMAX / 2) < 2 AND yp > 40 AND yp < yMAX - 40 THEN flag = 1 IF ABS(yp - yMAX - 40) < 2 AND xp > 40 AND xp < xMAX / 2 THEN flag = 1 IF ABS(yp - yMAX - 40) < 2 AND xp > xMAX / 2 AND xp < xMAX - 40 THEN flag = 1 IF ABS(xp - 40) < 2 AND yp > 40 AND yp < yMAX / 2 THEN flag = 1 IF ABS(xp - xMAX - 40) < 2 AND yp > yMAX / 2 AND yp < yMAX - 40 THEN flag = 1 IF ABS(yp - 40) < 2 AND xp > xMAX / 2 AND xp < xMAX - 40 THEN flag = 1 IF ABS(yp - yMAX - 40) < 2 AND xp > 40 AND xp < xMAX / 2 THEN flag = 1 IF ABS(xp - xMAX / 2 - 40) < 2 AND yp > 80 AND yp < yMAX - 40 THEN flag = 1 IF ABS(xp - xMAX - 40) < 2 AND yp > 40 AND yp < yMAX - 80 THEN flag = 1 END SELECT WEND LINE (xp - 1, yp - 1)-(xp + 1, yp + 1), 15, BF flag = 0 END IF IF x < 2 OR x > xMAX - 2 THEN flag = 2 IF y < 10 OR y > yMAX - 2 THEN flag = 2 LLPJUDGE: IF ABS(x - xp) < 2 AND ABS(y - yp) < 2 THEN flag = 1 IF x = xp AND ABS(y - yp) < 3 THEN flag = 1 IF y = yp AND ABS(x - xp) < 3 THEN flag = 1 LLPOINT: IF flag = 1 THEN BEEP itime = itime + (2 - (itime < 400)) * 100 iscore = iscore + 100 * (1 - (itime < 500)) + ipoint * 10 ipoint = ipoint + 1: IF ipoint = 10 THEN flag = 8 LINE (xp - 1, yp - 1)-(xp + 1, yp + 1), 1, BF GOTO LLWEND END IF LLMOVE: dd = dr: ' dr: Direction i$ = INKEY$: IF i$ <> "" THEN iturn = iturn + 1 SELECT CASE i$ CASE CHR$(0) + "H", "8": IF dd <> 3 THEN dr = 1 CASE CHR$(0) + "M", "6": IF dd <> 4 THEN dr = 2 CASE CHR$(0) + "P", "2": IF dd <> 1 THEN dr = 3 CASE CHR$(0) + "K", "4": IF dd <> 2 THEN dr = 4 CASE "Q", CHR$(27): GOTO LLERR END SELECT SELECT CASE dr CASE 1: y = y - 1 CASE 2: x = x + 1 CASE 3: y = y + 1 CASE 4: x = x - 1 END SELECT LLCHR: LOCATE 24, 2: PRINT "X="; x; "Y="; y; LINE (XS(itail) - 1, YS(itail) - 1)-(XS(itail) + 1, YS(itail) + 1), 0, BF FOR i = iMEM TO itail + 1 STEP -1 XS(i) = XS(i - 1): YS(i) = YS(i - 1) ' LINE (XS(i) - 1, YS(i) - 1)-(XS(i) + 1, YS(i) + 1), 0, BF NEXT FOR i = itail TO 1 STEP -1 XS(i) = XS(i - 1): YS(i) = YS(i - 1) ' Touch on tail IF XS(i) = x AND YS(i) = y THEN flag = 5 NEXT XS(0) = x: YS(0) = y icol = icol + 1: IF icol > 72 + 24 THEN icol = 72 LINE (x - 1, y)-(x + 1, y), icol: LINE (x, y - 1)-(x, y + 1), icol itime = itime - 1: IF itime < 0 THEN flag = 3 itail = idtail + ipoint * 20 - itime / 100 iloop = iloop + 1 LOCATE 1, 2: PRINT ipoint; "Timer:"; itime; "Level"; ilevel LOCATE 1, 23: PRINT "Score:"; ascore + iscore - iturn * 3 LLWAIT: FOR a = 0 TO await * (itime + 5000) / 65: NEXT LLJUDGE: IF x < 3 OR x > xMAX - 3 OR y < 12 OR y > yMAX - 3 THEN flag = 6 SELECT CASE ilevel CASE 1: IF ABS(y - yMAX / 2) < 2 THEN IF x > 60 - 1 AND x < xMAX - 60 + 1 THEN flag = 4 END IF CASE 2: IF ABS(y - (yMAX - 60) / 2) < 2 AND x > 60 AND x < xMAX - 40 THEN flag = 4 IF ABS(y - (yMAX + 60) / 2) < 2 AND x > 40 AND x < xMAX - 60 THEN flag = 4 CASE 3: IF ABS(y - (yMAX - 60) / 2) < 2 AND x > 50 AND x < xMAX - 50 THEN flag = 4 IF ABS(y - (yMAX + 60) / 2) < 2 AND x > 50 AND x < xMAX - 50 THEN flag = 4 IF ABS(x - xMAX / 2) < 2 AND y > 40 AND y < yMAX - 40 THEN flag = 4 CASE 4: IF ABS(y - yMAX / 2) < 2 AND x < xMAX * 2 / 3 THEN flag = 4 IF ABS(x - xMAX / 3) < 2 AND y > yMAX / 2 AND y < yMAX - 30 THEN flag = 4 IF ABS(y - 70) < 2 AND x > 50 AND x < xMAX - 50 THEN flag = 4 CASE 5: IF ABS(x - xMAX / 2) < 2 AND y > 40 AND y < yMAX - 40 THEN flag = 4 IF ABS(y - yMAX - 40) < 2 AND x > 40 AND x < xMAX / 2 THEN flag = 4 IF ABS(y - yMAX - 40) < 2 AND x > xMAX / 2 AND x < xMAX - 40 THEN flag = 4 IF ABS(x - 40) < 2 AND yp > 40 AND yp < yMAX / 2 THEN flag = 4 IF ABS(x - xMAX - 40) < 2 AND y > yMAX / 2 AND y < yMAX - 40 THEN flag = 4 IF ABS(y - 40) < 2 AND xp > xMAX / 2 AND x < xMAX - 40 THEN flag = 4 IF ABS(y - yMAX - 40) < 2 AND x > 40 AND x < xMAX / 2 THEN flag = 4 IF ABS(x - xMAX / 2 - 40) < 2 AND yp > 80 AND y < yMAX - 40 THEN flag = 4 IF ABS(x - xMAX - 40) < 2 AND y > 40 AND y < yMAX - 80 THEN flag = 4 END SELECT LLWEND: WEND '''''''''''''''''''''''''''''''''''''''''''''''''''' LLENDING: PRINT : PRINT : PRINT : PRINT SELECT CASE flag CASE 3: pr$ = " TIME OVER!" ' ilevel = ilevel - 1 CASE 4: pr$ = " YOU CRASHED WALL!" ' ilevel = ilevel - 1 CASE 5: pr$ = " YOU CRASHED YOUR TAIL!" CASE 6: pr$ = " YOU ARE OUT OF SCREEN!" CASE 8: PRINT " YOU HAVE COMPLETED THIS LEVEL " PRINT : PRINT " Push [SPACE] Key" WHILE INPUT$(1) <> " ": WEND ilevel = ilevel + 1 idtail = idtail + itail / 10 ascore = ascore + iscore - iturn END SELECT IF flag = 8 THEN GOTO LLINIT PRINT pr$ PRINT : PRINT " WOULD YOU LIKE TO PLAY AGAIN? (Y/N)" i$ = " " WHILE INSTR("YyNn", i$) = 0: i$ = INPUT$(1): WEND IF i$ = "Y" OR i$ = "y" THEN GOTO LLINIT LLERR: SCREEN 12 COLOR 14: LOCATE 19, 1: PRINT "=== DEBUG VALUE ===" PRINT "iloop:"; iloop; " itale"; itail PRINT "X,Y="; x; y; " Ending Flag"; flag END LLSTAGE: LINE (2, 9)-(xMAX - 2, yMAX - 2), 4, B SELECT CASE ilevel CASE 1: LINE (60, yMAX / 2 - 1)-(xMAX - 60, yMAX / 2 + 1), 4, BF x = 20: y = 80: dr = 3 CASE 2: LINE (60, (yMAX - 60) / 2 - 1)-(xMAX - 40, (yMAX - 60) / 2 + 1), 4, BF LINE (40, (yMAX + 60) / 2 - 1)-(xMAX - 60, (yMAX + 60) / 2 + 1), 4, BF x = 20: y = 80: dr = 3 CASE 3: LINE (50, (yMAX - 60) / 2 - 1)-(xMAX - 50, (yMAX - 60) / 2 + 1), 4, BF LINE (50, (yMAX + 60) / 2 - 1)-(xMAX - 50, (yMAX + 60) / 2 + 1), 4, BF LINE (xMAX / 2 - 1, 40)-(xMAX / 2 + 1, yMAX - 40), 4, BF x = 20: y = 80: dr = 3 CASE 4: LINE (0, yMAX / 2 - 1)-(xMAX * 2 / 3, yMAX / 2 + 1), 4, BF LINE (xMAX / 3 - 1, yMAX / 2)-(xMAX / 3 + 1, yMAX - 30), 4, BF LINE (50, 70 - 1)-(xMAX - 50, 70 + 1), 4, BF x = 20: y = 80: dr = 3 CASE 5: LINE (xMAX / 2 - 1, 40)-(xMAX / 2 + 1, yMAX - 40), 4, BF LINE (40, 40 - 1)-(xMAX / 2, 40 + 1), 4, BF LINE (xMAX / 2, yMAX - 40 - 1)-(xMAX - 40, yMAX - 40 + 1), 4, BF LINE (40 - 1, 40)-(40 + 1, yMAX - 40), 4, BF LINE (xMAX - 40 - 1, 40)-(xMAX - 40 + 1, yMAX - 40), 4, BF LINE (40, yMAX - 40 - 1)-(xMAX / 2 - 40, yMAX - 40 + 1), 4, BF LINE (xMAX / 2 + 40, 40 - 1)-(xMAX - 40, 40 + 1), 4, BF LINE (xMAX / 2 - 40 - 1, 80)-(xMAX / 2 - 40 + 1, yMAX - 40), 4, BF LINE (xMAX / 2 + 40 - 1, 40)-(xMAX / 2 + 40 + 1, yMAX - 80), 4, BF x = 20: y = 80: dr = 3 END SELECT RETURN