home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 3 / FreeSoftwareCollection3pd199x-jp.img / fb386 / tyusen2 / tyusen2.bas < prev    next >
BASIC Source File  |  1980-01-02  |  13KB  |  338 lines
  1. 10000 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  2. 10010 '－極秘文章“Ｔｈｅ　抽選”－－ＴＹＰＥ　Ｘ２－－－－－－－－－－－
  3. 10020 '－－－－－－－－－－－－－－－Ｃｏｐｙｒｉｇｈｔ（ｃ）クラリス－－
  4. 10030 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  5. 10040 '－１９９０年１０月１５日－ａｌｌ　ｖｅｒｓｉｏｎ　ＳＰＥＣＩＡＬ－
  6. 10050 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  7. 10060 '－－－－－－－－－－－－Ｎｉｆｔｙ　Ｓｅｒｖｅ　ＮＢＤ００５２０－
  8. 10070 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  9. 10080 'SAVE "a:\抽選2.BAS",A
  10. 10090 '
  11. 10100 '＜－－－－－－－－　ＭＡＩＮ　ＰＲＯＧＲＡＭ　－－－－－－－－－＞
  12. 10110  GOSUB   *初期設定                      :PRINT "初期設定完了" 
  13. 10120  GOSUB   *音声データ登録                :PRINT "音声デ－タ登録完了"
  14. 10130  GOSUB   *ボールのスプライト登録        :PRINT "スプライト登録完了"
  15. 10140  GOSUB   *スプライトＯＮ
  16. 10150 *割り込み                               '数値変更後の戻り
  17. 10160  GOSUB   *抽選画面描写
  18. 10170  GOSUB   *パレットセット
  19. 10200  WHILE 1
  20. 10210      GOSUB *トリガー監視
  21. 10220      GOSUB *結果告知
  22. 10230      GOSUB *玉の加速
  23. 10240  WEND
  24. 11000 '－－－－－－－－－＞初期設定
  25. 11010 *初期設定
  26. 11020  WIDTH 80,25 : COLOR 7,0,0,4
  27. 11030  SCREEN@ 0 : CLS
  28. 11040  DEF SPRITE 99,0
  29. 11050  RANDOMIZE TIME+DATE
  30. 11060  MOUSE 0
  31. 12000 '－－－－－－－－－＞配列宣言 '音声データはファイルの大きさ割る４です
  32. 12010  DIM   BALL%(255),賞(5),PICT%(5000)
  33. 12020  DIM   TYYTO(16724/4)          'ちょっと待って！
  34. 12030  DIM   DOUZO(13120/4)          'どうぞ          
  35. 12040  DIM   STOOP( 8258/4)          'ストップ
  36. 12050  DIM  DORAMU(71598/4)          'ドラムロール
  37. 12060  DIM   OWATA(11809/4)          '終わった
  38. 12070  DIM    一等(37721/4)          '一等
  39. 12080  DIM    二等(18802/4)          '二等
  40. 12090  DIM    三等(22008/4)          '三等
  41. 12100  DIM    四等(20766/4)          '四等
  42. 12110  DIM    五等(10108/4)          '五等
  43. 12120  DIM KEYCODE(14)               'key code
  44. 13000 '－－－－－－－－－＞初期値設定
  45. 13010 *初期値設定
  46. 13020  PI#=3.14159265358979#
  47. 13030  RAD#=PI#/180
  48. 13040  座標X=345 : ZZZ=16 '分割数
  49. 13050  座標Y=45
  50. 13060  '←－－－－－－－－玉の数の初期設定値です
  51. 13070  等(1)=  10 '　一等賞
  52. 13080  等(2)=  30 '　二等賞
  53. 13090  等(3)=  60 '　三等賞
  54. 13100  等(4)= 100 '　四等賞
  55. 13110  等(5)= 500 '　五等賞(ハズレ)
  56. 13200  '<-------------------------キーコード登録
  57. 13210  '数値変更時のパッド←→キーコードデータ交換用
  58. 13220  RESTORE *KEYCODEDATA
  59. 13230  FOR I=0 TO 14 
  60. 13240    READ KEYCODE(I)
  61. 13250  NEXT I
  62. 13260  *KEYCODEDATA
  63. 13270  '     0, 1, 2, 3, 4, 5, 6, 7, 8, 9,bs,cr,lf,re,esc 
  64. 13280  DATA 48,49,50,51,52,53,54,55,56,57, 8,13,30,31,27
  65. 13290 RETURN
  66. 14000 '－－－－－－－－－＞音声データ読み込み登録
  67. 14010 *音声データ登録
  68. 14015  PRINT "☆☆☆☆☆☆☆☆☆☆";CHR$(13); 
  69. 14020  LOAD@ "tyoma_f.snd",TYYTO : PRINT "★"; 'ちょっと待って！
  70. 14030  PCMPLAY TYYTO
  71. 14040  LOAD@ "douzo_f.snd",DOUZO : PRINT "★"; 'どうぞ
  72. 14050  LOAD@ "stop_f.snd" ,STOOP : PRINT "★"; 'ストップ
  73. 14060  LOAD@ "doramu.snd" ,DORAMU: PRINT "★"; 'ドラムロール
  74. 14070  LOAD@ "owata_f.snd",OWATA : PRINT "★"; '終わったよ
  75. 14080  LOAD@ "1.snd"      ,一等  : PRINT "★"; '一等
  76. 14090  LOAD@ "2.snd"      ,二等  : PRINT "★"; '二等
  77. 14100  LOAD@ "3.snd"      ,三等  : PRINT "★"; '三等
  78. 14110  LOAD@ "4.snd"      ,四等  : PRINT "★"; '四等
  79. 14120  LOAD@ "gomen_f.snd",五等  : PRINT "★"  '五等
  80. 14130 RETURN
  81. 15000 '－－－－－－－－－＞極秘行動＜抽選画面描写＞
  82. 15010 *抽選画面描写
  83. 15020 '  表示  背景
  84. 15030  LOAD@ "ny.tif"
  85. 15040 '  抽選用サークルを描く
  86. 15050  CIRCLE (120+座標X    ,120+座標Y),125,4
  87. 15060  CIRCLE (120+座標X    ,120+座標Y), 85,4
  88. 15070  PAINT  (120+座標X+100,120+座標Y),  5,4
  89. 15080  PAINT  (120+座標X+100,120+座標Y),  0,4
  90. 15090  CIRCLE (120+座標X    ,120+座標Y),125,5
  91. 15100  CIRCLE (120+座標X    ,120+座標Y), 85,5
  92. 15110  PAINT  (120+座標X+100,120+座標Y),  2,5
  93. 15120 'CIRCLE (120+座標X    ,120+座標Y),140,2,,,,F
  94. 15130 '
  95. 15200  FOR I=1/ZZZ/2-.5! TO 1+1/ZZZ/2-.5! STEP 1/ZZZ
  96. 15210      X1=SIN(2*PI#*I)*125+120+座標X
  97. 15220      Y1=COS(2*PI#*I)*125+120+座標Y
  98. 15230      X2=SIN(2*PI#*I)* 85+120+座標X
  99. 15240      Y2=COS(2*PI#*I)* 85+120+座標Y
  100. 15250      LINE (X1,Y1)-(X2,Y2),PSET,5
  101. 15260  NEXT I
  102. 15270 '
  103. 15300  FOR I=1 TO 4: P = VAL("&H"+MID$("084c",I,1))
  104. 15310      X =SIN(2*PI#*(P/ZZZ-.5!))*105+120+座標X
  105. 15320      Y =COS(2*PI#*(P/ZZZ-.5!))*105+120+座標Y
  106. 15330      PAINT (X,Y),%VAL("&H"+(MID$("b924",I,1))),5
  107. 15340      PR$=STRING$(-(I<=9)," ")+AKCNV$(MID$(STR$(I),2))
  108. 15350      SYMBOL (X-20,Y-8) , PR$,1.2!,1.2!,7,,,3
  109. 15360  NEXT I
  110. 15370 '
  111. 15400 '此処にこの様な文字を入れると面白いですよ(REMマークを取ってです)
  112. 15410 'SYMBOL ( 30,370) , "電脳遊遊園地",2,2,[100,100,  0],,,2
  113. 15420 'SYMBOL ( 29,369) , "電脳遊遊園地",2,2,[255,255,  0],,,2
  114. 15430 'SYMBOL ( 30,402) , "    ｉｎ　　",2,2,[  0,100,  0],,,2
  115. 15440 'SYMBOL ( 29,401) , "　　ｉｎ　　",2,2,[  0,255,  0],,,2
  116. 15450 'SYMBOL ( 30,434) , " ＧＩＦＵ ",2,2,[  0,100,100],,,2
  117. 15460 'SYMBOL ( 29,433) , " ＧＩＦＵ ",2,2,[  0,255,255],,,2
  118. 15990 RETURN
  119. 16000 '－－－－－－－－－＞極秘行動＜スプライト登録＞
  120. 16010 *ボールのスプライト登録      'SPRITE 0 金 1 銀 2 赤
  121. 16020  BB=0*1024
  122. 16030  LOAD@ "Ball.trn",PICT%
  123. 16040  FOR I=0 TO 3
  124. 16050      FOR K=0 TO 255
  125. 16060         BALL%(K)=PICT%(BB)
  126. 16070         IF BALL%(K)=0 THEN BALL%(K)=-32768
  127. 16080         BB=BB+1
  128. 16090      NEXT K
  129. 16100      DEF SPRITE 0,I*4,BALL%,1
  130. 16110  NEXT I
  131. 16120  DEF SPRITE 1,0,(256,256),0,2,2,1
  132. 16130 RETURN
  133. 17000 '－－－－－－－－－＞極秘行動開始＜スプライトｏｎ＞
  134. 17010 *スプライトＯＮ
  135. 17020  SPRITE ON
  136. 17030  SPRITE SCREEN (座標X-11,座標Y)
  137. 17040  SPRITE 0, 0 ,1
  138. 17050 RETURN
  139. 18000 '－－－－－－－－－＞ 極秘行動＜パレット情報登録＞
  140. 18010 *パレットセット
  141. 18020  RESTORE *パレットDATA
  142. 18030  FOR I=0 TO 7
  143. 18040      READ R,G,B
  144. 18050      PALETTE I,[G*16,R*16,B*16],1
  145. 18060  NEXT I
  146. 18070 *パレットDATA
  147. 18080  DATA  0, 0, 0 ,  0, 0, 7 ,  7, 0, 0 , 14, 8, 7
  148. 18090  DATA  0,11, 0 ,  0,11,11 ,  7, 7, 0 , 10,10,10
  149. 18100 RETURN
  150. 30000 '－－－－－－－－－＞極秘行動＜確率によるボールの設定＞
  151. 30010 *トリガー監視
  152. 30020  乱=RND(1)
  153. 30030  乱1=乱*(等(1)+等(2)+等(3)+等(4)+等(5))
  154. 30040                                                      等 = 5
  155. 30050  IF 0 < 等(4) AND 等(5)                   < 乱1 THEN 等 = 4
  156. 30060  IF 0 < 等(3) AND 等(5)+等(4)             < 乱1 THEN 等 = 3
  157. 30070  IF 0 < 等(2) AND 等(5)+等(4)+等(3)       < 乱1 THEN 等 = 2
  158. 30080  IF 0 < 等(1) AND 等(5)+等(4)+等(3)+等(2) < 乱1 THEN 等 = 1
  159. 30090  等(等) = 等(等) -1
  160. 30100 'トリガーが放されるまで待つ    チャッタリング防止(^_^;
  161. 30110  WHILE (PTRIG(1) AND 1)=1
  162. 30120      位置=位置+2
  163. 30130      GOSUB *玉の回転
  164. 30140  WEND
  165. 30150 'トリガーが押されるまで待つ
  166. 30160  PCMPLAY DOUZO
  167. 30170  WHILE (PTRIG(1) AND 1)=0
  168. 30180      位置=位置+2
  169. 30190      GOSUB *玉の回転
  170. 30200  WEND
  171. 30210  PCMPLAY STOOP
  172. 30220 '  PCMPLAY DORAMU'CD PLAY 43
  173. 30230  IF 等 < 5 THEN 30300                      '五等の時は別処理
  174. 30240    '        90ﾟ単位変換,五等の時の位置決め各三箇所位置設定
  175. 30250      停止位置=INT(乱*4)*90+360/16*(INT(乱*300) MOD 3+1) '停止位置決定
  176. 30260      GOTO 30400
  177. 30300 'ELSE
  178. 30320      停止位置=VAL(MID$("3120",等,1))*90      '停止位置決定
  179. 30400 'ENDIF
  180. 30410  距離=停止位置-位置-(停止位置<=位置)*360
  181. 30420  距離=距離-360*(距離<180)                   '180ﾟ以内の時＋一回転
  182. 30430 '玉を止める時間を決定する
  183. 30440                    時間=300
  184. 30450  IF 270< 距離 THEN 時間=400
  185. 30460  IF 360<=距離 THEN 時間=550
  186. 30470  IF 540<=距離 THEN 時間=600
  187. 30500  '－－－－－－－－＞極秘行動＜玉の減速＞
  188. 30510  'ΣＸ^2 =  X *(  X +1)*(2*  X +1)/6
  189. 30520  時間定数=時間*(時間+1)*(2*時間+1)/6
  190. 30530  FOR 時=時間 TO 時間-30 STEP -1
  191. 30540      位置=位置+距離/時間定数*時*時
  192. 30550      GOSUB *玉の回転
  193. 30560  NEXT 時
  194. 30570 '
  195. 30580  PCMPLAY DORAMU
  196. 30630  FOR 時=時間-30 TO 10 STEP -1
  197. 30640      位置=位置+距離/時間定数*時*時
  198. 30650      GOSUB *玉の回転
  199. 30660  NEXT 時
  200. 30670 RETURN
  201. 31000 '－－－－－－－－－＞極秘行動＜玉の加速＞
  202. 31010 *玉の加速
  203. 31020  時間=150 : 距離=150
  204. 31030  'ΣＸ^2 =  X *(  X +1)*(2*  X +1)/6
  205. 31040  時間定数=時間*(時間+1)*(2*時間+1)/6
  206. 31050  FOR 時=0 TO 時間
  207. 31060      位置=位置+距離/時間定数*時*時
  208. 31070      GOSUB *玉の回転
  209. 31080  NEXT 時
  210. 31090 RETURN
  211. 32000 '－－－－－－－－－＞極秘行動＜玉の回転＞
  212. 32010 *玉の回転
  213. 32020  位置=位置+(360<=位置)*360
  214. 32030  X=COS(位置*RAD#)*103+117 - SPRITE(0,6)
  215. 32040  Y=SIN(位置*RAD#)*103+105 - SPRITE(0,7)
  216. 32050  SPRITE 6, 0 ,X,Y
  217. 32060 RETURN
  218. 33000 '－－－－－－－－－＞極秘行動＜結果告知＞
  219. 33010 *結果告知
  220. 33020  IF 等=1 THEN PCMPLAY 一等
  221. 33030  IF 等=2 THEN PCMPLAY 二等
  222. 33040  IF 等=3 THEN PCMPLAY 三等
  223. 33050  IF 等=4 THEN PCMPLAY 四等
  224. 33060  IF 等=5 THEN PCMPLAY 五等
  225. 33070  IF MOUSE(2,0) AND MOUSE(2,1) THEN SPRITE 6,0,255,255:GOTO *選択
  226. 33080  FOR I=0 TO 2500
  227. 33090    K$=INKEY$
  228. 33100  NEXT I
  229. 33110 '-----------------＞極秘行動を終了しなければならないか？
  230. 33200  END_F=0
  231. 33210  WHILE END_F=0
  232. 33220    IF 等(1)+等(2)+等(3)+等(4)+等(5) THEN END_F=1 : GOTO 33270
  233. 33230      PCMPLAY OWATA,127             'おわったよ
  234. 33240      WHILE MOUSE(2,0)*MOUSE(2,1)=0
  235. 33250      WEND
  236. 33260      GOSUB *初期値設定
  237. 33270  WEND
  238. 33280 RETURN
  239. 40000 '－－－－－－－－－＞極秘行動＜商品個数変更＞ 
  240. 40010 *選択 
  241. 40020  CLS
  242. 40030  BER_P=0 : ANS_P=0 : D$="" : YP=0
  243. 40040  等(等)=等(等)+1        '商品が減ってしまうのを防止する
  244. 40050  LOAD@ "TYOUSEI.tif" '変更画面呼び出し
  245. 40100  '
  246. 40110  FOR I=1 TO 5
  247. 40120      A$=AKCNV$(RIGHT$("      "+STR$(等(I)),5))
  248. 40130      SYMBOL(300,70+(I-1)*65),A$,3.7!,3.7!,4,,PSET,1,0
  249. 40140  NEXT I
  250. 40200  '
  251. 40210  GOSUB *下線移動
  252. 40220 'LINE(400,5)-(610,40),PSET,7,BF
  253. 40230  SYMBOL(425,7),"カ－ソルで選んで数値を　",1,1,2,,,2,1
  254. 40240  SYMBOL(425,25)," 入力して下ださい"      ,1,1,2,,,2,1
  255. 40250  '
  256. 40260  WHILE INKEY$<>"" : WEND
  257. 40270  '
  258. 40280  PAINT (70,65*YP+90),2,4
  259. 40290  '
  260. 40300  D=0
  261. 40310  WHILE D<>27
  262. 40320      GOSUB *数値入力
  263. 40330      IF ANS_P=0                   THEN 等(YP+1)=ANS
  264. 40340                                        YP_F= 0
  265. 40350      IF  D=30          AND 0<YP   THEN YP_F=-1
  266. 40360      IF (D=31 OR D=13) AND   YP<4 THEN YP_F= 1
  267. 40370      IF YP_F                      THEN PAINT (70,65*YP+90),7,4
  268. 40380      YP=YP+YP_F
  269. 40390      IF YP_F                      THEN PAINT (70,65*YP+90),2,4
  270. 40400  WEND
  271. 40410 RETURN *割り込み
  272. 50000 '－－－－－－－－－＞極秘行動＜数値入力＞ 
  273. 50010 *数値入力 
  274. 50020  K$="" : T=0 : ANS_P=0 : TRAP=0
  275. 50030  WHILE TRAP=0
  276. 50040    D=0
  277. 50050    WHILE D=0
  278. 50060      D$=INKEY$ : D=ASC(D$+CHR$(0))
  279. 50070      T=(T MOD 120)+1
  280. 50080      XX=305+LEN(K$)*60:YY=YP*65+125
  281. 50090      IF T=1  THEN LINE (XX,YY)-STEP(40,5),PSET,1,BF
  282. 50100      IF T=60 THEN LINE (XX,YY)-STEP(40,5),PSET,7,BF
  283. 50110      PAD_D=     -((PAD(1)=7)*29+(PAD(1)=3)*28+(PTRIG(1)=1)*32)
  284. 50120      PAD_D=PAD_D-((PAD(1)=1)*30+(PAD(1)=5)*31)
  285. 50130      IF D=28 OR D=29 OR D=32 THEN PAD_D=D '左右キー，スペースキー
  286. 50140      IF PAD_D THEN GOSUB *下線移動 : T=T+10 
  287. 50150    WEND
  288. 50200    IF 0<INSTR("0123456789",D$) AND LEN(K$)<5 THEN GOSUB *数値入力_INC
  289. 50210    IF (D=8 OR D=127) AND K$<>""              THEN GOSUB *数値入力_DEC
  290. 50220    IF D=13                                   THEN ANS_P=0 : TRAP=1
  291. 50230    IF D=30 OR D=31 OR D=27                   THEN ANS_P=1 : TRAP=1
  292. 50240  WEND
  293. 50300 '
  294. 50310 '数値入力脱出用後処理
  295. 50320 '
  296. 50330  IF K$=""   THEN ANS_P=1
  297. 50340  IF ANS_P=1 THEN K$=STR$(等(YP+1))
  298. 50350  ANS = VAL(K$) : K$=RIGHT$("     "+STR$(ANS),5)
  299. 50360  LINE  (XX ,YY      )-STEP(40 , 5),PSET,7,BF
  300. 50370  LINE  (300,70+YP*65)-STEP(340,60),PSET,7,BF
  301. 50380  SYMBOL(300,70+YP*65),AKCNV$(K$),3.7!,3.7!,4,,PSET,3,0
  302. 50390 RETURN '--------------->数値入力脱出
  303. 50400 '
  304. 50410 *数値入力_INC
  305. 50420  K$=K$+D$
  306. 50430  GOSUB *数値入力_PRN
  307. 50440 RETURN
  308. 50450 '
  309. 50500 *数値入力_DEC
  310. 50510 '
  311. 50520  K$=LEFT$(K$,LEN(K$)-1)
  312. 50530  GOSUB *数値入力_PRN
  313. 50540 RETURN
  314. 50500 '
  315. 50610 *数値入力_PRN
  316. 50620 '
  317. 50630  LINE (XX,YY)-STEP(40,5),PSET,7,BF
  318. 50640  XX=305+LEN(K$)*60
  319. 50650  IF T=1 THEN LINE (XX,YY)-STEP(40,5),PSET,1,BF
  320. 50560  LINE  (300,70+YP*65)-STEP(340,60),PSET,7,BF
  321. 50670  SYMBOL(300,70+YP*65),AKCNV$(K$),3.7!,3.7!,2,,PSET,1,0
  322. 50680 RETURN
  323. 50700 '－－－－－－－－－＞極秘行動＜下線移動＞
  324. 50710 *下線移動
  325. 50720  LINE(188+BER_P*30,440)-STEP(25,5),PSET,7,BF
  326. 50740  IF PAD_D=29             THEN BER_P=BER_P-1
  327. 50750  IF PAD_D=28             THEN BER_P=BER_P+1
  328. 50760  IF    BER_P<0           THEN BER_P=14
  329. 50770  IF 14<BER_P             THEN BER_P=0
  330. 50780  IF PAD_D=32 OR PAD_D=27 THEN D=KEYCODE(BER_P)
  331. 50790  IF PAD_D=31 OR PAD_D=30 THEN D=PAD_D
  332. 50800  LINE(188+BER_P*30,440)-STEP(25,5),PSET,2,BF
  333. 50810  TT=0
  334. 50820  WHILE ((PAD(1)=7)+(PAD(1)=3)+(PTRIG(1)=1)) AND (TT<50)
  335. 50830    TT=TT+1
  336. 50840  WEND
  337. 50850 RETURN
  338.