home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 5 / FREESOFT.BIN / fb386 / st / st.bas < prev    next >
BASIC Source File  |  1992-08-19  |  12KB  |  237 lines
  1. 1000 '********************************************************************
  2. 2000 '*                                                                  *
  3. 3000 '*                   3D MAIZE EXTRA VERSION (16)                    *
  4. 4000 '*                                                 by <Nakatani>    *
  5. 5000 '********************************************************************
  6. 10000 CLEAR:CLS:LOAD@"OPENNING.TIF":CONSOLE 0,25:DEFINT A-Z:COLOR 7,,4
  7. 10100 DIM D(17,17,17),DP(2,2,4),LS(3),PDT(1005,3),PM(1005),AX(20000),AY(20000),AZ(20000),F(15,15)
  8. 10200 LS(0)=40:LS(1)=140:LS(2)=190:LS(3)=215:KFLG=-1:RANDOMIZE TIME
  9. 10300 KX=1:TZ=1:HY=-1:X=1:Y=1:Z=1:FOR I=1 TO 2:FX(I)=0:FY(I)=0:FZ(I)=0:NEXT
  10. 10400 LOAD@"PATTERN\START.PDT",PM:FOR I=0 TO 1005:PDT(I,0)=PM(I):NEXT
  11. 10500 LOAD@"PATTERN\GOAL.PDT",PM:FOR I=0 TO 1005:PDT(I,1)=PM(I):NEXT
  12. 10600 LOAD@"PATTERN\FLG1.PDT",PM:FOR I=0 TO 1005:PDT(I,2)=PM(I):NEXT
  13. 10700 LOAD@"PATTERN\FLGR.PDT",PM:FOR I=0 TO 1005:PDT(I,3)=PM(I):NEXT
  14. 10800 ON ERROR GOTO *ER
  15. 10900 PRINT "MAPをロードしますか??(Yes=実行/No=取消)"
  16. 11000 YN$=INKEY$:IF YN$="" THEN 11000
  17. 11100 IF YN$=CHR$(13) THEN FILES"MAP\*.?JF":INPUT"ファイル名を入力してください(拡張子省略可) ＞ ",FL$ ELSE 11500
  18. 11200 IF FL$="" THEN 11500
  19. 11300 IF INSTR(FL$,".")=0 THEN FL$=FL$+".MJF"
  20. 11400 GOSUB *LDMAP:GOTO 12800
  21. 11500 IF YN$=CHR$(24) THEN 11600 ELSE 11000
  22. 11600 X=1:Y=1:Z=1:D(X,Y,Z)=2:R=1:AX(1)=1:AY(1)=1:AZ(1)=1:LOCATE 0,0:PRINT SPC(60):GOSUB 14900
  23. 11700 FOR I=1 TO 1000:LOCATE 0,1:PRINT "(";I;"/1000)   ":KFLG=-1:GOSUB *DIG :NEXT:LOCATE 0,1:PRINT "(---/----)"
  24. 11800 IF D(16,16,16)=0 THEN 11900
  25. 11900 IF D(16,16,15)+D(16,15,16)+D(15,16,16)>0 THEN 12100 
  26. 12000 GOSUB *DIG:GOTO 11800
  27. 12100 D(1,1,1)=2:D(0,0,0)=R:D(16,16,16)=3
  28. 12200 CONSOLE 0,25:CLS:PRINT "MAPが完成しました｡セーブしておきますか? (Yes=実行/No=取消)"
  29. 12300 YN$=INKEY$:IF YN$="" THEN 12300
  30. 12400 IF YN$=CHR$(13) THEN INPUT"ファイル名を入力してください(拡張子省略可) ＞ ",FL$ ELSE 12700
  31. 12500 IF INSTR(FL$,".")=0 THEN FL$=FL$+".MJF"
  32. 12600 GOSUB *SVMAP:GOTO 12800
  33. 12700 IF YN$=CHR$(24) THEN 12800 ELSE 12300
  34. 12800 KX=1:KY=0:KZ=0:TX=0:TY=0:TZ=1:HX=0:HY=-1:HZ=0:X=1:Y=1:Z=1:COLOR 7,,,4:CLS
  35. 12900 GOSUB *SC
  36. 13000 GOSUB *DISPLAY
  37. 13100 'LOCATE 66,2:PRINT "現在位置"
  38. 13200 'LOCATE 62,5:PRINT "ゴールまでの距離"
  39. 13300 'LOCATE 66,21:PRINT "現在の向き"
  40. 13400 SYMBOL(66*8+1,40),"現在位置",1,1,%0
  41. 13500 SYMBOL(66*8,38),"現在位置",1,1,%15
  42. 13600 SYMBOL(62*8+1,98),"ゴールまでの距離",1,1,%0
  43. 13700 SYMBOL(62*8,96),"ゴールまでの距離",1,1,%15
  44. 13800 SYMBOL(66*8+1,402),"現在の向き",1,1,%0
  45. 13900 SYMBOL(66*8,400),"現在の向き",1,1,%15
  46. 14000 PALETTE 2,[0,255,0],1
  47. 14100 GOTO *MAIN
  48. 14200 '
  49. 14300 *DIG
  50. 14400 '
  51. 14500 AR=R:KFLG=-1
  52. 14600 IF R>1000 THEN AR=INT(RND*R)+1:X=AX(AR):Y=AY(AR):Z=AZ(AR):GOTO 14900
  53. 14700 IF RND(1)<.02! THEN X=AX(AR):Y=AY(AR):Z=AZ(AR):GOTO 14900
  54. 14800 AR=AR-1:IF AR<1 THEN 14300 ELSE 14600
  55. 14900 RM=0
  56. 15000 WHILE KFLG:BEEP 1:LOCATE 0,2:PRINT "SEARCH(";X;Y;Z;") "
  57. 15100 K=INT(RND*12)+1:BEEP 0
  58. 15200 ON K GOSUB 16300,16400,16500,16600,16700,16800
  59. 15300 IF X+KX>16 OR Y+KY>16 OR Z+KZ>16 OR X+KX<1 OR Y+KY<1 OR Z+KZ<1 THEN RM=RM+1:GOTO 16000
  60. 15400 IF D(X+KX+KX,Y+KY+KY,Z+KZ+KZ)>0 THEN RM=RM+1:GOTO 16000
  61. 15500 IF KX<>0 AND (D(X+KX,Y+KY+1,Z+KZ)>0 OR D(X+KX,Y+KY-1,Z+KZ)>0 OR D(X+KX,Y+KY,Z+KZ+1)>0 OR D(X+KX,Y+KY,Z+KZ-1)>0) THEN RM=RM+1:GOTO 16000
  62. 15600 IF KY<>0 AND (D(X+KX+1,Y+KY,Z+KZ)>0 OR D(X+KX-1,Y+KY,Z+KZ)>0 OR D(X+KX,Y+KY,Z+KZ+1)>0 OR D(X+KX,Y+KY,Z+KZ-1)>0) THEN RM=RM+1:GOTO 16000
  63. 15700 IF KZ<>0 AND (D(X+KX,Y+KY+1,Z+KZ)>0 OR D(X+KX,Y+KY-1,Z+KZ)>0 OR D(X+KX+1,Y+KY,Z+KZ)>0 OR D(X+KX-1,Y+KY,Z+KZ)>0) THEN RM=RM+1:GOTO 16000
  64. 15800 IF D(X+KX,Y+KY,Z+KZ)>0 THEN BEEP:KFLG=0
  65. 15900 X=X+KX:Y=Y+KY:Z=Z+KZ:PRINT ">DIG<";X;Y;Z;"> ":D(X,Y,Z)=1:R=R+1:AX(R)=X:AY(R)=Y:AZ(R)=Z:IF X=16 AND Y=16 AND Z=16 THEN COLOR 2
  66. 16000 IF RM>10 THEN BEEP:KFLG=0
  67. 16100 WEND:LOCATE 0,0:PRINT "DIG=";R
  68. 16200 RETURN
  69. 16300 KX=1:KY=0:KZ=0:RETURN
  70. 16400 KX=0:KY=1:KZ=0:RETURN
  71. 16500 KX=0:KY=0:KZ=1:RETURN
  72. 16600 KX=-1:KY=0:KZ=0:RETURN
  73. 16700 KX=0:KY=-1:KZ=0:RETURN
  74. 16800 KX=0:KY=0:KZ=-1:RETURN
  75. 16900 '
  76. 17000 *DISPLAY
  77. 17100 FOR I=0 TO 4:FOR Q=0 TO 2:FOR W=0 TO 2:DP(Q,W,I)=0:NEXT:NEXT
  78. 17200 DP(0,1,I)=D(X+KX*I-HX,Y+KY*I-HY,Z+KZ*I-HZ)
  79. 17300 DP(1,2,I)=D(X+KX*I-TX,Y+KY*I-TY,Z+KZ*I-TZ)
  80. 17400 DP(1,1,I)=D(X+KX*I,Y+KY*I,Z+KZ*I)
  81. 17500 DP(1,0,I)=D(X+KX*I+TX,Y+KY*I+TY,Z+KZ*I+TZ)
  82. 17600 DP(2,1,I)=D(X+KX*I+HX,Y+KY*I+HY,Z+KZ*I+HZ)
  83. 17700 NEXT
  84. 17800 FOR I=4 TO 5
  85. 17900 IF FX(I-3)=0 THEN PUT@A(238+I*65,300)-(298+I*65,360),PDT,MATTE,1,1,0,(I-2)*1006 ELSE LINE(238+I*65,300)-(298+I*65,360),PSET,%6,BF
  86. 18000 NEXT
  87. 18100 SQ!=SQR((16-X)^2+(16-Y)^2+(16-Z)^2)
  88. 18200 PALETTE 8,[0,0,0]
  89. 18300 PALETTE 9,[0,0,0]
  90. 18400 PALETTE 10,[0,0,0]
  91. 18500 PALETTE 11,[0,0,0]
  92. 18600 PALETTE 12,[0,0,0]
  93. 18700 PALETTE 13,[0,0,0]
  94. 18800 PALETTE 14,[0,0,0]
  95. 18900 LOCATE 27,11:PRINT AL1$
  96. 19000 LOCATE 27,12:PRINT AL2$
  97. 19100 LOCATE 27,13:PRINT AL3$
  98. 19200 LOCATE 62,3:PRINT USING"X=##/ Y=##/ Z=##";X;Y;Z
  99. 19300 LOCATE 68,6:PRINT USING"##.#";SQ!
  100. 19400 IF KX+KY+KZ>0 THEN KS$="+" ELSE KS$="-"
  101. 19500 IF KX<>0 THEN KR$="Ｘ" ELSE IF KY<>0 THEN KR$="Ｙ" ELSE KR$="Ｚ"
  102. 19600 LOCATE 69,22:PRINT KS$+KR$
  103. 19700 IF TX<>0 THEN TR$="+Ｘ" ELSE IF TY<>0 THEN TR$="+Ｙ" ELSE TR$="+Ｚ"
  104. 19800 IF HX<>0 THEN HR$="+Ｘ" ELSE IF HY<>0 THEN HR$="+Ｙ" ELSE HR$="+Ｚ"
  105. 19900 LINE(0,0)-(479,479),PSET,%9,BF,%9
  106. 20000 LINE(40,40)-(439,439),PSET,%10,BF,%10
  107. 20100 LINE(140,140)-(339,339),PSET,%11,BF,%11
  108. 20200 LINE(190,190)-(289,289),PSET,%12,BF,%12
  109. 20300 LINE(215,215)-(264,264),PSET,%13,BF,%13
  110. 20400 LINE(479,0)-(0,479),PSET,%8
  111. 20500 LINE(439,40)-(40,439),PSET,%9
  112. 20600 LINE(339,140)-(140,339),PSET,%10
  113. 20700 LINE(289,190)-(190,289),PSET,%11
  114. 20800 LINE(264,215)-(215,264),PSET,%12
  115. 20900 LINE(0,0)-(479,479),PSET,%8
  116. 21000 LINE(40,40)-(439,439),PSET,%9
  117. 21100 LINE(140,140)-(339,339),PSET,%10
  118. 21200 LINE(190,190)-(289,289),PSET,%11
  119. 21300 LINE(215,215)-(264,264),PSET,%12
  120. 21400 LINE (230,230)-(249,249),PSET,%14,BF,%14
  121. 21500 SYMBOL(232,232-232*(TX+TY+TZ)),TR$,1,1,%8
  122. 21600 SYMBOL(228+228*(HX+HY+HZ),232),HR$,1,1,%8
  123. 21700 IF D(X+KX*4,Y+KY*4,Z+KZ*4)=0 THEN LINE(215,215)-(264,264),PSET,%11,BF,%12
  124. 21800 IF DP(1,1,1)=0 THEN LINE(40,40)-(439,439),PSET,%8,BF,%9:GOTO 22700
  125. 21900 I=3
  126. 22000 IF DP(1,1,I)=0 THEN LINE(LS(I-1),LS(I-1))-(479-LS(I-1),479-LS(I-1)),PSET,%(7+I),BF,%(8+I):GOTO 22600
  127. 22100 IF DP(1,1,I)>=2 THEN PUT@A(240-30*(2^(3-I)),240-30*(2^(3-I)))-(300-30*(2^(3-I)),300-30*(2^(3-I))),PDT,MATTE,2^(3-I),2^(3-I),0,(DP(1,1,I)-2)*1006
  128. 22200 IF DP(1,0,I)>0 THEN LINE(LS(I),LS(I))-(LS(I),LS(I-1)),PSET,%(I+8):LINE(479-LS(I),LS(I))-(479-LS(I),LS(I-1)),PSET,%(I+8)
  129. 22300 IF DP(0,1,I)>0 THEN LINE(LS(I-1),LS(I))-(LS(I),LS(I)),PSET,%(I+8):LINE(LS(I-1),479-LS(I))-(LS(I),479-LS(I)),PSET,%(I+8)
  130. 22400 IF DP(2,1,I)>0 THEN LINE(479-LS(I),LS(I))-(479-LS(I-1),LS(I)),PSET,%(I+8):LINE(479-LS(I),479-LS(I))-(479-LS(I-1),479-LS(I)),PSET,%(I+8)
  131. 22500 IF DP(1,2,I)>0 THEN LINE(LS(I),479-LS(I))-(LS(I),479-LS(I-1)),PSET,%(I+8):LINE(479-LS(I),479-LS(I))-(479-LS(I),479-LS(I-1)),PSET,%(I+8)
  132. 22600 I=I-1:IF I=0 THEN 22700 ELSE 22000
  133. 22700 IF DP(1,0,0)>0 THEN LINE(40,40)-(40,0),PSET,%8:LINE(439,40)-(439,0),PSET,%8
  134. 22800 IF DP(0,1,0)>0 THEN LINE(0,40)-(40,40),PSET,%8:LINE(0,439)-(40,439),PSET,%8
  135. 22900 IF DP(2,1,0)>0 THEN LINE(439,40)-(479,40),PSET,%8:LINE(439,439)-(479,439),PSET,%8
  136. 23000 IF DP(1,2,0)>0 THEN LINE(40,439)-(40,479),PSET,%8:LINE(439,439)-(439,479),PSET,%8
  137. 23100 IF DP(1,1,0)>1 THEN PUT@A(400,400)-(460,460),PDT,MATTE,1,1,0,(DP(1,1,0)-2)*1006
  138. 23200 PALETTE 8,[150,150,200],1
  139. 23300 PALETTE 9,[120,120,180]
  140. 23400 PALETTE 10,[80,80,160]
  141. 23500 PALETTE 11,[60,60,120]
  142. 23600 PALETTE 12,[40,40,80]
  143. 23700 PALETTE 13,[20,20,60]
  144. 23800 PALETTE 14,[10,10,40]
  145. 23900 LOCATE 27,11:PRINT "      ":AL1$=""
  146. 24000 LOCATE 27,12:PRINT "      ":AL2$=""
  147. 24100 LOCATE 27,13:PRINT "      ":AL3$=""
  148. 24200 RETURN
  149. 24300 '
  150. 24400 *MAIN
  151. 24500 '
  152. 24600 BN$=INKEY$:IF BN$="" THEN 24600
  153. 24700 IF BN$="*" OR BN$="z" OR BN$="Z" THEN 25800
  154. 24800 IF BN$="/" OR BN$="x" OR BN$="X" THEN 26000
  155. 24900 IF BN$="5" OR BN$=":" THEN AL1$="  ↓":AL2$="→  ←":AL3$="  ↑":GOTO 25600
  156. 25000 IF BN$="2" OR BN$=CHR$(34) THEN AL1$="↓  ↓":AL3$=AL1$:AL2$="":SWAP KX,TX:SWAP KY,TY:SWAP KZ,TZ:KX=-KX:KY=-KY:KZ=-KZ
  157. 25100 IF BN$="4" OR BN$=";" THEN AL1$="←  ←":AL3$=AL1$:AL2$="":SWAP KX,HX:SWAP KY,HY:SWAP KZ,HZ:KX=-KX:KY=-KY:KZ=-KZ
  158. 25200 IF BN$="6" OR BN$="]" THEN AL1$="→  →":AL3$=AL1$:AL2$="":SWAP KX,HX:SWAP KY,HY:SWAP KZ,HZ:HX=-HX:HY=-HY:HZ=-HZ
  159. 25300 IF BN$="8" OR BN$="@" THEN AL1$="↑  ↑":AL3$=AL1$:AL2$="":SWAP KX,TX:SWAP KY,TY:SWAP KZ,TZ:TX=-TX:TY=-TY:TZ=-TZ
  160. 25400 GOSUB *DISPLAY:IF X=16 AND Y=16 AND Z=16 THEN GOTO *ENDING
  161. 25500 GOTO *MAIN
  162. 25600 IF D(X+KX,Y+KY,Z+KZ)=0 THEN BEEP:GOTO 25400
  163. 25700 X=X+KX:Y=Y+KY:Z=Z+KZ:GOTO 25400
  164. 25800 IF FX(1)=0 AND D(X,Y,Z)=1 THEN D(X,Y,Z)=4 :FX(1)=X:FY(1)=Y:FZ(1)=Z ELSE IF D(X,Y,Z)=4 THEN D(X,Y,Z)=1:FX(1)=0:FY(1)=0:FZ(1)=0
  165. 25900 GOTO 25400
  166. 26000 IF FX(2)=0 AND D(X,Y,Z)=1 THEN D(X,Y,Z)=5 :FX(2)=X:FY(2)=Y:FZ(2)=Z ELSE IF D(X,Y,Z)=5 THEN D(X,Y,Z)=1:FX(2)=0:FY(2)=0:FZ(2)=0
  167. 26100 GOTO 25400
  168. 26200 *ER
  169. 26300 IF ERR=5 OR ERR=9 THEN 26500
  170. 26400 PRINT ERL,ERR:RESUME NEXT
  171. 26500 RESUME NEXT
  172. 26600 *ENDING
  173. 26700 CLS:LOAD@"ENDING.TIF",(160,0)
  174. 26800 DATA 1,5,"Design:",0,2,1000
  175. 26900 DATA 3,7,"T.",0,2,50
  176. 27000 DATA 3,9,"Nakatani",0,1,10
  177. 27100 DATA 5,5,"Program:",0,2,1000
  178. 27200 DATA 7,7,"T.",0,1,10
  179. 27300 DATA 7,9,"Nakatani",0,2,50
  180. 27400 DATA 9,5,"Advice:",0,2,1000
  181. 27500 DATA 11,7,"N.Komyo",0,1,0
  182. 27600 DATA 13,5,"Testplay:",0,2,1000
  183. 27700 DATA 15,7,"T.Nakatani",1,2,0
  184. 27800 DATA 16,7,"N.Komyo",1,2,0
  185. 27900 DATA 17,7,"T.Tatsuta",1,2,0
  186. 28000 DATA 19,3,"Arrive at GOAL:",0,2,1000
  187. 28100 DATA 21,7,"none.",0,2,1000
  188. 28200 DATA 22,31,"Hit",0,1,0
  189. 28300 DATA 22,35,"Any",0,1,0
  190. 28400 DATA 22,39,"Key",0,1,0
  191. 28500 DATA 22,43,"to",0,1,0
  192. 28600 DATA 22,46,"END",1,1,0
  193. 28700 DATA 0,0,"",0,0,0
  194. 28800 RESTORE 26800:S$=" "':CLS:LINE(160,0)-(639,359),PSET,,B
  195. 28900 WHILE S$<>"":READ Y,X,S$,V,B,W:GOSUB *SLIDE:WEND
  196. 29000 SYMBOL(248,418),"Hit Any Key to END",1,1,%7
  197. 29100 LOCATE 31,22:PRINT "                  "
  198. 29200 WHILE INKEY$=""
  199. 29300 PALETTE 7,[(SIN(F!+.2!)+1)*127,(COS(F!)+1)*127,(SIN(F!)+1)*127],1:F!=F!+.1!
  200. 29400 WEND
  201. 29500 END
  202. 29600 *SLIDE
  203. 29700 IF V>0 THEN J=LEN(S$)/V ELSE J=1
  204. 29800 IF V>0 THEN L=V ELSE L=LEN(S$)
  205. 29900 FOR I=1 TO J
  206. 30000 IF V>0 THEN ST$=MID$(S$,I,V)+" " ELSE ST$=S$+" "
  207. 30100 IF B=1 THEN FOR K=78-L-I TO X STEP -1:BEEP ((K/8) MOD 2):BEEP 0:LOCATE K+I-1,Y:PRINT ST$:FOR N=1 TO W:NEXT:NEXT
  208. 30200 IF B=2 THEN LOCATE X+I-1,23:PRINT ST$:FOR K=22 TO Y STEP -1:LOCATE X+I-1,K:PRINT ST$:LOCATE X+I-1,K+1:PRINT SPACE$(L):BEEP 1:BEEP 0:FOR N=1 TO W:NEXT:NEXT
  209. 30300 NEXT
  210. 30400 RETURN
  211. 30500 *SVMAP:GOSUB *CL
  212. 30600 FOR Z=1 TO 16
  213. 30700 FOR Y=1 TO 16
  214. 30800 FOR X=2 TO 16
  215. 30900 IF D(X,Y,Z)>0 THEN F(Y-1,Z-1)=F(Y-1,Z-1)+2^(16-X)
  216. 31000 NEXT
  217. 31100 IF D(1,Y,Z)>0 THEN F(Y-1,Z-1)=-F(Y-1,Z-1)
  218. 31200 NEXT:PRINT ">";:NEXT:SAVE@ "MAP\"+FL$,F:RETURN
  219. 31300 *LDMAP:R=0:LOAD@ "MAP\"+FL$,F
  220. 31400 FOR Z=1 TO 16
  221. 31500 FOR Y=1 TO 16
  222. 31600 IF F(Y-1,Z-1)<0 THEN F(Y-1,Z-1)=-F(Y-1,Z-1):D(1,Y,Z)=1:R=R+1
  223. 31700 FOR X=2 TO 16
  224. 31800 IF F(Y-1,Z-1)=>2^(16-X) THEN F(Y-1,Z-1)=F(Y-1,Z-1)-2^(16-X):D(X,Y,Z)=1:R=R+1
  225. 31900 NEXT:NEXT:PRINT "<";:NEXT:D(1,1,1)=2:D(16,16,16)=3:D(0,0,0)=R:RETURN
  226. 32000 *CL
  227. 32100 FOR Z=0 TO 15:FOR Y=0 TO 15:F(Y,Z)=0:NEXT:NEXT:RETURN
  228. 32200 *SC:CLS
  229. 32300 PALETTE 7,[96,64,96]
  230. 32400 PALETTE 6,[64,32,64]
  231. 32500 LINE (481,1)-(639,479),PSET,%7,BF
  232. 32600 CONNECT(480,479)-(480,0)-(639,0),%15
  233. 32700 LINE (489,8)-(632,472),PSET,%6,BF
  234. 32800 CONNECT(488,473)-(488,7)-(633,7),%0
  235. 32900 CONNECT(489,473)-(633,473)-(633,8),%15
  236. 33000 RETURN
  237.