home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 3 / FreeSoftwareCollection3pd199x-jp.img / fb386 / tyusen1 / tyusen1.bas < prev    next >
BASIC Source File  |  1980-01-02  |  13KB  |  381 lines
  1. 10000 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  2. 10010 '－－極秘文章“Ｔｈｅ　抽選”　ＴＹＰＥ　Ｘ１改－－－－－－－－－－
  3. 10020 '－－－－－－－－－－－－－－－Ｃｏｐｙｒｉｇｈｔ（ｃ）クラリス－－
  4. 10030 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－ﾄﾞﾋﾞｼｭ－－
  5. 10040 '－１９８９年　６月　１日－－－－－－協力  ＡＰＰＯ　＆　怒毘狩－－
  6. 10050 '－１９９１年　１月　１日改造－－－－－－－－－－－－－－－－－－－
  7. 10060 '－－－－－－－－－－－－Ｎｉｆｔｙ　Ｓｅｒｖｅ　ＮＢＤ００５２０－
  8. 10070 '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
  9. 10080 'SAVE "A:抽選.BAS",A
  10. 10090 '
  11. 10100 '＜－－－－－－－－　ＭＡＩＮ　ＰＲＯＧＲＡＭ　－－－－－－－－－＞
  12. 10110  COLOR 7,,,4
  13. 10120  GOSUB   *初期設定                      :PRINT "初期設定終了" 
  14. 10130  GOSUB   *音声データ登録                :PRINT "音声デ－タ登録終了"
  15. 10140  GOSUB   *抽選画面描写                  :PRINT "画面設定終了"
  16. 10150  GOSUB   *ボールのスプライト登録        :PRINT "スプライト登録完了"
  17. 10160  GOSUB   *スプライトＯＮ
  18. 10170  GOSUB   *ボールを飛ばす                '玉を空飛ばしする 
  19. 10180  WHILE 1
  20. 10190    GOSUB *極秘行動を終了するか？
  21. 10200    GOSUB *トリガー監視
  22. 10210    GOSUB *確率によるボールの設定
  23. 10220    GOSUB *ボールを飛ばす
  24. 10230    GOSUB *結果告知
  25. 10240  WEND
  26. 11000 '－－－－－－－－－＞初期設定
  27. 11010 *初期設定
  28. 11020  WIDTH 80,25 : COLOR 7,0,0
  29. 11030  SCREEN@ 1 : CLS
  30. 11040  DEF SPRITE 99,0
  31. 11050  RANDOMIZE TIME
  32. 11060  MOUSE 0
  33. 11100 '－－－－－－－－－＞配列宣言
  34. 11110  DIM A%(64),BALL%(255),BALL2%(255),PICT%(5000)
  35. 11120  DIM  TYYTO(16724/4)          'ちょっと待って！
  36. 11130  DIM  DOUZO(13120/4)          'どうぞ          
  37. 11140  DIM    SPO(20658/4)          'スッポ！        
  38. 11150  DIM    GLF(27872/4)          'コロンコロン    
  39. 11170  DIM   BOIL(46206/4)          'グツグツ        
  40. 11180  DIM  OWATA(11809/4)          '終ったよ        
  41. 11190  DIM   一等(37721/4)          '一等
  42. 11200  DIM   二等(18802/4)          '二等
  43. 11210  DIM   三等(22008/4)          '三等
  44. 11220  DIM  賞(3)                   '商品の個数を格納する
  45. 11230  DIM  TAMA(3)                 '回転するボールの座標を保持する
  46. 11300 '－－－－－－－－－＞初期値設定
  47. 11310 *初期値設定
  48. 11320  π#=3.14159265358979# 
  49. 11330  RAD#=2*π#/360    'ラディアン
  50. 11340  減 = 0            '減算フラグ
  51. 11350  等 = 1            '最初に飛ばすボールの色
  52. 11360  等(1) =  30       '一等賞
  53. 11370  等(2) =  50       '二等賞
  54. 11380  等(3) = 100       '三等賞
  55. 11390 RETURN
  56. 12000 '－－－－－－－－－＞音声データ読み込み登録
  57. 12010 *音声データ登録
  58. 12020  LOAD@ "tyoma_f.snd" ,TYYTO    'ちょっと待って！
  59. 12030  PCMPLAY TYYTO
  60. 12040  LOAD@ "douzo_f.snd" ,DOUZO    'どうぞ          
  61. 12050  LOAD@ "spo.snd"     ,SPO      'スッポ！        
  62. 12060  LOAD@ "glf_pat.snd" ,GLF      'コロンコロン    
  63. 12070  LOAD@ "boil.snd"    ,BOIL     'グツグツ        
  64. 12080  LOAD@ "owata_f.snd" ,OWATA    '終ったよ        
  65. 12090  LOAD@ "1.snd"       ,一等     '一等
  66. 12100  LOAD@ "2.snd"       ,二等     '二等
  67. 12110  LOAD@ "3.snd"       ,三等     '三等
  68. 12120 RETURN
  69. 14000 '－－－－－－－－－－－－＞抽選画面描写
  70. 14010 *抽選画面描写
  71. 14020  '  表示  背景
  72. 14030  PAINT(0,0),1,[255,0,1]
  73. 14040  FOR I=0 TO 12
  74. 14050    LINE (0,I*15)-(340,I*15+15),PSET,[192-I*16,192-I*16,250],BF
  75. 14060  NEXT I
  76. 14100  '　表示  皿
  77. 14110  CONNECT ( 25,175)-( 30,200)-(180,200),[240,128,210],PSET
  78. 14120  CONNECT          -(185,175)-(183,175),[240,128,210],PSET
  79. 14130  CONNECT          -(177,197)-( 33,197),[240,128,210],PSET
  80. 14140  CONNECT          -( 27,175)-( 25,175),[240,128,210],PSET
  81. 14150  PAINT  ( 27,178)       ,[230,128,200],[240,128,210]
  82. 14200  '　表示  賞
  83. 14210  SYMBOL ( 73, 21) , "１等賞",2,2,[100,100,  0],,,2
  84. 14220  SYMBOL ( 72, 20) , "１等賞",2,2,[230,230,  0],,,2
  85. 14230  SYMBOL ( 63, 57) , "２等賞",2,2,[140,140,140],,,2
  86. 14240  SYMBOL ( 62, 56) , "２等賞",2,2,[240,240,240],,,2
  87. 14250  SYMBOL ( 53, 93) , "３等賞",2,2,[  0,128,  0],,,2
  88. 14260  SYMBOL ( 52, 92) , "３等賞",2,2,2            ,,,2
  89. 14300 '   表示  富士通
  90. 14310  LOAD@ "fujitu.trn",PICT%
  91. 14320  PUT@A(205,15)-(295,58),PICT%,MATTE,,,0
  92. 14330 '
  93. 14400 '   表示  ＦＭ－ＴＯＷＮＳ
  94. 14410  LOAD@ "fmtowns.trn",PICT%
  95. 14420  PUT@A(25,203)-(185,228),PICT%,MATTE,,,0
  96. 14430 '
  97. 14500 '   表示　『ＣＬＡＲＩＳ』
  98. 14510 'SYMBOL (190,220),"byＣＬＡＲＩＳ",.7!,.7!,6,,,,4
  99. 14520 '
  100. 14580 RETURN
  101. 15000 '－－－－－－－－－＞ ボールの絵をスプライトに登録
  102. 15010 *ボールのスプライト登録      'SPRITE 0金 4銀 8赤
  103. 15020  LOAD@ "ball.trn",PICT%
  104. 15030  SP=0 : BB=0
  105. 15040  FOR N=1 TO 3  '1=金 2=銀 3=赤
  106. 15050    FOR I=0 TO 1
  107. 15060      FOR J=0 TO 1
  108. 15070        FOR K=0 TO 255
  109. 15080          BALL%(K) =PICT%(BB)
  110. 15090          BALL2%(K)=PICT%(BB)
  111. 15100          IF BALL%(K)=0 THEN BALL%(K)=-32768
  112. 15110          BB=BB+1
  113. 15120        NEXT K
  114. 15130        X=40+16*J+21-N*11
  115. 15140        Y=N*37+16*I-20
  116. 15150        PUT@A( X, Y)-( X+15, Y+15),BALL2%,MATTE,,,0
  117. 15160        DEF SPRITE 0,SP*4,BALL%,1
  118. 15170        SP=SP+1
  119. 15180      NEXT J
  120. 15190    NEXT I
  121. 15200  NEXT N
  122. 15210 '
  123. 15300 '  スプライトＮｏ．定義
  124. 15310  DEF SPRITE 1,0*4,(140,120),0*4*4,2,2,1 '金
  125. 15320  DEF SPRITE 1,1*4,(140,120),1*4*4,2,2,1 '銀
  126. 15330  DEF SPRITE 1,2*4,(140,120),2*4*4,2,2,1 '赤
  127. 15340  DEF SPRITE 1,3*4,(140,120),2*4*4,2,2,1 '赤
  128. 15350 '
  129. 15400 RETURN
  130. 16000 '－－－－－－－－－＞極秘行動＜ＳＴＡＲＴ＞
  131. 16010 *スプライトＯＮ
  132. 16020  SPRITE ON
  133. 16030  SPRITE SCREEN (30,0)
  134. 16040  SPRITE SCREEN 0
  135. 16050  FOR I=0 TO 3
  136. 16060    SPRITE 0, I*4 ,1
  137. 16070  NEXT I
  138. 16080 RETURN
  139. 18000 '－－－－－－－－－＞極秘行動(確率によるボールの設定)
  140. 18010 *確率によるボールの設定
  141. 18020  乱=RND(1)
  142. 18030  乱1=乱*(等(1)+等(2)+等(3))
  143. 18040                                          等 = 3
  144. 18050  IF 0 < 等(2) AND 等(3)       < 乱1 THEN 等 = 2
  145. 18060  IF 0 < 等(1) AND 等(3)+等(2) < 乱1 THEN 等 = 1
  146. 18070  IF PAAT = 10 AND 乱<>1 THEN 乱=1 : GOTO 18030
  147. 18080  等(等) = 等(等) -1
  148. 18090  減=1
  149. 18100  DERU=(等-1)*4
  150. 18110  SPRITE 0, DERU ,1
  151. 18120 RETURN
  152. 20000 '－－－－－－－－－＞極秘行動(ボールを飛ばす)
  153. 20010 *ボールを飛ばす
  154. 20020  PCMPLAY SPO
  155. 20030  XP# = 130 : YP# = 120
  156. 20040  角度 = (40+外乱#/10)/180*π# : 速度# = 32+外乱#
  157. 20050  T#=0 
  158. 20060  方向フラグ=0
  159. 20070  '
  160. 20080  WHILE 1 
  161. 20090    X#=XP#- 速度#*COS(角度)*T#
  162. 20100    Y#=YP#-(速度#*SIN(角度)*T#-4.9#*T#*T#)
  163. 20110    SPRITE TIME
  164. 20120    IF 方向フラグ = 0 AND X# <    0 THEN 方向フラグ=1
  165. 20130    IF 方向フラグ = 1 AND X# < -120 THEN 方向フラグ=2
  166. 20140    IF 方向フラグ = 0               THEN XX=    X#
  167. 20150    IF 方向フラグ = 1               THEN XX=   -X#
  168. 20160    IF 方向フラグ = 2               THEN XX=240+X#
  169. 20170    DEF SPRITE 1,DERU,(XX,Y#),DERU*4,2,2,1
  170. 20180    SPRITE 0, DERU ,1
  171. 20190    IF Y#<165 THEN *ボールは地に着いていない
  172. 20200      T#=0
  173. 20210      IF 速度#<=0 THEN *ボールは速度を失った
  174. 20220        速度#=速度#-6  '玉の減速
  175. 20230        PCMPLAY GLF
  176. 20240        XP# = X# : YP# = Y#
  177. 20250 *ボールは地に着いていない
  178. 20260    T#=T#+.1#
  179. 20270  WEND
  180. 20280 *ボールは速度を失った
  181. 20290 RETURN
  182. 21000 '－－－－－－－－－＞極秘行動(結果告知)
  183. 21010 *結果告知
  184. 21020  IF 等=1 THEN PCMPLAY 一等
  185. 21030  IF 等=2 THEN PCMPLAY 二等
  186. 21040  IF 等=3 THEN PCMPLAY 三等
  187. 21050  FOR I=0 TO 2000
  188. 21060    K$=INKEY$
  189. 21070  NEXT I
  190. 21080 RETURN
  191. 30000 '－－－－－－－－－＞極秘行動(パッド監視)
  192. 30010 *トリガー監視
  193. 30020 'トリガーが押されるまで待つ
  194. 30030  音量=20
  195. 30040  PAT=0 
  196. 30045  PT=等-1
  197. 30050  外乱#=0
  198. 30060  PCMPLAY DOUZO
  199. 30070  WHILE PAT=0
  200. 30080    PAAT=PTRIG(1)
  201. 30090    GOSUB *玉の回転
  202. 30100  WEND
  203. 30200 'トリガーが放されるまで待つ
  204. 30210  外乱#=1
  205. 30220  音量 = 64
  206. 30230  PCMPLAY BOIL
  207. 30235  PT=999
  208. 30240  WHILE PAT=1
  209. 30250    PAAT=PTRIG(1)
  210. 30260    GOSUB *玉の回転
  211. 30270  WEND
  212. 30280  外乱#=外乱#-1
  213. 30290 RETURN
  214. 31000 '－－－－－－－－－＞極秘行動(玉の回転)
  215. 31010 *玉の回転
  216. 31020  PAT = PAAT AND 1
  217. 31030  外乱#=外乱#+.001#
  218. 31040  乱#=16+外乱#*PAT
  219. 31050  FOR I=0 TO 3
  220. 31060    IF PT = I THEN I=I+1
  221. 31070    TAMA(I)=TAMA(I)+(3-I)*乱#+20
  222. 31080    IF 360<=TAMA(I) THEN TAMA(I)=TAMA(I)-360
  223. 31090    X=(COS(TAMA(I)*RAD#)*45+180)-SPRITE(I*4,6)
  224. 31100    Y=(SIN(TAMA(I)*RAD#)*45+100)-SPRITE(I*4,7)
  225. 31110    SPRITE 6, I*4 ,X,Y
  226. 31120  NEXT I
  227. 31130  IF 外乱#*1000 MOD 30 = 0 THEN PCMPLAY BOIL,音量
  228. 31140 RETURN
  229. 35000 '－－－－－－－－－＞極秘行動(極秘行動を終了するか？)
  230. 35010 *極秘行動を終了するか？
  231. 35020  IF MOUSE(2,0) AND MOUSE(2,1) THEN GOSUB *割込み
  232. 35030  WHILE 等(1)+等(2)+等(3)=0
  233. 35040      PCMPLAY OWATA,127             'おわったよ
  234. 35050      WHILE MOUSE(2,0)*MOUSE(2,1)=0
  235. 35060      WEND
  236. 35070      GOSUB *初期値設定
  237. 35080  WEND
  238. 35090 RETURN
  239. 36000 '－－－－－－－－－＞極秘行動(割込み)メンテンナンスへ突入
  240. 36010 *割込み 
  241. 36020  SPRITE OFF
  242. 36030  ROLL , 200,1
  243. 36040  LINE (186,170)-(210,240),PSET  ,[0,0,255],BF
  244. 36050  LINE (185,177)-(210,240),PSET  ,[0,0,255],BF
  245. 36060  LINE (  0,  0)-(210,240),PASTEL,[0,0,128],BF
  246. 36070  GOSUB *選択
  247. 36080  ROLL ,-200
  248. 36090  FOR I=0 TO 12
  249. 36100    LINE (0,I*15)-(23,I*15+15),PSET,[192-I*16,192-I*16,250],BF
  250. 36110  NEXT I
  251. 36120  LINE (0,13*15)-(23,240),PSET,[0,0,250],BF
  252. 36130  GOSUB   *スプライトＯＮ
  253. 36140 RETURN
  254. 40000 '－－－－－－－－－－－－＞極秘行動(選択) 
  255. 40010 *選択 
  256. 40020  等(等)=等(等)+減        '商品が減ってしまうのを防止する
  257. 40030  CLS 1
  258. 40040  SYMBOL( 0, 10),"くじ引きメンテナンス",1.3!,1.3!,4,,,3 
  259. 40050  SYMBOL(10, 40),"商品個数変更"        ,1   ,1   ,[255,255,0],,,3,3
  260. 40060  SYMBOL(10, 60),"メンテナンス終了"    ,1   ,1   ,[255,240,0],,,3,3 
  261. 40070  SYMBOL( 0,110),"１等賞 残 　  　　個",1   ,1   ,4,,,3,1
  262. 40080  SYMBOL( 0,130),"２等賞 残 　　  　個",1   ,1   ,4,,,3,1
  263. 40090  SYMBOL( 0,150),"３等賞 残 　　　  個",1   ,1   ,4,,,3,1
  264. 40100  FOR I=0 TO 2
  265. 40110    A$=AKCNV$(RIGHT$("  "+STR$(等(I+1)),4))
  266. 40120    SYMBOL(85,110+I*20),A$            ,1   ,1   ,6,,,3,1
  267. 40130  NEXT I
  268. 40200 '選択ＬＯＯＰ１
  269. 40210  TRAP=0
  270. 40220  WHILE TRAP=0
  271. 40230    LINE(0,203)-(210,240),PSET,[0,0,185],BF
  272. 40240    SYMBOL(0,207),"カ－ソルで選んで改行キ－" ,1,1,2,,,2,1
  273. 40250    SYMBOL(0,225)," を押して下ださい"        ,1,1,2,,,2,1
  274. 40260    YP=0 : K=0
  275. 40270    LINE(8,40+18+YP*20)-(170,40+18+YP*20),PSET,2
  276. 40280    WHILE K<>13   'ＣＲ ｋｅｙ？
  277. 40290      WHILE INKEY$<>""
  278. 40300      WEND
  279. 40310      K$ = ""
  280. 40320      WHILE K$=""
  281. 40330        K$ = INKEY$
  282. 40340      WEND
  283. 40350      K = ASC(K$)
  284. 40360                            YP_F= 0
  285. 40370      IF K=30 AND YP=1 THEN YP_F=-1
  286. 40380      IF K=31 AND YP=0 THEN YP_F= 1
  287. 40400      IF YP_F THEN LINE(8,58+YP*20)-(170,58+YP*20),PSET,[54,54,185]
  288. 40410      YP=YP+YP_F
  289. 40420      IF YP_F THEN LINE(8,58+YP*20)-(170,58+YP*20),PSET,2
  290. 40430    WEND
  291. 40440    IF YP=1 THEN TRAP=1
  292. 40450    IF YP=0 THEN GOSUB *商品個数変更
  293. 40460  WEND
  294. 40470 RETURN
  295. 40600 '－－－－－－－－－－－－－－－＞極秘行動＜商品個数変更＞
  296. 40610 *商品個数変更
  297. 40620  LINE(0,205)-(210,240),PSET,[0,0,185],BF
  298. 40630  SYMBOL( 0,207),"カ－ソルで選んで数値を　",1,1,2,    ,,2,1
  299. 40640  SYMBOL( 0,225)," 入力して下ださい"       ,1,1,2,    ,,2,1
  300. 40650  SYMBOL(30,170),"個数変更終了"            ,1,1,[255,255,0],,,3,7
  301. 40660  LINE(3,110+18+YP*20)-(183,110+18+YP*20),PSET,2
  302. 40670  '
  303. 40700  WHILE INKEY$<>""
  304. 40710  WEND
  305. 40720  D=0
  306. 40730  WHILE D<>999
  307. 40740    D=0
  308. 40750    X=45 : Y=12+YP*2
  309. 40760    IF YP<3 THEN GOSUB *数値入力
  310. 40770    WHILE NOT(D=13 OR D=30 OR D=31 OR YP<3)
  311. 40780      D$ = ""
  312. 40790      WHILE D$=""
  313. 40800        D$ = INKEY$
  314. 40810      WEND
  315. 40820      D = ASC(D$)
  316. 40830    WEND
  317. 40840    IF D=13 AND   YP=3 THEN D=999 '商品個数変更脱出
  318. 40850    IF D=13 AND K$=""  THEN D=31  'カーソルを下へ
  319. 40860    IF D=13 AND   YP<3 THEN D=31 : GOSUB *変更_RET
  320. 40870                            YP_F= 0
  321. 40880    IF D=30 AND 0<YP   THEN YP_F=-1
  322. 40890    IF D=31 AND   YP<3 THEN YP_F= 1
  323. 40900    IF YP_F THEN LINE(3,128+YP*20)-(183,128+YP*20),PSET,[8,8,185]
  324. 40910    YP=YP+YP_F
  325. 40920    IF YP_F THEN LINE(3,128+YP*20)-(183,128+YP*20),PSET,2
  326. 40930  WEND
  327. 41000 '商品個数変更脱出
  328. 41010  LINE(3,110+18+YP*20)-(183,110+18+YP*20),PSET,[8,8,185]
  329. 41020  LINE(30,170)-(175,185),PSET,[8,8,185],BF
  330. 41030 RETURN
  331. 41040 '
  332. 41100 *変更_RET
  333. 41110  等(YP+1)=ANS
  334. 41120  A$=AKCNV$(RIGHT$("  "+STR$(等(YP+1)),4))
  335. 41130  LINE(90,111+YP*20)-(158,124+YP*20),PSET,[16,16,185],BF
  336. 41140  SYMBOL(85,110+YP*20),A$      ,1,1,6,,,3,1
  337. 41150 RETURN
  338. 50000 '－－－－－－－－－－－－－－－＞極秘行動(数値入力) 
  339. 50010 *数値入力 
  340. 50020  K$="" : ANS_F=0 : K=89 : D=0
  341. 50030  COLOR 7,,,4
  342. 50040  LOCATE X,Y
  343. 50100  WHILE NOT(D=13 OR D=30 OR D=31)
  344. 50110    D$=""
  345. 50120    WHILE D$=""
  346. 50130      D$=INKEY$
  347. 50140      K=(K MOD 160)+1
  348. 50150      LOCATE X+LEN(K$)*2,Y
  349. 50160      IF K= 80 THEN PRINT "＿";
  350. 50170      IF K=160 THEN PRINT "　";
  351. 50180    WEND
  352. 50190    D=ASC(D$)
  353. 50200    IF 0<INSTR("0123456789",D$) AND LEN(K$)<4 THEN GOSUB *数値入力_INC
  354. 50210    IF (D=8 OR D=127) AND K$<>""              THEN GOSUB *数値入力_DEC
  355. 50220    IF D=13                                   THEN ANS_F=0
  356. 50230    IF D=30 OR D=31                           THEN ANS_F=1
  357. 50240  WEND
  358. 50250 '
  359. 50300 '数値入力脱出用変換
  360. 50310 '
  361. 50320  ANS = VAL(K$)
  362. 50330  LOCATE X,Y
  363. 50340  PRINT "　　　　　";
  364. 50350 RETURN
  365. 50360 '
  366. 50400 *数値入力_INC
  367. 50410  K$=K$+D$
  368. 50420  COLOR 4,,4
  369. 50430  LOCATE X,Y
  370. 50440  PRINT AKCNV$(K$);
  371. 50450  COLOR 7,,4
  372. 50460 RETURN
  373. 50470 '
  374. 50500 *数値入力_DEC
  375. 50510  K$=LEFT$(K$,LEN(K$)-1)
  376. 50520  COLOR 4,,4
  377. 50530  LOCATE X,Y
  378. 50540  PRINT AKCNV$(K$);"    ";
  379. 50550  COLOR 7,,4
  380. 50560 RETURN
  381.