home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FreeWare Collection 3
/
FreeSoftwareCollection3pd199x-jp.img
/
fb386
/
tyusen1
/
tyusen1.bas
< prev
next >
Wrap
BASIC Source File
|
1980-01-02
|
13KB
|
381 lines
10000 '---------------------------------
10010 '--極秘文章“The 抽選” TYPE X1改----------
10020 '---------------Copyright(c)クラリス--
10030 '----------------------------ドビシュ--
10040 '-1989年 6月 1日------協力 APPO & 怒毘狩--
10050 '-1991年 1月 1日改造-------------------
10060 '------------Nifty Serve NBD00520-
10070 '---------------------------------
10080 'SAVE "A:抽選.BAS",A
10090 '
10100 '<-------- MAIN PROGRAM --------->
10110 COLOR 7,,,4
10120 GOSUB *初期設定 :PRINT "初期設定終了"
10130 GOSUB *音声データ登録 :PRINT "音声デ-タ登録終了"
10140 GOSUB *抽選画面描写 :PRINT "画面設定終了"
10150 GOSUB *ボールのスプライト登録 :PRINT "スプライト登録完了"
10160 GOSUB *スプライトON
10170 GOSUB *ボールを飛ばす '玉を空飛ばしする
10180 WHILE 1
10190 GOSUB *極秘行動を終了するか?
10200 GOSUB *トリガー監視
10210 GOSUB *確率によるボールの設定
10220 GOSUB *ボールを飛ばす
10230 GOSUB *結果告知
10240 WEND
11000 '--------->初期設定
11010 *初期設定
11020 WIDTH 80,25 : COLOR 7,0,0
11030 SCREEN@ 1 : CLS
11040 DEF SPRITE 99,0
11050 RANDOMIZE TIME
11060 MOUSE 0
11100 '--------->配列宣言
11110 DIM A%(64),BALL%(255),BALL2%(255),PICT%(5000)
11120 DIM TYYTO(16724/4) 'ちょっと待って!
11130 DIM DOUZO(13120/4) 'どうぞ
11140 DIM SPO(20658/4) 'スッポ!
11150 DIM GLF(27872/4) 'コロンコロン
11170 DIM BOIL(46206/4) 'グツグツ
11180 DIM OWATA(11809/4) '終ったよ
11190 DIM 一等(37721/4) '一等
11200 DIM 二等(18802/4) '二等
11210 DIM 三等(22008/4) '三等
11220 DIM 賞(3) '商品の個数を格納する
11230 DIM TAMA(3) '回転するボールの座標を保持する
11300 '--------->初期値設定
11310 *初期値設定
11320 π#=3.14159265358979#
11330 RAD#=2*π#/360 'ラディアン
11340 減 = 0 '減算フラグ
11350 等 = 1 '最初に飛ばすボールの色
11360 等(1) = 30 '一等賞
11370 等(2) = 50 '二等賞
11380 等(3) = 100 '三等賞
11390 RETURN
12000 '--------->音声データ読み込み登録
12010 *音声データ登録
12020 LOAD@ "tyoma_f.snd" ,TYYTO 'ちょっと待って!
12030 PCMPLAY TYYTO
12040 LOAD@ "douzo_f.snd" ,DOUZO 'どうぞ
12050 LOAD@ "spo.snd" ,SPO 'スッポ!
12060 LOAD@ "glf_pat.snd" ,GLF 'コロンコロン
12070 LOAD@ "boil.snd" ,BOIL 'グツグツ
12080 LOAD@ "owata_f.snd" ,OWATA '終ったよ
12090 LOAD@ "1.snd" ,一等 '一等
12100 LOAD@ "2.snd" ,二等 '二等
12110 LOAD@ "3.snd" ,三等 '三等
12120 RETURN
14000 '------------>抽選画面描写
14010 *抽選画面描写
14020 ' 表示 背景
14030 PAINT(0,0),1,[255,0,1]
14040 FOR I=0 TO 12
14050 LINE (0,I*15)-(340,I*15+15),PSET,[192-I*16,192-I*16,250],BF
14060 NEXT I
14100 ' 表示 皿
14110 CONNECT ( 25,175)-( 30,200)-(180,200),[240,128,210],PSET
14120 CONNECT -(185,175)-(183,175),[240,128,210],PSET
14130 CONNECT -(177,197)-( 33,197),[240,128,210],PSET
14140 CONNECT -( 27,175)-( 25,175),[240,128,210],PSET
14150 PAINT ( 27,178) ,[230,128,200],[240,128,210]
14200 ' 表示 賞
14210 SYMBOL ( 73, 21) , "1等賞",2,2,[100,100, 0],,,2
14220 SYMBOL ( 72, 20) , "1等賞",2,2,[230,230, 0],,,2
14230 SYMBOL ( 63, 57) , "2等賞",2,2,[140,140,140],,,2
14240 SYMBOL ( 62, 56) , "2等賞",2,2,[240,240,240],,,2
14250 SYMBOL ( 53, 93) , "3等賞",2,2,[ 0,128, 0],,,2
14260 SYMBOL ( 52, 92) , "3等賞",2,2,2 ,,,2
14300 ' 表示 富士通
14310 LOAD@ "fujitu.trn",PICT%
14320 PUT@A(205,15)-(295,58),PICT%,MATTE,,,0
14330 '
14400 ' 表示 FM-TOWNS
14410 LOAD@ "fmtowns.trn",PICT%
14420 PUT@A(25,203)-(185,228),PICT%,MATTE,,,0
14430 '
14500 ' 表示 『CLARIS』
14510 'SYMBOL (190,220),"byCLARIS",.7!,.7!,6,,,,4
14520 '
14580 RETURN
15000 '---------> ボールの絵をスプライトに登録
15010 *ボールのスプライト登録 'SPRITE 0金 4銀 8赤
15020 LOAD@ "ball.trn",PICT%
15030 SP=0 : BB=0
15040 FOR N=1 TO 3 '1=金 2=銀 3=赤
15050 FOR I=0 TO 1
15060 FOR J=0 TO 1
15070 FOR K=0 TO 255
15080 BALL%(K) =PICT%(BB)
15090 BALL2%(K)=PICT%(BB)
15100 IF BALL%(K)=0 THEN BALL%(K)=-32768
15110 BB=BB+1
15120 NEXT K
15130 X=40+16*J+21-N*11
15140 Y=N*37+16*I-20
15150 PUT@A( X, Y)-( X+15, Y+15),BALL2%,MATTE,,,0
15160 DEF SPRITE 0,SP*4,BALL%,1
15170 SP=SP+1
15180 NEXT J
15190 NEXT I
15200 NEXT N
15210 '
15300 ' スプライトNo.定義
15310 DEF SPRITE 1,0*4,(140,120),0*4*4,2,2,1 '金
15320 DEF SPRITE 1,1*4,(140,120),1*4*4,2,2,1 '銀
15330 DEF SPRITE 1,2*4,(140,120),2*4*4,2,2,1 '赤
15340 DEF SPRITE 1,3*4,(140,120),2*4*4,2,2,1 '赤
15350 '
15400 RETURN
16000 '--------->極秘行動<START>
16010 *スプライトON
16020 SPRITE ON
16030 SPRITE SCREEN (30,0)
16040 SPRITE SCREEN 0
16050 FOR I=0 TO 3
16060 SPRITE 0, I*4 ,1
16070 NEXT I
16080 RETURN
18000 '--------->極秘行動(確率によるボールの設定)
18010 *確率によるボールの設定
18020 乱=RND(1)
18030 乱1=乱*(等(1)+等(2)+等(3))
18040 等 = 3
18050 IF 0 < 等(2) AND 等(3) < 乱1 THEN 等 = 2
18060 IF 0 < 等(1) AND 等(3)+等(2) < 乱1 THEN 等 = 1
18070 IF PAAT = 10 AND 乱<>1 THEN 乱=1 : GOTO 18030
18080 等(等) = 等(等) -1
18090 減=1
18100 DERU=(等-1)*4
18110 SPRITE 0, DERU ,1
18120 RETURN
20000 '--------->極秘行動(ボールを飛ばす)
20010 *ボールを飛ばす
20020 PCMPLAY SPO
20030 XP# = 130 : YP# = 120
20040 角度 = (40+外乱#/10)/180*π# : 速度# = 32+外乱#
20050 T#=0
20060 方向フラグ=0
20070 '
20080 WHILE 1
20090 X#=XP#- 速度#*COS(角度)*T#
20100 Y#=YP#-(速度#*SIN(角度)*T#-4.9#*T#*T#)
20110 SPRITE TIME
20120 IF 方向フラグ = 0 AND X# < 0 THEN 方向フラグ=1
20130 IF 方向フラグ = 1 AND X# < -120 THEN 方向フラグ=2
20140 IF 方向フラグ = 0 THEN XX= X#
20150 IF 方向フラグ = 1 THEN XX= -X#
20160 IF 方向フラグ = 2 THEN XX=240+X#
20170 DEF SPRITE 1,DERU,(XX,Y#),DERU*4,2,2,1
20180 SPRITE 0, DERU ,1
20190 IF Y#<165 THEN *ボールは地に着いていない
20200 T#=0
20210 IF 速度#<=0 THEN *ボールは速度を失った
20220 速度#=速度#-6 '玉の減速
20230 PCMPLAY GLF
20240 XP# = X# : YP# = Y#
20250 *ボールは地に着いていない
20260 T#=T#+.1#
20270 WEND
20280 *ボールは速度を失った
20290 RETURN
21000 '--------->極秘行動(結果告知)
21010 *結果告知
21020 IF 等=1 THEN PCMPLAY 一等
21030 IF 等=2 THEN PCMPLAY 二等
21040 IF 等=3 THEN PCMPLAY 三等
21050 FOR I=0 TO 2000
21060 K$=INKEY$
21070 NEXT I
21080 RETURN
30000 '--------->極秘行動(パッド監視)
30010 *トリガー監視
30020 'トリガーが押されるまで待つ
30030 音量=20
30040 PAT=0
30045 PT=等-1
30050 外乱#=0
30060 PCMPLAY DOUZO
30070 WHILE PAT=0
30080 PAAT=PTRIG(1)
30090 GOSUB *玉の回転
30100 WEND
30200 'トリガーが放されるまで待つ
30210 外乱#=1
30220 音量 = 64
30230 PCMPLAY BOIL
30235 PT=999
30240 WHILE PAT=1
30250 PAAT=PTRIG(1)
30260 GOSUB *玉の回転
30270 WEND
30280 外乱#=外乱#-1
30290 RETURN
31000 '--------->極秘行動(玉の回転)
31010 *玉の回転
31020 PAT = PAAT AND 1
31030 外乱#=外乱#+.001#
31040 乱#=16+外乱#*PAT
31050 FOR I=0 TO 3
31060 IF PT = I THEN I=I+1
31070 TAMA(I)=TAMA(I)+(3-I)*乱#+20
31080 IF 360<=TAMA(I) THEN TAMA(I)=TAMA(I)-360
31090 X=(COS(TAMA(I)*RAD#)*45+180)-SPRITE(I*4,6)
31100 Y=(SIN(TAMA(I)*RAD#)*45+100)-SPRITE(I*4,7)
31110 SPRITE 6, I*4 ,X,Y
31120 NEXT I
31130 IF 外乱#*1000 MOD 30 = 0 THEN PCMPLAY BOIL,音量
31140 RETURN
35000 '--------->極秘行動(極秘行動を終了するか?)
35010 *極秘行動を終了するか?
35020 IF MOUSE(2,0) AND MOUSE(2,1) THEN GOSUB *割込み
35030 WHILE 等(1)+等(2)+等(3)=0
35040 PCMPLAY OWATA,127 'おわったよ
35050 WHILE MOUSE(2,0)*MOUSE(2,1)=0
35060 WEND
35070 GOSUB *初期値設定
35080 WEND
35090 RETURN
36000 '--------->極秘行動(割込み)メンテンナンスへ突入
36010 *割込み
36020 SPRITE OFF
36030 ROLL , 200,1
36040 LINE (186,170)-(210,240),PSET ,[0,0,255],BF
36050 LINE (185,177)-(210,240),PSET ,[0,0,255],BF
36060 LINE ( 0, 0)-(210,240),PASTEL,[0,0,128],BF
36070 GOSUB *選択
36080 ROLL ,-200
36090 FOR I=0 TO 12
36100 LINE (0,I*15)-(23,I*15+15),PSET,[192-I*16,192-I*16,250],BF
36110 NEXT I
36120 LINE (0,13*15)-(23,240),PSET,[0,0,250],BF
36130 GOSUB *スプライトON
36140 RETURN
40000 '------------>極秘行動(選択)
40010 *選択
40020 等(等)=等(等)+減 '商品が減ってしまうのを防止する
40030 CLS 1
40040 SYMBOL( 0, 10),"くじ引きメンテナンス",1.3!,1.3!,4,,,3
40050 SYMBOL(10, 40),"商品個数変更" ,1 ,1 ,[255,255,0],,,3,3
40060 SYMBOL(10, 60),"メンテナンス終了" ,1 ,1 ,[255,240,0],,,3,3
40070 SYMBOL( 0,110),"1等賞 残 個",1 ,1 ,4,,,3,1
40080 SYMBOL( 0,130),"2等賞 残 個",1 ,1 ,4,,,3,1
40090 SYMBOL( 0,150),"3等賞 残 個",1 ,1 ,4,,,3,1
40100 FOR I=0 TO 2
40110 A$=AKCNV$(RIGHT$(" "+STR$(等(I+1)),4))
40120 SYMBOL(85,110+I*20),A$ ,1 ,1 ,6,,,3,1
40130 NEXT I
40200 '選択LOOP1
40210 TRAP=0
40220 WHILE TRAP=0
40230 LINE(0,203)-(210,240),PSET,[0,0,185],BF
40240 SYMBOL(0,207),"カ-ソルで選んで改行キ-" ,1,1,2,,,2,1
40250 SYMBOL(0,225)," を押して下ださい" ,1,1,2,,,2,1
40260 YP=0 : K=0
40270 LINE(8,40+18+YP*20)-(170,40+18+YP*20),PSET,2
40280 WHILE K<>13 'CR key?
40290 WHILE INKEY$<>""
40300 WEND
40310 K$ = ""
40320 WHILE K$=""
40330 K$ = INKEY$
40340 WEND
40350 K = ASC(K$)
40360 YP_F= 0
40370 IF K=30 AND YP=1 THEN YP_F=-1
40380 IF K=31 AND YP=0 THEN YP_F= 1
40400 IF YP_F THEN LINE(8,58+YP*20)-(170,58+YP*20),PSET,[54,54,185]
40410 YP=YP+YP_F
40420 IF YP_F THEN LINE(8,58+YP*20)-(170,58+YP*20),PSET,2
40430 WEND
40440 IF YP=1 THEN TRAP=1
40450 IF YP=0 THEN GOSUB *商品個数変更
40460 WEND
40470 RETURN
40600 '--------------->極秘行動<商品個数変更>
40610 *商品個数変更
40620 LINE(0,205)-(210,240),PSET,[0,0,185],BF
40630 SYMBOL( 0,207),"カ-ソルで選んで数値を ",1,1,2, ,,2,1
40640 SYMBOL( 0,225)," 入力して下ださい" ,1,1,2, ,,2,1
40650 SYMBOL(30,170),"個数変更終了" ,1,1,[255,255,0],,,3,7
40660 LINE(3,110+18+YP*20)-(183,110+18+YP*20),PSET,2
40670 '
40700 WHILE INKEY$<>""
40710 WEND
40720 D=0
40730 WHILE D<>999
40740 D=0
40750 X=45 : Y=12+YP*2
40760 IF YP<3 THEN GOSUB *数値入力
40770 WHILE NOT(D=13 OR D=30 OR D=31 OR YP<3)
40780 D$ = ""
40790 WHILE D$=""
40800 D$ = INKEY$
40810 WEND
40820 D = ASC(D$)
40830 WEND
40840 IF D=13 AND YP=3 THEN D=999 '商品個数変更脱出
40850 IF D=13 AND K$="" THEN D=31 'カーソルを下へ
40860 IF D=13 AND YP<3 THEN D=31 : GOSUB *変更_RET
40870 YP_F= 0
40880 IF D=30 AND 0<YP THEN YP_F=-1
40890 IF D=31 AND YP<3 THEN YP_F= 1
40900 IF YP_F THEN LINE(3,128+YP*20)-(183,128+YP*20),PSET,[8,8,185]
40910 YP=YP+YP_F
40920 IF YP_F THEN LINE(3,128+YP*20)-(183,128+YP*20),PSET,2
40930 WEND
41000 '商品個数変更脱出
41010 LINE(3,110+18+YP*20)-(183,110+18+YP*20),PSET,[8,8,185]
41020 LINE(30,170)-(175,185),PSET,[8,8,185],BF
41030 RETURN
41040 '
41100 *変更_RET
41110 等(YP+1)=ANS
41120 A$=AKCNV$(RIGHT$(" "+STR$(等(YP+1)),4))
41130 LINE(90,111+YP*20)-(158,124+YP*20),PSET,[16,16,185],BF
41140 SYMBOL(85,110+YP*20),A$ ,1,1,6,,,3,1
41150 RETURN
50000 '--------------->極秘行動(数値入力)
50010 *数値入力
50020 K$="" : ANS_F=0 : K=89 : D=0
50030 COLOR 7,,,4
50040 LOCATE X,Y
50100 WHILE NOT(D=13 OR D=30 OR D=31)
50110 D$=""
50120 WHILE D$=""
50130 D$=INKEY$
50140 K=(K MOD 160)+1
50150 LOCATE X+LEN(K$)*2,Y
50160 IF K= 80 THEN PRINT "_";
50170 IF K=160 THEN PRINT " ";
50180 WEND
50190 D=ASC(D$)
50200 IF 0<INSTR("0123456789",D$) AND LEN(K$)<4 THEN GOSUB *数値入力_INC
50210 IF (D=8 OR D=127) AND K$<>"" THEN GOSUB *数値入力_DEC
50220 IF D=13 THEN ANS_F=0
50230 IF D=30 OR D=31 THEN ANS_F=1
50240 WEND
50250 '
50300 '数値入力脱出用変換
50310 '
50320 ANS = VAL(K$)
50330 LOCATE X,Y
50340 PRINT " ";
50350 RETURN
50360 '
50400 *数値入力_INC
50410 K$=K$+D$
50420 COLOR 4,,4
50430 LOCATE X,Y
50440 PRINT AKCNV$(K$);
50450 COLOR 7,,4
50460 RETURN
50470 '
50500 *数値入力_DEC
50510 K$=LEFT$(K$,LEN(K$)-1)
50520 COLOR 4,,4
50530 LOCATE X,Y
50540 PRINT AKCNV$(K$);" ";
50550 COLOR 7,,4
50560 RETURN