十進BASIC 第3掲示板

「PITGAL」パズルゲーム - しばっち

2025/06/22 (Sun) 07:15:00

「PITGAL」パズルゲーム

一昔前パソコン雑誌に掲載されていたプログラムの移植版です。(厳密には移植の移植版)
まず先に下記プログラムを実行して面データファイルを作成してください。

一度実行すれば再実行は必要ありません。

PRINT "「ＰＩＴＧＡＬ」の "
PRINT "画面データーを作成します。"
FOR K=0 TO 49
PRINT K+1;"面をセーブ中です。"
OPEN #1:NAME "pitgal"&RIGHT$("0"&STR$(K),2)&".txt"
ERASE #1
FOR I=1 TO 2
READ A$
PRINT #1:A$;
NEXT I
CLOSE #1
NEXT K
PRINT "終了しました"
DATA 00040000000155450555511004050000110630000001
DATA 55550500001000050000012000000004155505550555
DATA 00400000000004040000000051230000000513220002
DATA 00513330333205100333005051000000650555555555
DATA 00006050400000041514000002415120000233151220
DATA 05211151550055555515200000000155005555555550
DATA 00000400000020003000020310125450100021352540
DATA 02031034320231016333403002055533132135233331
DATA 55555555555424000053354441510533533300105335
DATA 00215105335344001053352121510533510200165555
DATA 00400000000064040000001330100000010033331110
DATA 33332001542000030550442000050012450531015132
DATA 01104000555014040065350140255153501401441535
DATA 51502331535510011555355500515333535021155555
DATA 33305001111333652030213331540324134415303541
DATA 03415003041003151110310251555155101110000001
DATA 00004002053155140150531051201505310512055055
DATA 10514055001105553000511002005555110010060001
DATA 00600053302043331523340233115431303031533313
DATA 00401513313035310510131510303513330133133123
DATA 00000200000000200020000200060002000005450000
DATA 00000200000545454545450000000000050505050505
DATA 00400100400005551004000000000041100555554341
DATA 00111114041001323030312010420500110102105061
DATA 32200520233345210514031353310531013533310501
DATA 13033331014165113115423351410113433313330001
DATA 00040000000000400000500114055510001434400000
DATA 01403400000013033000206100400024055113000120
DATA 00400600400111113111111004030400110323032301
DATA 10353035301103330333011000101000110001010001
DATA 40005540043306400300211533133303302401330300
DATA 33331001030254015050004033333002031000001050
DATA 11111000000124414200001424124400012421432100
DATA 14241244100132214231005515124110252151111601
DATA 10000000001133343334311032363240110334434201
DATA 10322033301100320240011002403400110333303301
DATA 00000033545155431335251502514354511040133545
DATA 10033300333011533333441064040003350550505121
DATA 01111111111600000000015022404240150002020201
DATA 50442040401502000202015042402240150000000001
DATA 00040000000054514555100044036001002330330010
DATA 03501000010200300000105055555555050500000000
DATA 00005335440000255554400003111531100404012001
DATA 11434005001163340020011303300500111111115001
DATA 34000000000360555555510324000000130324000001
DATA 03032400001303032400010303032000130303030001
DATA 11464000000104140000001041400000010545410000
DATA 10040401000105505055001004040500210550505005
DATA 33234052040213340554514000315044133154100351
DATA 01504331401302330013133055413150236333151511
DATA 30000040000303531111113053500000130353040001
DATA 30000333001300003230013333033300100030060001
DATA 55556111111533550004215333500423153555042315
DATA 53520023155535550311535335202155355551015533
DATA 00000000240000000001410000005503100000000051
DATA 00200400001015055001550100000010000000006100
DATA 00040533333000405555550114000000201434555555
DATA 01404011111013030323010100502420161005012101
DATA 10000001000133333304001400600055513055500000
DATA 14022500120130545000101003330000130133333330
DATA 32330404000333311111113052030000130330300001
DATA 30006400001133033000010000000000155555555500
DATA 00000005240000040405311333103154110001301531
DATA 14040001001130331055211030013055416015301254
DATA 30000430000334403310003134303106031032055555
DATA 31004030250312040345003140403500031111155555
DATA 00006404000000015040000401500400004150004020
DATA 13000004050130000422001001003220055510032200
DATA 00000411110000024614100002411141020241151310
DATA 10411524011103325130011003551400110033311100
DATA 56665666520555555555510000400050101523000501
DATA 01514400501133323406011000333150111111111500
DATA 00000444440002004222200011024222600005224221
DATA 00000222421000152222410001022222100051111111
DATA 00404000000003011111110004140000100032100201
DATA 05004140501025030100010100000006155101511155
DATA 00034004000001153111111001530000155015304001
DATA 02015033301150150323011101103330100000000061
DATA 16000400021130442440311052424250110242224201
DATA 10542224501114222224111122222221111111111111
DATA 00140040002001101100152041010204610410101012
DATA 00110100411010101041000001010102000010000010
DATA 33200402040334012050303440111110113300000331
DATA 13304600401100013332011003000150130333301000
DATA 00000004004155555550021111160004204000551022
DATA 32000051042332000510243332020132233330501022
DATA 00000520400000000545510004050204115550505051
DATA 10020030301101500313111010002505110000610101
DATA 12500000400140004011421255540013414000400102
DATA 12330420103130032503301000125334055161250030
DATA 50000000005515552555555153540402551555402245
DATA 51020214235515255552055103060020555555555555
DATA 02041000000150410000001504100000013041000400
DATA 51041551400500416003105422330031050231210010
DATA 04005100200133041015401020310104010330100331
DATA 10006100401333331015012000000103155055505333
DATA 24214244222422134604444221113000024415001111
DATA 44413451224444513313330005531552011111113310
DATA 30043333336411122411124221442101032144221110
DATA 33131113330233310133201423111331012202221210
END

Re: 「PITGAL」パズルゲーム - しばっち

2025/06/22 (Sun) 07:17:05

こちらがゲーム本体です。
基本操作はテンキーの2,4,6,8キー又は矢印キーにスペーキーとリターンキーです。

マウスは使用しません。

実行するとゲームプレイか画面編集かの選択になります。
2,8キー又は矢印キーで「PLAY」か「EDIT」か選択してください。

「PLAY」を選ぶとゲームプレイになります。
面数選択になりますので2,8キー又は矢印キーで何面からスタートするか選択してください。
スペースキー又はリターンキーでゲームスタートします。

キャラクターを操作してゴールドを全部取ればクリアになるパズルゲームです。全50面あります。
時間制限、敵キャラ等はありません。行き詰った場合や操作に失敗した場合は「G」キーでギブアップしてください。
残り人数が0になるとゲームオーバーです。何かキーを押すと最初の画面に戻ります。

　　　　　　　　　　ゲーム説明

ゴールド....全部取ればクリアになります。横方向からしか取れません。上に乗ることもできます。
岩..........岩の隣がスペースなら動かすことができます。横向きにしか動かせませんが下に何もないと落ちます。岩の上に乗ることもできます。　　　　
はしご......上下左右方向に移動できます。
レンガ......レンガ上を移動できます。
ピンクの壁..横方向からなら破壊できますが復元はできません。上に乗ることもできます。
主人公......テンキー又は矢印キーで操作します。下に何もなければ下に落ちます。
　　　　　　敵はなくやられて死ぬことはありません。身動きできなくなった等操作に失敗した時には「G」キーでギブアップしてください。

そんなに難しいルールではないので実際に操作してみればすぐに分かるかと思います。

「EDIT」を選ぶと面データを編集できます。
2,8キーで面を選びZ,X,C,V,B,N,Mキーで面データを作成できます。

リターンキーで編集を終えセーブするか問いてきますのでY/Nキーで選択してください。
Nキーを押すとメニューが表示されます。2,8キーでメニューから選択してください。
「EXIT」を選ぶと最初の画面に戻ります。

ANSWER.zip 18.2MB(19,151,906 バイト)
パスワード:設定していません。
ダウンロード期限：2025年8月21日(木)

https://99.gigafile.nu/0821-c1ff77cf8a2375aaec0b631fcdf2d80f0

OPTION BASE 0
DECLARE EXTERNAL FUNCTION INKEY$
PUBLIC NUMERIC XPOS,YPOS
SET BITMAP SIZE 640,400
SET WINDOW 0,639,399,0
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT HEIGHT 14
SET TEXT BACKGROUND "OPAQUE"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
LET F$="PITGAL" ! BASE名
20 DIM Z(10, 8), AA(32,32), BB(32 ,32), CC(32,32), DD(32,32), EE(32,32), FF(32,32), GG(32,32), HH(32,32), II(32,32), JJ(16,16), KK(16,16), LL(16,16), MM(16,16)
30 GOSUB 1800
GOSUB 1940
40 GOSUB 1300
LET MA = 5
50 LET A$ = INKEY$
IF A$ = "" THEN 50
60 IF A$ = "2" THEN GOSUB 1360
70 IF A$ = "8" THEN GOSUB 1370
80 IF A$ <> " " AND A$ <> CHR$(13) THEN 50
90 IF J = 1 THEN
GOSUB 1380
LET PP = 1
GOTO 1000
END IF
100 LET PP = 0
LET L = 0
GOSUB 1380
110 GOSUB 1540
! CALL GLOCATE( 9, 13)
! CALL GPRINT( "画面データーをロードします。")
! CALL GLOCATE( 10, 22)
! CALL GPRINT( "ＦＩＬＥ")
! CALL GLOCATE( 11, 22)
! CALL GPRINT("ＮＡＭＥ")
! CALL GLOCATE( 12, 20)
! CALL GPRINT( "＞")
120 ! INPUT "FILE NAME=",F$ ! BASE名(EDITで画面データを作成した場合の読み込み)
! IF LEN(F$) > 6 THEN
! GOTO 120
! ELSE
GOSUB 1530
GOTO 820
! END IF
130 LET GB = 0
LET G = 0
GOSUB 1530
OPEN #1:NAME F$ & RIGHT$("0" & STR$(L), 2)&".txt"
140 FOR Y = 0 TO 7
FOR X = 0 TO 10
150 CHARACTER INPUT #1: Q$
LET Q = VAL(Q$)
LET Z(X, Y) = Q
IF Q=2 THEN LET G=G+1
IF Q = 6 THEN
LET MX = X
LET MY = Y
END IF
160 IF Q > 6 THEN LET Q = 5
170 LET XA = (X * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
LET QQ = Q
GOSUB 1620
180 NEXT X
NEXT Y
CLOSE #1
IF G = 0 THEN LET G = 1
190 FOR I = 0 TO 10
LET Z(I, 8) = 5
NEXT I
200 LET X = MX
LET Y = MY
LET X1 = X
LET X2 = X
210 IF Z(X, Y + 1) = 0 AND GB = 0 THEN
LET MY = MY + 1
LET SY = 1
GOTO 470
END IF
230 LET A$ = INKEY$
IF A$ = "" THEN 230
240 IF A$ <> "8" OR Y < 1 THEN 270
250 LET A = Z(X, Y - 1)
260 IF A = 0 OR A = 1 AND GB = 1 THEN
LET MY = MY - 1
LET SY = 1
GOTO 470
END IF
270 IF A$ <> "2" THEN 300
280 LET A = Z(X, Y + 1)
290 IF A = 1 OR A = 0 THEN
LET MY = MY + 1
LET SY = 1
GOTO 470
END IF
300 IF A$ = "6" THEN
LET HX = 1
LET SY = 3
GOTO 390
END IF
310 IF A$ = "4" THEN
LET HX = -1
LET SY = 2
GOTO 390
END IF
320 IF A$ = CHR$(13) THEN 630
330 IF A$ = "g" OR A$ = "G" THEN 370
340 IF A$ = "n" OR A$ = "N" THEN
IF L = 49 THEN
GOTO 200
ELSE
LET L = L + 1
GOTO 370
END IF
END IF
350 IF A$ = "b" OR A$ = "B" THEN
IF L = 0 THEN
GOTO 200
ELSE
LET L = L - 1
GOTO 370
END IF
END IF
360 GOTO 200
370 LET MA = MA - 1
GOSUB 1460
IF MA > 0 THEN 130
380 CALL BOXFULL (8 * 18, 12 * 16,36 * 8, 13 * 16, 0)
CALL GLOCATE( 13, 19)
CALL GPRINT( "ＧＡＭＥＯＶＥＲ")
CHARACTER INPUT A$
GOTO 40
390 IF X + HX < 0 OR X + HX > 10 THEN 200
400 LET B = Z(X + HX, Y)
410 IF B >= 0 AND B < 4 THEN
LET MX = MX + HX
GOTO 470
END IF
420 IF X + HX * 2 < 0 OR X + HX * 2 > 10 THEN 200
430 IF Z(X + HX, Y) <> 4 OR Z(X + HX * 2, Y) <> 0 THEN 200
440 LET XA = ((X + HX) * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
LET QQ = 0
GOSUB 1620
LET Z(X + HX, Y) = 0
450 LET XA = ((X + HX * 2) * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
LET QQ = 4
GOSUB 1620
LET Z(X + HX * 2, Y) = 4
460 IF HX = 1 THEN
LET X1 = X + 1
LET X2 = X + 2
LET SY = 3
ELSE
LET X1 = X - 2
LET X2 = X - 1
LET SY = 2
END IF
470 LET XA = (X * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
LET QQ = GB
GOSUB 1620
LET Z(X, Y) = GB
480 LET A = Z(MX, MY)
IF A=1 THEN LET GB=1 ELSE LET GB=0
490 IF A = 2 THEN LET G = G - 1
500 LET XA = (MX * 2 + 3) * 16
LET YA = (MY * 2 + 7) * 16
LET QQ = 5 + SY
GOSUB 1620
LET Z(MX, MY) = 5 + SY
510 LET Q = 0
FOR X = X1 TO X2
FOR Y = 7 TO 1 STEP -1
520 IF Z(X, Y) <> 0 THEN 560
530 IF Z(X, Y - 1) = 2 THEN
LET XA = (X * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
LET QQ = 2
GOSUB 1620
LET Z(X, Y) = 2
GOTO 550
END IF
540 IF Z(X, Y - 1) = 4 THEN
LET XA = (X * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
LET QQ = 4
GOSUB 1620
LET Z(X, Y) = 4
ELSE
GOTO 560
END IF
550 LET XA = (X * 2 + 3) * 16
LET YA = ((Y - 1) * 2 + 7) * 16
LET QQ = 0
GOSUB 1620
LET Z(X, Y - 1) = 0
LET Q = 1
560 NEXT Y
NEXT X
570 IF Q > 0 THEN 510
580 IF G = 0 THEN 600
590 GOTO 200
600 CALL BOXFULL(8 * 12, 12 * 16,44 * 8, 13 * 16, 0)
CALL GLOCATE( 13, 13)
CALL GPRINT( "ＣＯＮＧＲＡＴＵＬＡＴＩＯＮＳ")
WAIT DELAY 4
610 LET L = L + 1
IF L < 50 THEN
IF MA = 5 THEN
GOSUB 1460
GOTO 130
ELSE
LET MA = MA + 1
GOSUB 1460
GOTO 130
END IF
END IF
620 CALL BOXFULL (8 * 12, 14 * 16,42 * 8, 15 * 16, 0)
CALL GLOCATE( 15, 13)
CALL GPRINT( "ＡＬＬＬＥＶＥＬＣＬＥＡＲ")
WAIT DELAY 4
GOTO 40
630 GOSUB 780
CALL GLOCATE( 12, 22)
CALL GPRINT( "** ＭＥＮＵ **")
GOSUB 720
GOSUB 730
GOSUB 740
GOSUB 750
640 LET CU = 0
LET CCC = 0
GOSUB 710
650 LET A$ = INKEY$
IF A$ = "" THEN 650
660 IF A$ = "8" AND CU > 0 THEN
LET CCC = -1
GOSUB 710
GOTO 650
END IF
670 IF A$ = "2" AND CU < 3 THEN
LET CCC = 1
GOSUB 710
GOTO 650
END IF
680 IF A$ <> " " AND A$<>CHR$(13) THEN 650
690 SET TEXT COLOR 7
GOSUB 1530
GOSUB 800
700 IF CU+1=1 THEN 820
IF CU+1=2 THEN 850
IF CU+1=3 THEN 1000
IF CU+1=4 THEN 770
710 SET TEXT COLOR 7
IF CU+1=1 THEN GOSUB 720
IF CU+1=2 THEN GOSUB 730
IF CU+1=3 THEN GOSUB 740
IF CU+1=4 THEN GOSUB 750
LET CU = CU + CCC
GOTO 760
720 CALL GLOCATE( 15, 25)
CALL GPRINT( "ＰＬＡＹ")
RETURN
730 CALL GLOCATE( 16, 25)
CALL GPRINT( "ＬＯＡＤ")
RETURN
740 CALL GLOCATE( 17, 25)
CALL GPRINT( "ＥＤＩＴ")
RETURN
750 CALL GLOCATE( 18, 25)
CALL GPRINT( "ＥＸＩＴ")
RETURN
760 SET TEXT COLOR 5
IF CU+1=1 THEN GOSUB 720
IF CU+1=2 THEN GOSUB 730
IF CU+1=3 THEN GOSUB 740
IF CU+1=4 THEN GOSUB 750
RETURN
770 IF PP = 1 THEN 40 ELSE 200
780 LET XS = 9
LET YS = 11
LET XE = 19
LET YE = XE
LET QQ = 1
GOSUB 1720
790 CALL BOXFULL(10 * 16, 12 * 16,17 * 16 + 15, 17 * 16 + 15, 0)
RETURN
800 FOR J = 0 TO 3
FOR I = 0 TO 4
LET Q = Z(I + 3, J + 2)
810 LET XA = ((I + 3) * 2 + 3) * 16
LET YA = ((J + 2) * 2 + 7) * 16
LET QQ = Q
GOSUB 1620
NEXT I
NEXT J
RETURN
820 IF PP = 1 THEN GOTO 110 ELSE GOSUB 780
830 CALL GLOCATE( 14, 23)
CALL GPRINT( "ＳＴＡＲＴ")
CALL GLOCATE( 15, 25)
CALL GPRINT( "ＳＴＡＧＥ")
GOSUB 910
840 LET MA = 5
GOSUB 1540
GOSUB 1460
GOTO 130
850 GOSUB 1540
! CALL GLOCATE( 9, 13)
! CALL GPRINT( "画面データーをロードします。")
! CALL GLOCATE( 10, 22)
! CALL GPRINT( "ＦＩＬＥ")
! CALL GLOCATE( 11, 22)
! CALL GPRINT( "ＮＡＭＥ")
! CALL GLOCATE( 12, 20)
! CALL GPRINT( "＞")
860 ! CALL GLOCATE( 21, 11)
! INPUT PROMPT "LOAD FILE NAME=": F$
! IF LEN(F$) > 6 THEN
! CALL GLOCATE( 23, 13)
! CALL GPRINT(" ")
! GOTO 860
!END IF
870 GOSUB 1530
GOSUB 780
CALL GLOCATE( 14, 23)
CALL GPRINT( "ＬＯＡＤ")
CALL GLOCATE( 15, 25)
CALL GPRINT( "ＳＴＡＧＥ")
GOSUB 910
880 GOSUB 1540
GOSUB 1530
IF PP = 0 THEN 130
890 OPEN #1:NAME F$ & RIGHT$("0" & STR$(L), 2)&".txt"
FOR Y = 0 TO 7
FOR X = 0 TO 10
900 CHARACTER INPUT #1:Q$
LET Z(X, Y) = VAL(Q$)
NEXT X
NEXT Y
CLOSE #1
GOSUB 1020
GOTO 1060
910 CALL GLOCATE( 17, 27)
CALL GPRINT( RIGHT$("0" & STR$(L + 1), 2))
930 LET A$ = INKEY$
IF A$ = "" THEN 930
950 IF A$="8" THEN LET L=L+1
IF A$="2" THEN LET L=L-1
960 IF L < 0 THEN
LET L = 49
ELSEIF L>49 THEN
LET L=0
END IF
970 IF A$ = " " OR A$=CHR$(13) THEN
GOSUB 990
RETURN
END IF
980 GOTO 910
990 CALL GLOCATE( 11, 65)
CALL GPRINT( RIGHT$("0" & STR$(L + 1), 2))
RETURN
1000 GOSUB 780
CALL GLOCATE( 14, 23)
CALL GPRINT( "ＥＤＩＴ")
CALL GLOCATE( 15, 25)
CALL GPRINT( "ＳＴＡＧＥ")
GOSUB 910
GOSUB 1530
GOSUB 1540
IF PP = 1 THEN
GOSUB 1020
GOTO 1060
END IF
1010 OPEN #1:NAME F$ & RIGHT$("0" & STR$(L), 2)
FOR Y = 0 TO 7
FOR X = 0 TO 10
CHARACTER INPUT #1: Q$
LET Z(X, Y) = VAL(Q$)
NEXT X
NEXT Y
CLOSE #1
GOSUB 1020
GOTO 1060
1020 FOR X = 0 TO 10
FOR Y = 0 TO 7
1030 LET Q = Z(X, Y)
IF Q > 6 THEN
LET Q = 5
LET MX = X
LET MY = Y
END IF
1040 IF Q=2 THEN LET G=G+1
1050 LET XA = (X * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
LET QQ = Q
GOSUB 1620
NEXT Y
NEXT X
RETURN
1060 LET X = 0
LET Y = 0
1070 LET XX = X
LET YY = Y
LET LC = 0
LET AC=1-AC
1080 LET XS = X * 2 + 3
LET YS = Y * 2 + 7
LET XE = XS + 2
LET YE = YS + 2
IF AC = 0 THEN
LET QQ = 1
GOSUB 1720
GOTO 1100
END IF
1090 LET QQ = Z(X, Y)
LET XA = (X * 2 + 3) * 16
LET YA = (Y * 2 + 7) * 16
GOSUB 1620
1100 LET LC = LC + 1
LET A$ = INKEY$
IF LC > 20 THEN
GOTO 1070
ELSE
IF A$ = "" THEN 1100
END IF
1110 !'IF INKEY$ <> "" THEN 1110
1120 IF POS("2468",A$)>0 THEN LET A = VAL(A$) ELSE LET A=0
IF A > 0 THEN 1270
1130 IF A$ = CHR$(13) THEN
1140 GOSUB 1540
CALL GLOCATE( 11, 17)
CALL GPRINT( "画面データーを")
CALL GLOCATE( 13, 13)
CALL GPRINT( "セーブしますか（Ｙ／Ｎ）")
CHARACTER INPUT A$
IF A$ = "Y" OR A$ = "y" THEN 1160
1150 GOSUB 1530
GOSUB 1020
IF PP = 0 THEN
LET MA = 5
GOSUB 1460
GOSUB 1020
GOTO 200
ELSE
GOTO 630
END IF
1160 ! CALL GLOCATE( 10, 22)
! CALL GPRINT( "ＦＩＬＥ")
! CALL GLOCATE( 11, 22)
! CALL GPRINT( "ＮＡＭＥ")
! CALL GLOCATE( 12, 20)
! CALL GPRINT( "＞")
1170 ! CALL GLOCATE( 12, 22)
INPUT PROMPT "SAVE FILE NAME=": F$
! IF LEN(F$) > 6 THEN
! CALL GLOCATE( 12, 22)
! CALL GPRINT(" ")
! GOTO 1170
! END IF
1180 GOSUB 1530
GOSUB 1020
OPEN #1:NAME F$ & RIGHT$("0" & STR$(L), 2)&".txt"
1190 FOR Y = 0 TO 7
FOR X = 0 TO 10
PRINT #1:STR$(Z(X, Y));
NEXT X
NEXT Y
CLOSE #1
IF PP = 0 THEN
LET MA = 5
GOSUB 1460
GOSUB 1020
GOTO 200
ELSE
GOTO 630
END IF
1200 END IF
1210 IF A$ = CHR$(12) THEN GOSUB 1540
1220 LET Q = VAL(MID$("012345671234567", POS("zxcvbnmZXCVBNM", A$) + 1, 1))
1230 IF Q > 0 THEN
LET Z(X, Y) = Q - 1
LET AC = 0
END IF
1240 IF A$ <> "+" AND A$ <> "-" AND A$<>"8" AND A$<>"2" THEN 1070
1250 IF A$="+" OR A$="8" THEN LET L=L+1
IF A$="-" OR A$="2" THEN LET L=L-1
IF L < 0 THEN
LET L=49
ELSEIF L>49 THEN
LET L = 0
END IF
1260 GOSUB 990
GOTO 1070
1270 IF A=4 THEN LET X=X-1
IF A=6 THEN LET X=X+1
IF X < 0 THEN
LET X=10
ELSEIF X>10 THEN
LET X = 0
END IF
1280 IF A=8 THEN LET Y=Y-1
IF A=2 THEN LET Y=Y+1
IF Y < 0 THEN
LET Y = 7
ELSEIF Y>7 THEN
LET Y=0
END IF
1290 LET Q = Z(XX, YY)
LET XA = (XX * 2 + 3) * 16
LET YA = (YY * 2 + 7) * 16
LET QQ = Q
GOSUB 1620
GOTO 1070
1300 CLEAR
LET XS = 0
LET YS = 0
LET XE = 40
LET YE = 25
LET QQ = 4
GOSUB 1720
1310 CALL BOXFULL(0, 2 * 16,39 * 16 + 15, 10 * 16 + 15, 0)
1320 CALL BOXFULL (16 * 16, 12 * 16,23 * 16 + 15, 16 * 16 + 15, 0)
1330 CALL BOXFULL (1 * 16, 19 * 16,38 * 16 + 15, 23 * 16 + 15, 0)
1340 RESTORE 1550
FOR J = 0 TO 6
READ A$
1350 LET XA = 0
LET YA = J + 3
GOSUB 1770
NEXT J
1360 SET TEXT COLOR 0
CALL GLOCATE( 14, 37)
CALL GPRINT( "ＥＤＩＴ")
SET TEXT COLOR 2
CALL GLOCATE( 16, 37)
CALL GPRINT( "ＰＬＡＹ")
SET TEXT COLOR 7
LET J = 0
RETURN
1370 SET TEXT COLOR 0
CALL GLOCATE( 16, 37)
CALL GPRINT( "ＰＬＡＹ")
SET TEXT COLOR 2
CALL GLOCATE( 14, 37)
CALL GPRINT( "ＥＤＩＴ")
SET TEXT COLOR 7
LET J = 1
RETURN
1380 CLEAR
LET XS = 7
LET YS = 0
LET XE = 33
LET YE = 7
LET QQ = 4
GOSUB 1720
1390 FOR I = 1 TO 7
1400 LET XA = 7 - I
LET YA = I - 1
LET A$ = LEFT$("2444444", I)
GOSUB 1770
1410 LET XA = 33
LET YA = I - 1
LET A$ = RIGHT$("4444443", I)
GOSUB 1770
NEXT I
1420 LET XS = 1
LET YS = 7
LET XE = 3
LET YE = 23
LET QQ = 1
GOSUB 1720
1430 LET XS = 25
LET YS = 7
LET XE = 27
LET YE = 23
LET QQ = 1
GOSUB 1720
1440 LET XS = 37
LET YS = 7
LET XE = 39
LET YE = 23
LET QQ = 1
GOSUB 1720
1450 LET XS = 0
LET YS = 23
LET XE = 40
LET YE = 25
LET QQ = 1
GOSUB 1720
1460 CALL GLOCATE( 9, 57)
CALL GPRINT( "ＬＥＶＥＬ")
1470 CALL GLOCATE( 11, 65)
CALL GPRINT( RIGHT$("0" & STR$(L + 1), 2))
1480 CALL GLOCATE( 15, 65)
CALL GPRINT( "ＬＥＦＴ")
1490 CALL BOXFULL(28 * 16, 16 * 16,36 * 16, 18 * 16, 0)
1500 IF MA = 1 THEN 1520
1510 FOR I = 1 TO MA - 1
LET XA = (36 - I * 2) * 16
LET YA = 16 * 16
LET QQ = 7
GOSUB 1620
NEXT I
1520 RETURN
1530 FOR YM = 8 TO 23
FOR XM = 7 TO 49
CALL GLOCATE( YM, XM)
CALL GPRINT( " ")
NEXT XM
NEXT YM
RETURN
1540 CALL BOXFULL (3 * 16, 7 * 16,24 * 16 + 15, 22 * 16 + 15, 0)
RETURN
1550 DATA"1111111 1 1111111 11111 111 1"
1560 DATA"1 1 1 1 1 1 1 1 1"
1570 DATA"1 1 1 1 1 1 1 1"
1580 DATA"1111111 1 1 1 1111 1111111 1"
1590 DATA"1 1 1 1 1 1 1 1"
1600 DATA"1 1 1 1 1 1 1 1"
1610 DATA"1 1 1 11111 1 1 111111"
1620 IF QQ+1=1 THEN GOSUB 1630
IF QQ+1=2 THEN GOSUB 1640
IF QQ+1=3 THEN GOSUB 1650
IF QQ+1=4 THEN GOSUB 1660
IF QQ+1=5 THEN GOSUB 1670
IF QQ+1=6 THEN GOSUB 1680
IF QQ+1=7 THEN GOSUB 1690
IF QQ+1=8 THEN GOSUB 1700
IF QQ+1=9 THEN GOSUB 1710
RETURN
1630 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: AA
RETURN
1640 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: BB
RETURN
1650 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: CC
RETURN
1660 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: DD
RETURN
1670 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: EE
RETURN
1680 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: FF
RETURN
1690 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: GG
RETURN
1700 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: HH
RETURN
1710 MAT PLOT CELLS, IN XA, YA;XA+31,YA+31: II
RETURN
1720 FOR YA = YS * 16 TO (YE - 1) * 16 STEP 16
FOR XA = XS * 16 TO (XE - 1) * 16 STEP 16
IF QQ=1 THEN GOSUB 1730
IF QQ=2 THEN GOSUB 1740
IF QQ=3 THEN GOSUB 1750
IF QQ=4 THEN GOSUB 1760
NEXT XA
NEXT YA
RETURN
1730 MAT PLOT CELLS, IN XA, YA;XA+15,YA+15: JJ
RETURN
1740 MAT PLOT CELLS, IN XA, YA;XA+15,YA+15: KK
RETURN
1750 MAT PLOT CELLS, IN XA, YA;XA+15,YA+15: LL
RETURN
1760 MAT PLOT CELLS, IN XA, YA;XA+15,YA+15: MM
RETURN
1770 LET XA = 16 * XA
LET YA = 16 * YA
FOR K = 1 TO LEN(A$)
IF MID$(A$, K, 1) = " " THEN 1790
1780 LET P= VAL(MID$(A$, K, 1))
IF P=1 THEN GOSUB 1730
IF P=2 THEN GOSUB 1740
IF P=3 THEN GOSUB 1750
IF P=4 THEN GOSUB 1760
1790 LET XA = XA + 16
NEXT K
RETURN
1800 RESTORE 1950
CLEAR
GOSUB 1810
FOR K = 1 TO 8
FOR J = 0 TO 15
READ A$
FOR I = 0 TO 15
CALL BOXFULL(I * 2, J * 2,I * 2 + 1, J * 2 + 1, VAL(MID$(A$, I + 1, 1)))
NEXT I
NEXT J
IF K=1 THEN GOSUB 1820
IF K=2 THEN GOSUB 1830
IF K=3 THEN GOSUB 1840
IF K=4 THEN GOSUB 1850
IF K=5 THEN GOSUB 1860
IF K=6 THEN GOSUB 1870
IF K=7 THEN GOSUB 1880
IF K=8 THEN GOSUB 1890
NEXT K
RETURN
1810 ASK PIXEL ARRAY (0, 0) AA
RETURN
1820 ASK PIXEL ARRAY (0, 0) BB
RETURN
1830 ASK PIXEL ARRAY (0, 0) CC
RETURN
1840 ASK PIXEL ARRAY (0, 0) DD
RETURN
1850 ASK PIXEL ARRAY (0, 0) EE
RETURN
1860 ASK PIXEL ARRAY (0, 0) FF
RETURN
1870 ASK PIXEL ARRAY (0, 0) GG
RETURN
1880 ASK PIXEL ARRAY (0, 0) HH
RETURN
1890 ASK PIXEL ARRAY (0, 0) II
RETURN
1900 ASK PIXEL ARRAY (0, 0) JJ
RETURN
1910 ASK PIXEL ARRAY (0, 0) KK
RETURN
1920 ASK PIXEL ARRAY (0, 0) LL
RETURN
1930 ASK PIXEL ARRAY (0, 0) MM
RETURN
1940 RESTORE 3310
CLEAR
FOR K = 1 TO 4
FOR J = 0 TO 7
READ A$
FOR I = 0 TO 7
CALL BOXFULL (I * 2, J * 2,I * 2 + 1, J * 2 + 1, VAL(MID$(A$, I + 1, 1)))
NEXT I
NEXT J
IF K=1 THEN GOSUB 1900
IF K=2 THEN GOSUB 1910
IF K=3 THEN GOSUB 1920
IF K=4 THEN GOSUB 1930
NEXT K
RETURN
1950 DATA 0750000000000750
1960 DATA 0750000000000750
1970 DATA 0750000000000750
1980 DATA 0757777777777750
1990 DATA 0755555555555750
2000 DATA 0750000000000750
2010 DATA 0750000000000750
2020 DATA 0750000000000750
2030 DATA 0750000000000750
2040 DATA 0750000000000750
2050 DATA 0750000000000750
2060 DATA 0757777777777750
2070 DATA 0755555555555750
2080 DATA 0750000000000750
2090 DATA 0750000000000750
2100 DATA 0750000000000750
2110 !'
2120 DATA 0000000000000000
2130 DATA 0000600600600000
2140 DATA 0006060606006000
2150 DATA 0600600000060060
2160 DATA 0060006606000600
2170 DATA 6000666666060006
2180 DATA 0006666660606000
2190 DATA 0066666666060600
2200 DATA 0666666660606060
2210 DATA 0666666666660600
2220 DATA 6666666666606060
2230 DATA 6666666666660606
2240 DATA 6666666666606060
2250 DATA 6666666666660606
2260 DATA 6666666666606060
2270 DATA 6666666666660606
2280 !'
2290 DATA 3232323232323232
2300 DATA 2323232323232323
2310 DATA 3232323232323232
2320 DATA 2323232323232323
2330 DATA 3232323232323232
2340 DATA 2323232323232323
2350 DATA 3232323232323232
2360 DATA 2323232323232323
2370 DATA 3232323232323232
2380 DATA 2323232323232323
2390 DATA 3232323232323232
2400 DATA 2323232323232323
2410 DATA 3232323232323232
2420 DATA 2323232323232323
2430 DATA 3232323232323232
2440 DATA 2323232323232323
2450 !'
2460 DATA 0000000000000000
2470 DATA 0002020202020000
2480 DATA 0020202626262000
2490 DATA 0200020262626200
2500 DATA 2000202020262620
2510 DATA 0202020202626200
2520 DATA 2020202020202620
2530 DATA 0202020202026200
2540 DATA 2020202020202620
2550 DATA 0202020202026200
2560 DATA 2000202020202020
2570 DATA 0200020202020200
2580 DATA 2000002020202020
2590 DATA 0200000202020200
2600 DATA 0020202020202000
2610 DATA 0002020202020000
2620 !'
2630 DATA 0000000000000000
2640 DATA 5450545454545454
2650 DATA 4540454545454545
2660 DATA 5450545454545454
2670 DATA 4540454545454545
2680 DATA 5450545454545454
2690 DATA 4540454545454545
2700 DATA 5450545454545454
2710 DATA 0000000000000000
2720 DATA 5454545454540454
2730 DATA 4545454545450545
2740 DATA 5454545454540454
2750 DATA 4545454545450545
2760 DATA 5454545454540454
2770 DATA 4545454545450545
2780 DATA 5454545454540454
2790 !'
2800 DATA 0000003333000000
2810 DATA 0000333333330000
2820 DATA 0003333333333000
2830 DATA 0003333333333000
2840 DATA 0033333333333300
2850 DATA 0033333333333300
2860 DATA 0033333333333300
2870 DATA 0033333333333300
2880 DATA 0033327777233300
2890 DATA 0033222222223300
2900 DATA 0033222222223300
2910 DATA 0003222222223000
2920 DATA 0002222222222000
2930 DATA 0002222222222000
2940 DATA 0000077007700000
2950 DATA 0000022002200000
2960 !'
2970 DATA 0000003333300000
2980 DATA 0000033333330000
2990 DATA 0000333333330000
3000 DATA 0000333333330000
3010 DATA 0000333333333000
3020 DATA 0700707077333700
3030 DATA 0770707077337700
3040 DATA 0077777777377300
3050 DATA 0007277773773000
3060 DATA 0000222222333000
3070 DATA 0000222222233000
3080 DATA 0000222222230000
3090 DATA 0002222222220000
3100 DATA 0002222222220000
3110 DATA 0000077077000000
3120 DATA 0000022022000000
3130 !'
3140 DATA 0000033333000000
3150 DATA 0000333333300000
3160 DATA 0003333333330000
3170 DATA 0003333333330000
3180 DATA 0033333333330000
3190 DATA 0073337707070070
3200 DATA 0077337707070770
3210 DATA 0037737777777700
3220 DATA 0003773777727000
3230 DATA 0003332222220000
3240 DATA 0003322222220000
3250 DATA 0000322222220000
3260 DATA 0000222222222000
3270 DATA 0000222222222000
3280 DATA 0000007707700000
3290 DATA 0000002202200000
3300 !'
3310 DATA 77777777
3320 DATA 22222722
3330 DATA 22222722
3340 DATA 22222722
3350 DATA 77777777
3360 DATA 22722222
3370 DATA 22722222
3380 DATA 22722222
3390 !'
3400 DATA 00000001
3410 DATA 00000011
3420 DATA 00000711
3430 DATA 00001711
3440 DATA 00077777
3450 DATA 00711111
3460 DATA 01711111
3470 DATA 11711111
3480 !'
3490 DATA 10000000
3500 DATA 11000000
3510 DATA 11100000
3520 DATA 11110000
3530 DATA 77777000
3540 DATA 11711100
3550 DATA 11711110
3560 DATA 11711111
3570 !'
3580 DATA 77777777
3590 DATA 11111711
3600 DATA 11111711
3610 DATA 11111711
3620 DATA 77777777
3630 DATA 11711111
3640 DATA 11711111
3650 DATA 11711111
END

EXTERNAL SUB GPRINT(X$)
PLOT TEXT ,AT XPOS*8-16,YPOS*16-16:X$
END SUB

EXTERNAL SUB GLOCATE(Y,X)
LET XPOS=X
LET YPOS=Y
END SUB

EXTERNAL FUNCTION INKEY$
LET A$=""
CHARACTER INPUT CLEAR,NOWAIT:A$
IF A$="" THEN
IF GETKEYSTATE(37)<0 THEN LET A$="4"
IF GETKEYSTATE(38)<0 THEN LET A$="8"
IF GETKEYSTATE(39)<0 THEN LET A$="6"
IF GETKEYSTATE(40)<0 THEN LET A$="2"
DO
LOOP WHILE GETKEYSTATE(37)<0 OR GETKEYSTATE(38)<0 OR GETKEYSTATE(39)<0 OR GETKEYSTATE(40)<0
END IF
LET INKEY$=A$
END FUNCTION

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

月齢カレンダーの修正(二度目) - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:42:52

!!月齢カレンダーの修正(二度目)!!

!' カレンダー
!'
!' 投稿者：しばっち
!' 投稿日：2014年 9月 2日(火)19時16分5秒　通報返信・引用
!'
!' ----------------------------------------------------------------------------------------------------
!' 加筆修正者：gnuutera2012
!' ※新元号が令和となり、あちこち加筆修正させていただきました。
!' (例)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' 加筆修正加筆修正加筆修正加筆修正加筆修正加筆修正
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ----------------------------------------------------------------------------------------------------
DECLARE EXTERNAL FUNCTION SHUKU28$
DECLARE EXTERNAL FUNCTION CALC_ETO60$
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
DECLARE EXTERNAL FUNCTION TYOKU12$
DECLARE EXTERNAL FUNCTION CALC_ETO61$
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
PUBLIC STRING SEKKI24$(0 TO 23, 0 TO 1),QROKUYOU$,QJUKKAN$,Z$
PUBLIC NUMERIC QYEAR,QURUU,QMONTH,QDAY,QMAGE,QMAGENOON,QILLUMI,QMPHASE,RM_SUN0
LET A4=297/210
!' LET B5=257/182
!' LET B4=364/257
LET XSIZE=800
LET YSIZE=INT(XSIZE*A4)
LET XS=XSIZE*75/800
LET YS=YSIZE*250/800
CALL GINIT(XSIZE,YSIZE)
LET HEIGHT=XSIZE*50/800
SET TEXT HEIGHT HEIGHT

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' センター数学(BASIC)による「ゲームプログラミングの宝箱」をダウンロードして、実例\ユーティリティー\時間・日付\カレンダー.BASを開く。
!' https://hp.vector.co.jp/authors/VA008683/QA_Primary.htmも参照。
FUNCTION IsLeapYear(y) ! うるう年の判定
LET IsLeapYear=0
IF (MOD(y,4)=0 AND MOD(y,100)<>0) OR MOD(y,400)=0 THEN LET IsLeapYear=1 ! うるう年
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

DIM DD(12),MON$(12)
MAT READ DD
DATA 31,28,31,30,31,30,31,31,30,31,30,31

MAT READ MON$
DATA "睦月","如月","弥生","卯月","皐月","水無月","文月","葉月","長月","神無月","霜月","師走"
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' LET YEAR = INT(VAL(DATE$)/10000)
!' LET MONTH = MOD(INT(VAL(DATE$)/100),100)
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
INPUT PROMPT "西暦=":YEAR$
IF YEAR$<>"" THEN LET YEAR=VAL(YEAR$)
INPUT PROMPT "月=":MONTH$
IF MONTH$<>"" THEN LET MONTH=VAL(MONTH$)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF IsLeapYear(YEAR)<>0 THEN LET DD(2)=29 !うるう年なら
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
LET TM = YMDT2JD(YEAR, MONTH, 1, 0, 0, 0)
LET R=MOD(TM+2,7)
SET LINE COLOR "BLACK"
LET XX=R*XSIZE/8

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF ((YEAR= 2019 AND MONTH>= 5) AND (YEAR= 2019 AND MONTH=<12)) OR (YEAR>=2020 AND MONTH>= 1) THEN LET M$=" 令和"&STR$(YEAR-2018)&"年" !' 令和元年は2019年5月1日から。
IF ((YEAR>=1989 AND MONTH>= 1) AND (YEAR=<2018 AND MONTH=<12)) OR ((YEAR= 2019 AND MONTH>= 1) AND (YEAR= 2019 AND MONTH=< 4)) THEN LET M$=" 平成"&STR$(YEAR-1988)&"年" !' IF YEAR=<2018 AND YEAR>=1989 THEN LET GENGOUNEN$=STR$(YEAR-1988)
IF ((YEAR>=1926 AND MONTH>= 1) AND (YEAR=<1988 AND MONTH=<12)) THEN LET M$=" 昭和"&STR$(YEAR-1925)&"年" !' IF YEAR=<1988 AND YEAR>=1926 THEN LET GENGOUNEN$=STR$(YEAR-1925)
IF ((YEAR= 1912 AND MONTH>= 8) AND (YEAR= 1912 AND MONTH=<12)) OR ((YEAR>=1913 AND MONTH>= 1) AND (YEAR=<1925 AND MONTH=<12)) THEN LET M$=" 大正"&STR$(YEAR-1911)&"年" !' IF YEAR=<1925 AND YEAR>=1912 THEN LET GENGOUNEN$=STR$(YEAR-1911)
IF ((YEAR= 1868 AND MONTH>= 9) AND (YEAR= 1868 AND MONTH=<12)) OR ((YEAR>=1869 AND MONTH>= 1) AND (YEAR=<1911 AND MONTH=<12)) OR ((YEAR= 1912 AND MONTH>= 1) AND (YEAR= 1912 AND MONTH=< 7)) THEN LET M$=" 明治"&STR$(YEAR-1867)&"年" !' IF YEAR=<1911 AND YEAR>=1868 THEN LET GENGOUNEN$=STR$(YEAR-1867)
!' IF YEAR<1989 AND YEAR>=1926 THEN LET M$=" 昭和"&STR$(YEAR-1925)&"年"
!' IF YEAR<1926 AND YEAR>=1912 THEN LET M$=" 大正"&STR$(YEAR-1911)&"年"
!' IF YEAR<1912 AND YEAR>=1868 THEN LET M$=" 明治"&STR$(YEAR-1867)&"年"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF ((YEAR= 2019 AND MONTH>= 5) AND (YEAR= 2019 AND MONTH=<12)) OR (YEAR>=2020 AND MONTH>= 1) THEN LET ERA$="令和"&RIGHT$(" "&STR$(YEAR-2018),2)&"年" ! 令和元年は2019年5月1日から。
IF ((YEAR>=1989 AND MONTH>= 1) AND (YEAR=<2018 AND MONTH=<12)) OR ((YEAR= 2019 AND MONTH>= 1) AND (YEAR= 2019 AND MONTH=< 4)) THEN LET ERA$="平成"&RIGHT$(" "&STR$(YEAR-1988),2)&"年"
IF ((YEAR>=1926 AND MONTH>= 1) AND (YEAR=<1988 AND MONTH=<12)) THEN LET ERA$="昭和"&RIGHT$(" "&STR$(YEAR-1925),2)&"年"
IF ((YEAR= 1912 AND MONTH>= 8) AND (YEAR= 1912 AND MONTH=<12)) OR ((YEAR>=1913 AND MONTH>= 1) AND (YEAR=<1925 AND MONTH=<12)) THEN LET ERA$="大正"&RIGHT$(" "&STR$(YEAR-1911),2)&"年"
IF ((YEAR= 1868 AND MONTH>= 9) AND (YEAR= 1868 AND MONTH=<12)) OR ((YEAR>=1869 AND MONTH>= 1) AND (YEAR=<1911 AND MONTH=<12)) OR ((YEAR= 1912 AND MONTH>= 1) AND (YEAR= 1912 AND MONTH=< 7)) THEN LET ERA$="明治"&RIGHT$(" "&STR$(YEAR-1867),2)&"年"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
CALL SYMBOL(XSIZE/2-HEIGHT*3,YSIZE/8,"BLACK",STR$(YEAR)&"年"&" "&STR$(MONTH)&"月")
SET TEXT HEIGHT HEIGHT/2
CALL SYMBOL(XSIZE/2+HEIGHT*4,YSIZE/9,"BLACK",M$)
CALL SYMBOL(XSIZE/2+HEIGHT*5,YSIZE/9+HEIGHT*2/3,"BLACK",CALC_ETO60$(YEAR))
CALL SYMBOL(XSIZE/2+HEIGHT*5,YSIZE/9+HEIGHT*4/3,"BLACK",MON$(MONTH))
SET TEXT HEIGHT HEIGHT
FOR I=0 TO 6
READ A$,COL$
DATA "日","RED","月","BLACK","火","BLACK","水","BLACK","木","BLACK","金","BLACK","土","BLUE"
CALL SYMBOL(XS+I*XSIZE/8,YSIZE/4,COL$,A$)
NEXT I
CALL CALC_SEKKI24(YEAR)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! メモ帳に用いる場合に使う。
PRINT USING ">######## >######## ":RIGHT$(" "&YEAR$,4)&"年",RIGHT$(" "&MONTH$,2)&"月"
PRINT USING ">######## >######## ":ERA$,MON$(MONTH)
PRINT USING ">######## ":CALC_ETO60$(YEAR)
PRINT USING " ######## #### ################ ########## ######## ######## ###### #### #### #### ######## ###### ######## ##########":"新暦","曜日","祝祭日","旧暦","零時月齢","正午月齢","輝面比","月相","六曜","干支","九星","十二直","二十八宿","二十四節気"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
FOR I=1 TO DD(MONTH)
LET FL=0
SET TEXT HEIGHT HEIGHT
LET COL$=DAYCOLOR$(YEAR,MONTH,I,R)
CALL SYMBOL(XS+XX,YS+YY,COL$,USING$("##",I))
CALL CALC_KYUREKI(YEAR,MONTH,I)
IF QURUU<>0 THEN LET N$="閏" ELSE LET N$=""
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF QMONTH=1 AND QDAY=1 THEN LET Z$="旧正月"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
LET TM = YMDT2JD(YEAR, MONTH, I, 0, 0, 0)
LET A$=CALC_JUKKAN$(TM)
LET B$=QSEI$(TM)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! メモ帳に用いる場合に使う。
LET C$=MEMO_JUKKAN$(TM)
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! メモ帳に用いる場合に使う。
IF MONTH=1 OR MONTH=2 THEN LET ye=YEAR-1
IF MONTH=1 THEN LET mo=13
IF MONTH=2 THEN LET mo=14
IF MONTH<>1 AND MONTH<>2 THEN LET ye=YEAR
IF MONTH<>1 AND MONTH<>2 THEN LET mo=MONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET NIJYUUHASSHUKU=MOD(INT(12.25*c)+INT(1.25*n)+INT(2.6*(mo+1))+16+I,28)
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
DIM SEKKIOF24$(31)
FOR K=0 TO 23
IF VAL(SEKKI24$(K, 0)(6:7))=MONTH AND VAL(SEKKI24$(K, 0)(9:10))=I THEN
IF Z$<>"" THEN
LET SEKKIOF24$(I)=SEKKI24$(K, 1)
LET FL=1
ELSE
LET SEKKIOF24$(I)=SEKKI24$(K, 1)
LET FL=2
END IF
EXIT FOR
END IF
NEXT K
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
LET JDSHOUKANN=YMDT2JD(YEAR, VAL(SEKKI24$(0, 0)(6:6))*10+VAL(SEKKI24$(0, 0)(7:7)), VAL(SEKKI24$(0, 0)(9:9))*10+VAL(SEKKI24$(0, 0)(10:10)), 0, 0, 0)
FOR JUSHI=1 TO 12 !' Jではなく、JUSHIとする。
LET JDSHOUKANNUSHIKOUHO=JDSHOUKANN+JUSHI !' Jではなく、JUSHIとする。
LET DATEOFSHOUKANNUSHIKOUHO$=JD2YMDT$(JDSHOUKANNUSHIKOUHO)
LET SHOUKANNUSHIKOUHOMONTH=VAL(DATEOFSHOUKANNUSHIKOUHO$(6:6))*10+VAL(DATEOFSHOUKANNUSHIKOUHO$(7:7))
LET SHOUKANNUSHIKOUHODAY=VAL(DATEOFSHOUKANNUSHIKOUHO$(9:9))*10+VAL(DATEOFSHOUKANNUSHIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,SHOUKANNUSHIKOUHOMONTH,SHOUKANNUSHIKOUHODAY, 0, 0, 0)
IF SHOUKANNUSHIKOUHOMONTH=1 OR SHOUKANNUSHIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF SHOUKANNUSHIKOUHOMONTH=1 THEN LET mo=13
IF SHOUKANNUSHIKOUHOMONTH=2 THEN LET mo=14
IF SHOUKANNUSHIKOUHOMONTH<>1 AND SHOUKANNUSHIKOUHOMONTH<>2 THEN LET ye=YEAR
IF SHOUKANNUSHIKOUHOMONTH<>1 AND SHOUKANNUSHIKOUHOMONTH<>2 THEN LET mo=SHOUKANNUSHIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+SHOUKANNUSHIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF SHOUKANNUSHIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="丑" THEN LET SHOUKANNUSHIMONTH=SHOUKANNUSHIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="丑" THEN LET SHOUKANNUSHIDAY=SHOUKANNUSHIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="丑" THEN EXIT FOR
NEXT JUSHI !' Jではなく、JUSHIとする。
LET JDRISSHUNN=YMDT2JD(YEAR, VAL(SEKKI24$(2, 0)(6:6))*10+VAL(SEKKI24$(2, 0)(7:7)), VAL(SEKKI24$(2, 0)(9:9))*10+VAL(SEKKI24$(2, 0)(10:10)), 0, 0, 0)
FOR JTORA=1 TO 12 !' Jではなく、JTORAとする。
LET JDRISSHUNNTORAKOUHO=JDRISSHUNN+JTORA !' Jではなく、JTORAとする。
LET DATEOFRISSHUNNTORAKOUHO$=JD2YMDT$(JDRISSHUNNTORAKOUHO)
LET RISSHUNNTORAKOUHOMONTH=VAL(DATEOFRISSHUNNTORAKOUHO$(6:6))*10+VAL(DATEOFRISSHUNNTORAKOUHO$(7:7))
LET RISSHUNNTORAKOUHODAY=VAL(DATEOFRISSHUNNTORAKOUHO$(9:9))*10+VAL(DATEOFRISSHUNNTORAKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RISSHUNNTORAKOUHOMONTH,RISSHUNNTORAKOUHODAY, 0, 0, 0)
IF RISSHUNNTORAKOUHOMONTH=1 OR RISSHUNNTORAKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RISSHUNNTORAKOUHOMONTH=1 THEN LET mo=13
IF RISSHUNNTORAKOUHOMONTH=2 THEN LET mo=14
IF RISSHUNNTORAKOUHOMONTH<>1 AND RISSHUNNTORAKOUHOMONTH<>2 THEN LET ye=YEAR
IF RISSHUNNTORAKOUHOMONTH<>1 AND RISSHUNNTORAKOUHOMONTH<>2 THEN LET mo=RISSHUNNTORAKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RISSHUNNTORAKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RISSHUNNTORAKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="寅" THEN LET RISSHUNNTORAMONTH=RISSHUNNTORAKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="寅" THEN LET RISSHUNNTORADAY=RISSHUNNTORAKOUHODAY
IF ETOMOJIWATASHI$(2:2)="寅" THEN EXIT FOR
NEXT JTORA !' Jではなく、JTORAとする。
LET JDKEICHITU=YMDT2JD(YEAR, VAL(SEKKI24$(4, 0)(6:6))*10+VAL(SEKKI24$(4, 0)(7:7)), VAL(SEKKI24$(4, 0)(9:9))*10+VAL(SEKKI24$(4, 0)(10:10)), 0, 0, 0)
FOR JUU=1 TO 12 !' Jではなく、JUUとする。
LET JDKEICHITUUUKOUHO=JDKEICHITU+JUU !' Jではなく、JUUとする。
LET DATEOFKEICHITUUUKOUHO$=JD2YMDT$(JDKEICHITUUUKOUHO)
LET KEICHITUUUKOUHOMONTH=VAL(DATEOFKEICHITUUUKOUHO$(6:6))*10+VAL(DATEOFKEICHITUUUKOUHO$(7:7))
LET KEICHITUUUKOUHODAY=VAL(DATEOFKEICHITUUUKOUHO$(9:9))*10+VAL(DATEOFKEICHITUUUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,KEICHITUUUKOUHOMONTH,KEICHITUUUKOUHODAY, 0, 0, 0)
IF KEICHITUUUKOUHOMONTH=1 OR KEICHITUUUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF KEICHITUUUKOUHOMONTH=1 THEN LET mo=13
IF KEICHITUUUKOUHOMONTH=2 THEN LET mo=14
IF KEICHITUUUKOUHOMONTH<>1 AND KEICHITUUUKOUHOMONTH<>2 THEN LET ye=YEAR
IF KEICHITUUUKOUHOMONTH<>1 AND KEICHITUUUKOUHOMONTH<>2 THEN LET mo=KEICHITUUUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+KEICHITUUUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF KEICHITUUUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="卯" THEN LET KEICHITUUUMONTH=KEICHITUUUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="卯" THEN LET KEICHITUUUDAY=KEICHITUUUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="卯" THEN EXIT FOR
NEXT JUU !' Jではなく、JUUとする。
LET JDSEIMEI=YMDT2JD(YEAR, VAL(SEKKI24$(6, 0)(6:6))*10+VAL(SEKKI24$(6, 0)(7:7)), VAL(SEKKI24$(6, 0)(9:9))*10+VAL(SEKKI24$(6, 0)(10:10)), 0, 0, 0)
FOR JTATSU=1 TO 12 !' Jではなく、JTATSUとする。
LET JDSEIMEITATSUKOUHO=JDSEIMEI+JTATSU !' Jではなく、JTATSUとする。
LET DATEOFSEIMEITATSUKOUHO$=JD2YMDT$(JDSEIMEITATSUKOUHO)
LET SEIMEITATSUKOUHOMONTH=VAL(DATEOFSEIMEITATSUKOUHO$(6:6))*10+VAL(DATEOFSEIMEITATSUKOUHO$(7:7))
LET SEIMEITATSUKOUHODAY=VAL(DATEOFSEIMEITATSUKOUHO$(9:9))*10+VAL(DATEOFSEIMEITATSUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,SEIMEITATSUKOUHOMONTH,SEIMEITATSUKOUHODAY, 0, 0, 0)
IF SEIMEITATSUKOUHOMONTH=1 OR SEIMEITATSUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF SEIMEITATSUKOUHOMONTH=1 THEN LET mo=13
IF SEIMEITATSUKOUHOMONTH=2 THEN LET mo=14
IF SEIMEITATSUKOUHOMONTH<>1 AND SEIMEITATSUKOUHOMONTH<>2 THEN LET ye=YEAR
IF SEIMEITATSUKOUHOMONTH<>1 AND SEIMEITATSUKOUHOMONTH<>2 THEN LET mo=SEIMEITATSUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+SEIMEITATSUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF SEIMEITATSUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="辰" THEN LET SEIMEITATSUMONTH=SEIMEITATSUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="辰" THEN LET SEIMEITATSUDAY=SEIMEITATSUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="辰" THEN EXIT FOR
NEXT JTATSU !' Jではなく、JTATSUとする。
LET JDRIKKA=YMDT2JD(YEAR, VAL(SEKKI24$(8, 0)(6:6))*10+VAL(SEKKI24$(8, 0)(7:7)), VAL(SEKKI24$(8, 0)(9:9))*10+VAL(SEKKI24$(8, 0)(10:10)), 0, 0, 0)
FOR JMI=1 TO 12 !' Jではなく、JMIとする。
LET JDRIKKAMIKOUHO=JDRIKKA+JMI !' Jではなく、JMIとする。
LET DATEOFRIKKAMIKOUHO$=JD2YMDT$(JDRIKKAMIKOUHO)
LET RIKKAMIKOUHOMONTH=VAL(DATEOFRIKKAMIKOUHO$(6:6))*10+VAL(DATEOFRIKKAMIKOUHO$(7:7))
LET RIKKAMIKOUHODAY=VAL(DATEOFRIKKAMIKOUHO$(9:9))*10+VAL(DATEOFRIKKAMIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RIKKAMIKOUHOMONTH,RIKKAMIKOUHODAY, 0, 0, 0)
IF RIKKAMIKOUHOMONTH=1 OR RIKKAMIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RIKKAMIKOUHOMONTH=1 THEN LET mo=13
IF RIKKAMIKOUHOMONTH=2 THEN LET mo=14
IF RIKKAMIKOUHOMONTH<>1 AND RIKKAMIKOUHOMONTH<>2 THEN LET ye=YEAR
IF RIKKAMIKOUHOMONTH<>1 AND RIKKAMIKOUHOMONTH<>2 THEN LET mo=RIKKAMIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RIKKAMIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RIKKAMIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="巳" THEN LET RIKKAMIMONTH=RIKKAMIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="巳" THEN LET RIKKAMIDAY=RIKKAMIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="巳" THEN EXIT FOR
NEXT JMI !' Jではなく、JMIとする。
LET JDBOUSHU=YMDT2JD(YEAR, VAL(SEKKI24$(10, 0)(6:6))*10+VAL(SEKKI24$(10, 0)(7:7)), VAL(SEKKI24$(10, 0)(9:9))*10+VAL(SEKKI24$(10, 0)(10:10)), 0, 0, 0)
FOR JUMA=1 TO 12 !' Jではなく、JUMAとする。
LET JDBOUSHUUMAKOUHO=JDBOUSHU+JUMA !' Jではなく、JUMAとする。
LET DATEOFBOUSHUUMAKOUHO$=JD2YMDT$(JDBOUSHUUMAKOUHO)
LET BOUSHUUMAKOUHOMONTH=VAL(DATEOFBOUSHUUMAKOUHO$(6:6))*10+VAL(DATEOFBOUSHUUMAKOUHO$(7:7))
LET BOUSHUUMAKOUHODAY=VAL(DATEOFBOUSHUUMAKOUHO$(9:9))*10+VAL(DATEOFBOUSHUUMAKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,BOUSHUUMAKOUHOMONTH,BOUSHUUMAKOUHODAY, 0, 0, 0)
IF BOUSHUUMAKOUHOMONTH=1 OR BOUSHUUMAKOUHOMONTH=2 THEN LET ye=YEAR-1
IF BOUSHUUMAKOUHOMONTH=1 THEN LET mo=13
IF BOUSHUUMAKOUHOMONTH=2 THEN LET mo=14
IF BOUSHUUMAKOUHOMONTH<>1 AND BOUSHUUMAKOUHOMONTH<>2 THEN LET ye=YEAR
IF BOUSHUUMAKOUHOMONTH<>1 AND BOUSHUUMAKOUHOMONTH<>2 THEN LET mo=BOUSHUUMAKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+BOUSHUUMAKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF BOUSHUUMAKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="午" THEN LET BOUSHUUMAMONTH=BOUSHUUMAKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="午" THEN LET BOUSHUUMADAY=BOUSHUUMAKOUHODAY
IF ETOMOJIWATASHI$(2:2)="午" THEN EXIT FOR
NEXT JUMA !' Jではなく、JUMAとする。
LET JDSHOUSHO=YMDT2JD(YEAR, VAL(SEKKI24$(12, 0)(6:6))*10+VAL(SEKKI24$(12, 0)(7:7)), VAL(SEKKI24$(12, 0)(9:9))*10+VAL(SEKKI24$(12, 0)(10:10)), 0, 0, 0)
FOR JHITUJI=1 TO 12 !' Jではなく、JHITUJIとする。
LET JDSHOUSHOHITUJIKOUHO=JDSHOUSHO+JHITUJI !' Jではなく、JHITUJIとする。
LET DATEOFSHOUSHOHITUJIKOUHO$=JD2YMDT$(JDSHOUSHOHITUJIKOUHO)
LET SHOUSHOHITUJIKOUHOMONTH=VAL(DATEOFSHOUSHOHITUJIKOUHO$(6:6))*10+VAL(DATEOFSHOUSHOHITUJIKOUHO$(7:7))
LET SHOUSHOHITUJIKOUHODAY=VAL(DATEOFSHOUSHOHITUJIKOUHO$(9:9))*10+VAL(DATEOFSHOUSHOHITUJIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,SHOUSHOHITUJIKOUHOMONTH,SHOUSHOHITUJIKOUHODAY, 0, 0, 0)
IF SHOUSHOHITUJIKOUHOMONTH=1 OR SHOUSHOHITUJIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF SHOUSHOHITUJIKOUHOMONTH=1 THEN LET mo=13
IF SHOUSHOHITUJIKOUHOMONTH=2 THEN LET mo=14
IF SHOUSHOHITUJIKOUHOMONTH<>1 AND SHOUSHOHITUJIKOUHOMONTH<>2 THEN LET ye=YEAR
IF SHOUSHOHITUJIKOUHOMONTH<>1 AND SHOUSHOHITUJIKOUHOMONTH<>2 THEN LET mo=SHOUSHOHITUJIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+SHOUSHOHITUJIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF SHOUSHOHITUJIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="未" THEN LET SHOUSHOHITUJIMONTH=SHOUSHOHITUJIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="未" THEN LET SHOUSHOHITUJIDAY=SHOUSHOHITUJIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="未" THEN EXIT FOR
NEXT JHITUJI !' Jではなく、JHITUJIとする。
LET JDRISSHUU=YMDT2JD(YEAR, VAL(SEKKI24$(14, 0)(6:6))*10+VAL(SEKKI24$(14, 0)(7:7)), VAL(SEKKI24$(14, 0)(9:9))*10+VAL(SEKKI24$(14, 0)(10:10)), 0, 0, 0)
FOR JSARU=1 TO 12 !' Jではなく、JSARUとする。
LET JDRISSHUUSARUKOUHO=JDRISSHUU+JSARU !' Jではなく、JSARUとする。
LET DATEOFRISSHUUSARUKOUHO$=JD2YMDT$(JDRISSHUUSARUKOUHO)
LET RISSHUUSARUKOUHOMONTH=VAL(DATEOFRISSHUUSARUKOUHO$(6:6))*10+VAL(DATEOFRISSHUUSARUKOUHO$(7:7))
LET RISSHUUSARUKOUHODAY=VAL(DATEOFRISSHUUSARUKOUHO$(9:9))*10+VAL(DATEOFRISSHUUSARUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RISSHUUSARUKOUHOMONTH,RISSHUUSARUKOUHODAY, 0, 0, 0)
IF RISSHUUSARUKOUHOMONTH=1 OR RISSHUUSARUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RISSHUUSARUKOUHOMONTH=1 THEN LET mo=13
IF RISSHUUSARUKOUHOMONTH=2 THEN LET mo=14
IF RISSHUUSARUKOUHOMONTH<>1 AND RISSHUUSARUKOUHOMONTH<>2 THEN LET ye=YEAR
IF RISSHUUSARUKOUHOMONTH<>1 AND RISSHUUSARUKOUHOMONTH<>2 THEN LET mo=RISSHUUSARUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RISSHUUSARUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RISSHUUSARUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="申" THEN LET RISSHUUSARUMONTH=RISSHUUSARUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="申" THEN LET RISSHUUSARUDAY=RISSHUUSARUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="申" THEN EXIT FOR
NEXT JSARU !' Jではなく、JSARUとする。
LET JDHAKURO=YMDT2JD(YEAR, VAL(SEKKI24$(16, 0)(6:6))*10+VAL(SEKKI24$(16, 0)(7:7)), VAL(SEKKI24$(16, 0)(9:9))*10+VAL(SEKKI24$(16, 0)(10:10)), 0, 0, 0)
FOR JTORI=1 TO 12 !' Jではなく、JTORIとする。
LET JDHAKUROTORIKOUHO=JDHAKURO+JTORI !' Jではなく、JTORIとする。
LET DATEOFHAKUROTORIKOUHO$=JD2YMDT$(JDHAKUROTORIKOUHO)
LET HAKUROTORIKOUHOMONTH=VAL(DATEOFHAKUROTORIKOUHO$(6:6))*10+VAL(DATEOFHAKUROTORIKOUHO$(7:7))
LET HAKUROTORIKOUHODAY=VAL(DATEOFHAKUROTORIKOUHO$(9:9))*10+VAL(DATEOFHAKUROTORIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,HAKUROTORIKOUHOMONTH,HAKUROTORIKOUHODAY, 0, 0, 0)
IF HAKUROTORIKOUHOMONTH=1 OR HAKUROTORIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF HAKUROTORIKOUHOMONTH=1 THEN LET mo=13
IF HAKUROTORIKOUHOMONTH=2 THEN LET mo=14
IF HAKUROTORIKOUHOMONTH<>1 AND HAKUROTORIKOUHOMONTH<>2 THEN LET ye=YEAR
IF HAKUROTORIKOUHOMONTH<>1 AND HAKUROTORIKOUHOMONTH<>2 THEN LET mo=HAKUROTORIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+HAKUROTORIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RISSHUUSARUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="酉" THEN LET HAKUROTORIMONTH=HAKUROTORIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="酉" THEN LET HAKUROTORIDAY=HAKUROTORIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="酉" THEN EXIT FOR
NEXT JTORI !' Jではなく、JTORIとする。
LET JDKANNRO=YMDT2JD(YEAR, VAL(SEKKI24$(18, 0)(6:6))*10+VAL(SEKKI24$(18, 0)(7:7)), VAL(SEKKI24$(18, 0)(9:9))*10+VAL(SEKKI24$(18, 0)(10:10)), 0, 0, 0)
FOR JINU=1 TO 12 !' Jではなく、JINUとする。
LET JDKANNROINUKOUHO=JDKANNRO+JINU !' Jではなく、JINUとする。転記ミス発見。LET JDKANNROINUKOUHO=JDHAKURO+JINUをLET JDKANNROINUKOUHO=JDKANNRO+JINUに直した。
LET DATEOFKANNROINUKOUHO$=JD2YMDT$(JDKANNROINUKOUHO)
LET KANNROINUKOUHOMONTH=VAL(DATEOFKANNROINUKOUHO$(6:6))*10+VAL(DATEOFKANNROINUKOUHO$(7:7))
LET KANNROINUKOUHODAY=VAL(DATEOFKANNROINUKOUHO$(9:9))*10+VAL(DATEOFKANNROINUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,KANNROINUKOUHOMONTH,KANNROINUKOUHODAY, 0, 0, 0)
IF KANNROINUKOUHOMONTH=1 OR KANNROINUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF KANNROINUKOUHOMONTH=1 THEN LET mo=13
IF KANNROINUKOUHOMONTH=2 THEN LET mo=14
IF KANNROINUKOUHOMONTH<>1 AND KANNROINUKOUHOMONTH<>2 THEN LET ye=YEAR
IF KANNROINUKOUHOMONTH<>1 AND KANNROINUKOUHOMONTH<>2 THEN LET mo=KANNROINUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+KANNROINUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF KANNROINUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="戌" THEN LET KANNROINUMONTH=KANNROINUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="戌" THEN LET KANNROINUDAY=KANNROINUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="戌" THEN EXIT FOR
NEXT JINU !' Jではなく、JINUとする。
LET JDRITTOU=YMDT2JD(YEAR, VAL(SEKKI24$(20, 0)(6:6))*10+VAL(SEKKI24$(20, 0)(7:7)), VAL(SEKKI24$(20, 0)(9:9))*10+VAL(SEKKI24$(20, 0)(10:10)), 0, 0, 0)
FOR JII=1 TO 12 !' Jではなく、JIIとする。
LET JDRITTOUIIKOUHO=JDRITTOU+JII !' Jではなく、JIIとする。
LET DATEOFRITTOUIIKOUHO$=JD2YMDT$(JDRITTOUIIKOUHO)
LET RITTOUIIKOUHOMONTH=VAL(DATEOFRITTOUIIKOUHO$(6:6))*10+VAL(DATEOFRITTOUIIKOUHO$(7:7))
LET RITTOUIIKOUHODAY=VAL(DATEOFRITTOUIIKOUHO$(9:9))*10+VAL(DATEOFRITTOUIIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RITTOUIIKOUHOMONTH,RITTOUIIKOUHODAY, 0, 0, 0)
IF RITTOUIIKOUHOMONTH=1 OR RITTOUIIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RITTOUIIKOUHOMONTH=1 THEN LET mo=13
IF RITTOUIIKOUHOMONTH=2 THEN LET mo=14
IF RITTOUIIKOUHOMONTH<>1 AND RITTOUIIKOUHOMONTH<>2 THEN LET ye=YEAR
IF RITTOUIIKOUHOMONTH<>1 AND RITTOUIIKOUHOMONTH<>2 THEN LET mo=RITTOUIIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RITTOUIIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RITTOUIIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="亥" THEN LET RITTOUIIMONTH=RITTOUIIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="亥" THEN LET RITTOUIIDAY=RITTOUIIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="亥" THEN EXIT FOR
NEXT JII !' Jではなく、JIIとする。
LET JDDAISETSU=YMDT2JD(YEAR, VAL(SEKKI24$(22, 0)(6:6))*10+VAL(SEKKI24$(22, 0)(7:7)), VAL(SEKKI24$(22, 0)(9:9))*10+VAL(SEKKI24$(22, 0)(10:10)), 0, 0, 0)
FOR JNE=1 TO 12 !' Jではなく、JNEとする。
LET JDDAISETSUNEKOUHO=JDDAISETSU+JNE !' Jではなく、JNEとする。
LET DATEOFDAISETSUNEKOUHO$=JD2YMDT$(JDDAISETSUNEKOUHO)
LET DAISETSUNEKOUHOMONTH=VAL(DATEOFDAISETSUNEKOUHO$(6:6))*10+VAL(DATEOFDAISETSUNEKOUHO$(7:7))
LET DAISETSUNEKOUHODAY=VAL(DATEOFDAISETSUNEKOUHO$(9:9))*10+VAL(DATEOFDAISETSUNEKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,DAISETSUNEKOUHOMONTH,DAISETSUNEKOUHODAY, 0, 0, 0)
IF DAISETSUNEKOUHOMONTH=1 OR DAISETSUNEKOUHOMONTH=2 THEN LET ye=YEAR-1
IF DAISETSUNEKOUHOMONTH=1 THEN LET mo=13
IF DAISETSUNEKOUHOMONTH=2 THEN LET mo=14
IF DAISETSUNEKOUHOMONTH<>1 AND DAISETSUNEKOUHOMONTH<>2 THEN LET ye=YEAR
IF DAISETSUNEKOUHOMONTH<>1 AND DAISETSUNEKOUHOMONTH<>2 THEN LET mo=DAISETSUNEKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+DAISETSUNEKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF DAISETSUNEKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="子" THEN LET DAISETSUNEMONTH=DAISETSUNEKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="子" THEN LET DAISETSUNEDAY=DAISETSUNEKOUHODAY
IF ETOMOJIWATASHI$(2:2)="子" THEN EXIT FOR
NEXT JNE !' Jではなく、JNEとする。
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
DIM TYOKUOF12$(42)
IF MONTH=SHOUKANNUSHIMONTH AND I <SHOUKANNUSHIDAY-JUSHI AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY+1,12))
IF MONTH=SHOUKANNUSHIMONTH AND I=>SHOUKANNUSHIDAY-JUSHI AND I=<DD(SHOUKANNUSHIMONTH) THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY,12))
IF MONTH=RISSHUNNTORAMONTH AND I <RISSHUNNTORADAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY +DD(SHOUKANNUSHIMONTH),12))
IF MONTH=RISSHUNNTORAMONTH AND I=>RISSHUNNTORADAY-JTORA AND I<RISSHUNNTORADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY +DD(SHOUKANNUSHIMONTH)-1,12))
IF MONTH=RISSHUNNTORAMONTH AND I=>RISSHUNNTORADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUNNTORADAY,12))
IF MONTH=KEICHITUUUMONTH AND I <KEICHITUUUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUNNTORADAY +DD(RISSHUNNTORAMONTH),12))
IF MONTH=KEICHITUUUMONTH AND I=>KEICHITUUUDAY-JUU AND I<KEICHITUUUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUNNTORADAY +DD(RISSHUNNTORAMONTH)-1,12))
IF MONTH=KEICHITUUUMONTH AND I=>KEICHITUUUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KEICHITUUUDAY,12))
IF MONTH=SEIMEITATSUMONTH AND I <SEIMEITATSUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KEICHITUUUDAY +DD(KEICHITUUUMONTH),12))
IF MONTH=SEIMEITATSUMONTH AND I=>SEIMEITATSUDAY-JTATSU AND I<SEIMEITATSUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KEICHITUUUDAY +DD(KEICHITUUUMONTH)-1,12))
IF MONTH=SEIMEITATSUMONTH AND I=>SEIMEITATSUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SEIMEITATSUDAY,12))
IF MONTH=RIKKAMIMONTH AND I <RIKKAMIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SEIMEITATSUDAY +DD(SEIMEITATSUMONTH),12))
IF MONTH=RIKKAMIMONTH AND I=>RIKKAMIDAY-JMI AND I<RIKKAMIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SEIMEITATSUDAY +DD(SEIMEITATSUMONTH)-1,12))
IF MONTH=RIKKAMIMONTH AND I=>RIKKAMIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RIKKAMIDAY,12))
IF MONTH=BOUSHUUMAMONTH AND I <BOUSHUUMADAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RIKKAMIDAY +DD(RIKKAMIMONTH),12))
IF MONTH=BOUSHUUMAMONTH AND I=>BOUSHUUMADAY-JUMA AND I<BOUSHUUMADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RIKKAMIDAY +DD(RIKKAMIMONTH)-1,12))
IF MONTH=BOUSHUUMAMONTH AND I=>BOUSHUUMADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-BOUSHUUMADAY,12))
IF MONTH=SHOUSHOHITUJIMONTH AND I <SHOUSHOHITUJIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-BOUSHUUMADAY +DD(BOUSHUUMAMONTH),12))
IF MONTH=SHOUSHOHITUJIMONTH AND I=>SHOUSHOHITUJIDAY-JHITUJI AND I<SHOUSHOHITUJIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-BOUSHUUMADAY +DD(BOUSHUUMAMONTH)-1,12))
IF MONTH=SHOUSHOHITUJIMONTH AND I=>SHOUSHOHITUJIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUSHOHITUJIDAY,12))
IF MONTH=RISSHUUSARUMONTH AND I <RISSHUUSARUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUSHOHITUJIDAY +DD(SHOUSHOHITUJIMONTH),12))
IF MONTH=RISSHUUSARUMONTH AND I=>RISSHUUSARUDAY-JSARU AND I<RISSHUUSARUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUSHOHITUJIDAY +DD(SHOUSHOHITUJIMONTH)-1,12)) !' RISSHUUSARUDAY-JSARU =< I < RISSHUUSARUDAY を満たす日だけはRISSHUUSARUDAY-JSARUの日はRISSHUUSARUDAY-JSARU-1の十二直を一日だけ繰り返したあとで、さらに規則を続ける。
IF MONTH=RISSHUUSARUMONTH AND I=>RISSHUUSARUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUUSARUDAY,12))
IF MONTH=HAKUROTORIMONTH AND I <HAKUROTORIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUUSARUDAY +DD(RISSHUUSARUMONTH),12))
IF MONTH=HAKUROTORIMONTH AND I=>HAKUROTORIDAY-JTORI AND I<HAKUROTORIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUUSARUDAY +DD(RISSHUUSARUMONTH)-1,12))
IF MONTH=HAKUROTORIMONTH AND I=>HAKUROTORIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-HAKUROTORIDAY,12))
IF MONTH=KANNROINUMONTH AND I <KANNROINUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-HAKUROTORIDAY +DD(HAKUROTORIMONTH),12))
IF MONTH=KANNROINUMONTH AND I=>KANNROINUDAY-JINU AND I<KANNROINUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-HAKUROTORIDAY +DD(HAKUROTORIMONTH)-1,12))
IF MONTH=KANNROINUMONTH AND I=>KANNROINUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KANNROINUDAY,12))
IF MONTH=RITTOUIIMONTH AND I <RITTOUIIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KANNROINUDAY +DD(KANNROINUMONTH),12))
IF MONTH=RITTOUIIMONTH AND I=>RITTOUIIDAY-JII AND I<RITTOUIIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KANNROINUDAY +DD(KANNROINUMONTH)-1,12))
IF MONTH=RITTOUIIMONTH AND I=>RITTOUIIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RITTOUIIDAY,12))
IF MONTH=DAISETSUNEMONTH AND I <DAISETSUNEDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RITTOUIIDAY +DD(RITTOUIIMONTH),12))
IF MONTH=DAISETSUNEMONTH AND I=>DAISETSUNEDAY-JNE AND I<DAISETSUNEDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RITTOUIIDAY +DD(RITTOUIIMONTH)-1,12))
IF MONTH=DAISETSUNEMONTH AND I=>DAISETSUNEDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-DAISETSUNEDAY,12))
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
SET TEXT HEIGHT HEIGHT*.2
CALL MOON(XS+XX+HEIGHT*.6,YS+YY+HEIGHT*.5,HEIGHT*.5,QMAGENOON-.5,QILLUMI/100)
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.25,COL$,QROKUYOU$&" "&N$&STR$(QMONTH)&"/"&STR$(QDAY))
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.5,COL$,A$)
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.75,COL$,B$)
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.0,COL$,TYOKUOF12$(I))
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.25,COL$,SHUKU28$(NIJYUUHASSHUKU))
IF Z$<>"" THEN CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.5,"GREEN",Z$)
FOR K=0 TO 23
IF VAL(SEKKI24$(K, 0)(6:7))=MONTH AND VAL(SEKKI24$(K, 0)(9:10))=I THEN
IF Z$<>"" THEN
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.75,"MAGENTA",SEKKI24$(K, 1))
LET FL=1
ELSE
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.5,"MAGENTA",SEKKI24$(K, 1))
LET FL=2
END IF
EXIT FOR
END IF
NEXT K
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
FOR K=0 TO 23
IF VAL(SEKKI24$(K, 0)(6:7))=MONTH THEN
IF VAL(SEKKI24$(K, 0)(9:10))= I THEN
IF MOD(I+R-1,7)=0 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","日",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=1 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","月",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=2 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","火",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=3 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","水",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=4 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","木",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=5 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","金",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=6 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","土",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
ELSE
IF MOD(I+R-1,7)=0 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","日",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=1 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","月",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=2 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","火",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=3 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","水",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=4 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","木",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=5 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","金",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=6 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","土",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
END IF
EXIT FOR
END IF
NEXT K
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF QMPHASE=14 THEN
LET S$="満月"
ELSEIF QMPHASE=0 THEN
LET S$="新月"
ELSE
!'LET S$=USING$("##.#",QILLUMI)&"%"
LET S$=""
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF S$<>"" THEN
IF Z$="" AND FL<>2 THEN
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.6,"BLUE",S$)
ELSEIF FL<>1 THEN
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.8,"BLUE",S$)
ELSE
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*2.0,"BLUE",S$)
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
LET XX=XX+XSIZE/8
IF MOD(R+I,7)=0 THEN
LET XX=0
LET YY=YY+YSIZE/8
END IF
NEXT I
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
CLEAR
END SUB

EXTERNAL SUB SYMBOL(X,Y,COL$,A$)
SET TEXT COLOR COL$
PLOT TEXT,AT X,Y:A$
END SUB

EXTERNAL FUNCTION DAYCOLOR$(Y,M,N,R)
LET DAYCOLOR$="BLACK"
LET Z$=""
IF MOD(N+R,7)=1 THEN LET DAYCOLOR$="RED"
IF MOD(N+R,7)=0 THEN LET DAYCOLOR$="BLUE"
IF M=1 AND N=1 THEN
LET DAYCOLOR$="RED"
LET Z$="元日"
END IF
IF Y>=1973 AND M=1 AND N=2 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y>=2000 THEN
IF M=1 AND ((R<=1 AND R+N=9) OR (R>1 AND R+N=16)) THEN
LET DAYCOLOR$="RED"
LET Z$="成人の日"
END IF
ELSE
IF M=1 AND N=15 THEN
LET DAYCOLOR$="RED"
LET Z$="成人の日"
END IF
IF Y>=1973 AND M=1 AND N=16 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF M=2 AND N=11 THEN
LET DAYCOLOR$="RED"
LET Z$="建国記念の日"
END IF
IF Y>=1973 AND M=2 AND N=12 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2020 THEN
IF M=2 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="天皇誕生日"
END IF
IF M=2 AND N=24 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF Y>=1900 AND Y<1980 THEN
IF M=3 AND N=INT(20.8357+0.242194*(Y-1980)-INT((Y-1983)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="春分の日"
END IF
IF Y>=1973 AND M=3 AND N=INT(20.8357+0.242194*(Y-1980)-INT((Y-1983)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF M=9 AND N=INT(23.2588+0.242194*(Y-1980)-INT((Y-1983)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="秋分の日"
END IF
IF Y>=1973 AND M=9 AND N=INT(23.2588+0.242194*(Y-1980)-INT((Y-1983)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
ELSEIF Y>=1980 AND Y<2100 THEN
IF M=3 AND N=INT(20.8431 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4) THEN
LET DAYCOLOR$="RED"
LET Z$="春分の日"
END IF
IF M=3 AND N=INT(20.8431 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4)+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF M=9 AND N=INT(23.2488 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4) THEN
LET DAYCOLOR$="RED"
LET Z$="秋分の日"
END IF
IF M=9 AND N=INT(23.2488 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4)+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
ELSEIF Y>=2100 AND Y<2150 THEN
IF M=3 AND N=INT(21.8510+0.242194*(Y-1980)-INT((Y-1980)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="春分の日"
END IF
IF M=3 AND N=INT(21.8510+0.242194*(Y-1980)-INT((Y-1980)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF M=9 AND N=INT(24.2488+0.242194*(Y-1980)-INT((Y-1980)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="秋分の日"
END IF
IF M=9 AND N=INT(24.2488+0.242194*(Y-1980)-INT((Y-1980)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF M=4 AND N=29 THEN
LET DAYCOLOR$="RED"
IF Y>=2007 THEN
LET Z$="昭和の日"
ELSEIF Y>=1989 AND Y<2007 THEN
LET Z$="みどりの日"
ELSEIF Y>1948 THEN
LET Z$="天皇誕生日"
END IF
END IF
IF Y>=1973 AND M=4 AND N=30 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2019 AND M=4 AND N=30 AND MOD(N+R-1,7)<>1 THEN ! 令和元年昭和の日は2019年4月29日、即位の日は2019年5月1日。
LET DAYCOLOR$="RED" ! 間の2019年4月30日は振替休日でなくても公休日。
LET Z$="公休日"
END IF
IF Y=2019 AND M=5 AND N=1 THEN ! 令和元年即位の日は2019年5月1日。
LET DAYCOLOR$="RED"
LET Z$="即位の日"
END IF
IF Y=2019 AND M=5 AND N=2 AND MOD(N+R-1,7)=1 THEN ! 2019年5月2日が月曜なら振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2019 AND M=5 AND N=2 AND MOD(N+R-1,7)<>1 THEN ! 令和元年即位の日は2019年5月1日、憲法記念日は西暦何年であっても5月3日。
LET DAYCOLOR$="RED" ! 間の2019年5月2日は振替休日でなくても公休日。
LET Z$="公休日"
END IF
IF M=5 AND N=3 THEN
LET DAYCOLOR$="RED"
LET Z$="憲法記念日"
END IF
IF Y>=2007 THEN
IF M=5 AND N=4 THEN
LET DAYCOLOR$="RED"
LET Z$="みどりの日"
END IF
ELSEIF Y>=1988 AND Y<2007 THEN
IF M=5 AND N=4 THEN
LET DAYCOLOR$="RED"
LET Z$="国民の休日"
END IF
END IF
IF M=5 AND N=5 THEN
LET DAYCOLOR$="RED"
LET Z$="こどもの日"
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! IF Y>=1973 AND M=5 AND N=6 AND MOD(N+R-1,7)=1 THEN
! LET DAYCOLOR$="RED"
! LET Z$="振替休日"
! END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=1948 AND M=5 AND N=6 AND MOD(N+R-1,7)=1 THEN ! 5月6日が月曜なら5月6日を振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!(!!)以下同様に、(!!)
IF Y>=1948 AND M=5 AND N=6 AND MOD(N+R-1,7)=2 THEN ! 5月6日が火曜なら5月6日を振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!(!!)以下同様に、(!!)
IF Y>=1948 AND M=5 AND N=6 AND MOD(N+R-1,7)=3 THEN ! 5月6日が水曜なら5月6日を振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2003 THEN
IF Y=2021 AND M=7 AND N=22 THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
IF Y=2020 AND M=7 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
IF Y<>2020 AND Y<>2021 AND M=7 AND ((R<=1 AND R+N=16) OR (R>1 AND R+N=23)) THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
ELSEIF Y>=1996 AND Y<2003 THEN
IF M=7 AND N=20 THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
IF M=7 AND N=21 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2016 THEN
IF Y<>2020 AND Y<>2021 AND M=8 AND N=11 THEN
LET DAYCOLOR$="RED"
LET Z$="山の日"
END IF
IF Y<>2020 AND Y<>2021 AND M=8 AND N=12 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2021 AND M=8 AND N=8 THEN
LET DAYCOLOR$="RED"
LET Z$="山の日"
END IF
IF Y=2021 AND M=8 AND N=9 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2020 AND M=8 AND N=10 THEN
LET DAYCOLOR$="RED"
LET Z$="山の日"
END IF
IF Y=2020 AND M=8 AND N=11 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF Y>=2003 THEN
IF M=9 AND ((R<=1 AND R+N=16) OR (R>1 AND R+N=23)) THEN
LET DAYCOLOR$="RED"
LET Z$="敬老の日"
END IF
ELSEIF Y>=1966 AND Y<2003 THEN
IF M=9 AND N=15 THEN
LET DAYCOLOR$="RED"
LET Z$="敬老の日"
END IF
IF Y>=1973 AND M=9 AND N=16 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y=2019 AND M=10 AND N=22 THEN ! 令和元年即位礼正殿の儀は2019年10月22日に執り行われる。
LET DAYCOLOR$="RED"
LET Z$="即位礼正殿の儀"
END IF
IF Y=2019 AND M=10 AND N=23 AND MOD(N+R-1,7)=1 THEN ! 2019年10月23日が月曜なら振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2022 THEN
IF M=10 AND ((R<=1 AND R+N=9) OR (R>1 AND R+N=16)) THEN
LET DAYCOLOR$="RED"
LET Z$="体育の日"
END IF
END IF
IF Y=2021 THEN
IF M=7 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="スポーツの日"
END IF
IF M=7 AND N=24 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF Y=2020 THEN
IF M=7 AND N=24 THEN
LET DAYCOLOR$="RED"
LET Z$="スポーツの日"
END IF
IF M=7 AND N=25 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF Y>=2000 AND Y<2020 THEN
IF M=10 AND ((R<=1 AND R+N=9) OR (R>1 AND R+N=16)) THEN
LET DAYCOLOR$="RED"
LET Z$="体育の日"
END IF
ELSEIF Y>=1966 AND Y<2000 THEN
IF M=10 AND N=10 THEN
LET DAYCOLOR$="RED"
LET Z$="体育の日"
END IF
IF Y>=1973 AND M=10 AND N=11 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF M=11 AND N=3 THEN
LET DAYCOLOR$="RED"
LET Z$="文化の日"
END IF
IF M=11 AND N=23 THEN
LET DAYCOLOR$="RED"
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
LET Z$="勤労感謝の日"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
END IF
IF Y>=1973 AND M=11 AND (N=4 OR N=24) AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y=2019 THEN
IF M=12 AND N=23 THEN
LET DAYCOLOR$="BLACK" ! 祝日にならない模様。∴LET DAYCOLOR$="BLACK"
LET Z$="平成の天皇誕生日"
END IF
END IF
IF Y>=1989 AND Y<=2018 THEN
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF M=12 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="天皇誕生日"
END IF
IF M=12 AND N=24 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
LET D$=DATE$
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! IF Y=VAL(D$(1:4)) AND M=VAL(D$(5:6)) AND N=VAL(D$(7:8)) THEN LET DAYCOLOR$="CYAN" ! ← 当日の日付の色がシアンになる。
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
END FUNCTION

EXTERNAL FUNCTION QSEI$(TM)
DIM A$(9)
MAT READ A$
LET QSEI$=A$(MOD(TM-1,9)+1)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' DATA 九紫火星
!' DATA 八白土星
!' DATA 七赤金星
!' DATA 六白金星
!' DATA 五黄土星
!' DATA 四緑木星
!' DATA 三碧木星
!' DATA 二黒土星
!' DATA 一白水星
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

Re: 月齢カレンダーの修正(二度目) - gnuutera2012or文句うさびょん URL

2025/06/19 (Thu) 15:21:46

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
EXTERNAL FUNCTION CALC_ETO60$(ALLYEAR)
DIM A$(10),B$(12)
MAT READ A$,B$
LET CALC_ETO60$=A$(MOD(ALLYEAR+6,10)+1)&B$(MOD(ALLYEAR+8,12)+1)
DATA "甲", "乙", "丙", "丁", "戊"
DATA "己", "庚", "辛", "壬", "癸"
DATA "子", "丑", "寅", "卯", "辰", "巳"
DATA "午", "未", "申", "酉", "戌", "亥"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
EXTERNAL FUNCTION CALC_ETO61$(JOUYOKEI)
DIM A$(60)
MAT READ A$
LET CALC_ETO61$=A$(JOUYOKEI+1)
DATA "甲子","乙丑","丙寅","丁卯","戊辰","己巳","庚午","辛未","壬申","癸酉","甲戌","乙亥","丙子","丁丑","戊寅","己卯","庚辰","辛巳","壬午","癸未"
DATA "甲申","乙酉","丙戌","丁亥","戊子","己丑","庚寅","辛卯","壬辰","癸巳","甲午","乙未","丙申","丁酉","戊戌","己亥","庚子","辛丑","壬寅","癸卯"
DATA "甲辰","乙巳","丙午","丁未","戊申","己酉","庚戌","辛亥","壬子","癸丑","甲寅","乙卯","丙辰","丁巳","戊午","己未","庚申","辛酉","壬戌","癸亥"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' (1)黄道に沿って、天球を28に区分し、星宿(星座の意)の所在を明瞭にしたもの。太陰(月(つき))はおよそ1日に1宿ず
!' つ運行する。中国では蒼竜(東)・玄武(北)・白虎(西)・朱雀(南)の4宮に分け、さらに各宮を七分した。
!' 東は角(すぼし)・亢(あみぼし)・氏(とも)・房(そい)・心(なかご)・尾(あしたれ)・箕(み)
!' 北は斗(ひきつ)・牛(いなみ)・女(うるき)・虚(とみて)・危(うみやめ)・室(はつい)・壁(なまめ)
!' 西は奎(とかき)・婁(たたら)・胃(えきえ)・昴(すばる)・畢(あめふり)・觜(とろき)・參(からすき)
!' 南は井(ちちり)・鬼(たまほめ)・柳(ぬりこ)・星(ほとほり)・張(ちりこ)・翼(たすき)・軫(みつかけ)
!' (2)(1)のうち、牛宿を除いた二十七宿を月日にあてて吉凶を占う法。宿曜道の系統の選日。【広辞苑】
!' (注)氏(とも)と記載したものは、正しくは、五胡十六国時代の「てい」に該当し、低から人偏をとりさったものと同じである。以下同じ。
!' 二十八宿
EXTERNAL FUNCTION SHUKU28$(JOUYOKEI)
DIM A$(28)
MAT READ A$
LET SHUKU28$=A$(JOUYOKEI+1)
DATA "角","亢","氏","房","心","尾","箕","斗","牛","女","虚","危","室","壁"
DATA "奎","婁","胃","昴","畢","觜","參","井","鬼","柳","星","張","翼","軫"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' 中国秦時代からある暦注で、出土した最古の元光元年暦に書かれている。建(たつ),除(のぞく),満(みつ),平(たいら)
!' ,定(さだん),執(とる),破(やぶる),危(あやぶ),成(なる),納(おさん),開(ひらく),閉(とづ)の12あり、納は古い具注暦
!' では収と書かれている。読みは「仮名暦」の記載である。選日法は立春後の最初の寅、啓蟄後の最初の卯、清明後の最
!' 初の辰、立夏後の最初の巳、芒種後の最初の午、小暑後の最初の未、立秋後の最初の申、白露後の最初の酉、寒露後の
!' 最初の戌、立冬後の最初の亥、大雪後の最初の子、小寒後の最初の丑の日を建として順番に配当する。【日本歴史大辞典】
!' 十二直
EXTERNAL FUNCTION TYOKU12$(JOUYOKEI)
DIM A$(12)
MAT READ A$
LET TYOKU12$=A$(JOUYOKEI+1)
DATA "建","除","満","平","定","執","破","危","成","納","開","閉"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

EXTERNAL SUB MOON(X,Y,R,H,N)
DIM XX(73),YY(73)
SET COLOR "GRAY"
DRAW DISK WITH SCALE(R)*SHIFT(X,Y)
SET AREA COLOR "YELLOW"
IF H>15 THEN LET SW=-1 ELSE LET SW=1
LET RR=2*(N-.5)
IF RR>0 THEN
FOR T=0 TO 360 STEP 5
LET B=R
IF T>=90 AND T<=270 THEN LET B=R*RR
LET I=I+1
LET YY(I)=R*SIN(RAD(T))+Y
LET XX(I)=SW*B*COS(RAD(T))+X
NEXT T
ELSE
FOR T=-90 TO 90 STEP 5
LET I=I+1
LET YY(I)=R*SIN(RAD(T))+Y
LET XX(I)=SW*R*COS(RAD(T))+X
NEXT T
LET B=R*ABS(RR)
FOR T=85 TO -90 STEP -5
LET I=I+1
LET YY(I)=R*SIN(RAD(T))+Y
LET XX(I)=SW*B*COS(RAD(T))+X
NEXT T
END IF
IF RR>-1 THEN MAT PLOT AREA :XX,YY
END SUB

!'これより以下は、「旧暦 for VB」から「旧暦.bas」を(仮称)十進BASICに移植したものです。
!' http://www.vector.co.jp/soft/win95/personal/se243537.html?_ga=1.114790919.1276112294.1407498580

!' 旧暦計算　標準モジュール「旧暦.bas」Version 1.0
!' Arranged for Visual Basic 6.0 or 5.0 & Excel97 VBA & Access97 VBA
!' 　　　　　　　　　　　　　by Masayuki Kanari (C)2002
!'
!' 原典「旧暦計算サンプルプログラム」
!' Copyright (C) 1993,1994 by H.Takano
!' http://www.vector.co.jp/soft/dos/personal/se016093.html
!'
!' 原典旧暦計算 JavaScript(ECMAScript) Library "qreki.js" Version 1.5
!' Arranged for ECMAScript(ECMA-262) by Nagano Yutaka (C)1999-2001
!' http://www.ai.wakwak.com/~y-nagano/Programs/koyomi/
!'
!' この標準モジュールの計算結果は無保証です。
!' この標準モジュールはフリーソフトであり、自由に再利用・改良を行ってかまいませんが、
!' 著作権は原典のjgAWK版を開発された高野英明氏、およびJavaScript版を開発された長野隆氏に
!' 帰属しています。上記のリンクより高野氏の「QRSAMP」、長野氏の「qreki.js」を取得し、
!' そのドキュメント内に書かれている再配布規定に従ってください。
!'
!' 使用法
!' １．旧暦は下記コードをFormモジュールで実行すると、Kyurekiに旧暦が入っています。
!' Kyureki.QYear に旧暦年 Kyureki.QMonth に旧暦月下記コードの Type Q_Rekiを参照
!' Calc_Kyureki "2002","5","26"　　　"2002"などは当然ですが、変数でも可
!'
!' ２．二十四節季は下記コードをFormモジュールで実行すると、Sekki24に二十四節季が入っています。
!' Sekki24(i,0) に節季の日時　Sekki24(i,1) に節季の名称が入ります。
!' Calc_Sekki24 "2002"　　　　　　　"2002"は当然ですが、変数でも可
!'Type Q_Reki ' ユーザー定義型を作成
!' QYear As Integer ' 旧暦年
!' QUruu As Boolean ' 平月:False 閏月:True
!' QMonth As Integer ' 旧暦月
!' QDay As Integer ' 旧暦日
!' QRokuyou As String ' 六曜名
!' QJukkan As String ' 十干十二支
!' QMage ' リアルタイム月齢
!' QMagenoon ' 正午月齢
!' QIllumi ' 輝面比％
!' QMphase As Integer ' 月相 0～27
!'End Type
!' 十干十二支
EXTERNAL FUNCTION CALC_JUKKAN$(TM)
DIM A$(10),B$(12)
MAT READ A$,B$
LET N$ = A$(MOD(INT(TM / 2), 5) * 2 + MOD(TM ,2) + 1)
DATA "甲", "乙", "丙", "丁", "戊"
DATA "己", "庚", "辛", "壬", "癸"
LET CALC_JUKKAN$ = N$ & " " & B$(MOD(TM - 10,12) + 1)
DATA "子", "丑", "寅", "卯", "辰", "巳"
DATA "午", "未", "申", "酉", "戌", "亥"
END FUNCTION

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
EXTERNAL FUNCTION MEMO_JUKKAN$(TM)
DIM A$(10),B$(12)
MAT READ A$,B$
LET N$ = A$(MOD(INT(TM / 2), 5) * 2 + MOD(TM ,2) + 1)
DATA "甲", "乙", "丙", "丁", "戊"
DATA "己", "庚", "辛", "壬", "癸"
LET MEMO_JUKKAN$ = N$ & "" & B$(MOD(TM - 10,12) + 1)
DATA "子", "丑", "寅", "卯", "辰", "巳"
DATA "午", "未", "申", "酉", "戌", "亥"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' 二分二至の時刻または中気の時刻を求める二分二至の時刻
!' 引数 tm .... 計算対象となる時刻(ユリウス日)
!' logitudeas .... 二分二至の時90 中気の時30
!' 戻り値 .... 二分二至の時刻または中気の時刻(ユリウス日)
!' グローバル変数rm_sun0にその時の太陽黄経をセットする
EXTERNAL FUNCTION CALC_CHU(TM, LOGITUDEAS)
LET TM1 = INT(TM) !' 時刻引数を分解する
LET TM2 = TM - TM1 - 9 / 24 !' JST ==> DT
!' 二分二至の時刻または中気の黄経λsun0を求める
LET T = (TM2 + 0.5 + TM1 - 2451545) / 36525
LET RM_SUN = LONGITUDE_SUN(T)
LET RM_SUN0 = LOGITUDEAS * INT(RM_SUN / LOGITUDEAS)
!' 繰り返し計算によって中気の時刻を計算する(誤差が±1.0 sec以内になったら打ち切る)
DO
LET T = (TM2 + 0.5 + TM1 - 2451545) / 36525
LET RM_SUN = LONGITUDE_SUN(T) !' 太陽の黄経λsunを計算
LET DELTA_RM = RM_SUN - RM_SUN0 !' 黄経差Δλ
!' Δλの引き込み範囲(±180°)を逸脱した場合には、補正を行う
IF DELTA_RM > 180 THEN
LET DELTA_RM = DELTA_RM - 360
ELSEIF DELTA_RM < -180 THEN
LET DELTA_RM = DELTA_RM + 360
END IF
LET DELTA_T1 = INT(DELTA_RM * 365.24219878 / 360) !' 時刻引数の補正値 Δt
LET DELTA_T2 = DELTA_RM * 365.24219878 / 360
LET DELTA_T2 = DELTA_T2 - DELTA_T1
LET TM1 = TM1 - DELTA_T1 !' 時刻引数の補正
LET TM2 = TM2 - DELTA_T2
IF TM2 < 0 THEN
LET TM2 = TM2 + 1
LET TM1 = TM1 - 1
END IF
LOOP UNTIL ABS(DELTA_T1 + DELTA_T2) < (1 / 86400)
LET CALC_CHU = TM1 + TM2 + 9 / 24
END FUNCTION

!' 朔の計算
!' 与えられた時刻の直近の朔の時刻(JST)を求める
!' 引数 tm ........ 計算対象となる時刻(ユリウス日)
!' 戻り値 ........ 朔の時刻引数、戻り値ともユリウス日で表し、時分秒は日の小数で表す
EXTERNAL FUNCTION CALC_SAKU(TM)
LET LC = 1 !' ループカウンタのセット
LET TM1 = INT(TM) !' 時刻引数を分解する
LET TM2 = TM - TM1 - 9 / 24 !' JST ==> DT
!' 繰り返し計算によって朔の時刻を計算する(誤差が±1.0 sec以内になったら打ち切る)
DO
LET T = (TM2 + 0.5 + TM1 - 2451545) / 36525
LET RM_SUN = LONGITUDE_SUN(T) !' 太陽の黄経λsunを計算
LET RM_MOON = LONGITUDE_MOON(T) !' 月の黄経λmoonを計算
LET DELTA_RM = RM_MOON - RM_SUN !' 月と太陽の黄経差Δλ
!' ループの１回目(Lc=1)で delta_rm < 0 の場合には引き込み範囲に入るように補正する
IF LC = 1 AND DELTA_RM < 0 THEN
LET DELTA_RM = NORMALIZATION_ANGLE(DELTA_RM)
!' 春分の近くで朔がある場合(0 ≦λsun≦ 20)で、月の黄経λmoon≧300 の
!' 場合には、Δλ＝ 360 － Δλ と計算して補正する
ELSEIF RM_SUN >= 0 AND RM_SUN <= 20 AND RM_MOON >= 300 THEN
LET DELTA_RM = NORMALIZATION_ANGLE(DELTA_RM)
LET DELTA_RM = 360 - DELTA_RM
!' Δλの引き込み範囲(±40°)を逸脱した場合には、補正を行う
ELSEIF ABS(DELTA_RM) > 40 THEN
LET DELTA_RM = NORMALIZATION_ANGLE(DELTA_RM)
END IF
LET DELTA_T1 = INT(DELTA_RM * 29.530589 / 360) !' 時刻引数の補正値 Δt
LET DELTA_T2 = DELTA_RM * 29.530589 / 360
LET DELTA_T2 = DELTA_T2 - DELTA_T1
LET TM1 = TM1 - DELTA_T1 !' 時刻引数の補正
LET TM2 = TM2 - DELTA_T2
IF TM2 < 0 THEN
LET TM2 = TM2 + 1
LET TM1 = TM1 - 1
END IF
!' ループ回数が15回になったら、初期値 tm を tm-26 とする
IF LC = 15 AND ABS(DELTA_T1 + DELTA_T2) > (1 / 86400) THEN
LET TM1 = INT(TM - 26)
LET TM2 = 0
!' 初期値を補正したにも関わらず､振動を続ける場合には初期値を答えとして返して強制的にループを抜け出して異常終了させる
ELSEIF LC > 30 AND ABS(DELTA_T1 + DELTA_T2) > (1 / 86400) THEN
LET TM1 = TM
LET TM2 = 0
EXIT DO
END IF
LET LC = LC + 1
LOOP UNTIL ABS(DELTA_T1 + DELTA_T2) < (1 / 86400)
!' 時刻引数を合成するのと、DT ==> JST 変換を行い、戻り値とする
LET CALC_SAKU = TM2 + TM1 + 9 / 24
END FUNCTION

REM 続き

!' 角度の正規化を行う。すなわち引数の範囲を０≦θ＜３６０にする
EXTERNAL FUNCTION NORMALIZATION_ANGLE(ANGLE)
LET NORMALIZATION_ANGLE = MOD(ANGLE+360,360)
END FUNCTION

EXTERNAL FUNCTION LONGITUDE_SUN(T) !' 太陽の黄経λsunを計算する
!' 摂動項の計算
LET ANG = NORMALIZATION_ANGLE(31557 * T + 161)
LET TH = 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(29930 * T + 48)
LET TH = TH + 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(2281 * T + 221)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(155 * T + 118)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(33718 * T + 316)
LET TH = TH + 0.0006 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(9038 * T + 64)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(3035 * T + 110)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(65929 * T + 45)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(22519 * T + 352)
LET TH = TH + 0.0013 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(45038 * T + 254)
LET TH = TH + 0.0015 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(445267 * T + 208)
LET TH = TH + 0.0018 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(19 * T + 159)
LET TH = TH + 0.0018 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(32964 * T + 158)
LET TH = TH + 0.002 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(71998.1 * T + 265.1)
LET TH = TH + 0.02 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(35999.05 * T + 267.52)
LET TH = TH - 0.0048 * T * COS(PI * ANG / 180)
LET TH = TH + 1.9147 * COS(PI * ANG / 180)
!' 比例項の計算
LET ANG = NORMALIZATION_ANGLE(36000.7695 * T)
LET ANG = NORMALIZATION_ANGLE(ANG + 280.4659)
LET LONGITUDE_SUN = NORMALIZATION_ANGLE(TH + ANG)
END FUNCTION

EXTERNAL FUNCTION LONGITUDE_MOON(T) !' 月の黄経λmoonを計算する
!' 摂動項の計算
LET ANG = NORMALIZATION_ANGLE(2322131 * T + 191)
LET TH = 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(4067 * T + 70)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(549197 * T + 220)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1808933 * T + 58)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(349472 * T + 337)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(381404 * T + 354)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(958465 * T + 340)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(12006 * T + 187)
LET TH = TH + 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(39871 * T + 223)
LET TH = TH + 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(509131 * T + 242)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1745069 * T + 24)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1908795 * T + 90)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(2258267 * T + 156)
LET TH = TH + 0.0006 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(111869 * T + 38)
LET TH = TH + 0.0006 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(27864 * T + 127)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(485333 * T + 186)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(405201 * T + 50)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(790672 * T + 114)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1403732 * T + 98)
LET TH = TH + 0.0008 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(858602 * T + 129)
LET TH = TH + 0.0009 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1920802 * T + 186)
LET TH = TH + 0.0011 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1267871 * T + 249)
LET TH = TH + 0.0012 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1856938 * T + 152)
LET TH = TH + 0.0016 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(401329 * T + 274)
LET TH = TH + 0.0018 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(341337 * T + 16)
LET TH = TH + 0.0021 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(71998 * T + 85)
LET TH = TH + 0.0021 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(990397 * T + 357)
LET TH = TH + 0.0021 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(818536 * T + 151)
LET TH = TH + 0.0022 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(922466 * T + 163)
LET TH = TH + 0.0023 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(99863 * T + 122)
LET TH = TH + 0.0024 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1379739 * T + 17)
LET TH = TH + 0.0026 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(918399 * T + 182)
LET TH = TH + 0.0027 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1934 * T + 145)
LET TH = TH + 0.0028 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(541062 * T + 259)
LET TH = TH + 0.0037 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1781068 * T + 21)
LET TH = TH + 0.0038 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(133 * T + 29)
LET TH = TH + 0.004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1844932 * T + 56)
LET TH = TH + 0.004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1331734 * T + 283)
LET TH = TH + 0.004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(481266 * T + 205)
LET TH = TH + 0.005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(31932 * T + 107)
LET TH = TH + 0.0052 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(926533 * T + 323)
LET TH = TH + 0.0068 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(449334 * T + 188)
LET TH = TH + 0.0079 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(826671 * T + 111)
LET TH = TH + 0.0085 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1431597 * T + 315)
LET TH = TH + 0.01 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1303870 * T + 246)
LET TH = TH + 0.0107 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(489205 * T + 142)
LET TH = TH + 0.011 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1443603 * T + 52)
LET TH = TH + 0.0125 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(75870 * T + 41)
LET TH = TH + 0.0154 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(513197.9 * T + 222.5)
LET TH = TH + 0.0304 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(445267.1 * T + 27.9)
LET TH = TH + 0.0347 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(441199.8 * T + 47.4)
LET TH = TH + 0.0409 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(854535.2 * T + 148.2)
LET TH = TH + 0.0458 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1367733.1 * T + 280.7)
LET TH = TH + 0.0533 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(377336.3 * T + 13.2)
LET TH = TH + 0.0571 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(63863.5 * T + 124.2)
LET TH = TH + 0.0588 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(966404 * T + 276.5)
LET TH = TH + 0.1144 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(35999.05 * T + 87.53)
LET TH = TH + 0.1851 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(954397.74 * T + 179.93)
LET TH = TH + 0.2136 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(890534.22 * T + 145.7)
LET TH = TH + 0.6583 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(413335.35 * T + 10.74)
LET TH = TH + 1.274 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(477198.868 * T + 44.963)
LET TH = TH + 6.2888 * COS(PI * ANG / 180)
!' 比例項の計算
LET ANG = NORMALIZATION_ANGLE(481267.8809 * T)
LET ANG = NORMALIZATION_ANGLE(ANG + 218.3162)
LET LONGITUDE_MOON = NORMALIZATION_ANGLE(TH + ANG)
END FUNCTION

!' ユリウス日(JD)から年月日、時分秒(世界時)を計算する
!' この関数で求めた年月日は、グレゴリオ暦法によって表されている
EXTERNAL FUNCTION JD2YMDT$(JD)
LET X0 = INT(JD + 68570)
LET X1 = INT(X0 / 36524.25)
LET X2 = X0 - INT(36524.25 * X1 + 0.75)
LET X3 = INT((X2 + 1) / 365.2425)
LET X4 = X2 - INT(365.25 * X3) + 31
LET X5 = INT(INT(X4) / 30.59)
LET X6 = INT(INT(X5) / 11)
LET GDAY = X4 - INT(30.59 * X5)
LET GMONTH = X5 - 12 * X6 + 2
LET GYEAR = 100 * (X1 - 49) + X3 + X6
!' 2月30日の補正
IF GMONTH = 2 AND GDAY > 28 THEN
IF MOD(GYEAR,100) = 0 AND MOD(GYEAR,400) = 0 THEN
LET GDAY = 29
ELSEIF MOD(GYEAR,4) = 0 AND MOD(GYEAR,100) > 0 THEN
LET GDAY = 29
ELSE
LET GDAY = 28
END IF
END IF
LET X0 = 24 * (JD - INT(JD))
LET GHOUR = INT(X0)
LET GMINUTE = INT((X0 - GHOUR) * 60)
LET GSECOND = INT((X0 - GHOUR - GMINUTE / 60) * 3600 + 0.05)
LET JD2YMDT$ = STR$(GYEAR) & "/" & RIGHT$("0"&STR$(GMONTH),2) & "/" & RIGHT$("0"&STR$(GDAY),2) & " " & RIGHT$("0"&STR$(GHOUR),2) & ":" & RIGHT$("0"&STR$(GMINUTE),2) & ":" & RIGHT$("0"&STR$(GSECOND),2)
END FUNCTION

!' 年月日、時分秒(世界時)からユリウス日(JD)を計算する
EXTERNAL FUNCTION YMDT2JD(GYEAR, GMONTH, GDAY, GHOUR, GMINUTE, GSECOND)
IF GMONTH < 3 THEN
LET CALC_GYEAR = GYEAR - 1
LET CALC_GMONTH = GMONTH + 12
ELSE
LET CALC_GYEAR = GYEAR
LET CALC_GMONTH = GMONTH
END IF
LET Y = INT(365.25 * CALC_GYEAR) + INT(CALC_GYEAR / 400) - INT(CALC_GYEAR / 100)
LET Y = Y + INT(30.59 * (CALC_GMONTH - 2)) + 1721088 + GDAY
LET YMDT2JD = Y + (GHOUR + GMINUTE / 60 + GSECOND / 3600) / 24
END FUNCTION

!' 二十四節季
!' Sekki(x,0) 　.... 節季日
!' Sekki(x,1) 　.... 節季
EXTERNAL SUB CALC_SEKKI24(GYEAR)
DIM A$(24)
MAT READ A$
LET YMD = YMDT2JD(GYEAR, 1, 1, 0, 0, 0)
LET J = 0
FOR I = 0 TO 400 STEP 15
LET SEKKI$ = JD2YMDT$(CALC_CHU(YMD + I, 15))
IF VAL(LEFT$(SEKKI$, 4)) = GYEAR THEN
LET SEKKI24$(J, 0) = SEKKI$
LET SEKKI24$(J, 1) = A$(RM_SUN0 / 15+1)
DATA "春分", "清明", "穀雨", "立夏", "小満", "芒種"
DATA "夏至", "小暑", "大暑", "立秋", "処暑", "白露"
DATA "秋分", "寒露", "霜降", "立冬", "小雪", "大雪"
DATA "冬至", "小寒", "大寒", "立春", "雨水", "啓蟄"
LET J = J + 1
END IF
NEXT I
END SUB

!' 新暦に対応する、旧暦を求める
!' 引数 tm .... 計算する日付(ユリウス日)
!' 戻り値 .... kyureki
EXTERNAL SUB CALC_KYUREKI(GYEAR, GMONTH, GDAY)
DIM CHU(0 TO 4), SAKU(0 TO 5), M(0 TO 5, 0 TO 2),ROKU$(6)
LET TM = YMDT2JD(GYEAR, GMONTH, GDAY, 0, 0, 0)
LET CHU(0) = CALC_CHU(TM, 90) !' 計算対象の直前にあたる二分二至の時刻を求める
LET M(0, 0) = INT(RM_SUN0 / 30) + 2 !' 上で求めた二分二至の時の太陽黄経をもとに朔日行列の先頭に月名をセット
FOR I = 1 TO 4
LET CHU(I) = CALC_CHU(CHU(I - 1) + 32, 30)
NEXT I
!' 計算対象の直前にあたる二分二至の直前の朔の時刻を求める
LET SAKU(0) = CALC_SAKU(CHU(0))
!' 朔の時刻を求める
FOR I = 1 TO 5
LET SAKU(I) = CALC_SAKU(SAKU(I - 1) + 30)
!' 前と同じ時刻を計算した場合(両者の差が26日以内)には、初期値を+33日にして再実行させる
IF ABS(INT(SAKU(I - 1)) - INT(SAKU(I))) <= 26 THEN
LET SAKU(I) = CALC_SAKU(SAKU(I - 1) + 35)
END IF
NEXT I
!' saku(1)が二分二至の時刻以前になってしまった場合には、朔をさかのぼり過ぎたと考えて、
!' 朔の時刻を繰り下げて修正する
!' その際、計算もれsaku(4)になっている部分を補うため、朔の時刻を計算する
!' 近日点通過の近辺で朔があると起こる事があるようだ...？
IF INT(SAKU(1)) <= INT(CHU(0)) THEN
FOR I = 0 TO 4
LET SAKU(I) = SAKU(I + 1)
NEXT I
LET SAKU(4) = CALC_SAKU(SAKU(3) + 35)
!' saku(0)が二分二至の時刻以後になってしまった場合には、朔をさかのぼり足りないと見て、
!' 朔の時刻を繰り上げて修正する
!' その際、計算もれsaku(0)になっている部分を補うため、朔の時刻を計算する
!' 春分点の近辺で朔があると起こる事があるようだ...？
ELSEIF INT(SAKU(0)) > INT(CHU(0)) THEN
FOR I = 4 TO 1 STEP -1
LET SAKU(I) = SAKU(I - 1)
NEXT I
LET SAKU(0) = CALC_SAKU(SAKU(0) - 27)
END IF
!' 閏月検索Flagセット節月で４ヶ月の間に朔が５回あると、閏月がある可能性がある
!' lap=false:平月 lap=true:閏月
IF INT(SAKU(4)) <= INT(CHU(3)) THEN LET LAP=1 ELSE LET LAP=0
!' 朔日行列の作成
!' m(i,0) ... 月名(1:正月 2:２月 3:３月 ....)
!' m(i,1) ... 閏フラグ(false:平月 true:閏月)
!' m(i,2) ... 朔日のjd
!' m(0, 0)はこの関数の始めの方ですでに代入済み
LET M(0, 1) = 0
LET M(0, 2) = INT(SAKU(0))
FOR I = 1 TO 5
IF LAP=1 AND I > 1 THEN
IF CHU(I - 1) <= INT(SAKU(I - 1)) OR CHU(I - 1) >= INT(SAKU(I)) THEN
LET M(I - 1, 0) = M(I - 2, 0)
LET M(I - 1, 1) = 1
LET M(I - 1, 2) = INT(SAKU(I - 1))
LET LAP = 0
END IF
END IF
LET M(I, 0) = M(I - 1, 0) + 1
IF M(I, 0) > 12 THEN
LET M(I, 0) = M(I, 0) - 12
END IF
LET M(I, 2) = INT(SAKU(I))
LET M(I, 1) = 0
NEXT I
!' 朔日行列から旧暦を求める
LET STATE = 0
FOR I = 0 TO 5
IF INT(TM) < INT(M(I, 2)) THEN
LET STATE = 1
EXIT FOR
ELSEIF INT(TM) = INT(M(I, 2)) THEN
LET STATE = 2
EXIT FOR
END IF
NEXT I
IF STATE = 0 OR STATE = 1 THEN
LET I = I - 1
END IF
LET QURUU = M(I, 1)
LET QMONTH = M(I, 0)
LET QDAY = INT(TM) - INT(M(I, 2)) + 1
!'旧暦年の計算旧暦月が10以上でかつ新暦月より大きい場合には、まだ年を越していないはず...
!'YMD$ = JD2YMDT$(tm)
!'QYear = Val(Left$(YMD$, 4))
!'If QMonth > 9 And QMonth > Val(Mid$(YMD$, 6, 2)) Then
LET QYEAR = GYEAR
IF QMONTH > 9 AND QMONTH > GMONTH THEN
LET QYEAR = QYEAR - 1
END IF
!' 六曜を求める
MAT READ ROKU$
DATA "大安", "赤口", "先勝", "友引", "先負", "仏滅"
LET QROKUYOU$ = ROKU$(MOD((QMONTH + QDAY) ,6) + 1)
!' 十干十二支を求める
LET QJUKKAN$ = CALC_JUKKAN$(TM)
!' リアルタイム月齢を求める
LET QMAGE = TM - SAKU(I)
IF QMAGE < 0 THEN
LET QMAGE = TM - SAKU(I - 1)
END IF
!' 正午月齢を求める
LET QMAGENOON = INT(TM) + 0.5 - SAKU(I)
IF QMAGENOON < 0 THEN
LET QMAGENOON = INT(TM) + 0.5 - SAKU(I - 1)
END IF
!' 輝面比を求める
LET TM1 = INT(TM)
LET TM2 = TM - TM1 - 9 / 24
LET T = (TM2 + 0.5) / 36525 + (TM1 - 2451545) / 36525
LET QILLUMI = (1 - COS(PI * NORMALIZATION_ANGLE(LONGITUDE_MOON(T) - LONGITUDE_SUN(T)) / 180)) * 50
!' 月相を求める輝面比の計算で求めた変数tを使用
LET QMPHASE = INT(NORMALIZATION_ANGLE(LONGITUDE_MOON(T) - LONGITUDE_SUN(T)) / 360 * 28 + 0.5)
LET QMPHASE = MOD(QMPHASE, 28)
END SUB

Re: Re: 月齢カレンダーの修正(二度目) - gnuutera2012or文句うさびょん URL

2025/06/19 (Thu) 15:24:40

修正した理由です。
ゴールデンウィークに間違いがございました。
https://x.com/gnuutera2012/status/1919563843304620113?t=JH8cOLz0yVmbANp2qzsZHw&s=19

投稿者削除 - (削除)

2025/05/31 (Sat) 11:50:10

(投稿者により削除されました)

Re: 高DPI環境で文字がぼやけてしまいます - SHIRAISHI Kazuo

2025/05/31 (Sat) 15:49:26

Lazarus版については可能性があります。
https://wiki.lazarus.freepascal.org/High_DPI

Re: 高DPI環境で文字がぼやけてしまいます - SHIRAISHI Kazuo

2025/06/02 (Mon) 09:00:59

DPI-aware のテスト版を作成しました。
下記ページの最下部にあります。
https://decimalbasic.web.fc2.com/basicw32.htm

ダーツの結果をDATA処理してみた。 - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:29:29

1000 DECLARE EXTERNAL PICTURE circle
1010 DECLARE EXTERNAL PICTURE bar
1020 OPTION ANGLE DEGREES
1030 SET WINDOW -1,1,-1,1
1040 DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
1050 DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
1060 DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
1070 DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
1080 DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
1090 DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
1100 DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
1110 FOR g=1 TO 20
1120 DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
1130 NEXT g
1140 SET TEXT BACKGROUND "TRANSPARENT"
1150 SET TEXT FONT "ＭＳゴシック" , 10
1160 SET TEXT COLOR 1
1170 PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
1180 PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
1190 PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
1200 PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
1210 PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
1220 PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
1230 PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
1240 PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
1250 PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
1260 PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
1270 PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
1280 PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
1290 PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
1300 PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
1310 PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
1320 PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
1330 PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
1340 PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
1350 PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
1360 PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
!1370 SET AREA COLOR 0
!1380 FOR h=1 TO 10
!1390 PAINT 0.48*COS(36*h),0.48*SIN(36*h)
!1400 PAINT 0.78*COS(36*h),0.78*SIN(36*h)
!1410 PAINT 0,0
!1420 NEXT h
!1430 SET AREA COLOR 0
!1440 FOR h=1 TO 10
!1450 PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
!1460 PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
!1470 PAINT 0.1,0.1
!1480 NEXT h
!1490 SET AREA COLOR 0
!1500 FOR h=1 TO 10
!1510 PAINT 0.2*COS(36*h),0.2*SIN(36*h)
!1520 PAINT 0.6*COS(36*h),0.6*SIN(36*h)
!1530 NEXT h
!1540 SET AREA COLOR 0
!1550 FOR h=1 TO 10
!1560 PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
!1570 PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
!1580 NEXT h
1590 SET POINT STYLE 5
1600 SET POINT COLOR 4
1610 DIM x(100)
1620 DIM y(100)
1630 DIM P(100)
1631 DIM P$(100)
1640 PRINT "i";"x(i)";"y(i)";"P(i)";"P$(i)"
SET POINT STYLE 5
SET WINDOW -1,1,-1,1
FOR i=1 TO 100
READ X(i),Y(i)
PLOT POINTS : X(i),Y(i)
PLOT TEXT ,AT X(i),Y(i): STR$(i)
WAIT DELAY 0.5
NEXT i
DATA .136,-.108
DATA .216,-.016
DATA .512,-.488
DATA .356,-.44
DATA .116,.348
DATA .132,.624
DATA -.236,-.172
DATA -.196,-.328
DATA -.068,-.06
DATA .336,-.38
DATA .296,-.268
DATA .356,-.264
DATA .32,.536
DATA .216,.348
DATA -.056,.512
DATA .256,.728
DATA -.388,.224
DATA .28,.608
DATA -.028,-.292
DATA .408,.152
DATA -.088,-.272
DATA .86,.196
DATA .476,.024
DATA .252,-.092
DATA .252,-.092
DATA .748,-.472
DATA .684,-.552
DATA .336,-.868
DATA .34,-.856
DATA .4,-.352
DATA -.92,-.952
! 1660 GET POINT: x(i),y(i)
! 1670 PLOT POINTS: x(i),y(i)
1650 FOR i=1 TO 100
1680 PLOT TEXT ,AT x(i),y(i): STR$(i)
1690 IF x(i)^2+y(i)^2<0.05^2 THEN GOTO 1700
1691 IF x(i)^2+y(i)^2>0.05^2 THEN GOTO 1720
1692 IF x(i)^2+y(i)^2=0.05^2 THEN GOTO 4190
1700 LET P(i)=50
1710 LET P$(i)="Double Bull"
1715 GOTO 4210
1720 IF 0.05^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.15^2 THEN GOTO 1730
1721 IF 0.05^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.15^2 THEN GOTO 1750
1722 IF 0.05^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.15^2 THEN GOTO 4190
1730 LET P(i)=25
1740 LET P$(i)="Bull"
1745 GOTO 4210
1750 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 1760
1751 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 1780
1752 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
1760 LET P(i)=20
1770 LET P$(i)="S20"
1775 GOTO 4210
1780 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 1790
1781 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 1810
1782 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
1790 LET P(i)=1
1800 LET P$(i)="S1"
1805 GOTO 4210
1810 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 1820
1811 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 1840
1812 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
1820 LET P(i)=18
1830 LET P$(i)="S18"
1835 GOTO 4210
1840 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 1850
1841 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 1870
1842 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
1850 LET P(i)=4
1860 LET P$(i)="S4"
1865 GOTO 4210
1870 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 1880
1871 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 1900
1872 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
1880 LET P(i)=13
1890 LET P$(i)="S13"
1895 GOTO 4210
1900 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 1910
1901 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 1930
1902 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
1910 LET P(i)=6
1920 LET P$(i)="S6"
1925 GOTO 4210
1930 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 1940
1931 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 1960
1932 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
1940 LET P(i)=10
1950 LET P$(i)="S10"
1955 GOTO 4210
1960 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 1970
1961 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 1990
1962 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
1970 LET P(i)=15
1980 LET P$(i)="S15"
1985 GOTO 4210
1990 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2000
1991 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2020
1992 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2000 LET P(i)=2
2010 LET P$(i)="S2"
2015 GOTO 4210
2020 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2030
2021 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2050
2022 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2030 LET P(i)=17
2040 LET P$(i)="S17"
2045 GOTO 4210
2050 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2060
2051 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2080
2052 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2060 LET P(i)=3
2070 LET P$(i)="S3"
2075 GOTO 4210
2080 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2090
2081 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2110
2082 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2090 LET P(i)=19
2100 LET P$(i)="S19"
2105 GOTO 4210
2110 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2120
2111 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2140
2112 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2120 LET P(i)=7
2130 LET P$(i)="S7"
2135 GOTO 4210
2140 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2150
2141 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2170
2142 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2150 LET P(i)=16
2160 LET P$(i)="S16"
2165 GOTO 4210
2170 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2180
2171 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2200
2172 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2180 LET P(i)=8
2190 LET P$(i)="S8"
2195 GOTO 4210
!2/4
2200 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2210
2201 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2230
2202 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2210 LET P(i)=11
2220 LET P$(i)="S11"
2225 GOTO 4210
2230 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2240
2231 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2260
2232 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2240 LET P(i)=14
2250 LET P$(i)="S14"
2255 GOTO 4210
2260 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2270
2261 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2290
2262 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2270 LET P(i)=9
2280 LET P$(i)="S9"
2285 GOTO 4210
2290 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2300
2291 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2320
2292 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2300 LET P(i)=12
2310 LET P$(i)="S12"
2315 GOTO 4210
2320 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2330
2321 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2360
2322 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2330 LET P(i)=5
2340 LET P$(i)="S5"
2345 GOTO 4210
!2350
2360 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2370
2361 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 2390
2362 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2370 LET P(i)=60
2380 LET P$(i)="T20"
2385 GOTO 4210
2390 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 2400
2391 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 2420
2392 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
2400 LET P(i)=3
2410 LET P$(i)="T1"
2415 GOTO 4210
2420 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2430
2421 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2450
2422 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2430 LET P(i)=54
2440 LET P$(i)="T18"
2445 GOTO 4210
2450 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2460
2451 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2480
2452 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2460 LET P(i)=12
2470 LET P$(i)="T4"
2475 GOTO 4210
2480 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2490
2481 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2510
2482 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2490 LET P(i)=39
2500 LET P$(i)="T13"
2505 GOTO 4210
2510 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2520
2511 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2540
2512 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2520 LET P(i)=18
2530 LET P$(i)="T6"
2535 GOTO 4210
2540 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2550
2541 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2570
2542 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2550 LET P(i)=30
2560 LET P$(i)="T10"
2565 GOTO 4210
2570 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2580
2571 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2600
2572 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2580 LET P(i)=45
2590 LET P$(i)="T15"
2595 GOTO 4210
2600 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2610
2601 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2630
2602 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2610 LET P(i)=6
2620 LET P$(i)="T2"
2625 GOTO 4210
2630 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2640
2631 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2660
2632 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2640 LET P(i)=51
2650 LET P$(i)="T17"
2655 GOTO 4210
2660 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2670
2661 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2690
2662 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2670 LET P(i)=9
2680 LET P$(i)="T3"
2685 GOTO 4210
2690 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2700
2691 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2720
2692 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2700 LET P(i)=57
2710 LET P$(i)="T19"
2715 GOTO 4210
2720 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2730
2721 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2750
2722 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2730 LET P(i)=21
2740 LET P$(i)="T7"
2745 GOTO 4210
2750 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2760
2751 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2780
2752 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2760 LET P(i)=48
2770 LET P$(i)="T16"
2775 GOTO 4210
2780 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2790
2781 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2810
2782 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2790 LET P(i)=24
2800 LET P$(i)="T8"
2805 GOTO 4210
2810 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2820
2811 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2840
2812 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2820 LET P(i)=33
2830 LET P$(i)="T11"
2835 GOTO 4210
2840 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2850
2841 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2870
2842 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2850 LET P(i)=42
2860 LET P$(i)="T14"
2865 GOTO 4210
2870 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2880
2871 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2900
2872 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2880 LET P(i)=27
2890 LET P$(i)="T9"
2895 GOTO 4210
2900 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2910
2901 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2930
2902 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2910 LET P(i)=36
2920 LET P$(i)="T12"
2925 GOTO 4210
2930 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2940
!3/4
2931 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2970
2932 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2940 LET P(i)=15
2950 LET P$(i)="T5"
2955 GOTO 4210
!2960
2970 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2980
2971 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3000
2972 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2980 LET P(i)=20
2990 LET P$(i)="S20"
2995 GOTO 4210
3000 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3010
3001 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3030
3002 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3010 LET P(i)=1
3020 LET P$(i)="S1"
3025 GOTO 4210
3030 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3040
3031 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3060
3032 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3040 LET P(i)=18
3050 LET P$(i)="S18"
3055 GOTO 4210
3060 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3070
3061 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3090
3062 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3070 LET P(i)=4
3080 LET P$(i)="S4"
3085 GOTO 4210
3090 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3100
3091 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3120
3092 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3100 LET P(i)=13
3110 LET P$(i)="S13"
3115 GOTO 4210
3120 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3130
3121 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3150
3122 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3130 LET P(i)=6
3140 LET P$(i)="S6"
3145 GOTO 4210
3150 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3160
3151 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3180
3152 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3160 LET P(i)=10
3170 LET P$(i)="S10"
3175 GOTO 4210
3180 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3190
3181 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3210
3182 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3190 LET P(i)=15
3200 LET P$(i)="S15"
3205 GOTO 4210
3210 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3220
3211 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3240
3212 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3220 LET P(i)=2
3230 LET P$(i)="S2"
3235 GOTO 4210
3240 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3250
3241 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3270
3242 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3250 LET P(i)=17
3260 LET P$(i)="S17"
3265 GOTO 4210
3270 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3280
3271 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3300
3272 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3280 LET P(i)=3
3290 LET P$(i)="S3"
3295 GOTO 4210
3300 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3310
3301 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3330
3302 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3310 LET P(i)=19
3320 LET P$(i)="S19"
3325 GOTO 4210
3330 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3340
3331 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3360
3332 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3340 LET P(i)=7
3350 LET P$(i)="S7"
3355 GOTO 4210
3360 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3370
3361 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3390
3362 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3370 LET P(i)=16
3380 LET P$(i)="S16"
3385 GOTO 4210
3390 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3400
3391 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3420
3392 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3400 LET P(i)=8
3410 LET P$(i)="S8"
3415 GOTO 4210
3420 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3430
3421 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3450
3422 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3430 LET P(i)=11
3440 LET P$(i)="S11"
3445 GOTO 4210
3450 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3460
3451 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3480
3452 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3460 LET P(i)=14
3470 LET P$(i)="S14"
3475 GOTO 4210
3480 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3490
3481 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3510
3482 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3490 LET P(i)=9
3500 LET P$(i)="S9"
3505 GOTO 4210
3510 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3520
3511 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3540
3512 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3520 LET P(i)=12
3530 LET P$(i)="S12"
3535 GOTO 4210
3540 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 3550
3541 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 3580
3542 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3550 LET P(i)=5
3560 LET P$(i)="S5"
3565 GOTO 4210
!3570
3580 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 3590
3581 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3610
3582 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
3590 LET P(i)=40
3600 LET P$(i)="D20"
3605 GOTO 4210
3610 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3620
3611 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3640
3612 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3620 LET P(i)=2
3630 LET P$(i)="D1"
3635 GOTO 4210
3640 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3650
3641 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3670
3642 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3650 LET P(i)=36
3660 LET P$(i)="D18"
3665 GOTO 4210
3670 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3680
3671 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3700
3672 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3680 LET P(i)=8
3690 LET P$(i)="D4"
3695 GOTO 4210
!4/4
3700 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3710
3701 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3730
3702 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3710 LET P(i)=26
3720 LET P$(i)="D13"
3725 GOTO 4210
3730 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3740
3731 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3760
3732 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3740 LET P(i)=12
3750 LET P$(i)="D6"
3755 GOTO 4210
3760 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3770
3761 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3790
3762 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3770 LET P(i)=20
3780 LET P$(i)="D10"
3785 GOTO 4210
3790 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3800
3791 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3820
3792 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3800 LET P(i)=30
3810 LET P$(i)="D15"
3815 GOTO 4210
3820 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3830
3821 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3850
3822 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3830 LET P(i)=4
3840 LET P$(i)="D2"
3845 GOTO 4210
3850 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3860
3851 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3880
3852 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3860 LET P(i)=34
3870 LET P$(i)="D17"
3875 GOTO 4210
3880 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3890
3881 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3910
3882 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3890 LET P(i)=6
3900 LET P$(i)="D3"
3915 GOTO 4210
3910 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3920
3911 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3940
3912 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3920 LET P(i)=38
3930 LET P$(i)="D19"
3935 GOTO 4210
3940 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3950
3941 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3970
3942 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3950 LET P(i)=14
3960 LET P$(i)="D7"
3965 GOTO 4210
3970 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3980
3971 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 4000
3972 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3980 LET P(i)=32
3990 LET P$(i)="D16"
3995 GOTO 4210
4000 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 4010
4001 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 4030
4002 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
4010 LET P(i)=16
4020 LET P$(i)="D8"
4025 GOTO 4210
4030 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 4040
4031 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 4060
4032 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
4040 LET P(i)=22
4050 LET P$(i)="D11"
4055 GOTO 4210
4060 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 4070
4061 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 4090
4062 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
4070 LET P(i)=28
4080 LET P$(i)="D14"
4085 GOTO 4210
4090 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 4100
4091 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 4120
4092 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
4100 LET P(i)=18
4110 LET P$(i)="D9"
4115 GOTO 4210
4120 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 4130
4121 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 4150
4122 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
4130 LET P(i)=24
4140 LET P$(i)="D12"
4145 GOTO 4210
4150 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 4160
4151 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 4180
4152 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
4160 LET P(i)=10
4170 LET P$(i)="D5"
4175 GOTO 4210
4180 IF 0.79^2<x(i)^2+y(i)^2 THEN GOTO 4190
4190 LET P(i)=0
4200 LET P$(i)="foul"
4210 PRINT i;x(i);y(i);P(i);P$(i)
4220 NEXT i
4230 END
!4240
4250 EXTERNAL PICTURE circle
4260 OPTION ANGLE DEGREES
4270 FOR j=0 TO 360 STEP 4
4280 PLOT LINES:COS(j*360/360),SIN(j*360/360);
4290 NEXT j
4300 END PICTURE
4310
4320 EXTERNAL PICTURE bar
4330 OPTION ANGLE DEGREES
4340 FOR k=0 TO 1
4350 PLOT LINES:k,0;
4360 NEXT k
4370 END PICTURE

ダーツ count up 御一人様練習用 - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:27:31

REM 十進BASIC DARTS ダーツ count up お一人様練習用(COUNT UP GAME練習用)
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM 1人用01game練習用に作りました。
REM グラフィックスにてダーツボードを描画。
REM グラフィックスが見られないときは表示タブのグラフィックスを選択すれば閲覧可能です。
REM いきなりグラフィックスもテキストウィンドウも現れないことがありますが、十進BASICのウィンドウを小さくすると表示されるようです。
REM グラフィックスをクリックすることにより位置情報を保存可能。
REM グラフィックスはオプション->サイズ->BitMapサイズのラジオボタンを押下してサイズ変更してください。
REM バーストは1point処理、マイナス処理すべてに対応。
REM シングルアウト対応。
REM 4人対戦には未対応。
REM Dドライブに自動的に練習結果「DARTS RESULT」を作成します。
REM ちなみにx座標、y座標は練習の向上につながりますので、データをとっておくことをお勧めします。
REM 要らない方は2箇所ある該当箇所を確実に削除ください。
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"合計","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 5600
! IF MOD(k,3)=1 THEN GOTO 5500
!5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
! GOTO 6700
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
!と、
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
!LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"合計","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 6600
! IF MOD(k,3)=1 THEN GOTO 6500
!6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Quit!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
OPTION BASE 0
DIM x(24)
DIM y(24)
DIM z(24)
DIM P(24)
DIM P$(24)
LET LL=3 ! D1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET MM=4 ! D20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET NN=0 ! S1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET OO=2 ! S20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
PRINT "プレイヤーの氏名を入力して下さい。(全角、半角で入力して下さい。)"
INPUT PLAYERANAME$
PRINT TAB(10),PLAYERANAME$&"さん","COUNT UP GAME"
PRINT "i","P$(i)","P(i)","合計","x(i)","y(i)"
LET A=0
LET SHOTS=24 ! ターン数*3 ここでは8ターン。
1000 DECLARE EXTERNAL PICTURE circle
1010 DECLARE EXTERNAL PICTURE bar
1020 OPTION ANGLE DEGREES
1030 SET WINDOW -1,1,-1,1
1031 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1032 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
1033 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
1034 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
1040 DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
1050 DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
1060 DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
1070 DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
1080 DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
1090 DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
1100 DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
1110 FOR g=1 TO 20
1120 DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
1121 NEXT g
1122 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
1123 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1124 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
1125 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
1140 SET TEXT BACKGROUND "TRANSPARENT"
1150 SET TEXT FONT "ＭＳゴシック" , 10
1160 SET TEXT COLOR 1
1170 PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
1180 PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
1190 PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
1200 PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
1210 PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
1220 PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
1230 PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
1240 PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
1250 PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
1260 PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
1270 PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
1280 PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
1290 PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
1300 PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
1310 PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
1320 PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
1330 PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
1340 PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
1350 PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
1360 PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
1361 PLOT TEXT ,AT -0.99,-0.99 : "quit"
1362 PLOT TEXT ,AT -0.99,-0.89 : STR$(z(i))
1370 SET AREA COLOR LL
1380 FOR h=1 TO 10
1390 PAINT 0.48*COS(36*h),0.48*SIN(36*h)
1400 PAINT 0.78*COS(36*h),0.78*SIN(36*h)
1410 PAINT 0,0
1420 NEXT h
1430 SET AREA COLOR MM
1440 FOR h=1 TO 10
1450 PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
1460 PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
1470 PAINT 0.1,0.1
1480 NEXT h
1490 SET AREA COLOR NN
1500 FOR h=1 TO 10
1510 PAINT 0.2*COS(36*h),0.2*SIN(36*h)
1520 PAINT 0.6*COS(36*h),0.6*SIN(36*h)
1530 NEXT h
1540 SET AREA COLOR OO
1550 FOR h=1 TO 10
1560 PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
1570 PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
1580 NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.9 : "COUNT UP GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
1590 SET POINT STYLE 5
1600 SET POINT COLOR 4

1650 FOR i=1 TO SHOTS
1660 GET POINT: x(i),y(i)
1670 PLOT POINTS: x(i),y(i)
1680 PLOT TEXT ,AT x(i),y(i): STR$(i)
1681 IF -1<x(i) AND x(i)<-0.85 AND -1<y(i) AND y(i)<-0.9 THEN GOTO 6000
1690 IF x(i)^2+y(i)^2<0.05^2 THEN GOTO 1700
1691 IF x(i)^2+y(i)^2>0.05^2 THEN GOTO 1720
1692 IF x(i)^2+y(i)^2=0.05^2 THEN GOTO 4190
1700 LET P(i)=50
1710 LET P$(i)="Double Bull"
1715 GOTO 4201
1720 IF 0.05^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.15^2 THEN GOTO 1730
1721 IF 0.05^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.15^2 THEN GOTO 1750
1722 IF 0.05^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.15^2 THEN GOTO 4190
1730 LET P(i)=25
1740 LET P$(i)="Bull"
1745 GOTO 4201
1750 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 1760
1751 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 1780
1752 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
1760 LET P(i)=20
1770 LET P$(i)="S20"
1775 GOTO 4201
1780 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 1790
1781 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 1810
1782 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
1790 LET P(i)=1
1800 LET P$(i)="S1"
1805 GOTO 4201
1810 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 1820
1811 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 1840
1812 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
1820 LET P(i)=18
1830 LET P$(i)="S18"
1835 GOTO 4201
1840 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 1850
1841 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 1870
1842 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
1850 LET P(i)=4
1860 LET P$(i)="S4"
1865 GOTO 4201
1870 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 1880
1871 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 1900
1872 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
1880 LET P(i)=13
1890 LET P$(i)="S13"
1895 GOTO 4201
1900 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 1910
1901 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 1930
1902 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
1910 LET P(i)=6
1920 LET P$(i)="S6"
1925 GOTO 4201
1930 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 1940
1931 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 1960
1932 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
1940 LET P(i)=10
1950 LET P$(i)="S10"
1955 GOTO 4201
1960 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 1970
1961 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 1990
1962 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
1970 LET P(i)=15
1980 LET P$(i)="S15"
1985 GOTO 4201
1990 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2000
1991 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2020
1992 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2000 LET P(i)=2
2010 LET P$(i)="S2"
2015 GOTO 4201
2020 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2030
2021 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2050
2022 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2030 LET P(i)=17
2040 LET P$(i)="S17"
2045 GOTO 4201
2050 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2060
2051 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2080
2052 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2060 LET P(i)=3
2070 LET P$(i)="S3"
2075 GOTO 4201
2080 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2090
2081 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2110
2082 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2090 LET P(i)=19
2100 LET P$(i)="S19"
2105 GOTO 4201
2110 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2120
2111 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2140
2112 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2120 LET P(i)=7
2130 LET P$(i)="S7"
2135 GOTO 4201
2140 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2150
2141 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2170
2142 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2150 LET P(i)=16
2160 LET P$(i)="S16"
2165 GOTO 4201
2170 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2180
2171 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2200
2172 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2180 LET P(i)=8
2190 LET P$(i)="S8"
2195 GOTO 4201
2200 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2210
2201 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2230
2202 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2210 LET P(i)=11
2220 LET P$(i)="S11"
2225 GOTO 4201
2230 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2240
2231 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2260
2232 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2240 LET P(i)=14
2250 LET P$(i)="S14"
2255 GOTO 4201
2260 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2270
2261 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2290
2262 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2270 LET P(i)=9
2280 LET P$(i)="S9"
2285 GOTO 4201
2290 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2300
2291 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2320
2292 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2300 LET P(i)=12
2310 LET P$(i)="S12"
2315 GOTO 4201
2320 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2330
2321 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2360
2322 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2330 LET P(i)=5
2340 LET P$(i)="S5"
2345 GOTO 4201
!2350
2360 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2370
2361 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 2390
2362 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2370 LET P(i)=60
2380 LET P$(i)="T20"
2385 GOTO 4201
2390 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 2400
2391 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 2420
2392 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
2400 LET P(i)=3
2410 LET P$(i)="T1"
2415 GOTO 4201
2420 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2430
2421 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2450
2422 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2430 LET P(i)=54
2440 LET P$(i)="T18"
2445 GOTO 4201
2450 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2460
2451 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2480
2452 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2460 LET P(i)=12
2470 LET P$(i)="T4"
2475 GOTO 4201
2480 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2490
2481 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2510
2482 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2490 LET P(i)=39
2500 LET P$(i)="T13"
2505 GOTO 4201
2510 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2520
2511 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2540
2512 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2520 LET P(i)=18
2530 LET P$(i)="T6"
2535 GOTO 4201
2540 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2550
2541 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2570
2542 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2550 LET P(i)=30
2560 LET P$(i)="T10"
2565 GOTO 4201
2570 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2580
2571 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2600
2572 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2580 LET P(i)=45
2590 LET P$(i)="T15"
2595 GOTO 4201
2600 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2610
2601 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2630
2602 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2610 LET P(i)=6
2620 LET P$(i)="T2"
2625 GOTO 4201
2630 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2640
2631 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2660
2632 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2640 LET P(i)=51
2650 LET P$(i)="T17"
2655 GOTO 4201
2660 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2670
2661 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2690
2662 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2670 LET P(i)=9
2680 LET P$(i)="T3"
2685 GOTO 4201
2690 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2700
2691 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2720
2692 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2700 LET P(i)=57
2710 LET P$(i)="T19"
2715 GOTO 4201
2720 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2730
2721 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2750
2722 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2730 LET P(i)=21
2740 LET P$(i)="T7"
2745 GOTO 4201
2750 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2760
2751 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2780
2752 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2760 LET P(i)=48
2770 LET P$(i)="T16"
2775 GOTO 4201
2780 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2790
2781 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2810
2782 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2790 LET P(i)=24
2800 LET P$(i)="T8"
2805 GOTO 4201
2810 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2820
2811 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2840
2812 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2820 LET P(i)=33
2830 LET P$(i)="T11"
2835 GOTO 4201
2840 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2850
2841 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2870
2842 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2850 LET P(i)=42
2860 LET P$(i)="T14"
2865 GOTO 4201
2870 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2880
2871 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2900
2872 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2880 LET P(i)=27
2890 LET P$(i)="T9"
2895 GOTO 4201
2900 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2910
2901 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2930
2902 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2910 LET P(i)=36
2920 LET P$(i)="T12"
2925 GOTO 4201
2930 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2940
2931 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2970
2932 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2940 LET P(i)=15
2950 LET P$(i)="T5"
2955 GOTO 4201
!2960
2970 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2980
2971 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3000
2972 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2980 LET P(i)=20
2990 LET P$(i)="S20"
2995 GOTO 4201
3000 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3010
3001 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3030
3002 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3010 LET P(i)=1
3020 LET P$(i)="S1"
3025 GOTO 4201
3030 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3040
3031 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3060
3032 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3040 LET P(i)=18
3050 LET P$(i)="S18"
3055 GOTO 4201
3060 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3070
3061 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3090
3062 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3070 LET P(i)=4
3080 LET P$(i)="S4"
3085 GOTO 4201
3090 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3100
3091 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3120
3092 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3100 LET P(i)=13
3110 LET P$(i)="S13"
3115 GOTO 4201
3120 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3130
3121 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3150
3122 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3130 LET P(i)=6
3140 LET P$(i)="S6"
3145 GOTO 4201
3150 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3160
3151 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3180
3152 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3160 LET P(i)=10
3170 LET P$(i)="S10"
3175 GOTO 4201
3180 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3190
3181 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3210
3182 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3190 LET P(i)=15
3200 LET P$(i)="S15"
3205 GOTO 4201
3210 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3220
3211 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3240
3212 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3220 LET P(i)=2
3230 LET P$(i)="S2"
3235 GOTO 4201
3240 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3250
3241 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3270
3242 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3250 LET P(i)=17
3260 LET P$(i)="S17"
3265 GOTO 4201
3270 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3280
3271 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3300
3272 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3280 LET P(i)=3
3290 LET P$(i)="S3"
3295 GOTO 4201
3300 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3310
3301 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3330
3302 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3310 LET P(i)=19
3320 LET P$(i)="S19"
3325 GOTO 4201
3330 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3340
3331 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3360
3332 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3340 LET P(i)=7
3350 LET P$(i)="S7"
3355 GOTO 4201
3360 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3370
3361 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3390
3362 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3370 LET P(i)=16
3380 LET P$(i)="S16"
3385 GOTO 4201
3390 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3400
3391 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3420
3392 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3400 LET P(i)=8
3410 LET P$(i)="S8"
3415 GOTO 4201
3420 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3430
3421 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3450
3422 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3430 LET P(i)=11
3440 LET P$(i)="S11"
3445 GOTO 4201
3450 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3460
3451 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3480
3452 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3460 LET P(i)=14
3470 LET P$(i)="S14"
3475 GOTO 4201
3480 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3490
3481 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3510
3482 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3490 LET P(i)=9
3500 LET P$(i)="S9"
3505 GOTO 4201
3510 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3520
3511 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3540
3512 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3520 LET P(i)=12
3530 LET P$(i)="S12"
3535 GOTO 4201
3540 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 3550
3541 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 3580
3542 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3550 LET P(i)=5
3560 LET P$(i)="S5"
3565 GOTO 4201
!3570
3580 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 3590
3581 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3610
3582 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
3590 LET P(i)=40
3600 LET P$(i)="D20"
3605 GOTO 4201
3610 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3620
3611 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3640
3612 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3620 LET P(i)=2
3630 LET P$(i)="D1"
3635 GOTO 4201
3640 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3650
3641 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3670
3642 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3650 LET P(i)=36
3660 LET P$(i)="D18"
3665 GOTO 4201
3670 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3680
3671 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3700
3672 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3680 LET P(i)=8
3690 LET P$(i)="D4"
3695 GOTO 4201
3700 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3710
3701 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3730
3702 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3710 LET P(i)=26
3720 LET P$(i)="D13"
3725 GOTO 4201
3730 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3740
3731 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3760
3732 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3740 LET P(i)=12
3750 LET P$(i)="D6"
3755 GOTO 4201
3760 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3770
3761 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3790
3762 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3770 LET P(i)=20
3780 LET P$(i)="D10"
3785 GOTO 4201
3790 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3800
3791 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3820
3792 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3800 LET P(i)=30
3810 LET P$(i)="D15"
3815 GOTO 4201
3820 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3830
3821 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3850
3822 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3830 LET P(i)=4
3840 LET P$(i)="D2"
3845 GOTO 4201
3850 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3860
3851 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3880
3852 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3860 LET P(i)=34
3870 LET P$(i)="D17"
3875 GOTO 4201
3880 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3890
3881 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3910
3882 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3890 LET P(i)=6
3900 LET P$(i)="D3"
3915 GOTO 4201
3910 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3920
3911 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3940
3912 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3920 LET P(i)=38
3930 LET P$(i)="D19"
3935 GOTO 4201
3940 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3950
3941 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3970
3942 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3950 LET P(i)=14
3960 LET P$(i)="D7"
3965 GOTO 4201
3970 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3980
3971 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 4000
3972 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3980 LET P(i)=32
3990 LET P$(i)="D16"
3995 GOTO 4201
4000 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 4010
4001 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 4030
4002 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
4010 LET P(i)=16
4020 LET P$(i)="D8"
4025 GOTO 4201
4030 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 4040
4031 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 4060
4032 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
4040 LET P(i)=22
4050 LET P$(i)="D11"
4055 GOTO 4201
4060 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 4070
4061 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 4090
4062 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
4070 LET P(i)=28
4080 LET P$(i)="D14"
4085 GOTO 4201
4090 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 4100
4091 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 4120
4092 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
4100 LET P(i)=18
4110 LET P$(i)="D9"
4115 GOTO 4201
4120 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 4130
4121 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 4150
4122 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
4130 LET P(i)=24
4140 LET P$(i)="D12"
4145 GOTO 4201
4150 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 4160
4151 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 4180
4152 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
4160 LET P(i)=10
4170 LET P$(i)="D5"
4175 GOTO 4201
4180 IF 0.79^2<x(i)^2+y(i)^2 THEN GOTO 4190
4190 LET P(i)=0
4200 LET P$(i)="Outboard"

4201 SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
SET TEXT COLOR 6
PLOT TEXT ,AT 0.7,0.9-MOD(i+2,3)/10 : STR$(P(i))
SET TEXT COLOR 4
PLOT TEXT ,AT 0.8,0.9-MOD(i+2,3)/10 : STR$(A+P(i))
SET TEXT FONT "ＭＳ明朝",10
SET TEXT COLOR 1

4214 LET A=A+P(i) ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4215 LET z(i)=A
4700 PRINT i,P$(i),P(i),z(i),x(i),y(i)
4701 IF MOD(i,3)<>0 THEN GOTO 4800
4702 IF MOD(i,3)=0 THEN GOTO 4703
4703 WAIT DELAY 1
CLEAR
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
FOR g=1 TO 20
DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
NEXT g
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT FONT "ＭＳゴシック" , 10
SET TEXT COLOR 1
PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
PLOT TEXT ,AT -0.99,-0.99 : "quit"
PLOT TEXT ,AT -0.99,-0.89 : STR$(z(i))
SET AREA COLOR LL
FOR h=1 TO 10
PAINT 0.48*COS(36*h),0.48*SIN(36*h)
PAINT 0.78*COS(36*h),0.78*SIN(36*h)
PAINT 0,0
NEXT h
SET AREA COLOR MM
FOR h=1 TO 10
PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
PAINT 0.1,0.1
NEXT h
SET AREA COLOR NN
FOR h=1 TO 10
PAINT 0.2*COS(36*h),0.2*SIN(36*h)
PAINT 0.6*COS(36*h),0.6*SIN(36*h)
NEXT h
SET AREA COLOR OO
FOR h=1 TO 10
PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.9 : "COUNT UP GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
4800 GOTO 4900
4900 NEXT i

5000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";"COUNT UP GAME"
PRINT " 合計";" x座標";" y座標"
FOR d=1 TO SHOTS
IF MOD(d,3)<>1 THEN GOTO 5200
IF MOD(d,3)=1 THEN GOTO 5100
5100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),z(d),x(d),y(d)
5200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " COUNT UP FINISHED!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん","COUNT UP GAME"
PRINT #1:TAB(10),,,"合計","x座標","y座標"
FOR k=1 TO SHOTS
IF MOD(k,3)<>1 THEN GOTO 5600
IF MOD(k,3)=1 THEN GOTO 5500
5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" COUNT UP FINISHED!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
GOTO 6700

6000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";"COUNT UP GAME"
PRINT " 合計";" x座標";" y座標"
FOR d=1 TO SHOTS
IF MOD(d,3)<>1 THEN GOTO 6200
IF MOD(d,3)=1 THEN GOTO 6100
6100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),z(d),x(d),y(d)
6200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Quit!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん","COUNT UP GAME"
PRINT #1:TAB(10),,,"合計","x座標","y座標"
FOR k=1 TO SHOTS
IF MOD(k,3)<>1 THEN GOTO 6600
IF MOD(k,3)=1 THEN GOTO 6500
6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Quit!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
6700 END
EXTERNAL PICTURE circle
OPTION ANGLE DEGREES
FOR j=0 TO 360 STEP 4
PLOT LINES:COS(j*360/360),SIN(j*360/360);
NEXT j
END PICTURE

EXTERNAL PICTURE bar
OPTION ANGLE DEGREES
FOR k=0 TO 1
PLOT LINES:k,0;
NEXT k
END PICTURE

01GAME multi in multi out - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:25:51

REM 十進BASIC DARTS ダーツ 01GAME multi-in multi-out お一人様練習用(01GAME練習用 7投目改)
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM 1人用01game練習用に作りました。
REM グラフィックスにてダーツボードを描画。
REM グラフィックスが見られないときは表示タブのグラフィックスを選択すれば閲覧可能です。
REM いきなりグラフィックスもテキストウィンドウも現れないことがありますが、十進BASICのウィンドウを小さくすると表示されるようです。
REM グラフィックスをクリックすることにより位置情報を保存可能。
REM グラフィックスはオプション->サイズ->BitMapサイズのラジオボタンを押下してサイズ変更してください。
REM バーストは1point処理、マイナス処理すべてに対応。
REM マルチインマルチアウト対応。
REM 4人対戦には未対応。
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM D25にしてしまった箇所をDouble Bullに直しました。
REM BullはOUTER BULLの呼称に変えようか検討中。
REM Double BullはINNER BULLの呼称に変えようか検討中。
REM Dドライブに自動的に練習結果「DARTS RESULT」を作成します。
REM ちなみにx座標、y座標は練習の向上につながりますので、データをとっておくことをお勧めします。
REM 要らない方は2箇所ある該当箇所を確実に削除ください。
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 5600
! IF MOD(k,3)=1 THEN GOTO 5500
!5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Doubleout!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
!と、
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 6600
! IF MOD(k,3)=1 THEN GOTO 6500
!6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Quit!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
OPTION BASE 0
DIM x(1000)
DIM y(1000)
DIM z(1000)
DIM P(1000)
DIM P$(1000)
LET LL=3 ! D1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET MM=4 ! D20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET NN=0 ! S1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET OO=2 ! S20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
PRINT "何点からスタートしますか?(半角英数で入力して下さい。)"
INPUT A
LET B=A
LET Z(1)=A
PRINT "プレイヤーの氏名を入力して下さい。(全角、半角で入力して下さい。)"
INPUT PLAYERANAME$
PRINT TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT "i","P$(i)","P(i)","あと","x(i)","y(i)"
1000 DECLARE EXTERNAL PICTURE circle
1010 DECLARE EXTERNAL PICTURE bar
1020 OPTION ANGLE DEGREES
1030 SET WINDOW -1,1,-1,1
1031 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1032 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
1033 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
1034 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
1040 DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
1050 DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
1060 DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
1070 DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
1080 DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
1090 DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
1100 DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
1110 FOR g=1 TO 20
1120 DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
1121 NEXT g
1122 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
1123 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1124 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
1125 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
1140 SET TEXT BACKGROUND "TRANSPARENT"
1150 SET TEXT FONT "ＭＳゴシック" , 10
1160 SET TEXT COLOR 1
1170 PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
1180 PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
1190 PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
1200 PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
1210 PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
1220 PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
1230 PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
1240 PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
1250 PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
1260 PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
1270 PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
1280 PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
1290 PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
1300 PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
1310 PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
1320 PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
1330 PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
1340 PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
1350 PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
1360 PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
1361 PLOT TEXT ,AT -0.99,-0.99 : "quit"
1362 PLOT TEXT ,AT -0.99,-0.89 : STR$(z(i))
1370 SET AREA COLOR LL
1380 FOR h=1 TO 10
1390 PAINT 0.48*COS(36*h),0.48*SIN(36*h)
1400 PAINT 0.78*COS(36*h),0.78*SIN(36*h)
1410 PAINT 0,0
1420 NEXT h
1430 SET AREA COLOR MM
1440 FOR h=1 TO 10
1450 PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
1460 PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
1470 PAINT 0.1,0.1
1480 NEXT h
1490 SET AREA COLOR NN
1500 FOR h=1 TO 10
1510 PAINT 0.2*COS(36*h),0.2*SIN(36*h)
1520 PAINT 0.6*COS(36*h),0.6*SIN(36*h)
1530 NEXT h
1540 SET AREA COLOR OO
1550 FOR h=1 TO 10
1560 PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
1570 PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
1580 NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.8 : STR$(B)&" GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
1590 SET POINT STYLE 5
1600 SET POINT COLOR 4
1640 LET gate=0
1650 FOR i=1 TO 1000
1660 GET POINT: x(i),y(i)
1670 PLOT POINTS: x(i),y(i)
1680 PLOT TEXT ,AT x(i),y(i): STR$(i)
1681 IF -1<x(i) AND x(i)<-0.85 AND -1<y(i) AND y(i)<-0.9 THEN GOTO 6000 ! quit達成条件。

1690 IF x(i)^2+y(i)^2<0.05^2 THEN GOTO 1700
1691 IF x(i)^2+y(i)^2>0.05^2 THEN GOTO 1720
1692 IF x(i)^2+y(i)^2=0.05^2 THEN GOTO 4190
1700 LET P(i)=50
1710 LET P$(i)="Double Bull"
1715 GOTO 4201
1720 IF 0.05^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.15^2 THEN GOTO 1730
1721 IF 0.05^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.15^2 THEN GOTO 1750
1722 IF 0.05^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.15^2 THEN GOTO 4190
1730 LET P(i)=25
1740 LET P$(i)="Bull"
1745 GOTO 4201
1750 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 1760
1751 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 1780
1752 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
1760 LET P(i)=20
1770 LET P$(i)="S20"
1775 GOTO 4201
1780 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 1790
1781 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 1810
1782 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
1790 LET P(i)=1
1800 LET P$(i)="S1"
1805 GOTO 4201
1810 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 1820
1811 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 1840
1812 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
1820 LET P(i)=18
1830 LET P$(i)="S18"
1835 GOTO 4201
1840 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 1850
1841 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 1870
1842 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
1850 LET P(i)=4
1860 LET P$(i)="S4"
1865 GOTO 4201
1870 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 1880
1871 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 1900
1872 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
1880 LET P(i)=13
1890 LET P$(i)="S13"
1895 GOTO 4201
1900 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 1910
1901 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 1930
1902 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
1910 LET P(i)=6
1920 LET P$(i)="S6"
1925 GOTO 4201
1930 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 1940
1931 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 1960
1932 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
1940 LET P(i)=10
1950 LET P$(i)="S10"
1955 GOTO 4201
1960 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 1970
1961 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 1990
1962 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
1970 LET P(i)=15
1980 LET P$(i)="S15"
1985 GOTO 4201
1990 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2000
1991 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2020
1992 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2000 LET P(i)=2
2010 LET P$(i)="S2"
2015 GOTO 4201
2020 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2030
2021 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2050
2022 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2030 LET P(i)=17
2040 LET P$(i)="S17"
2045 GOTO 4201
2050 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2060
2051 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2080
2052 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2060 LET P(i)=3
2070 LET P$(i)="S3"
2075 GOTO 4201
2080 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2090
2081 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2110
2082 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2090 LET P(i)=19
2100 LET P$(i)="S19"
2105 GOTO 4201
2110 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2120
2111 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2140
2112 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2120 LET P(i)=7
2130 LET P$(i)="S7"
2135 GOTO 4201
2140 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2150
2141 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2170
2142 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2150 LET P(i)=16
2160 LET P$(i)="S16"
2165 GOTO 4201
2170 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2180
2171 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2200
2172 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2180 LET P(i)=8
2190 LET P$(i)="S8"
2195 GOTO 4201
2200 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2210
2201 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2230
2202 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2210 LET P(i)=11
2220 LET P$(i)="S11"
2225 GOTO 4201
2230 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2240
2231 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2260
2232 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2240 LET P(i)=14
2250 LET P$(i)="S14"
2255 GOTO 4201
2260 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2270
2261 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2290
2262 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2270 LET P(i)=9
2280 LET P$(i)="S9"
2285 GOTO 4201
2290 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2300
2291 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2320
2292 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2300 LET P(i)=12
2310 LET P$(i)="S12"
2315 GOTO 4201
2320 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2330
2321 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2360
2322 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2330 LET P(i)=5
2340 LET P$(i)="S5"
2345 GOTO 4201
!2350
2360 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2370
2361 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 2390
2362 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2370 LET P(i)=60
2380 LET P$(i)="T20"
2385 GOTO 4201
2390 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 2400
2391 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 2420
2392 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
2400 LET P(i)=3
2410 LET P$(i)="T1"
2415 GOTO 4201
2420 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2430
2421 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2450
2422 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2430 LET P(i)=54
2440 LET P$(i)="T18"
2445 GOTO 4201
2450 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2460
2451 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2480
2452 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2460 LET P(i)=12
2470 LET P$(i)="T4"
2475 GOTO 4201
2480 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2490
2481 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2510
2482 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2490 LET P(i)=39
2500 LET P$(i)="T13"
2505 GOTO 4201
2510 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2520
2511 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2540
2512 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2520 LET P(i)=18
2530 LET P$(i)="T6"
2535 GOTO 4201
2540 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2550
2541 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2570
2542 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2550 LET P(i)=30
2560 LET P$(i)="T10"
2565 GOTO 4201
2570 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2580
2571 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2600
2572 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2580 LET P(i)=45
2590 LET P$(i)="T15"
2595 GOTO 4201
2600 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2610
2601 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2630
2602 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2610 LET P(i)=6
2620 LET P$(i)="T2"
2625 GOTO 4201
2630 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2640
2631 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2660
2632 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2640 LET P(i)=51
2650 LET P$(i)="T17"
2655 GOTO 4201
2660 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2670
2661 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2690
2662 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2670 LET P(i)=9
2680 LET P$(i)="T3"
2685 GOTO 4201
2690 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2700
2691 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2720
2692 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2700 LET P(i)=57
2710 LET P$(i)="T19"
2715 GOTO 4201
2720 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2730
2721 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2750
2722 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2730 LET P(i)=21
2740 LET P$(i)="T7"
2745 GOTO 4201
2750 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2760
2751 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2780
2752 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2760 LET P(i)=48
2770 LET P$(i)="T16"
2775 GOTO 4201
2780 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2790
2781 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2810
2782 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2790 LET P(i)=24
2800 LET P$(i)="T8"
2805 GOTO 4201
2810 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2820
2811 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2840
2812 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2820 LET P(i)=33
2830 LET P$(i)="T11"
2835 GOTO 4201
2840 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2850
2841 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2870
2842 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2850 LET P(i)=42
2860 LET P$(i)="T14"
2865 GOTO 4201
2870 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2880
2871 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2900
2872 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2880 LET P(i)=27
2890 LET P$(i)="T9"
2895 GOTO 4201
2900 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2910
2901 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2930
2902 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2910 LET P(i)=36
2920 LET P$(i)="T12"
2925 GOTO 4201
2930 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2940
2931 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2970
2932 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2940 LET P(i)=15
2950 LET P$(i)="T5"
2955 GOTO 4201
!2960
2970 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2980
2971 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3000
2972 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2980 LET P(i)=20
2990 LET P$(i)="S20"
2995 GOTO 4201
3000 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3010
3001 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3030
3002 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3010 LET P(i)=1
3020 LET P$(i)="S1"
3025 GOTO 4201
3030 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3040
3031 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3060
3032 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3040 LET P(i)=18
3050 LET P$(i)="S18"
3055 GOTO 4201
3060 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3070
3061 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3090
3062 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3070 LET P(i)=4
3080 LET P$(i)="S4"
3085 GOTO 4201
3090 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3100
3091 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3120
3092 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3100 LET P(i)=13
3110 LET P$(i)="S13"
3115 GOTO 4201
3120 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3130
3121 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3150
3122 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3130 LET P(i)=6
3140 LET P$(i)="S6"
3145 GOTO 4201
3150 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3160
3151 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3180
3152 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3160 LET P(i)=10
3170 LET P$(i)="S10"
3175 GOTO 4201
3180 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3190
3181 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3210
3182 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3190 LET P(i)=15
3200 LET P$(i)="S15"
3205 GOTO 4201
3210 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3220
3211 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3240
3212 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3220 LET P(i)=2
3230 LET P$(i)="S2"
3235 GOTO 4201
3240 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3250
3241 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3270
3242 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3250 LET P(i)=17
3260 LET P$(i)="S17"
3265 GOTO 4201
3270 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3280
3271 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3300
3272 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3280 LET P(i)=3
3290 LET P$(i)="S3"
3295 GOTO 4201
3300 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3310
3301 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3330
3302 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3310 LET P(i)=19
3320 LET P$(i)="S19"
3325 GOTO 4201
3330 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3340
3331 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3360
3332 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3340 LET P(i)=7
3350 LET P$(i)="S7"
3355 GOTO 4201
3360 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3370
3361 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3390
3362 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3370 LET P(i)=16
3380 LET P$(i)="S16"
3385 GOTO 4201
3390 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3400
3391 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3420
3392 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3400 LET P(i)=8
3410 LET P$(i)="S8"
3415 GOTO 4201
3420 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3430
3421 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3450
3422 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3430 LET P(i)=11
3440 LET P$(i)="S11"
3445 GOTO 4201
3450 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3460
3451 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3480
3452 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3460 LET P(i)=14
3470 LET P$(i)="S14"
3475 GOTO 4201
3480 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3490
3481 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3510
3482 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3490 LET P(i)=9
3500 LET P$(i)="S9"
3505 GOTO 4201
3510 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3520
3511 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3540
3512 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3520 LET P(i)=12
3530 LET P$(i)="S12"
3535 GOTO 4201
3540 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 3550
3541 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 3580
3542 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3550 LET P(i)=5
3560 LET P$(i)="S5"
3565 GOTO 4201
!3570
3580 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 3590
3581 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3610
3582 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
3590 LET P(i)=40
3600 LET P$(i)="D20"
3605 GOTO 4201
3610 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3620
3611 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3640
3612 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3620 LET P(i)=2
3630 LET P$(i)="D1"
3635 GOTO 4201
3640 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3650
3641 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3670
3642 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3650 LET P(i)=36
3660 LET P$(i)="D18"
3665 GOTO 4201
3670 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3680
3671 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3700
3672 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3680 LET P(i)=8
3690 LET P$(i)="D4"
3695 GOTO 4201
3700 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3710
3701 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3730
3702 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3710 LET P(i)=26
3720 LET P$(i)="D13"
3725 GOTO 4201
3730 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3740
3731 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3760
3732 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3740 LET P(i)=12
3750 LET P$(i)="D6"
3755 GOTO 4201
3760 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3770
3761 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3790
3762 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3770 LET P(i)=20
3780 LET P$(i)="D10"
3785 GOTO 4201
3790 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3800
3791 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3820
3792 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3800 LET P(i)=30
3810 LET P$(i)="D15"
3815 GOTO 4201
3820 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3830
3821 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3850
3822 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3830 LET P(i)=4
3840 LET P$(i)="D2"
3845 GOTO 4201
3850 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3860
3851 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3880
3852 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3860 LET P(i)=34
3870 LET P$(i)="D17"
3875 GOTO 4201
3880 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3890
3881 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3910
3882 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3890 LET P(i)=6
3900 LET P$(i)="D3"
3915 GOTO 4201
3910 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3920
3911 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3940
3912 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3920 LET P(i)=38
3930 LET P$(i)="D19"
3935 GOTO 4201
3940 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3950
3941 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3970
3942 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3950 LET P(i)=14
3960 LET P$(i)="D7"
3965 GOTO 4201
3970 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3980
3971 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 4000
3972 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3980 LET P(i)=32
3990 LET P$(i)="D16"
3995 GOTO 4201
4000 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 4010
4001 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 4030
4002 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
4010 LET P(i)=16
4020 LET P$(i)="D8"
4025 GOTO 4201
4030 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 4040
4031 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 4060
4032 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
4040 LET P(i)=22
4050 LET P$(i)="D11"
4055 GOTO 4201
4060 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 4070
4061 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 4090
4062 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
4070 LET P(i)=28
4080 LET P$(i)="D14"
4085 GOTO 4201
4090 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 4100
4091 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 4120
4092 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
4100 LET P(i)=18
4110 LET P$(i)="D9"
4115 GOTO 4201
4120 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 4130
4121 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 4150
4122 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
4130 LET P(i)=24
4140 LET P$(i)="D12"
4145 GOTO 4201
4150 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 4160
4151 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 4180
4152 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
4160 LET P(i)=10
4170 LET P$(i)="D5"
4175 GOTO 4201
4180 IF 0.79^2<x(i)^2+y(i)^2 THEN GOTO 4190
4190 LET P(i)=0
4200 LET P$(i)="Outboard"

4201 SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
SET TEXT COLOR 6
PLOT TEXT ,AT 0.7,0.9-MOD(i+2,3)/10 : STR$(P(i))
SET TEXT COLOR 4
PLOT TEXT ,AT 0.8,0.9-MOD(i+2,3)/10 : STR$(A-P(i))
SET TEXT FONT "ＭＳ明朝",10
SET TEXT COLOR 1
IF gate=1 THEN GOTO 4210
4202 IF gate=0 THEN GOTO 4203

4203 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" OR P$(i)="T1" OR P$(i)="T2" OR P$(i)="T3" OR P$(i)="T4" OR P$(i)="T5" OR P$(i)="T6" OR P$(i)="T7" OR P$(i)="T8" OR P$(i)="T9" OR P$(i)="T10" OR P$(i)="T11" OR P$(i)="T12" OR P$(i)="T13" OR P$(i)="T14" OR P$(i)="T15" OR P$(i)="T16" OR P$(i)="T17" OR P$(i)="T18" OR P$(i)="T19" OR P$(i)="T20" THEN LET gate=1
4204 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" OR P$(i)="T1" OR P$(i)="T2" OR P$(i)="T3" OR P$(i)="T4" OR P$(i)="T5" OR P$(i)="T6" OR P$(i)="T7" OR P$(i)="T8" OR P$(i)="T9" OR P$(i)="T10" OR P$(i)="T11" OR P$(i)="T12" OR P$(i)="T13" OR P$(i)="T14" OR P$(i)="T15" OR P$(i)="T16" OR P$(i)="T17" OR P$(i)="T18" OR P$(i)="T19" OR P$(i)="T20" THEN GOTO 4210 ! Multi in達成条件。
4205 IF P$(i)<>"D1" OR P$(i)<>"D2" OR P$(i)<>"D3" OR P$(i)<>"D4" OR P$(i)<>"D5" OR P$(i)<>"D6" OR P$(i)<>"D7" OR P$(i)<>"D8" OR P$(i)<>"D9" OR P$(i)<>"D10" OR P$(i)<>"D11" OR P$(i)<>"D12" OR P$(i)<>"D13" OR P$(i)<>"D14" OR P$(i)<>"D15" OR P$(i)<>"D16" OR P$(i)<>"D17" OR P$(i)<>"D18" OR P$(i)<>"D19" OR P$(i)<>"D20" OR P$(i)<>"Double Bull" OR P$(i)<>"T1" OR P$(i)<>"T2" OR P$(i)<>"T3" OR P$(i)<>"T4" OR P$(i)<>"T5" OR P$(i)<>"T6" OR P$(i)<>"T7" OR P$(i)<>"T8" OR P$(i)<>"T9" OR P$(i)<>"T10" OR P$(i)<>"T11" OR P$(i)<>"T12" OR P$(i)<>"T13" OR P$(i)<>"T14" OR P$(i)<>"T15" OR P$(i)<>"T16" OR P$(i)<>"T17" OR P$(i)<>"T18" OR P$(i)<>"T19" OR P$(i)<>"T20" THEN GOTO 4510 ! Multi in未達成条件。

4210 IF A-P(i)=0 THEN GOTO 4220 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4211 IF A-P(i)=1 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4212 IF A-P(i)<0 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4213 IF A-P(i)>0 THEN GOTO 4214 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4214 LET A=A-P(i) ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4215 LET Z(i)=A
4216 GOTO 4700

4220 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" OR P$(i)="T1" OR P$(i)="T2" OR P$(i)="T3" OR P$(i)="T4" OR P$(i)="T5" OR P$(i)="T6" OR P$(i)="T7" OR P$(i)="T8" OR P$(i)="T9" OR P$(i)="T10" OR P$(i)="T11" OR P$(i)="T12" OR P$(i)="T13" OR P$(i)="T14" OR P$(i)="T15" OR P$(i)="T16" OR P$(i)="T17" OR P$(i)="T18" OR P$(i)="T19" OR P$(i)="T20" THEN GOTO 5000 ! Multi out達成条件。
4221 IF P$(i)<>"D1" OR P$(i)<>"D2" OR P$(i)<>"D3" OR P$(i)<>"D4" OR P$(i)<>"D5" OR P$(i)<>"D6" OR P$(i)<>"D7" OR P$(i)<>"D8" OR P$(i)<>"D9" OR P$(i)<>"D10" OR P$(i)<>"D11" OR P$(i)<>"D12" OR P$(i)<>"D13" OR P$(i)<>"D14" OR P$(i)<>"D15" OR P$(i)<>"D16" OR P$(i)<>"D17" OR P$(i)<>"D18" OR P$(i)<>"D19" OR P$(i)<>"D20" OR P$(i)<>"Double Bull" OR P$(i)<>"T1" OR P$(i)<>"T2" OR P$(i)<>"T3" OR P$(i)<>"T4" OR P$(i)<>"T5" OR P$(i)<>"T6" OR P$(i)<>"T7" OR P$(i)<>"T8" OR P$(i)<>"T9" OR P$(i)<>"T10" OR P$(i)<>"T11" OR P$(i)<>"T12" OR P$(i)<>"T13" OR P$(i)<>"T14" OR P$(i)<>"T15" OR P$(i)<>"T16" OR P$(i)<>"T17" OR P$(i)<>"T18" OR P$(i)<>"T19" OR P$(i)<>"T20" THEN GOTO 4500 ! Multi out未達成条件。

4500 IF MOD(i,3)=0 THEN GOTO 4520 ! 3投目でBURSTになる場合、つまり、"ヒット、ヒット、バースト"の処理に回す。
IF MOD(i,3)=1 THEN GOTO 4510 ! 1投目でBURSTになる場合、つまり、"バースト"の処理に回す。
IF MOD(i,3)=2 THEN GOTO 4501 ! 2投目でBURSTになる場合、つまり、"ヒット、バースト"の処理に回す。
4501 ! ヒット、バースト CHECK OK!!
LET Z(i)=A+P(i-1) ! i投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET Z(i+1)=A+P(i-1) ! i+1投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1) ! 持ち点をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i-1)=0
LET P(i)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET i=i+1 ! 2投目でバーストなので、1投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4510 !バースト CHECK OK!! ここは、そのターンの1投目のバーストだから、4214行で点数を引かれていない。
4511 LET Z(i)=A ! i投目で「あと...」で表示される残り点数はそのまま。
LET A=A ! i投目の持ち点もそのまま。
LET P(i)=0
LET P(i+1)=0
LET P(i+2)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET P$(i+2)="no count"&"BURST"
LET Z(i+1)=A ! i+1投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+2)=A ! i+2投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+3)=A ! i+3投目で「あと...」で表示される残り点数はそのまま。
LET i=i+2 ! 1投目でバーストなので、2投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4520 !ヒット、ヒット、バースト CHECK OK!!
4521 LET Z(i)=A+P(i-1)+P(i-2) ! i投目で「あと...」で表示される残り点数をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1)+P(i-2) ! 持ち点をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i)=0
LET P(i-1)=0
LET P(i-2)=0
LET P$(i)=P$(i)&"BURST"
LET i=i ! 3投目でバーストなので、0投分スキップした後、4900行で、そのまま次のターンの1投目に行ける。
GOTO 4700
4700 PRINT i,P$(i),P(i),Z(i),x(i),y(i)
4701 IF MOD(i,3)<>0 THEN GOTO 4800
4702 IF MOD(i,3)=0 THEN GOTO 4703
4703 WAIT DELAY 1
CLEAR
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
FOR g=1 TO 20
DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
NEXT g
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT FONT "ＭＳゴシック" , 10
SET TEXT COLOR 1
PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
PLOT TEXT ,AT -0.99,-0.99 : "quit"
PLOT TEXT ,AT -0.99,-0.89 : STR$(Z(i))
SET AREA COLOR LL
FOR h=1 TO 10
PAINT 0.48*COS(36*h),0.48*SIN(36*h)
PAINT 0.78*COS(36*h),0.78*SIN(36*h)
PAINT 0,0
NEXT h
SET AREA COLOR MM
FOR h=1 TO 10
PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
PAINT 0.1,0.1
NEXT h
SET AREA COLOR NN
FOR h=1 TO 10
PAINT 0.2*COS(36*h),0.2*SIN(36*h)
PAINT 0.6*COS(36*h),0.6*SIN(36*h)
NEXT h
SET AREA COLOR OO
FOR h=1 TO 10
PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.8 : STR$(B)&" GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
4800 GOTO 4900
4900 NEXT i

5000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 5200
IF MOD(d,3)=1 THEN GOTO 5100
5100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
5200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Multiin & Multiout!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 5600
IF MOD(k,3)=1 THEN GOTO 5500
5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Multiin & Multiout!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
GOTO 6700

6000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 6200
IF MOD(d,3)=1 THEN GOTO 6100
6100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
6200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT "

01GAME double in double out - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:21:45

REM 十進BASIC DARTS ダーツ 01GAME double out お一人様練習用(01GAME練習用 7投目改)
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM 1人用01game練習用に作りました。
REM グラフィックスにてダーツボードを描画。
REM グラフィックスが見られないときは表示タブのグラフィックスを選択すれば閲覧可能です。
REM いきなりグラフィックスもテキストウィンドウも現れないことがありますが、十進BASICのウィンドウを小さくすると表示されるようです。
REM グラフィックスをクリックすることにより位置情報を保存可能。
REM グラフィックスはオプション->サイズ->BitMapサイズのラジオボタンを押下してサイズ変更してください。
REM バーストは1point処理、マイナス処理すべてに対応。
REM ダブルインダブルアウト対応。
REM 4人対戦には未対応。
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM D25にしてしまった箇所をDouble Bullに直しました。
REM BullはOUTER BULLの呼称に変えようか検討中。
REM Double BullはINNER BULLの呼称に変えようか検討中。
REM Dドライブに自動的に練習結果「DARTS RESULT」を作成します。
REM ちなみにx座標、y座標は練習の向上につながりますので、データをとっておくことをお勧めします。
REM 要らない方は2箇所ある該当箇所を確実に削除ください。
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 5600
! IF MOD(k,3)=1 THEN GOTO 5500
!5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Doubleout!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
!と、
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 6600
! IF MOD(k,3)=1 THEN GOTO 6500
!6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Quit!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
OPTION BASE 0
DIM x(1000)
DIM y(1000)
DIM z(1000)
DIM P(1000)
DIM P$(1000)
LET LL=3 ! D1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET MM=4 ! D20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET NN=0 ! S1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET OO=2 ! S20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
PRINT "何点からスタートしますか?(半角英数で入力して下さい。)"
INPUT A
LET B=A
LET Z(1)=A
PRINT "プレイヤーの氏名を入力して下さい。(全角、半角で入力して下さい。)"
INPUT PLAYERANAME$
PRINT TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT "i","P$(i)","P(i)","あと","x(i)","y(i)"
1000 DECLARE EXTERNAL PICTURE circle
1010 DECLARE EXTERNAL PICTURE bar
1020 OPTION ANGLE DEGREES
1030 SET WINDOW -1,1,-1,1
1031 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1032 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
1033 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
1034 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
1040 DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
1050 DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
1060 DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
1070 DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
1080 DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
1090 DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
1100 DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
1110 FOR g=1 TO 20
1120 DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
1121 NEXT g
1122 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
1123 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1124 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
1125 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
1140 SET TEXT BACKGROUND "TRANSPARENT"
1150 SET TEXT FONT "ＭＳゴシック" , 10
1160 SET TEXT COLOR 1
1170 PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
1180 PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
1190 PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
1200 PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
1210 PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
1220 PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
1230 PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
1240 PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
1250 PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
1260 PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
1270 PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
1280 PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
1290 PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
1300 PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
1310 PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
1320 PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
1330 PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
1340 PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
1350 PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
1360 PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
1361 PLOT TEXT ,AT -0.99,-0.99 : "quit"
1362 PLOT TEXT ,AT -0.99,-0.89 : STR$(z(i))
1370 SET AREA COLOR LL
1380 FOR h=1 TO 10
1390 PAINT 0.48*COS(36*h),0.48*SIN(36*h)
1400 PAINT 0.78*COS(36*h),0.78*SIN(36*h)
1410 PAINT 0,0
1420 NEXT h
1430 SET AREA COLOR MM
1440 FOR h=1 TO 10
1450 PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
1460 PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
1470 PAINT 0.1,0.1
1480 NEXT h
1490 SET AREA COLOR NN
1500 FOR h=1 TO 10
1510 PAINT 0.2*COS(36*h),0.2*SIN(36*h)
1520 PAINT 0.6*COS(36*h),0.6*SIN(36*h)
1530 NEXT h
1540 SET AREA COLOR OO
1550 FOR h=1 TO 10
1560 PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
1570 PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
1580 NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.8 : STR$(B)&" GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
1590 SET POINT STYLE 5
1600 SET POINT COLOR 4
1640 LET gate=0
1650 FOR i=1 TO 1000
1660 GET POINT: x(i),y(i)
1670 PLOT POINTS: x(i),y(i)
1680 PLOT TEXT ,AT x(i),y(i): STR$(i)
1681 IF -1<x(i) AND x(i)<-0.85 AND -1<y(i) AND y(i)<-0.9 THEN GOTO 6000 ! quit達成条件。
1690 IF x(i)^2+y(i)^2<0.05^2 THEN GOTO 1700
1691 IF x(i)^2+y(i)^2>0.05^2 THEN GOTO 1720
1692 IF x(i)^2+y(i)^2=0.05^2 THEN GOTO 4190
1700 LET P(i)=50
1710 LET P$(i)="Double Bull"
1715 GOTO 4201
1720 IF 0.05^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.15^2 THEN GOTO 1730
1721 IF 0.05^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.15^2 THEN GOTO 1750
1722 IF 0.05^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.15^2 THEN GOTO 4190
1730 LET P(i)=25
1740 LET P$(i)="Bull"
1745 GOTO 4201
1750 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 1760
1751 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 1780
1752 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
1760 LET P(i)=20
1770 LET P$(i)="S20"
1775 GOTO 4201
1780 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 1790
1781 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 1810
1782 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
1790 LET P(i)=1
1800 LET P$(i)="S1"
1805 GOTO 4201
1810 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 1820
1811 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 1840
1812 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
1820 LET P(i)=18
1830 LET P$(i)="S18"
1835 GOTO 4201
1840 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 1850
1841 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 1870
1842 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
1850 LET P(i)=4
1860 LET P$(i)="S4"
1865 GOTO 4201
1870 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 1880
1871 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 1900
1872 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
1880 LET P(i)=13
1890 LET P$(i)="S13"
1895 GOTO 4201
1900 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 1910
1901 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 1930
1902 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
1910 LET P(i)=6
1920 LET P$(i)="S6"
1925 GOTO 4201
1930 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 1940
1931 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 1960
1932 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
1940 LET P(i)=10
1950 LET P$(i)="S10"
1955 GOTO 4201
1960 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 1970
1961 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 1990
1962 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
1970 LET P(i)=15
1980 LET P$(i)="S15"
1985 GOTO 4201
1990 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2000
1991 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2020
1992 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2000 LET P(i)=2
2010 LET P$(i)="S2"
2015 GOTO 4201
2020 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2030
2021 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2050
2022 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2030 LET P(i)=17
2040 LET P$(i)="S17"
2045 GOTO 4201
2050 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2060
2051 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2080
2052 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2060 LET P(i)=3
2070 LET P$(i)="S3"
2075 GOTO 4201
2080 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2090
2081 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2110
2082 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2090 LET P(i)=19
2100 LET P$(i)="S19"
2105 GOTO 4201
2110 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2120
2111 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2140
2112 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2120 LET P(i)=7
2130 LET P$(i)="S7"
2135 GOTO 4201
2140 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2150
2141 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2170
2142 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2150 LET P(i)=16
2160 LET P$(i)="S16"
2165 GOTO 4201
2170 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2180
2171 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2200
2172 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2180 LET P(i)=8
2190 LET P$(i)="S8"
2195 GOTO 4201
2200 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2210
2201 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2230
2202 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2210 LET P(i)=11
2220 LET P$(i)="S11"
2225 GOTO 4201
2230 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2240
2231 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2260
2232 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2240 LET P(i)=14
2250 LET P$(i)="S14"
2255 GOTO 4201
2260 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2270
2261 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2290
2262 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2270 LET P(i)=9
2280 LET P$(i)="S9"
2285 GOTO 4201
2290 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2300
2291 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2320
2292 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2300 LET P(i)=12
2310 LET P$(i)="S12"
2315 GOTO 4201
2320 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2330
2321 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2360
2322 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2330 LET P(i)=5
2340 LET P$(i)="S5"
2345 GOTO 4201
!2350
2360 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2370
2361 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 2390
2362 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2370 LET P(i)=60
2380 LET P$(i)="T20"
2385 GOTO 4201
2390 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 2400
2391 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 2420
2392 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
2400 LET P(i)=3
2410 LET P$(i)="T1"
2415 GOTO 4201
2420 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2430
2421 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2450
2422 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2430 LET P(i)=54
2440 LET P$(i)="T18"
2445 GOTO 4201
2450 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2460
2451 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2480
2452 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2460 LET P(i)=12
2470 LET P$(i)="T4"
2475 GOTO 4201
2480 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2490
2481 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2510
2482 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2490 LET P(i)=39
2500 LET P$(i)="T13"
2505 GOTO 4201
2510 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2520
2511 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2540
2512 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2520 LET P(i)=18
2530 LET P$(i)="T6"
2535 GOTO 4201
2540 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2550
2541 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2570
2542 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2550 LET P(i)=30
2560 LET P$(i)="T10"
2565 GOTO 4201
2570 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2580
2571 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2600
2572 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2580 LET P(i)=45
2590 LET P$(i)="T15"
2595 GOTO 4201
2600 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2610
2601 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2630
2602 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2610 LET P(i)=6
2620 LET P$(i)="T2"
2625 GOTO 4201
2630 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2640
2631 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2660
2632 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2640 LET P(i)=51
2650 LET P$(i)="T17"
2655 GOTO 4201
2660 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2670
2661 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2690
2662 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2670 LET P(i)=9
2680 LET P$(i)="T3"
2685 GOTO 4201
2690 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2700
2691 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2720
2692 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2700 LET P(i)=57
2710 LET P$(i)="T19"
2715 GOTO 4201
2720 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2730
2721 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2750
2722 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2730 LET P(i)=21
2740 LET P$(i)="T7"
2745 GOTO 4201
2750 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2760
2751 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2780
2752 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2760 LET P(i)=48
2770 LET P$(i)="T16"
2775 GOTO 4201
2780 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2790
2781 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2810
2782 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2790 LET P(i)=24
2800 LET P$(i)="T8"
2805 GOTO 4201
2810 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2820
2811 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2840
2812 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2820 LET P(i)=33
2830 LET P$(i)="T11"
2835 GOTO 4201
2840 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2850
2841 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2870
2842 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2850 LET P(i)=42
2860 LET P$(i)="T14"
2865 GOTO 4201
2870 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2880
2871 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2900
2872 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2880 LET P(i)=27
2890 LET P$(i)="T9"
2895 GOTO 4201
2900 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2910
2901 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2930
2902 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2910 LET P(i)=36
2920 LET P$(i)="T12"
2925 GOTO 4201
2930 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2940
2931 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2970
2932 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2940 LET P(i)=15
2950 LET P$(i)="T5"
2955 GOTO 4201
!2960
2970 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2980
2971 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3000
2972 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2980 LET P(i)=20
2990 LET P$(i)="S20"
2995 GOTO 4201
3000 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3010
3001 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3030
3002 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3010 LET P(i)=1
3020 LET P$(i)="S1"
3025 GOTO 4201
3030 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3040
3031 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3060
3032 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3040 LET P(i)=18
3050 LET P$(i)="S18"
3055 GOTO 4201
3060 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3070
3061 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3090
3062 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3070 LET P(i)=4
3080 LET P$(i)="S4"
3085 GOTO 4201
3090 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3100
3091 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3120
3092 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3100 LET P(i)=13
3110 LET P$(i)="S13"
3115 GOTO 4201
3120 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3130
3121 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3150
3122 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3130 LET P(i)=6
3140 LET P$(i)="S6"
3145 GOTO 4201
3150 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3160
3151 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3180
3152 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3160 LET P(i)=10
3170 LET P$(i)="S10"
3175 GOTO 4201
3180 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3190
3181 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3210
3182 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3190 LET P(i)=15
3200 LET P$(i)="S15"
3205 GOTO 4201
3210 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3220
3211 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3240
3212 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3220 LET P(i)=2
3230 LET P$(i)="S2"
3235 GOTO 4201
3240 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3250
3241 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3270
3242 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3250 LET P(i)=17
3260 LET P$(i)="S17"
3265 GOTO 4201
3270 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3280
3271 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3300
3272 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3280 LET P(i)=3
3290 LET P$(i)="S3"
3295 GOTO 4201
3300 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3310
3301 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3330
3302 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3310 LET P(i)=19
3320 LET P$(i)="S19"
3325 GOTO 4201
3330 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3340
3331 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3360
3332 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3340 LET P(i)=7
3350 LET P$(i)="S7"
3355 GOTO 4201
3360 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3370
3361 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3390
3362 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3370 LET P(i)=16
3380 LET P$(i)="S16"
3385 GOTO 4201
3390 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3400
3391 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3420
3392 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3400 LET P(i)=8
3410 LET P$(i)="S8"
3415 GOTO 4201
3420 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3430
3421 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3450
3422 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3430 LET P(i)=11
3440 LET P$(i)="S11"
3445 GOTO 4201
3450 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3460
3451 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3480
3452 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3460 LET P(i)=14
3470 LET P$(i)="S14"
3475 GOTO 4201
3480 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3490
3481 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3510
3482 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3490 LET P(i)=9
3500 LET P$(i)="S9"
3505 GOTO 4201
3510 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3520
3511 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3540
3512 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3520 LET P(i)=12
3530 LET P$(i)="S12"
3535 GOTO 4201
3540 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 3550
3541 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 3580
3542 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3550 LET P(i)=5
3560 LET P$(i)="S5"
3565 GOTO 4201
!3570
3580 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 3590
3581 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3610
3582 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
3590 LET P(i)=40
3600 LET P$(i)="D20"
3605 GOTO 4201
3610 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3620
3611 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3640
3612 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3620 LET P(i)=2
3630 LET P$(i)="D1"
3635 GOTO 4201
3640 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3650
3641 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3670
3642 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3650 LET P(i)=36
3660 LET P$(i)="D18"
3665 GOTO 4201
3670 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3680
3671 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3700
3672 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3680 LET P(i)=8
3690 LET P$(i)="D4"
3695 GOTO 4201
3700 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3710
3701 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3730
3702 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3710 LET P(i)=26
3720 LET P$(i)="D13"
3725 GOTO 4201
3730 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3740
3731 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3760
3732 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3740 LET P(i)=12
3750 LET P$(i)="D6"
3755 GOTO 4201
3760 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3770
3761 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3790
3762 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3770 LET P(i)=20
3780 LET P$(i)="D10"
3785 GOTO 4201
3790 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3800
3791 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3820
3792 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3800 LET P(i)=30
3810 LET P$(i)="D15"
3815 GOTO 4201
3820 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3830
3821 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3850
3822 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3830 LET P(i)=4
3840 LET P$(i)="D2"
3845 GOTO 4201
3850 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3860
3851 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3880
3852 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3860 LET P(i)=34
3870 LET P$(i)="D17"
3875 GOTO 4201
3880 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3890
3881 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3910
3882 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3890 LET P(i)=6
3900 LET P$(i)="D3"
3915 GOTO 4201
3910 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3920
3911 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3940
3912 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3920 LET P(i)=38
3930 LET P$(i)="D19"
3935 GOTO 4201
3940 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3950
3941 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3970
3942 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3950 LET P(i)=14
3960 LET P$(i)="D7"
3965 GOTO 4201
3970 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3980
3971 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 4000
3972 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3980 LET P(i)=32
3990 LET P$(i)="D16"
3995 GOTO 4201
4000 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 4010
4001 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 4030
4002 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
4010 LET P(i)=16
4020 LET P$(i)="D8"
4025 GOTO 4201
4030 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 4040
4031 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 4060
4032 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
4040 LET P(i)=22
4050 LET P$(i)="D11"
4055 GOTO 4201
4060 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 4070
4061 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 4090
4062 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
4070 LET P(i)=28
4080 LET P$(i)="D14"
4085 GOTO 4201
4090 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 4100
4091 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 4120
4092 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
4100 LET P(i)=18
4110 LET P$(i)="D9"
4115 GOTO 4201
4120 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 4130
4121 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 4150
4122 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
4130 LET P(i)=24
4140 LET P$(i)="D12"
4145 GOTO 4201
4150 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 4160
4151 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 4180
4152 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
4160 LET P(i)=10
4170 LET P$(i)="D5"
4175 GOTO 4201
4180 IF 0.79^2<x(i)^2+y(i)^2 THEN GOTO 4190
4190 LET P(i)=0
4200 LET P$(i)="Outboard"

4201 SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
SET TEXT COLOR 6
PLOT TEXT ,AT 0.7,0.9-MOD(i+2,3)/10 : STR$(P(i))
SET TEXT COLOR 4
PLOT TEXT ,AT 0.8,0.9-MOD(i+2,3)/10 : STR$(A-P(i))
SET TEXT FONT "ＭＳ明朝",10
SET TEXT COLOR 1
IF gate=1 THEN GOTO 4210
4202 IF gate=0 THEN GOTO 4203
4203 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" THEN LET gate=1
4204 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" THEN GOTO 4210 ! Double in達成条件。
4205 IF P$(i)<>"D1" OR P$(i)<>"D2" OR P$(i)<>"D3" OR P$(i)<>"D4" OR P$(i)<>"D5" OR P$(i)<>"D6" OR P$(i)<>"D7" OR P$(i)<>"D8" OR P$(i)<>"D9" OR P$(i)<>"D10" OR P$(i)<>"D11" OR P$(i)<>"D12" OR P$(i)<>"D13" OR P$(i)<>"D14" OR P$(i)<>"D15" OR P$(i)<>"D16" OR P$(i)<>"D17" OR P$(i)<>"D18" OR P$(i)<>"D19" OR P$(i)<>"D20" OR P$(i)<>"Double Bull" THEN GOTO 4510 ! Double in未達成条件。
4210 IF A-P(i)=0 THEN GOTO 4220 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4211 IF A-P(i)=1 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4212 IF A-P(i)<0 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4213 IF A-P(i)>0 THEN GOTO 4214 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4214 LET A=A-P(i) ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4215 LET Z(i)=A
4216 GOTO 4700

4220 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" THEN GOTO 5000 ! Double out達成条件。
4221 IF P$(i)<>"D1" OR P$(i)<>"D2" OR P$(i)<>"D3" OR P$(i)<>"D4" OR P$(i)<>"D5" OR P$(i)<>"D6" OR P$(i)<>"D7" OR P$(i)<>"D8" OR P$(i)<>"D9" OR P$(i)<>"D10" OR P$(i)<>"D11" OR P$(i)<>"D12" OR P$(i)<>"D13" OR P$(i)<>"D14" OR P$(i)<>"D15" OR P$(i)<>"D16" OR P$(i)<>"D17" OR P$(i)<>"D18" OR P$(i)<>"D19" OR P$(i)<>"D20" OR P$(i)<>"Double Bull" THEN GOTO 4500 ! Double out未達成条件。

4500 IF MOD(i,3)=0 THEN GOTO 4520 ! 3投目でBURSTになる場合、つまり、"ヒット、ヒット、バースト"の処理に回す。
IF MOD(i,3)=1 THEN GOTO 4510 ! 1投目でBURSTになる場合、つまり、"バースト"の処理に回す。
IF MOD(i,3)=2 THEN GOTO 4501 ! 2投目でBURSTになる場合、つまり、"ヒット、バースト"の処理に回す。
4501 ! ヒット、バースト CHECK OK!!
LET Z(i)=A+P(i-1) ! i投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET Z(i+1)=A+P(i-1) ! i+1投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1) ! 持ち点をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i-1)=0
LET P(i)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET i=i+1 ! 2投目でバーストなので、1投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4510 !バースト CHECK OK!! ここは、そのターンの1投目のバーストだから、4214行で点数を引かれていない。
4511 LET Z(i)=A ! i投目で「あと...」で表示される残り点数はそのまま。
LET A=A ! i投目の持ち点もそのまま。
LET P(i)=0
LET P(i+1)=0
LET P(i+2)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET P$(i+2)="no count"&"BURST"
LET Z(i+1)=A ! i+1投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+2)=A ! i+2投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+3)=A ! i+3投目で「あと...」で表示される残り点数はそのまま。
LET i=i+2 ! 1投目でバーストなので、2投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4520 !ヒット、ヒット、バースト CHECK OK!!
4521 LET Z(i)=A+P(i-1)+P(i-2) ! i投目で「あと...」で表示される残り点数をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1)+P(i-2) ! 持ち点をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i)=0
LET P(i-1)=0
LET P(i-2)=0
LET P$(i)=P$(i)&"BURST"
LET i=i ! 3投目でバーストなので、0投分スキップした後、4900行で、そのまま次のターンの1投目に行ける。
GOTO 4700
4700 PRINT i,P$(i),P(i),Z(i),x(i),y(i)
4701 IF MOD(i,3)<>0 THEN GOTO 4800
4702 IF MOD(i,3)=0 THEN GOTO 4703
4703 WAIT DELAY 1
CLEAR
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
FOR g=1 TO 20
DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
NEXT g
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT FONT "ＭＳゴシック" , 10
SET TEXT COLOR 1
PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
PLOT TEXT ,AT -0.99,-0.99 : "quit"
PLOT TEXT ,AT -0.99,-0.89 : STR$(Z(i))
SET AREA COLOR LL
FOR h=1 TO 10
PAINT 0.48*COS(36*h),0.48*SIN(36*h)
PAINT 0.78*COS(36*h),0.78*SIN(36*h)
PAINT 0,0
NEXT h
SET AREA COLOR MM
FOR h=1 TO 10
PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
PAINT 0.1,0.1
NEXT h
SET AREA COLOR NN
FOR h=1 TO 10
PAINT 0.2*COS(36*h),0.2*SIN(36*h)
PAINT 0.6*COS(36*h),0.6*SIN(36*h)
NEXT h
SET AREA COLOR OO
FOR h=1 TO 10
PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.8 : STR$(B)&" GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
4800 GOTO 4900
4900 NEXT i

5000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 5200
IF MOD(d,3)=1 THEN GOTO 5100
5100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
5200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Doublein & Doubleout!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 5600
IF MOD(k,3)=1 THEN GOTO 5500
5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Doublein & Doubleout!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
GOTO 6700

6000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 6200
IF MOD(d,3)=1 THEN GOTO 6100
6100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
6200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Quit!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 6600
IF MOD(k,3)=1 THEN GOTO 6500
6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Quit!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
6700 END

EXTERNAL PICTURE circle
OPTION ANGLE DEGREES
FOR j=0 TO 360 STEP 4
PLOT LINES:COS(j*360/360),SIN(j*360/360);
NEXT j
END PICTURE

EXTERNAL PICTURE bar
OPTION ANGLE DEGREES
FOR k=0 TO 1
PLOT LINES:k,0;
NEXT k
END PICTURE

ダーツ 01GAME multi out 御一人様練習用 - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:19:49

REM 十進BASIC DARTS ダーツ 01GAME multi out お一人様練習用(01GAME練習用 7投目改)
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM 1人用01game練習用に作りました。
REM グラフィックスにてダーツボードを描画。
REM グラフィックスが見られないときは表示タブのグラフィックスを選択すれば閲覧可能です。
REM いきなりグラフィックスもテキストウィンドウも現れないことがありますが、十進BASICのウィンドウを小さくすると表示されるようです。
REM グラフィックスをクリックすることにより位置情報を保存可能。
REM グラフィックスはオプション->サイズ->BitMapサイズのラジオボタンを押下してサイズ変更してください。
REM バーストは1point処理、マイナス処理すべてに対応。
REM マルチアウト対応。
REM 4人対戦には未対応。
REM D25にしてしまった箇所をDouble Bullに直した。
REM BullはOUTER BULLの呼称に変えようか検討中。
REM Double BullはINNER BULLの呼称に変えようか検討中。
REM Dドライブに自動的に練習結果「DARTS RESULT」を作成します。
REM ちなみにx座標、y座標は練習の向上につながりますので、データをとっておくことをお勧めします。
REM 要らない方は2箇所ある該当箇所を確実に削除ください。
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 5600
! IF MOD(k,3)=1 THEN GOTO 5500
!5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Multiout!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
! GOTO 6700
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
!と、
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 6600
! IF MOD(k,3)=1 THEN GOTO 6500
!6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Quit!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲

1000 DECLARE EXTERNAL PICTURE circle
1010 DECLARE EXTERNAL PICTURE bar
1020 OPTION ANGLE DEGREES
1030 SET WINDOW -1,1,-1,1
1040 DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
1050 DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
1060 DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
1070 DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
1080 DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
1090 DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
1100 DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
1110 FOR g=1 TO 20
1120 DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
1121 NEXT g
1122 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
1123 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1124 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
1125 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
1140 SET TEXT BACKGROUND "TRANSPARENT"
1150 SET TEXT FONT "ＭＳゴシック" , 10
1160 SET TEXT COLOR 1
1170 PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
1180 PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
1190 PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
1200 PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
1210 PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
1220 PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
1230 PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
1240 PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
1250 PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
1260 PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
1270 PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
1280 PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
1290 PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
1300 PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
1310 PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
1320 PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
1330 PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
1340 PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
1350 PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
1360 PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
1361 PLOT TEXT ,AT -0.99,-0.99 : "quit"
1590 SET POINT STYLE 5
1600 SET POINT COLOR 4
1601 OPTION BASE 0
1610 DIM x(1000)
1620 DIM y(1000)
1625 DIM z(1000)
1630 DIM P(1000)
1631 DIM P$(1000)
1632 PRINT "何点からスタートしますか?(半角英数で入力して下さい。)"
1633 INPUT A
1634 LET B=A
1635 PRINT "プレイヤーの氏名を入力して下さい。(全角、半角で入力して下さい。)"
1636 INPUT PLAYERANAME$
1637 PRINT TAB(10),PLAYERANAME$&"さん",B;" GAME"
1640 PRINT "i","P$(i)","P(i)","あと","x(i)","y(i)"
1650 FOR i=1 TO 1000
1660 GET POINT: x(i),y(i)
1670 PLOT POINTS: x(i),y(i)
1680 PLOT TEXT ,AT x(i),y(i): STR$(i)
1681 IF -1<x(i) AND x(i)<-0.85 AND -1<y(i) AND y(i)<-0.9 THEN GOTO 6000
1690 IF x(i)^2+y(i)^2<0.05^2 THEN GOTO 1700
1691 IF x(i)^2+y(i)^2>0.05^2 THEN GOTO 1720
1692 IF x(i)^2+y(i)^2=0.05^2 THEN GOTO 4190
1700 LET P(i)=50
1710 LET P$(i)="Double Bull"
1715 GOTO 4210
1720 IF 0.05^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.15^2 THEN GOTO 1730
1721 IF 0.05^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.15^2 THEN GOTO 1750
1722 IF 0.05^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.15^2 THEN GOTO 4190
1730 LET P(i)=25
1740 LET P$(i)="Bull"
1745 GOTO 4210
1750 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 1760
1751 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 1780
1752 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
1760 LET P(i)=20
1770 LET P$(i)="S20"
1775 GOTO 4210
1780 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 1790
1781 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 1810
1782 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
1790 LET P(i)=1
1800 LET P$(i)="S1"
1805 GOTO 4210
1810 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 1820
1811 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 1840
1812 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
1820 LET P(i)=18
1830 LET P$(i)="S18"
1835 GOTO 4210
1840 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 1850
1841 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 1870
1842 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
1850 LET P(i)=4
1860 LET P$(i)="S4"
1865 GOTO 4210
1870 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 1880
1871 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 1900
1872 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
1880 LET P(i)=13
1890 LET P$(i)="S13"
1895 GOTO 4210
1900 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 1910
1901 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 1930
1902 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
1910 LET P(i)=6
1920 LET P$(i)="S6"
1925 GOTO 4210
1930 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 1940
1931 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 1960
1932 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
1940 LET P(i)=10
1950 LET P$(i)="S10"
1955 GOTO 4210
1960 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 1970
1961 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 1990
1962 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
1970 LET P(i)=15
1980 LET P$(i)="S15"
1985 GOTO 4210
1990 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2000
1991 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2020
1992 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2000 LET P(i)=2
2010 LET P$(i)="S2"
2015 GOTO 4210
2020 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2030
2021 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2050
2022 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2030 LET P(i)=17
2040 LET P$(i)="S17"
2045 GOTO 4210
2050 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2060
2051 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2080
2052 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2060 LET P(i)=3
2070 LET P$(i)="S3"
2075 GOTO 4210
2080 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2090
2081 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2110
2082 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2090 LET P(i)=19
2100 LET P$(i)="S19"
2105 GOTO 4210
2110 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2120
2111 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2140
2112 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2120 LET P(i)=7
2130 LET P$(i)="S7"
2135 GOTO 4210
2140 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2150
2141 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2170
2142 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2150 LET P(i)=16
2160 LET P$(i)="S16"
2165 GOTO 4210
2170 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2180
2171 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2200
2172 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2180 LET P(i)=8
2190 LET P$(i)="S8"
2195 GOTO 4210
2200 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2210
2201 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2230
2202 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2210 LET P(i)=11
2220 LET P$(i)="S11"
2225 GOTO 4210
2230 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2240
2231 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2260
2232 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2240 LET P(i)=14
2250 LET P$(i)="S14"
2255 GOTO 4210
2260 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2270
2261 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2290
2262 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2270 LET P(i)=9
2280 LET P$(i)="S9"
2285 GOTO 4210
2290 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2300
2291 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2320
2292 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2300 LET P(i)=12
2310 LET P$(i)="S12"
2315 GOTO 4210
2320 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2330
2321 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2360
2322 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2330 LET P(i)=5
2340 LET P$(i)="S5"
2345 GOTO 4210
!2350
2360 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2370
2361 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 2390
2362 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2370 LET P(i)=60
2380 LET P$(i)="T20"
2385 GOTO 4210
2390 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 2400
2391 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 2420
2392 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
2400 LET P(i)=3
2410 LET P$(i)="T1"
2415 GOTO 4210
2420 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2430
2421 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2450
2422 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2430 LET P(i)=54
2440 LET P$(i)="T18"
2445 GOTO 4210
2450 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2460
2451 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2480
2452 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2460 LET P(i)=12
2470 LET P$(i)="T4"
2475 GOTO 4210
2480 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2490
2481 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2510
2482 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2490 LET P(i)=39
2500 LET P$(i)="T13"
2505 GOTO 4210
2510 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2520
2511 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2540
2512 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2520 LET P(i)=18
2530 LET P$(i)="T6"
2535 GOTO 4210
2540 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2550
2541 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2570
2542 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2550 LET P(i)=30
2560 LET P$(i)="T10"
2565 GOTO 4210
2570 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2580
2571 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2600
2572 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2580 LET P(i)=45
2590 LET P$(i)="T15"
2595 GOTO 4210
2600 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2610
2601 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2630
2602 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2610 LET P(i)=6
2620 LET P$(i)="T2"
2625 GOTO 4210
2630 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2640
2631 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2660
2632 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2640 LET P(i)=51
2650 LET P$(i)="T17"
2655 GOTO 4210
2660 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2670
2661 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2690
2662 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2670 LET P(i)=9
2680 LET P$(i)="T3"
2685 GOTO 4210
2690 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2700
2691 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2720
2692 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2700 LET P(i)=57
2710 LET P$(i)="T19"
2715 GOTO 4210
2720 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2730
2721 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2750
2722 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2730 LET P(i)=21
2740 LET P$(i)="T7"
2745 GOTO 4210
2750 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2760
2751 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2780
2752 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2760 LET P(i)=48
2770 LET P$(i)="T16"
2775 GOTO 4210
2780 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2790
2781 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2810
2782 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2790 LET P(i)=24
2800 LET P$(i)="T8"
2805 GOTO 4210
2810 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2820
2811 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2840
2812 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2820 LET P(i)=33
2830 LET P$(i)="T11"
2835 GOTO 4210
2840 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2850
2841 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2870
2842 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2850 LET P(i)=42
2860 LET P$(i)="T14"
2865 GOTO 4210
2870 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2880
2871 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2900
2872 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2880 LET P(i)=27
2890 LET P$(i)="T9"
2895 GOTO 4210
2900 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2910
2901 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2930
2902 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2910 LET P(i)=36
2920 LET P$(i)="T12"
2925 GOTO 4210
2930 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2940
2931 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2970
2932 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2940 LET P(i)=15
2950 LET P$(i)="T5"
2955 GOTO 4210
!2960
2970 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2980
2971 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3000
2972 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2980 LET P(i)=20
2990 LET P$(i)="S20"
2995 GOTO 4210
3000 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3010
3001 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3030
3002 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3010 LET P(i)=1
3020 LET P$(i)="S1"
3025 GOTO 4210
3030 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3040
3031 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3060
3032 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3040 LET P(i)=18
3050 LET P$(i)="S18"
3055 GOTO 4210
3060 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3070
3061 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3090
3062 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3070 LET P(i)=4
3080 LET P$(i)="S4"
3085 GOTO 4210
3090 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3100
3091 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3120
3092 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3100 LET P(i)=13
3110 LET P$(i)="S13"
3115 GOTO 4210
3120 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3130
3121 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3150
3122 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3130 LET P(i)=6
3140 LET P$(i)="S6"
3145 GOTO 4210
3150 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3160
3151 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3180
3152 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3160 LET P(i)=10
3170 LET P$(i)="S10"
3175 GOTO 4210
3180 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3190
3181 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3210
3182 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3190 LET P(i)=15
3200 LET P$(i)="S15"
3205 GOTO 4210
3210 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3220
3211 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3240
3212 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3220 LET P(i)=2
3230 LET P$(i)="S2"
3235 GOTO 4210
3240 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3250
3241 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3270
3242 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3250 LET P(i)=17
3260 LET P$(i)="S17"
3265 GOTO 4210
3270 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3280
3271 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3300
3272 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3280 LET P(i)=3
3290 LET P$(i)="S3"
3295 GOTO 4210
3300 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3310
3301 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3330
3302 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3310 LET P(i)=19
3320 LET P$(i)="S19"
3325 GOTO 4210
3330 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3340
3331 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3360
3332 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3340 LET P(i)=7
3350 LET P$(i)="S7"
3355 GOTO 4210
3360 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3370
3361 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3390
3362 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3370 LET P(i)=16
3380 LET P$(i)="S16"
3385 GOTO 4210
3390 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3400
3391 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3420
3392 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3400 LET P(i)=8
3410 LET P$(i)="S8"
3415 GOTO 4210
3420 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3430
3421 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3450
3422 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3430 LET P(i)=11
3440 LET P$(i)="S11"
3445 GOTO 4210
3450 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3460
3451 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3480
3452 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3460 LET P(i)=14
3470 LET P$(i)="S14"
3475 GOTO 4210
3480 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3490
3481 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3510
3482 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3490 LET P(i)=9
3500 LET P$(i)="S9"
3505 GOTO 4210
3510 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3520
3511 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3540
3512 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3520 LET P(i)=12
3530 LET P$(i)="S12"
3535 GOTO 4210
3540 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 3550
3541 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 3580
3542 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3550 LET P(i)=5
3560 LET P$(i)="S5"
3565 GOTO 4210
!3570
3580 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 3590
3581 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3610
3582 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
3590 LET P(i)=40
3600 LET P$(i)="D20"
3605 GOTO 4210
3610 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3620
3611 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3640
3612 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3620 LET P(i)=2
3630 LET P$(i)="D1"
3635 GOTO 4210
3640 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3650
3641 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3670
3642 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3650 LET P(i)=36
3660 LET P$(i)="D18"
3665 GOTO 4210
3670 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3680
3671 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3700
3672 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3680 LET P(i)=8
3690 LET P$(i)="D4"
3695 GOTO 4210
3700 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3710
3701 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3730
3702 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3710 LET P(i)=26
3720 LET P$(i)="D13"
3725 GOTO 4210
3730 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3740
3731 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3760
3732 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3740 LET P(i)=12
3750 LET P$(i)="D6"
3755 GOTO 4210
3760 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3770
3761 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3790
3762 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3770 LET P(i)=20
3780 LET P$(i)="D10"
3785 GOTO 4210
3790 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3800
3791 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3820
3792 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3800 LET P(i)=30
3810 LET P$(i)="D15"
3815 GOTO 4210
3820 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3830
3821 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3850
3822 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3830 LET P(i)=4
3840 LET P$(i)="D2"
3845 GOTO 4210
3850 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3860
3851 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3880
3852 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3860 LET P(i)=34
3870 LET P$(i)="D17"
3875 GOTO 4210
3880 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3890
3881 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3910
3882 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3890 LET P(i)=6
3900 LET P$(i)="D3"
3915 GOTO 4210
3910 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3920
3911 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3940
3912 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3920 LET P(i)=38
3930 LET P$(i)="D19"
3935 GOTO 4210
3940 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3950
3941 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3970
3942 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3950 LET P(i)=14
3960 LET P$(i)="D7"
3965 GOTO 4210
3970 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3980
3971 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 4000
3972 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3980 LET P(i)=32
3990 LET P$(i)="D16"
3995 GOTO 4210
4000 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 4010
4001 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 4030
4002 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
4010 LET P(i)=16
4020 LET P$(i)="D8"
4025 GOTO 4210
4030 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 4040
4031 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 4060
4032 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
4040 LET P(i)=22
4050 LET P$(i)="D11"
4055 GOTO 4210
4060 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 4070
4061 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 4090
4062 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
4070 LET P(i)=28
4080 LET P$(i)="D14"
4085 GOTO 4210
4090 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 4100
4091 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 4120
4092 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
4100 LET P(i)=18
4110 LET P$(i)="D9"
4115 GOTO 4210
4120 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 4130
4121 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 4150
4122 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
4130 LET P(i)=24
4140 LET P$(i)="D12"
4145 GOTO 4210
4150 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 4160
4151 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 4180
4152 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
4160 LET P(i)=10
4170 LET P$(i)="D5"
4175 GOTO 4210
4180 IF 0.79^2<x(i)^2+y(i)^2 THEN GOTO 4190
4190 LET P(i)=0
4200 LET P$(i)="Outboard"
4210 IF A-P(i)=0 THEN GOTO 4220 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4211 IF A-P(i)=1 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4212 IF A-P(i)<0 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4213 IF A-P(i)>0 THEN GOTO 4214 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4214 LET A=A-P(i) ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4215 LET Z(i)=A
4216 GOTO 4700
4220 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" OR P$(i)="T1" OR P$(i)="T2" OR P$(i)="T3" OR P$(i)="T4" OR P$(i)="T5" OR P$(i)="T6" OR P$(i)="T7" OR P$(i)="T8" OR P$(i)="T9" OR P$(i)="T10" OR P$(i)="T11" OR P$(i)="T12" OR P$(i)="T13" OR P$(i)="T14" OR P$(i)="T15" OR P$(i)="T16" OR P$(i)="T17" OR P$(i)="T18" OR P$(i)="T19" OR P$(i)="T20" THEN GOTO 5000
4221 IF P$(i)<>"D1" OR P$(i)<>"D2" OR P$(i)<>"D3" OR P$(i)<>"D4" OR P$(i)<>"D5" OR P$(i)<>"D6" OR P$(i)<>"D7" OR P$(i)<>"D8" OR P$(i)<>"D9" OR P$(i)<>"D10" OR P$(i)<>"D11" OR P$(i)<>"D12" OR P$(i)<>"D13" OR P$(i)<>"D14" OR P$(i)<>"D15" OR P$(i)<>"D16" OR P$(i)<>"D17" OR P$(i)<>"D18" OR P$(i)<>"D19" OR P$(i)<>"D20" OR P$(i)<>"Double Bull" OR P$(i)<>"T1" OR P$(i)<>"T2" OR P$(i)<>"T3" OR P$(i)<>"T4" OR P$(i)<>"T5" OR P$(i)<>"T6" OR P$(i)<>"T7" OR P$(i)<>"T8" OR P$(i)<>"T9" OR P$(i)<>"T10" OR P$(i)<>"T11" OR P$(i)<>"T12" OR P$(i)<>"T13" OR P$(i)<>"T14" OR P$(i)<>"T15" OR P$(i)<>"T16" OR P$(i)<>"T17" OR P$(i)<>"T18" OR P$(i)<>"T19" OR P$(i)<>"T20" THEN GOTO 4500

4500 IF MOD(i,3)=0 THEN GOTO 4520 ! 3投目でBURSTになる場合、つまり、"ヒット、ヒット、バースト"の処理に回す。
IF MOD(i,3)=1 THEN GOTO 4510 ! 1投目でBURSTになる場合、つまり、"バースト"の処理に回す。
IF MOD(i,3)=2 THEN GOTO 4501 ! 2投目でBURSTになる場合、つまり、"ヒット、バースト"の処理に回す。
4501 ! ヒット、バースト CHECK OK!!
LET Z(i)=A+P(i-1) ! i投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET Z(i+1)=A+P(i-1) ! i+1投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1) ! 持ち点をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i-1)=0
LET P(i)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET i=i+1 ! 2投目でバーストなので、1投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4510 !バースト CHECK OK!! ここは、そのターンの1投目のバーストだから、4214行で点数を引かれていない。
4512 LET Z(i)=A ! i投目で「あと...」で表示される残り点数はそのまま。
LET A=A ! i投目の持ち点もそのまま。
LET P(i)=0
LET P(i+1)=0
LET P(i+2)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET P$(i+2)="no count"&"BURST"
LET Z(i+1)=A ! i+1投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+2)=A ! i+2投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+3)=A ! i+3投目で「あと...」で表示される残り点数はそのまま。
LET i=i+2 ! 1投目でバーストなので、2投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4520 !ヒット、ヒット、バースト CHECK OK!!
4521 LET Z(i)=A+P(i-1)+P(i-2) ! i投目で「あと...」で表示される残り点数をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1)+P(i-2) ! 持ち点をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i)=0
LET P(i-1)=0
LET P(i-2)=0
LET P$(i)=P$(i)&"BURST"
LET i=i ! 3投目でバーストなので、0投分スキップした後、4900行で、そのまま次のターンの1投目に行ける。
GOTO 4700
4700 PRINT i,P$(i),P(i),Z(i),x(i),y(i)
4701 IF MOD(i,3)<>0 THEN GOTO 4800
4702 IF MOD(i,3)=0 THEN GOTO 4703
4703 WAIT DELAY 1
CLEAR
DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
FOR g=1 TO 20
DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
NEXT g
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT FONT "ＭＳゴシック" , 10
SET TEXT COLOR 1
PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
PLOT TEXT ,AT -0.99,-0.99 : "quit"
4800 GOTO 4900
4900 NEXT i

5000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 5200
IF MOD(d,3)=1 THEN GOTO 5100
5100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
5200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Multiout!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 5600
IF MOD(k,3)=1 THEN GOTO 5500
5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Multiout!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
GOTO 6700

6000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 6200
IF MOD(d,3)=1 THEN GOTO 6100
6100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
6200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Quit!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 6600
IF MOD(k,3)=1 THEN GOTO 6500
6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Quit!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
6700 END

EXTERNAL PICTURE circle
OPTION ANGLE DEGREES
FOR j=0 TO 360 STEP 4
PLOT LINES:COS(j*360/360),SIN(j*360/360);
NEXT j
END PICTURE

EXTERNAL PICTURE bar
OPTION ANGLE DEGREES
FOR k=0 TO 1
PLOT LINES:k,0;
NEXT k
END PICTURE

ダーツ 01GAME double out 御一人様練習用 - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:18:21

REM 十進BASIC DARTS ダーツ 01GAME double out お一人様練習用(01GAME練習用 7投目改)
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM 1人用01game練習用に作りました。
REM グラフィックスにてダーツボードを描画。
REM グラフィックスが見られないときは表示タブのグラフィックスを選択すれば閲覧可能です。
REM いきなりグラフィックスもテキストウィンドウも現れないことがありますが、十進BASICのウィンドウを小さくすると表示されるようです。
REM グラフィックスをクリックすることにより位置情報を保存可能。
REM グラフィックスはオプション->サイズ->BitMapサイズのラジオボタンを押下してサイズ変更してください。
REM バーストは1point処理、マイナス処理すべてに対応。
REM ダブルアウト対応。
REM 4人対戦には未対応。
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM D25にしてしまった箇所をDouble Bullに直しました。
REM BullはOUTER BULLの呼称に変えようか検討中。
REM Double BullはINNER BULLの呼称に変えようか検討中。
REM Dドライブに自動的に練習結果「DARTS RESULT」を作成します。
REM ちなみにx座標、y座標は練習の向上につながりますので、データをとっておくことをお勧めします。
REM 要らない方は2箇所ある該当箇所を確実に削除ください。
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 5600
! IF MOD(k,3)=1 THEN GOTO 5500
!5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Doubleout!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
!と、
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 6600
! IF MOD(k,3)=1 THEN GOTO 6500
!6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Quit!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲

1000 DECLARE EXTERNAL PICTURE circle
1010 DECLARE EXTERNAL PICTURE bar
1020 OPTION ANGLE DEGREES
1030 SET WINDOW -1,1,-1,1
1040 DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
1050 DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
1060 DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
1070 DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
1080 DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
1090 DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
1100 DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
1110 FOR g=1 TO 20
1120 DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
1121 NEXT g
1122 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
1123 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1124 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
1125 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
1140 SET TEXT BACKGROUND "TRANSPARENT"
1150 SET TEXT FONT "ＭＳゴシック" , 10
1160 SET TEXT COLOR 1
1170 PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
1180 PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
1190 PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
1200 PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
1210 PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
1220 PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
1230 PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
1240 PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
1250 PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
1260 PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
1270 PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
1280 PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
1290 PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
1300 PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
1310 PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
1320 PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
1330 PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
1340 PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
1350 PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
1360 PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
1361 PLOT TEXT ,AT -0.99,-0.99 : "quit"
!1370 SET AREA COLOR 0
!1380 FOR h=1 TO 10
!1390 PAINT 0.48*COS(36*h),0.48*SIN(36*h)
!1400 PAINT 0.78*COS(36*h),0.78*SIN(36*h)
!1410 PAINT 0,0
!1420 NEXT h
!1430 SET AREA COLOR 0
!1440 FOR h=1 TO 10
!1450 PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
!1460 PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
!1470 PAINT 0.1,0.1
!1480 NEXT h
!1490 SET AREA COLOR 0
!1500 FOR h=1 TO 10
!1510 PAINT 0.2*COS(36*h),0.2*SIN(36*h)
!1520 PAINT 0.6*COS(36*h),0.6*SIN(36*h)
!1530 NEXT h
!1540 SET AREA COLOR 0
!1550 FOR h=1 TO 10
!1560 PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
!1570 PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
!1580 NEXT h
1590 SET POINT STYLE 5
1600 SET POINT COLOR 4
1601 OPTION BASE 0
1610 DIM x(1000)
1620 DIM y(1000)
1625 DIM z(1000)
1630 DIM P(1000)
1631 DIM P$(1000)
1632 PRINT "何点からスタートしますか?(半角英数で入力して下さい。)"
1633 INPUT A
1634 LET B=A
1635 PRINT "プレイヤーの氏名を入力して下さい。(全角、半角で入力して下さい。)"
1636 INPUT PLAYERANAME$
1637 PRINT TAB(10),PLAYERANAME$&"さん",B;" GAME"
1640 PRINT "i","P$(i)","P(i)","あと","x(i)","y(i)"
1650 FOR i=1 TO 1000
1660 GET POINT: x(i),y(i)
1670 PLOT POINTS: x(i),y(i)
1680 PLOT TEXT ,AT x(i),y(i): STR$(i)
1681 IF -1<x(i) AND x(i)<-0.85 AND -1<y(i) AND y(i)<-0.9 THEN GOTO 6000
1690 IF x(i)^2+y(i)^2<0.05^2 THEN GOTO 1700
1691 IF x(i)^2+y(i)^2>0.05^2 THEN GOTO 1720
1692 IF x(i)^2+y(i)^2=0.05^2 THEN GOTO 4190
1700 LET P(i)=50
1710 LET P$(i)="Double Bull"
1715 GOTO 4210
1720 IF 0.05^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.15^2 THEN GOTO 1730
1721 IF 0.05^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.15^2 THEN GOTO 1750
1722 IF 0.05^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.15^2 THEN GOTO 4190
1730 LET P(i)=25
1740 LET P$(i)="Bull"
1745 GOTO 4210
1750 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 1760
1751 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 1780
1752 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
1760 LET P(i)=20
1770 LET P$(i)="S20"
1775 GOTO 4210
1780 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 1790
1781 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 1810
1782 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
1790 LET P(i)=1
1800 LET P$(i)="S1"
1805 GOTO 4210
1810 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 1820
1811 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 1840
1812 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
1820 LET P(i)=18
1830 LET P$(i)="S18"
1835 GOTO 4210
1840 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 1850
1841 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 1870
1842 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
1850 LET P(i)=4
1860 LET P$(i)="S4"
1865 GOTO 4210
1870 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 1880
1871 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 1900
1872 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
1880 LET P(i)=13
1890 LET P$(i)="S13"
1895 GOTO 4210
1900 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 1910
1901 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 1930
1902 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
1910 LET P(i)=6
1920 LET P$(i)="S6"
1925 GOTO 4210
1930 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 1940
1931 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 1960
1932 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
1940 LET P(i)=10
1950 LET P$(i)="S10"
1955 GOTO 4210
1960 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 1970
1961 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 1990
1962 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
1970 LET P(i)=15
1980 LET P$(i)="S15"
1985 GOTO 4210
1990 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2000
1991 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2020
1992 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2000 LET P(i)=2
2010 LET P$(i)="S2"
2015 GOTO 4210
2020 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2030
2021 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2050
2022 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2030 LET P(i)=17
2040 LET P$(i)="S17"
2045 GOTO 4210
2050 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2060
2051 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2080
2052 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2060 LET P(i)=3
2070 LET P$(i)="S3"
2075 GOTO 4210
2080 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2090
2081 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2110
2082 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2090 LET P(i)=19
2100 LET P$(i)="S19"
2105 GOTO 4210
2110 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2120
2111 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2140
2112 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2120 LET P(i)=7
2130 LET P$(i)="S7"
2135 GOTO 4210
2140 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2150
2141 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2170
2142 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2150 LET P(i)=16
2160 LET P$(i)="S16"
2165 GOTO 4210
2170 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2180
2171 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2200
2172 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2180 LET P(i)=8
2190 LET P$(i)="S8"
2195 GOTO 4210
2200 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2210
2201 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2230
2202 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2210 LET P(i)=11
2220 LET P$(i)="S11"
2225 GOTO 4210
2230 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2240
2231 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2260
2232 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2240 LET P(i)=14
2250 LET P$(i)="S14"
2255 GOTO 4210
2260 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2270
2261 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2290
2262 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2270 LET P(i)=9
2280 LET P$(i)="S9"
2285 GOTO 4210
2290 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2300
2291 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2320
2292 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2300 LET P(i)=12
2310 LET P$(i)="S12"
2315 GOTO 4210
2320 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2330
2321 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2360
2322 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2330 LET P(i)=5
2340 LET P$(i)="S5"
2345 GOTO 4210
!2350
2360 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2370
2361 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 2390
2362 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2370 LET P(i)=60
2380 LET P$(i)="T20"
2385 GOTO 4210
2390 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 2400
2391 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 2420
2392 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
2400 LET P(i)=3
2410 LET P$(i)="T1"
2415 GOTO 4210
2420 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2430
2421 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2450
2422 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2430 LET P(i)=54
2440 LET P$(i)="T18"
2445 GOTO 4210
2450 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2460
2451 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2480
2452 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2460 LET P(i)=12
2470 LET P$(i)="T4"
2475 GOTO 4210
2480 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2490
2481 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2510
2482 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2490 LET P(i)=39
2500 LET P$(i)="T13"
2505 GOTO 4210
2510 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2520
2511 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2540
2512 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2520 LET P(i)=18
2530 LET P$(i)="T6"
2535 GOTO 4210
2540 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2550
2541 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2570
2542 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2550 LET P(i)=30
2560 LET P$(i)="T10"
2565 GOTO 4210
2570 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2580
2571 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2600
2572 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2580 LET P(i)=45
2590 LET P$(i)="T15"
2595 GOTO 4210
2600 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2610
2601 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2630
2602 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2610 LET P(i)=6
2620 LET P$(i)="T2"
2625 GOTO 4210
2630 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2640
2631 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2660
2632 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2640 LET P(i)=51
2650 LET P$(i)="T17"
2655 GOTO 4210
2660 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2670
2661 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2690
2662 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2670 LET P(i)=9
2680 LET P$(i)="T3"
2685 GOTO 4210
2690 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2700
2691 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2720
2692 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2700 LET P(i)=57
2710 LET P$(i)="T19"
2715 GOTO 4210
2720 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2730
2721 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2750
2722 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2730 LET P(i)=21
2740 LET P$(i)="T7"
2745 GOTO 4210
2750 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2760
2751 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2780
2752 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2760 LET P(i)=48
2770 LET P$(i)="T16"
2775 GOTO 4210
2780 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2790
2781 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2810
2782 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2790 LET P(i)=24
2800 LET P$(i)="T8"
2805 GOTO 4210
2810 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2820
2811 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2840
2812 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2820 LET P(i)=33
2830 LET P$(i)="T11"
2835 GOTO 4210
2840 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2850
2841 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2870
2842 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2850 LET P(i)=42
2860 LET P$(i)="T14"
2865 GOTO 4210
2870 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2880
2871 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2900
2872 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2880 LET P(i)=27
2890 LET P$(i)="T9"
2895 GOTO 4210
2900 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2910
2901 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2930
2902 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2910 LET P(i)=36
2920 LET P$(i)="T12"
2925 GOTO 4210
2930 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2940
2931 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2970
2932 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2940 LET P(i)=15
2950 LET P$(i)="T5"
2955 GOTO 4210
!2960
2970 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2980
2971 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3000
2972 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2980 LET P(i)=20
2990 LET P$(i)="S20"
2995 GOTO 4210
3000 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3010
3001 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3030
3002 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3010 LET P(i)=1
3020 LET P$(i)="S1"
3025 GOTO 4210
3030 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3040
3031 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3060
3032 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3040 LET P(i)=18
3050 LET P$(i)="S18"
3055 GOTO 4210
3060 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3070
3061 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3090
3062 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3070 LET P(i)=4
3080 LET P$(i)="S4"
3085 GOTO 4210
3090 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3100
3091 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3120
3092 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3100 LET P(i)=13
3110 LET P$(i)="S13"
3115 GOTO 4210
3120 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3130
3121 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3150
3122 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3130 LET P(i)=6
3140 LET P$(i)="S6"
3145 GOTO 4210
3150 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3160
3151 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3180
3152 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3160 LET P(i)=10
3170 LET P$(i)="S10"
3175 GOTO 4210
3180 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3190
3181 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3210
3182 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3190 LET P(i)=15
3200 LET P$(i)="S15"
3205 GOTO 4210
3210 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3220
3211 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3240
3212 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3220 LET P(i)=2
3230 LET P$(i)="S2"
3235 GOTO 4210
3240 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3250
3241 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3270
3242 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3250 LET P(i)=17
3260 LET P$(i)="S17"
3265 GOTO 4210
3270 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3280
3271 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3300
3272 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3280 LET P(i)=3
3290 LET P$(i)="S3"
3295 GOTO 4210
3300 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3310
3301 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3330
3302 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3310 LET P(i)=19
3320 LET P$(i)="S19"
3325 GOTO 4210
3330 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3340
3331 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3360
3332 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3340 LET P(i)=7
3350 LET P$(i)="S7"
3355 GOTO 4210
3360 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3370
3361 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3390
3362 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3370 LET P(i)=16
3380 LET P$(i)="S16"
3385 GOTO 4210
3390 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3400
3391 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3420
3392 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3400 LET P(i)=8
3410 LET P$(i)="S8"
3415 GOTO 4210
3420 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3430
3421 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3450
3422 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3430 LET P(i)=11
3440 LET P$(i)="S11"
3445 GOTO 4210
3450 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3460
3451 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3480
3452 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3460 LET P(i)=14
3470 LET P$(i)="S14"
3475 GOTO 4210
3480 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3490
3481 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3510
3482 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3490 LET P(i)=9
3500 LET P$(i)="S9"
3505 GOTO 4210
3510 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3520
3511 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3540
3512 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3520 LET P(i)=12
3530 LET P$(i)="S12"
3535 GOTO 4210
3540 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 3550
3541 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 3580
3542 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3550 LET P(i)=5
3560 LET P$(i)="S5"
3565 GOTO 4210
!3570
3580 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 3590
3581 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3610
3582 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
3590 LET P(i)=40
3600 LET P$(i)="D20"
3605 GOTO 4210
3610 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3620
3611 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3640
3612 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3620 LET P(i)=2
3630 LET P$(i)="D1"
3635 GOTO 4210
3640 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3650
3641 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3670
3642 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3650 LET P(i)=36
3660 LET P$(i)="D18"
3665 GOTO 4210
3670 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3680
3671 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3700
3672 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3680 LET P(i)=8
3690 LET P$(i)="D4"
3695 GOTO 4210
3700 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3710
3701 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3730
3702 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3710 LET P(i)=26
3720 LET P$(i)="D13"
3725 GOTO 4210
3730 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3740
3731 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3760
3732 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3740 LET P(i)=12
3750 LET P$(i)="D6"
3755 GOTO 4210
3760 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3770
3761 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3790
3762 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3770 LET P(i)=20
3780 LET P$(i)="D10"
3785 GOTO 4210
3790 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3800
3791 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3820
3792 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3800 LET P(i)=30
3810 LET P$(i)="D15"
3815 GOTO 4210
3820 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3830
3821 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3850
3822 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3830 LET P(i)=4
3840 LET P$(i)="D2"
3845 GOTO 4210
3850 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3860
3851 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3880
3852 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3860 LET P(i)=34
3870 LET P$(i)="D17"
3875 GOTO 4210
3880 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3890
3881 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3910
3882 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3890 LET P(i)=6
3900 LET P$(i)="D3"
3915 GOTO 4210
3910 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3920
3911 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3940
3912 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3920 LET P(i)=38
3930 LET P$(i)="D19"
3935 GOTO 4210
3940 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3950
3941 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3970
3942 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3950 LET P(i)=14
3960 LET P$(i)="D7"
3965 GOTO 4210
3970 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3980
3971 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 4000
3972 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3980 LET P(i)=32
3990 LET P$(i)="D16"
3995 GOTO 4210
4000 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 4010
4001 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 4030
4002 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
4010 LET P(i)=16
4020 LET P$(i)="D8"
4025 GOTO 4210
4030 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 4040
4031 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 4060
4032 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
4040 LET P(i)=22
4050 LET P$(i)="D11"
4055 GOTO 4210
4060 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 4070
4061 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 4090
4062 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
4070 LET P(i)=28
4080 LET P$(i)="D14"
4085 GOTO 4210
4090 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 4100
4091 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 4120
4092 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
4100 LET P(i)=18
4110 LET P$(i)="D9"
4115 GOTO 4210
4120 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 4130
4121 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 4150
4122 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
4130 LET P(i)=24
4140 LET P$(i)="D12"
4145 GOTO 4210
4150 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 4160
4151 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 4180
4152 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
4160 LET P(i)=10
4170 LET P$(i)="D5"
4175 GOTO 4210
4180 IF 0.79^2<x(i)^2+y(i)^2 THEN GOTO 4190
4190 LET P(i)=0
4200 LET P$(i)="Outboard"

4210 IF A-P(i)=0 THEN GOTO 4220 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4211 IF A-P(i)=1 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4212 IF A-P(i)<0 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4213 IF A-P(i)>0 THEN GOTO 4214 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4214 LET A=A-P(i) ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4215 LET Z(i)=A
4216 GOTO 4700
4220 IF P$(i)="D1" OR P$(i)="D2" OR P$(i)="D3" OR P$(i)="D4" OR P$(i)="D5" OR P$(i)="D6" OR P$(i)="D7" OR P$(i)="D8" OR P$(i)="D9" OR P$(i)="D10" OR P$(i)="D11" OR P$(i)="D12" OR P$(i)="D13" OR P$(i)="D14" OR P$(i)="D15" OR P$(i)="D16" OR P$(i)="D17" OR P$(i)="D18" OR P$(i)="D19" OR P$(i)="D20" OR P$(i)="Double Bull" THEN GOTO 5000
4221 IF P$(i)<>"D1" OR P$(i)<>"D2" OR P$(i)<>"D3" OR P$(i)<>"D4" OR P$(i)<>"D5" OR P$(i)<>"D6" OR P$(i)<>"D7" OR P$(i)<>"D8" OR P$(i)<>"D9" OR P$(i)<>"D10" OR P$(i)<>"D11" OR P$(i)<>"D12" OR P$(i)<>"D13" OR P$(i)<>"D14" OR P$(i)<>"D15" OR P$(i)<>"D16" OR P$(i)<>"D17" OR P$(i)<>"D18" OR P$(i)<>"D19" OR P$(i)<>"D20" OR P$(i)<>"Double Bull" THEN GOTO 4500

4500 IF MOD(i,3)=0 THEN GOTO 4520 ! 3投目でBURSTになる場合、つまり、"ヒット、ヒット、バースト"の処理に回す。
IF MOD(i,3)=1 THEN GOTO 4510 ! 1投目でBURSTになる場合、つまり、"バースト"の処理に回す。
IF MOD(i,3)=2 THEN GOTO 4501 ! 2投目でBURSTになる場合、つまり、"ヒット、バースト"の処理に回す。
4501 ! ヒット、バースト CHECK OK!!
LET Z(i)=A+P(i-1) ! i投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET Z(i+1)=A+P(i-1) ! i+1投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1) ! 持ち点をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i-1)=0
LET P(i)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET i=i+1 ! 2投目でバーストなので、1投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4510 !バースト CHECK OK!! ここは、そのターンの1投目のバーストだから、4214行で点数を引かれていない。
4511 LET Z(i)=A ! i投目で「あと...」で表示される残り点数はそのまま。
LET A=A ! i投目の持ち点もそのまま。
LET P(i)=0
LET P(i+1)=0
LET P(i+2)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET P$(i+2)="no count"&"BURST"
LET Z(i+1)=A ! i+1投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+2)=A ! i+2投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+3)=A ! i+3投目で「あと...」で表示される残り点数はそのまま。
LET i=i+2 ! 1投目でバーストなので、2投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4520 !ヒット、ヒット、バースト CHECK OK!!
4521 LET Z(i)=A+P(i-1)+P(i-2) ! i投目で「あと...」で表示される残り点数をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1)+P(i-2) ! 持ち点をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i)=0
LET P(i-1)=0
LET P(i-2)=0
LET P$(i)=P$(i)&"BURST"
LET i=i ! 3投目でバーストなので、0投分スキップした後、4900行で、そのまま次のターンの1投目に行ける。
GOTO 4700
4700 PRINT i,P$(i),P(i),Z(i),x(i),y(i)
4701 IF MOD(i,3)<>0 THEN GOTO 4800
4702 IF MOD(i,3)=0 THEN GOTO 4703
4703 WAIT DELAY 1
CLEAR
DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
FOR g=1 TO 20
DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
NEXT g
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT FONT "ＭＳゴシック" , 10
SET TEXT COLOR 1
PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
PLOT TEXT ,AT -0.99,-0.99 : "quit"
4800 GOTO 4900
4900 NEXT i

5000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 5200
IF MOD(d,3)=1 THEN GOTO 5100
5100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
5200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Doubleout!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 5600
IF MOD(k,3)=1 THEN GOTO 5500
5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Doubleout!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
GOTO 6700

6000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 6200
IF MOD(d,3)=1 THEN GOTO 6100
6100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
6200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Quit!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 6600
IF MOD(k,3)=1 THEN GOTO 6500
6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Quit!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
6700 END

EXTERNAL PICTURE circle
OPTION ANGLE DEGREES
FOR j=0 TO 360 STEP 4
PLOT LINES:COS(j*360/360),SIN(j*360/360);
NEXT j
END PICTURE

EXTERNAL PICTURE bar
OPTION ANGLE DEGREES
FOR k=0 TO 1
PLOT LINES:k,0;
NEXT k
END PICTURE

ダーツ 01GAME single out 御一人様練習用 - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:14:34

REM 十進BASIC DARTS ダーツ 01GAME single out お一人様練習用(01GAME練習用 6投目改)
REM 十進BASIC 2進法モードで開くと大吉。
REM 十進BASIC 10進法モードで開くと中吉。遅いから(^^)。
REM 1人用01game練習用に作りました。
REM グラフィックスにてダーツボードを描画。
REM グラフィックスが見られないときは表示タブのグラフィックスを選択すれば閲覧可能です。
REM いきなりグラフィックスもテキストウィンドウも現れないことがありますが、十進BASICのウィンドウを小さくすると表示されるようです。
REM グラフィックスをクリックすることにより位置情報を保存可能。
REM グラフィックスはオプション->サイズ->BitMapサイズのラジオボタンを押下してサイズ変更してください。
REM バーストは1point処理、マイナス処理すべてに対応。
REM シングルアウト対応。
REM 4人対戦には未対応。
REM Dドライブに自動的に練習結果「DARTS RESULT」を作成します。
REM ちなみにx座標、y座標は練習の向上につながりますので、データをとっておくことをお勧めします。
REM 要らない方は2箇所ある該当箇所を確実に削除ください。
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
! LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 5600
! IF MOD(k,3)=1 THEN GOTO 5500
!5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
! GOTO 6700
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
!と、
!▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
!LET G$="D:\DARTS RESULT"
! LET H$=".TXT"
! LET I$=G$&H$
! OPEN #1:NAME I$
! SET #1: POINTER END
! PRINT #1: DATE$&" "&TIME$
! PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
! PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
! PRINT #1:TAB(10),,,"あと","x座標","y座標"
! FOR k=1 TO i
! IF MOD(k,3)<>1 THEN GOTO 6600
! IF MOD(k,3)=1 THEN GOTO 6500
!6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
!6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
! NEXT k
! PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
! PRINT #1:" Quit!!"
! PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
! CLOSE #1
!▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
OPTION BASE 0
DIM x(1000)
DIM y(1000)
DIM z(1000)
DIM P(1000)
DIM P$(1000)
LET LL=3 ! D1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET MM=4 ! D20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET NN=0 ! S1の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
LET OO=2 ! S20の色 0白,1黒,2青,3緑,4赤,5水色,6黄色,7赤紫,8灰色,9濃い青,10濃い緑,11青緑,12えび茶,13オリーブ色,14 濃い紫,15銀色
PRINT "何点からスタートしますか?(半角英数で入力して下さい。)"
INPUT A
LET B=A
LET Z(1)=A
PRINT "プレイヤーの氏名を入力して下さい。(全角、半角で入力して下さい。)"
INPUT PLAYERANAME$
PRINT TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT "i","P$(i)","P(i)","あと","x(i)","y(i)"
1000 DECLARE EXTERNAL PICTURE circle
1010 DECLARE EXTERNAL PICTURE bar
1020 OPTION ANGLE DEGREES
1030 SET WINDOW -1,1,-1,1
1031 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1032 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
1033 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
1034 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
1040 DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
1050 DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
1060 DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
1070 DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
1080 DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
1090 DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
1100 DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
1110 FOR g=1 TO 20
1120 DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
1121 NEXT g
1122 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
1123 DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
1124 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
1125 DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
1140 SET TEXT BACKGROUND "TRANSPARENT"
1150 SET TEXT FONT "ＭＳゴシック" , 10
1160 SET TEXT COLOR 1
1170 PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
1180 PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
1190 PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
1200 PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
1210 PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
1220 PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
1230 PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
1240 PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
1250 PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
1260 PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
1270 PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
1280 PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
1290 PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
1300 PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
1310 PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
1320 PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
1330 PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
1340 PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
1350 PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
1360 PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
1361 PLOT TEXT ,AT -0.99,-0.99 : "quit"
1362 PLOT TEXT ,AT -0.99,-0.89 : STR$(z(i))
1370 SET AREA COLOR LL
1380 FOR h=1 TO 10
1390 PAINT 0.48*COS(36*h),0.48*SIN(36*h)
1400 PAINT 0.78*COS(36*h),0.78*SIN(36*h)
1410 PAINT 0,0
1420 NEXT h
1430 SET AREA COLOR MM
1440 FOR h=1 TO 10
1450 PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
1460 PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
1470 PAINT 0.1,0.1
1480 NEXT h
1490 SET AREA COLOR NN
1500 FOR h=1 TO 10
1510 PAINT 0.2*COS(36*h),0.2*SIN(36*h)
1520 PAINT 0.6*COS(36*h),0.6*SIN(36*h)
1530 NEXT h
1540 SET AREA COLOR OO
1550 FOR h=1 TO 10
1560 PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
1570 PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
1580 NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.8 : STR$(B)&" GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
1590 SET POINT STYLE 5
1600 SET POINT COLOR 4

1650 FOR i=1 TO 1000
1660 GET POINT: x(i),y(i)
1670 PLOT POINTS: x(i),y(i)
1680 PLOT TEXT ,AT x(i),y(i): STR$(i)
1681 IF -1<x(i) AND x(i)<-0.85 AND -1<y(i) AND y(i)<-0.9 THEN GOTO 6000
1690 IF x(i)^2+y(i)^2<0.05^2 THEN GOTO 1700
1691 IF x(i)^2+y(i)^2>0.05^2 THEN GOTO 1720
1692 IF x(i)^2+y(i)^2=0.05^2 THEN GOTO 4190
1700 LET P(i)=50
1710 LET P$(i)="Double Bull"
1715 GOTO 4201
1720 IF 0.05^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.15^2 THEN GOTO 1730
1721 IF 0.05^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.15^2 THEN GOTO 1750
1722 IF 0.05^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.15^2 THEN GOTO 4190
1730 LET P(i)=25
1740 LET P$(i)="Bull"
1745 GOTO 4201
1750 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 1760
1751 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 1780
1752 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
1760 LET P(i)=20
1770 LET P$(i)="S20"
1775 GOTO 4201
1780 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 1790
1781 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 1810
1782 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
1790 LET P(i)=1
1800 LET P$(i)="S1"
1805 GOTO 4201
1810 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 1820
1811 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 1840
1812 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
1820 LET P(i)=18
1830 LET P$(i)="S18"
1835 GOTO 4201
1840 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 1850
1841 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 1870
1842 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
1850 LET P(i)=4
1860 LET P$(i)="S4"
1865 GOTO 4201
1870 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 1880
1871 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 1900
1872 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
1880 LET P(i)=13
1890 LET P$(i)="S13"
1895 GOTO 4201
1900 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 1910
1901 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 1930
1902 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
1910 LET P(i)=6
1920 LET P$(i)="S6"
1925 GOTO 4201
1930 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 1940
1931 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 1960
1932 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
1940 LET P(i)=10
1950 LET P$(i)="S10"
1955 GOTO 4201
1960 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 1970
1961 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 1990
1962 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
1970 LET P(i)=15
1980 LET P$(i)="S15"
1985 GOTO 4201
1990 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2000
1991 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2020
1992 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2000 LET P(i)=2
2010 LET P$(i)="S2"
2015 GOTO 4201
2020 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2030
2021 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2050
2022 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2030 LET P(i)=17
2040 LET P$(i)="S17"
2045 GOTO 4201
2050 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2060
2051 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2080
2052 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2060 LET P(i)=3
2070 LET P$(i)="S3"
2075 GOTO 4201
2080 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2090
2081 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2110
2082 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2090 LET P(i)=19
2100 LET P$(i)="S19"
2105 GOTO 4201
2110 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2120
2111 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2140
2112 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2120 LET P(i)=7
2130 LET P$(i)="S7"
2135 GOTO 4201
2140 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2150
2141 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2170
2142 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2150 LET P(i)=16
2160 LET P$(i)="S16"
2165 GOTO 4201
2170 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2180
2171 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2200
2172 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2180 LET P(i)=8
2190 LET P$(i)="S8"
2195 GOTO 4201
2200 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2210
2201 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2230
2202 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2210 LET P(i)=11
2220 LET P$(i)="S11"
2225 GOTO 4201
2230 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2240
2231 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2260
2232 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2240 LET P(i)=14
2250 LET P$(i)="S14"
2255 GOTO 4201
2260 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2270
2261 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2290
2262 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2270 LET P(i)=9
2280 LET P$(i)="S9"
2285 GOTO 4201
2290 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2300
2291 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2320
2292 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2300 LET P(i)=12
2310 LET P$(i)="S12"
2315 GOTO 4201
2320 IF 0.15^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.46^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2330
2321 IF 0.15^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.46^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2360
2322 IF 0.15^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.46^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2330 LET P(i)=5
2340 LET P$(i)="S5"
2345 GOTO 4201
!2350
2360 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2370
2361 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 2390
2362 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2370 LET P(i)=60
2380 LET P$(i)="T20"
2385 GOTO 4201
2390 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 2400
2391 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 2420
2392 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
2400 LET P(i)=3
2410 LET P$(i)="T1"
2415 GOTO 4201
2420 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2430
2421 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2450
2422 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2430 LET P(i)=54
2440 LET P$(i)="T18"
2445 GOTO 4201
2450 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2460
2451 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2480
2452 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2460 LET P(i)=12
2470 LET P$(i)="T4"
2475 GOTO 4201
2480 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2490
2481 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2510
2482 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2490 LET P(i)=39
2500 LET P$(i)="T13"
2505 GOTO 4201
2510 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2520
2511 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2540
2512 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2520 LET P(i)=18
2530 LET P$(i)="T6"
2535 GOTO 4201
2540 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2550
2541 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2570
2542 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2550 LET P(i)=30
2560 LET P$(i)="T10"
2565 GOTO 4201
2570 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2580
2571 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2600
2572 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2580 LET P(i)=45
2590 LET P$(i)="T15"
2595 GOTO 4201
2600 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2610
2601 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2630
2602 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2610 LET P(i)=6
2620 LET P$(i)="T2"
2625 GOTO 4201
2630 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2640
2631 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2660
2632 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2640 LET P(i)=51
2650 LET P$(i)="T17"
2655 GOTO 4201
2660 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 2670
2661 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 2690
2662 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2670 LET P(i)=9
2680 LET P$(i)="T3"
2685 GOTO 4201
2690 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 2700
2691 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 2720
2692 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
2700 LET P(i)=57
2710 LET P$(i)="T19"
2715 GOTO 4201
2720 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 2730
2721 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 2750
2722 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
2730 LET P(i)=21
2740 LET P$(i)="T7"
2745 GOTO 4201
2750 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 2760
2751 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 2780
2752 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
2760 LET P(i)=48
2770 LET P$(i)="T16"
2775 GOTO 4201
2780 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 2790
2781 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 2810
2782 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
2790 LET P(i)=24
2800 LET P$(i)="T8"
2805 GOTO 4201
2810 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 2820
2811 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 2840
2812 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
2820 LET P(i)=33
2830 LET P$(i)="T11"
2835 GOTO 4201
2840 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 2850
2841 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 2870
2842 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
2850 LET P(i)=42
2860 LET P$(i)="T14"
2865 GOTO 4201
2870 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 2880
2871 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 2900
2872 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
2880 LET P(i)=27
2890 LET P$(i)="T9"
2895 GOTO 4201
2900 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 2910
2901 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 2930
2902 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
2910 LET P(i)=36
2920 LET P$(i)="T12"
2925 GOTO 4201
2930 IF 0.46^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.49^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 2940
2931 IF 0.46^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.49^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 2970
2932 IF 0.46^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.49^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
2940 LET P(i)=15
2950 LET P$(i)="T5"
2955 GOTO 4201
!2960
2970 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 2980
2971 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3000
2972 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
2980 LET P(i)=20
2990 LET P$(i)="S20"
2995 GOTO 4201
3000 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3010
3001 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3030
3002 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3010 LET P(i)=1
3020 LET P$(i)="S1"
3025 GOTO 4201
3030 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3040
3031 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3060
3032 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3040 LET P(i)=18
3050 LET P$(i)="S18"
3055 GOTO 4201
3060 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3070
3061 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3090
3062 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3070 LET P(i)=4
3080 LET P$(i)="S4"
3085 GOTO 4201
3090 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3100
3091 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3120
3092 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3100 LET P(i)=13
3110 LET P$(i)="S13"
3115 GOTO 4201
3120 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3130
3121 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3150
3122 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3130 LET P(i)=6
3140 LET P$(i)="S6"
3145 GOTO 4201
3150 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3160
3151 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3180
3152 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3160 LET P(i)=10
3170 LET P$(i)="S10"
3175 GOTO 4201
3180 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3190
3181 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3210
3182 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3190 LET P(i)=15
3200 LET P$(i)="S15"
3205 GOTO 4201
3210 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3220
3211 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3240
3212 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3220 LET P(i)=2
3230 LET P$(i)="S2"
3235 GOTO 4201
3240 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3250
3241 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3270
3242 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3250 LET P(i)=17
3260 LET P$(i)="S17"
3265 GOTO 4201
3270 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3280
3271 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3300
3272 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3280 LET P(i)=3
3290 LET P$(i)="S3"
3295 GOTO 4201
3300 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3310
3301 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3330
3302 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3310 LET P(i)=19
3320 LET P$(i)="S19"
3325 GOTO 4201
3330 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3340
3331 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3360
3332 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3340 LET P(i)=7
3350 LET P$(i)="S7"
3355 GOTO 4201
3360 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3370
3361 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3390
3362 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3370 LET P(i)=16
3380 LET P$(i)="S16"
3385 GOTO 4201
3390 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3400
3391 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3420
3392 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3400 LET P(i)=8
3410 LET P$(i)="S8"
3415 GOTO 4201
3420 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3430
3421 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3450
3422 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3430 LET P(i)=11
3440 LET P$(i)="S11"
3445 GOTO 4201
3450 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3460
3451 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3480
3452 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3460 LET P(i)=14
3470 LET P$(i)="S14"
3475 GOTO 4201
3480 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3490
3481 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3510
3482 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3490 LET P(i)=9
3500 LET P$(i)="S9"
3505 GOTO 4201
3510 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3520
3511 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3540
3512 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3520 LET P(i)=12
3530 LET P$(i)="S12"
3535 GOTO 4201
3540 IF 0.49^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.76^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 3550
3541 IF 0.49^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.76^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 3580
3542 IF 0.49^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.76^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3550 LET P(i)=5
3560 LET P$(i)="S5"
3565 GOTO 4201
!3570
3580 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND x(i)*TAN(-81)<y(i) THEN GOTO 3590
3581 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR x(i)*TAN(-81)>y(i) THEN GOTO 3610
3582 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR x(i)*TAN(-81)=y(i) THEN GOTO 4190
3590 LET P(i)=40
3600 LET P$(i)="D20"
3605 GOTO 4201
3610 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(81) THEN GOTO 3620
3611 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(81) THEN GOTO 3640
3612 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(81) THEN GOTO 4190
3620 LET P(i)=2
3630 LET P$(i)="D1"
3635 GOTO 4201
3640 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3650
3641 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3670
3642 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3650 LET P(i)=36
3660 LET P$(i)="D18"
3665 GOTO 4201
3670 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3680
3671 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3700
3672 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3680 LET P(i)=8
3690 LET P$(i)="D4"
3695 GOTO 4201
3700 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3710
3701 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 3730
3702 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3710 LET P(i)=26
3720 LET P$(i)="D13"
3725 GOTO 4201
3730 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 3740
3731 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 3760
3732 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
3740 LET P(i)=12
3750 LET P$(i)="D6"
3755 GOTO 4201
3760 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 3770
3761 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 3790
3762 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
3770 LET P(i)=20
3780 LET P$(i)="D10"
3785 GOTO 4201
3790 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 3800
3791 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 3820
3792 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
3800 LET P(i)=30
3810 LET P$(i)="D15"
3815 GOTO 4201
3820 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 3830
3821 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 3850
3822 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
3830 LET P(i)=4
3840 LET P$(i)="D2"
3845 GOTO 4201
3850 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-81)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 3860
3851 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-81)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 3880
3852 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-81)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
3860 LET P(i)=34
3870 LET P$(i)="D17"
3875 GOTO 4201
3880 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND y(i)<x(i)*TAN(81) AND y(i)<x(i)*TAN(-81) THEN GOTO 3890
3881 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR y(i)>x(i)*TAN(81) OR y(i)>x(i)*TAN(-81) THEN GOTO 3910
3882 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR y(i)=x(i)*TAN(81) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
3890 LET P(i)=6
3900 LET P$(i)="D3"
3915 GOTO 4201
3910 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(81)<y(i) AND y(i)<x(i)*TAN(63) THEN GOTO 3920
3911 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(81)>y(i) OR y(i)>x(i)*TAN(63) THEN GOTO 3940
3912 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(81)=y(i) OR y(i)=x(i)*TAN(63) THEN GOTO 4190
3920 LET P(i)=38
3930 LET P$(i)="D19"
3935 GOTO 4201
3940 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(63)<y(i) AND y(i)<x(i)*TAN(45) THEN GOTO 3950
3941 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(63)>y(i) OR y(i)>x(i)*TAN(45) THEN GOTO 3970
3942 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(63)=y(i) OR y(i)=x(i)*TAN(45) THEN GOTO 4190
3950 LET P(i)=14
3960 LET P$(i)="D7"
3965 GOTO 4201
3970 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(45)<y(i) AND y(i)<x(i)*TAN(27) THEN GOTO 3980
3971 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(45)>y(i) OR y(i)>x(i)*TAN(27) THEN GOTO 4000
3972 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(45)=y(i) OR y(i)=x(i)*TAN(27) THEN GOTO 4190
3980 LET P(i)=32
3990 LET P$(i)="D16"
3995 GOTO 4201
4000 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(27)<y(i) AND y(i)<x(i)*TAN(9) THEN GOTO 4010
4001 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(27)>y(i) OR y(i)>x(i)*TAN(9) THEN GOTO 4030
4002 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(27)=y(i) OR y(i)=x(i)*TAN(9) THEN GOTO 4190
4010 LET P(i)=16
4020 LET P$(i)="D8"
4025 GOTO 4201
4030 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(9)<y(i) AND y(i)<x(i)*TAN(-9) THEN GOTO 4040
4031 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(9)>y(i) OR y(i)>x(i)*TAN(-9) THEN GOTO 4060
4032 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(9)=y(i) OR y(i)=x(i)*TAN(-9) THEN GOTO 4190
4040 LET P(i)=22
4050 LET P$(i)="D11"
4055 GOTO 4201
4060 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-9)<y(i) AND y(i)<x(i)*TAN(-27) THEN GOTO 4070
4061 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-9)>y(i) OR y(i)>x(i)*TAN(-27) THEN GOTO 4090
4062 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-9)=y(i) OR y(i)=x(i)*TAN(-27) THEN GOTO 4190
4070 LET P(i)=28
4080 LET P$(i)="D14"
4085 GOTO 4201
4090 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-27)<y(i) AND y(i)<x(i)*TAN(-45) THEN GOTO 4100
4091 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-27)>y(i) OR y(i)>x(i)*TAN(-45) THEN GOTO 4120
4092 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-27)=y(i) OR y(i)=x(i)*TAN(-45) THEN GOTO 4190
4100 LET P(i)=18
4110 LET P$(i)="D9"
4115 GOTO 4201
4120 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-45)<y(i) AND y(i)<x(i)*TAN(-63) THEN GOTO 4130
4121 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-45)>y(i) OR y(i)>x(i)*TAN(-63) THEN GOTO 4150
4122 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-45)=y(i) OR y(i)=x(i)*TAN(-63) THEN GOTO 4190
4130 LET P(i)=24
4140 LET P$(i)="D12"
4145 GOTO 4201
4150 IF 0.76^2<x(i)^2+y(i)^2 AND x(i)^2+y(i)^2<0.79^2 AND x(i)*TAN(-63)<y(i) AND y(i)<x(i)*TAN(-81) THEN GOTO 4160
4151 IF 0.76^2>x(i)^2+y(i)^2 OR x(i)^2+y(i)^2>0.79^2 OR x(i)*TAN(-63)>y(i) OR y(i)>x(i)*TAN(-81) THEN GOTO 4180
4152 IF 0.76^2=x(i)^2+y(i)^2 OR x(i)^2+y(i)^2=0.79^2 OR x(i)*TAN(-63)=y(i) OR y(i)=x(i)*TAN(-81) THEN GOTO 4190
4160 LET P(i)=10
4170 LET P$(i)="D5"
4175 GOTO 4201
4180 IF 0.79^2<x(i)^2+y(i)^2 THEN GOTO 4190
4190 LET P(i)=0
4200 LET P$(i)="Outboard"

4201 SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
SET TEXT COLOR 6
PLOT TEXT ,AT 0.7,0.9-MOD(i+2,3)/10 : STR$(P(i))
SET TEXT COLOR 4
PLOT TEXT ,AT 0.8,0.9-MOD(i+2,3)/10 : STR$(A-P(i))
SET TEXT FONT "ＭＳ明朝",10
SET TEXT COLOR 1

4210 IF A-P(i)=0 THEN GOTO 5000 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
REM 4211 IF A-P(i)=1 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4212 IF A-P(i)<0 THEN GOTO 4500 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4213 IF A-P(i)>0 THEN GOTO 4214 ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4214 LET A=A-P(i) ! エラーが起こるなら、A-P(i)-P(i+1)-P(i+2)、か、A-P(i)-P(i-1)-P(i-2)に正すこと。
4215 LET Z(i)=A
4216 GOTO 4700

4500 IF MOD(i,3)=0 THEN GOTO 4520 ! 3投目でBURSTになる場合、つまり、"ヒット、ヒット、バースト"の処理に回す。
IF MOD(i,3)=1 THEN GOTO 4510 ! 1投目でBURSTになる場合、つまり、"バースト"の処理に回す。
IF MOD(i,3)=2 THEN GOTO 4501 ! 2投目でBURSTになる場合、つまり、"ヒット、バースト"の処理に回す。
4501 !ヒット、バースト CHECK OK!!
LET Z(i)=A+P(i-1) ! i投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET Z(i+1)=A+P(i-1) ! i+1投目で「あと...」で表示される残り点数をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1) ! 持ち点をそのターンの1投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i-1)=0
LET P(i)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET i=i+1 ! 2投目でバーストなので、1投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4510 !バースト CHECK OK!! ここは、そのターンの1投目のバーストだから、4214行で点数を引かれていない。
4512 LET Z(i)=A ! i投目で「あと...」で表示される残り点数はそのまま。
LET A=A ! i投目の持ち点もそのまま。
LET P(i)=0
LET P(i+1)=0
LET P(i+2)=0
LET P$(i)=P$(i)&"BURST"
LET P$(i+1)="no count"&"BURST"
LET P$(i+2)="no count"&"BURST"
LET Z(i+1)=A ! i+1投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+2)=A ! i+2投目で「あと...」で表示される残り点数はそのまま。
LET Z(i+3)=A ! i+3投目で「あと...」で表示される残り点数はそのまま。
LET i=i+2 ! 1投目でバーストなので、2投分スキップした後、4900行で、そのまま次のターンの1投目に行く。
GOTO 4700
4520 !ヒット、ヒット、バースト CHECK OK!!
4521 LET Z(i)=A+P(i-1)+P(i-2) ! i投目で「あと...」で表示される残り点数をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET A=A+P(i-1)+P(i-2) ! 持ち点をそのターンの1投目と2投目のヒットのために4214行で引かれた点数分だけ元に戻す。
LET P(i)=0
LET P(i-1)=0
LET P(i-2)=0
LET P$(i)=P$(i)&"BURST"
LET i=i ! 3投目でバーストなので、0投分スキップした後、4900行で、そのまま次のターンの1投目に行ける。
GOTO 4700
4700 PRINT i,P$(i),P(i),Z(i),x(i),y(i)
4701 IF MOD(i,3)<>0 THEN GOTO 4800
4702 IF MOD(i,3)=0 THEN GOTO 4703
4703 WAIT DELAY 1
CLEAR
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.8)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-0.9)
DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
FOR g=1 TO 20
DRAW bar WITH ROTATE(18*g+9)*SCALE(0.64)*SHIFT(0.15*COS(18*g+9),0.15*SIN(18*g+9))
NEXT g
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(0)*SCALE(0.15)*SHIFT(-1,-0.9)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-1,-1)
DRAW bar WITH ROTATE(90)*SCALE(0.1)*SHIFT(-0.85,-1)
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT FONT "ＭＳゴシック" , 10
SET TEXT COLOR 1
PLOT TEXT ,AT 0.9*COS(18*0+90), 0.9*SIN(18*0+90) : "20"
PLOT TEXT ,AT 0.9*COS(18*(-19)+90), 0.9*SIN(18*(-19)+90) : "5"
PLOT TEXT ,AT 0.9*COS(18*(-18)+90), 0.9*SIN(18*(-18)+90) : "12"
PLOT TEXT ,AT 0.9*COS(18*(-17)+90), 0.9*SIN(18*(-17)+90) : "9"
PLOT TEXT ,AT 0.9*COS(18*(-16)+90), 0.9*SIN(18*(-16)+90) : "14"
PLOT TEXT ,AT 0.9*COS(18*(-15)+90), 0.9*SIN(18*(-15)+90) : "11"
PLOT TEXT ,AT 0.9*COS(18*(-14)+90), 0.9*SIN(18*(-14)+90) : "8"
PLOT TEXT ,AT 0.9*COS(18*(-13)+90), 0.9*SIN(18*(-13)+90) : "16"
PLOT TEXT ,AT 0.9*COS(18*(-12)+90), 0.9*SIN(18*(-12)+90) : "7"
PLOT TEXT ,AT 0.9*COS(18*(-11)+90), 0.9*SIN(18*(-11)+90) : "19"
PLOT TEXT ,AT 0.9*COS(18*(-10)+90), 0.9*SIN(18*(-10)+90) : "3"
PLOT TEXT ,AT 0.9*COS(18*(-9)+90), 0.9*SIN(18*(-9)+90) : "17"
PLOT TEXT ,AT 0.9*COS(18*(-8)+90), 0.9*SIN(18*(-8)+90) : "2"
PLOT TEXT ,AT 0.9*COS(18*(-7)+90), 0.9*SIN(18*(-7)+90) : "15"
PLOT TEXT ,AT 0.9*COS(18*(-6)+90), 0.9*SIN(18*(-6)+90) : "10"
PLOT TEXT ,AT 0.9*COS(18*(-5)+90), 0.9*SIN(18*(-5)+90) : "6"
PLOT TEXT ,AT 0.9*COS(18*(-4)+90), 0.9*SIN(18*(-4)+90) : "13"
PLOT TEXT ,AT 0.9*COS(18*(-3)+90), 0.9*SIN(18*(-3)+90) : "4"
PLOT TEXT ,AT 0.9*COS(18*(-2)+90), 0.9*SIN(18*(-2)+90) : "18"
PLOT TEXT ,AT 0.9*COS(18*(-1)+90), 0.9*SIN(18*(-1)+90) : "1"
PLOT TEXT ,AT -0.99,-0.99 : "quit"
PLOT TEXT ,AT -0.99,-0.89 : STR$(Z(i))
SET AREA COLOR LL
FOR h=1 TO 10
PAINT 0.48*COS(36*h),0.48*SIN(36*h)
PAINT 0.78*COS(36*h),0.78*SIN(36*h)
PAINT 0,0
NEXT h
SET AREA COLOR MM
FOR h=1 TO 10
PAINT 0.48*COS(36*h+18),0.48*SIN(36*h+18)
PAINT 0.78*COS(36*h+18),0.78*SIN(36*h+18)
PAINT 0.1,0.1
NEXT h
SET AREA COLOR NN
FOR h=1 TO 10
PAINT 0.2*COS(36*h),0.2*SIN(36*h)
PAINT 0.6*COS(36*h),0.6*SIN(36*h)
NEXT h
SET AREA COLOR OO
FOR h=1 TO 10
PAINT 0.2*COS(36*h+18),0.2*SIN(36*h+18)
PAINT 0.6*COS(36*h+18),0.6*SIN(36*h+18)
NEXT h
SET AREA COLOR 2
PAINT 0.8,0.8
PAINT -0.8,0.8
PAINT 0.8,-0.8
PAINT -0.8,-0.8
SET TEXT COLOR 6
SET TEXT FONT "ＭＳ明朝",15 ! ボード表示
PLOT TEXT ,AT -0.99,0.8 : STR$(B)&" GAME"
SET TEXT COLOR 1
SET TEXT FONT "ＭＳ明朝",10 ! ボード表示
4800 GOTO 4900
4900 NEXT i

5000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 5200
IF MOD(d,3)=1 THEN GOTO 5100
5100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
5200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Singleout!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 5600
IF MOD(k,3)=1 THEN GOTO 5500
5500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
5600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Singleout!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
GOTO 6700

6000 PRINT "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT TAB(10),PLAYERANAME$&"さん";" ";B;" GAME"
PRINT " あと";" x座標";" y座標"
FOR d=1 TO i
IF MOD(d,3)<>1 THEN GOTO 6200
IF MOD(d,3)=1 THEN GOTO 6100
6100 PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
REM PRINT TAB(10);"第";d;"投",P(d),P$(d),Z(d),x(d),y(d)
6200 PRINT "第";d;"投",P$(d)
PRINT USING " ###### ###### #.##### #.#####": P(d),Z(d),x(d),y(d)
NEXT d
PRINT "――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT " Quit!!"
PRINT "△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"

LET G$="D:\DARTS RESULT"
LET H$=".TXT"
LET I$=G$&H$
OPEN #1:NAME I$
SET #1: POINTER END
PRINT #1: DATE$&" "&TIME$
PRINT #1: "▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽練習結果▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽▽"
PRINT #1:TAB(10),PLAYERANAME$&"さん",B;" GAME"
PRINT #1:TAB(10),,,"あと","x座標","y座標"
FOR k=1 TO i
IF MOD(k,3)<>1 THEN GOTO 6600
IF MOD(k,3)=1 THEN GOTO 6500
6500 PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
6600 PRINT #1:TAB(10);"第";k;"投",P$(k),P(k),Z(k),x(k),y(k)
NEXT k
PRINT #1:"――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――"
PRINT #1:" Quit!!"
PRINT #1:"△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△△"
CLOSE #1
6700 END
EXTERNAL PICTURE circle
OPTION ANGLE DEGREES
FOR j=0 TO 360 STEP 4
PLOT LINES:COS(j*360/360),SIN(j*360/360);
NEXT j
END PICTURE

EXTERNAL PICTURE bar
OPTION ANGLE DEGREES
FOR k=0 TO 1
PLOT LINES:k,0;
NEXT k
END PICTURE

ダーツボード - gnuutera2012or文句うさびょん URL

2025/06/01 (Sun) 00:08:39

!black,blue,redで彩られたダーツボードです。
DECLARE EXTERNAL PICTURE circle
DECLARE EXTERNAL PICTURE bar
OPTION ANGLE DEGREES
SET WINDOW -1,1,-1,1
DRAW circle WITH ROTATE(0)*SCALE(0.05)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.15)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.46)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.49)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.76)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(0.79)*SHIFT(0,0)
DRAW circle WITH ROTATE(0)*SCALE(1)*SHIFT(0,0)
FOR i=1 TO 20
DRAW bar WITH ROTATE(18*i+9)*SCALE(0.64)*SHIFT(0.15*COS(18*i+9),0.15*SIN(18*i+9))
NEXT i
SET TEXT BACKGROUND "TRANSPARENT"
SET TEXT FONT "ＭＳゴシック" , 10
SET TEXT COLOR 1
PLOT TEXT ,AT COS(18*0+90)*0.9, SIN(18*0+90)*0.9 : "20"
PLOT TEXT ,AT COS(18*(-1)+90)*0.9, SIN(18*(-1)+90)*0.9 : "1"
PLOT TEXT ,AT COS(18*(-2)+90)*0.9, SIN(18*(-2)+90)*0.9 : "18"
PLOT TEXT ,AT COS(18*(-3)+90)*0.9, SIN(18*(-3)+90)*0.9 : "4"
PLOT TEXT ,AT COS(18*(-4)+90)*0.9, SIN(18*(-4)+90)*0.9 : "13"
PLOT TEXT ,AT COS(18*(-5)+90)*0.9, SIN(18*(-5)+90)*0.9 : "6"
PLOT TEXT ,AT COS(18*(-6)+90)*0.9, SIN(18*(-6)+90)*0.9 : "10"
PLOT TEXT ,AT COS(18*(-7)+90)*0.9, SIN(18*(-7)+90)*0.9 : "15"
PLOT TEXT ,AT COS(18*(-8)+90)*0.9, SIN(18*(-8)+90)*0.9 : "2"
PLOT TEXT ,AT COS(18*(-9)+90)*0.9, SIN(18*(-9)+90)*0.9 : "17"
PLOT TEXT ,AT COS(18*(-10)+90)*0.9, SIN(18*(-10)+90)*0.9 : "3"
PLOT TEXT ,AT COS(18*(-11)+90)*0.9, SIN(18*(-11)+90)*0.9 : "19"
PLOT TEXT ,AT COS(18*(-12)+90)*0.9, SIN(18*(-12)+90)*0.9 : "7"
PLOT TEXT ,AT COS(18*(-13)+90)*0.9, SIN(18*(-13)+90)*0.9 : "16"
PLOT TEXT ,AT COS(18*(-14)+90)*0.9, SIN(18*(-14)+90)*0.9 : "8"
PLOT TEXT ,AT COS(18*(-15)+90)*0.9, SIN(18*(-15)+90)*0.9 : "11"
PLOT TEXT ,AT COS(18*(-16)+90)*0.9, SIN(18*(-16)+90)*0.9 : "14"
PLOT TEXT ,AT COS(18*(-17)+90)*0.9, SIN(18*(-17)+90)*0.9 : "9"
PLOT TEXT ,AT COS(18*(-18)+90)*0.9, SIN(18*(-18)+90)*0.9 : "12"
PLOT TEXT ,AT COS(18*(-19)+90)*0.9, SIN(18*(-19)+90)*0.9 : "5"
SET AREA COLOR 2
FOR i=1 TO 10
PAINT 0.48*COS(36*i),0.48*SIN(36*i)
PAINT 0.78*COS(36*i),0.78*SIN(36*i)
PAINT 0,0
NEXT i
SET AREA COLOR 4
FOR i=1 TO 10
PAINT 0.48*COS(36*i+18),0.48*SIN(36*i+18)
PAINT 0.78*COS(36*i+18),0.78*SIN(36*i+18)
PAINT 0.1,0.1
NEXT i
SET AREA COLOR 0
FOR i=1 TO 10
PAINT 0.2*COS(36*i),0.2*SIN(36*i)
PAINT 0.6*COS(36*i),0.6*SIN(36*i)
NEXT i
SET AREA COLOR 1
FOR i=1 TO 10
PAINT 0.2*COS(36*i+18),0.2*SIN(36*i+18)
PAINT 0.6*COS(36*i+18),0.6*SIN(36*i+18)
NEXT i
SET POINT STYLE 4
LET n=100
DIM x(n)
DIM y(n)
PRINT "i";"x(i)";"y(i)"
FOR i=1 TO n
GET POINT: x(i),y(i)
PLOT POINTS: x(i),y(i)
PLOT TEXT ,AT x(i),y(i): STR$(i)
PRINT i;x(i);y(i)
NEXT i

END

EXTERNAL PICTURE circle
OPTION ANGLE DEGREES
FOR i=0 TO 1440
PLOT LINES:COS(i*360/1440),SIN(i*360/1440);
NEXT i
END PICTURE

EXTERNAL PICTURE bar
OPTION ANGLE DEGREES
FOR i=0 TO 1
PLOT LINES:i,0;
NEXT i
END PICTURE

背景色と文字色によっては描画されません - しばっち

2025/05/25 (Sun) 07:27:16

Windows 64bit版Lazarus版BASICで背景色によって
文字が描画されません。

動作モード(2進、10進、複素数など)によっても挙動が
若干異なるようです。

SET WINDOW 0,10,10,0
SET TEXT HEIGHT 1.5
FOR I=0 TO 9
SET AREA COLOR I
PLOT AREA :0,0;10,0;10,10;0,10
FOR J=0 TO 9
SET TEXT COLOR J
PLOT TEXT ,AT J,5:STR$(J)
NEXT J
WAIT DELAY 3
NEXT I
END

Re: 背景色と文字色によっては描画されません - SHIRAISHI Kazuo

2025/05/25 (Sun) 15:08:26

背景色の問題というよりは描画をさぼっている感じです。
不具合があるのは Ver. 0.7.5 でしょうか？
Ver. 0.9では問題ないようです。

Re: 背景色と文字色によっては描画されません - SHIRAISHI Kazuo

2025/05/25 (Sun) 21:06:39

WAIT DELAYの問題かも知れません。精度を上げようとして負荷をかけすぎたようです。

Re: 背景色と文字色によっては描画されません - SHIRAISHI Kazuo

2025/05/28 (Wed) 06:39:36

修正版 Ver. 0.7.5.8 作成しました。
https://decimalbasic.web.fc2.com/BASICGenJa.htm

オセロゲーム - しばっち

2025/05/05 (Mon) 07:41:03

オセロゲームの移植版です。

キー入力による操作です。マウスは使用しません。

DECLARE EXTERNAL FUNCTION INKEY$
DECLARE EXTERNAL FUNCTION INPUT$
10 DIM V(8,8),N$(2),P(10),M(10)
CALL GINIT(640,400)
CALL GCOLOR(7)
40 CLEAR
GOSUB 660
50 CALL BOXFULL(0,0,639,399,4)
CALL BOXFULL(10,10,190*2,190*2,6)
FOR A=0 TO 7
FOR B=0 TO 7
60 CALL BOX(15+(A*20+10)*2,10+(B*20+10)*2,15+(A*20+30)*2,10+(B*20+30)*2,0)
NEXT B
NEXT A
70 CALL GPRINT(6,0,"1")
CALL GPRINT(11,0,"2")
CALL GPRINT(16,0,"3")
CALL GPRINT(21,0,"4")
CALL GPRINT(26,0,"5")
CALL GPRINT(31,0,"6")
CALL GPRINT(36,0,"7")
CALL GPRINT(41,0,"8")
CALL GPRINT(48,0,"--- COMPUTER OTHELLO ---")
80 FOR A=1 TO 8
CALL GPRINT(0,A*2.5+1,CHR$(48+A))
NEXT A
90 RESTORE 100
FOR A=1 TO 4
READ X,Y,CO
GOSUB 630
LET V(X,Y)=CO+1
NEXT A
100 DATA 4,4,7,5,4,0,4,5,0,5,5,7
110 CALL GPRINT(54,2,"先手(黒) ")
CALL GPRINT(54,4,"後手(白) ")
120 CALL GPRINT(52,6," --- 順番 ---")
130 CALL GPRINT(51,8,"対戦(0) / 先手(1) / 後手(2)")
DO
LET X$=INKEY$
LOOP WHILE X$=""
140 LET J=VAL(X$)
IF J>2 THEN LET J=2
150 IF J=0 THEN
LET N$(1)="PLAYER-1 "
LET N$(2)="PLAYER-2 "
GOTO 170
END IF
IF J=2 THEN LET JN=J-1 ELSE LET JN=J+1
160 LET N$(J)="PLAYER-1 "
LET N$(JN)="COMPUTER "
170 CALL GPRINT(63,2,N$(1))
CALL GPRINT(63,4,N$(2))
180 CALL GPRINT(52,6,"--- キー入力 ---")
CALL GPRINT(55,15,"--- パス ---")
190 CALL GPRINT(51,8," [E] 終了 ")
CALL GPRINT(54,17,N$(1)&" "&STR$(P(1)))
200 CALL GPRINT(54,9,"[P] パス")
LET E=0
CALL GPRINT(54,19,N$(2)&" "&STR$(P(2)))
210 IF E=60 THEN
GOTO 540
ELSE
LET F=1
GOTO 300
END IF
220 LET CO=0
LET K=8
IF J+1=1 OR J+1=2 THEN GOSUB 250
IF J+1=3 THEN GOSUB 380
IF KK=0 THEN
GOTO 210
ELSE
LET E=E+1
END IF
230 IF E=60 THEN
GOTO 540
ELSE
LET F=2
GOTO 300
END IF
240 LET CO=7
LET K=1
IF J+1=1 OR J+1=3 THEN GOSUB 250
IF J+1=2 THEN GOSUB 380
IF KK=0 THEN
GOTO 230
ELSE
LET E=E+1
GOTO 210
END IF
250 LET KX=X
LET KY=Y
FOR AX=-1 TO 1
FOR AY=-1 TO 1
IF AX=0 AND AY=0 THEN CALL GCOLOR(0) ELSE LET N=2
260 LET A=KX+AX*N
LET B=KY+AY*N
IF A<1 OR A>8 OR B<1 OR B>8 OR KX+AX>8 OR KX+AX<1 OR KY+AY<1 OR KY+AY>8 THEN
GOTO 290
ELSE
IF V(KX+AX*(N-1),KY+AY*(N-1))<>K THEN 290
END IF
270 IF V(A,B)<>CO+1 THEN
LET N=N+1
GOTO 260
ELSE
LET CO=CO
LET KK=1
END IF
280 FOR I=0 TO N
LET X=KX+AX*I
LET Y=KY+AY*I
GOSUB 630
LET V(X,Y)=CO+1
NEXT I
LET X=KX
LET Y=KY
GOSUB 630
290 NEXT AY
NEXT AX
RETURN
300 FOR Z=0 TO 5
NEXT Z
CALL GPRINT(52,11,N$(F)&"の番です｡ ")
LET KK=0
CALL GPRINT(55,13," ")
310 IF J+F=3 THEN 370
320 FOR Z=0 TO 5
NEXT Z
CALL GPRINT(55,13," ")
CALL GPRINT(55,13,"横=")
DO
LET X$=INKEY$
LOOP WHILE X$=""
CALL GPRINT(59,13,X$)
FOR Z=0 TO 1500
NEXT Z
330 IF X$="E" OR X$="e" THEN
GOTO 540
ELSE
IF X$="P" OR X$="p" THEN 490
END IF
340 LET X=VAL(X$)
IF X=0 OR X=9 THEN 320
350 CALL GPRINT(64,13," ")
CALL GPRINT(64,13,"縦=")
DO
LET X$=INKEY$
LOOP WHILE X$=""
LET Y=VAL(X$)
CALL GPRINT(68,13,STR$(Y))
360 IF Y=0 OR Y=9 THEN
GOTO 350
ELSE
IF V(X,Y)<>0 THEN 320
END IF
370 IF F=1 THEN 220
IF F=2 THEN 240
380 RESTORE 430
390 READ X,Y
IF X=9 THEN 490
400 IF V(X,Y)<>0 THEN 390
IF JN=2 THEN LET CO=7 ELSE LET CO=0
410 GOSUB 250
420 IF KK=0 THEN
GOTO 390
ELSE
RETURN
END IF
430 DATA 1,8,8,1,1,1,8,8,3,3,6,3,3,6,6,6,1,6,8,3
440 DATA 3,1,6,8,8,6,1,3,6,1,3,8,2,6,2,3,3,2,6,2
450 DATA 7,3,7,6,3,7,6,7,4,3,5,6,3,4,6,5,3,5,5,3
460 DATA 4,6,6,4,4,7,5,7,4,2,7,5,2,4,2,5,7,4,1,5
470 DATA 4,1,5,2,5,8,8,5,4,8,1,4,5,1,8,4,2,2,7,1
480 DATA 7,8,2,7,1,2,7,2,8,7,1,7,2,1,8,2,2,8,7,7,9,0
490 CALL GPRINT(54,13,N$(F)&" パス ")
FOR Z=0 TO 2000
NEXT Z
500 LET P(F)=P(F)+1
IF P(F)=3 THEN 540
510 FOR I=0 TO 1000
NEXT I
CALL GPRINT(54,2*F+15,N$(F)&" "&STR$(P(F)))
520 CALL GPRINT(54,13,REPEAT$(" ",18))
IF J+F=3 THEN
LET E=E-1
LET KK=1
RETURN
END IF
IF F=1 THEN 230
IF F=2 THEN 210
540 CALL GCOLOR(2)
CALL GPRINT(53,15,"-- GAME END --")
CALL GCOLOR(0)
550 FOR A=1 TO 8
FOR B=1 TO 8
LET M(V(A,B))=M(V(A,B))+1
NEXT B
NEXT A
560 CALL GPRINT(54,17,N$(1)&" "&STR$(M(1)))
570 CALL GPRINT(54,19,N$(2)&" "&STR$(M(8)))
580 LET SS=ABS(M(1)-M(8))
IF M(1)>M(8) THEN LET F=1 ELSE LET F=2
590 IF SS>0 THEN CALL GPRINT(52,11,N$(F)&"の勝ちです ") ELSE CALL GPRINT(52,11,"ひきわけです ")
600 CALL GPRINT(52,13,"HIT [RETURN] KEY")
610 LET A$=INPUT$(1)
IF A$=CHR$(13) THEN 40 ELSE 600
630 CALL CIRCLEFULL(X*20*2+15,Y*20*2+10,15,CO)
640 RETURN
660 FOR C=1 TO 7
670 CALL GCOLOR(C)
CALL GPRINT(27,5,"COMPUTER OTHELLO")
680 CALL GCOLOR(C-1)
CALL GPRINT(25,18,"PUSH [SPACE] KEY TO START!")
690 LET I$=INKEY$
700 IF I$=" " THEN RETURN
710 NEXT C
GOTO 660
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT FONT "ＭＳゴシック",0
SET TEXT HEIGHT 12
END SUB

EXTERNAL SUB GPRINT(X,Y,A$)
FOR I=1 TO LEN(A$)
LET AA$=MID$(A$,I,1)
ASK TEXT COLOR C
ASK PIXEL VALUE(XX+INT(X)*8,INT(Y)*16) CC
IF BLEN(AA$)<>LEN(AA$) THEN
CALL BOXFULL(XX+INT(X)*8,INT(Y)*16,XX+INT(X)*8+15,INT(Y)*16+15,CC)
ELSE
CALL BOXFULL(XX+INT(X)*8,INT(Y)*16,XX+INT(X)*8+7,INT(Y)*16+15,CC)
END IF
SET COLOR C
PLOT TEXT,AT XX+INT(X)*8,INT(Y)*16:AA$
IF BLEN(AA$)<>LEN(AA$) THEN LET XX=XX+16 ELSE LET XX=XX+8
NEXT I
END SUB

EXTERNAL SUB GCOLOR(C)
SET TEXT COLOR C
END SUB

EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES
PLOT LINES:XS,YS;XE,YE
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

EXTERNAL SUB CIRCLEFULL(X,Y,RR,C)
SET COLOR C
DRAW DISK WITH SCALE(RR)*SHIFT(X,Y)
END SUB

EXTERNAL FUNCTION INKEY$
SET ECHO "OFF"
LET S$=""
CHARACTER INPUT NOWAIT:S$
LET INKEY$=S$
END FUNCTION

EXTERNAL FUNCTION INPUT$(N)
SET ECHO "OFF"
FOR I=1 TO N
DO
LET X$=""
CHARACTER INPUT NOWAIT:X$
LOOP WHILE X$=""
LET S$=S$&X$
NEXT I
LET INPUT$=S$
END FUNCTION

EXTERNAL SUB BOX(XS,YS,XE,YE,C)
CALL LINE(XS,YS,XE,YS,C)
CALL LINE(XE,YS,XE,YE,C)
CALL LINE(XE,YE,XS,YE,C)
CALL LINE(XS,YE,XS,YS,C)
END SUB

グラフィックデモ - しばっち

2025/01/26 (Sun) 07:39:50

サンプルの文章にgnuutera2012or文句うさびょんさんの投稿ネタを使用しました。

OPTION ANGLE DEGREES
DIM MOV(4,4)
LET XSIZE=1000
LET YSIZE=600
CALL GINIT(XSIZE,YSIZE)
SET WINDOW -XSIZE/2,XSIZE/2,-YSIZE/2,YSIZE/2
DIM A$(50)
FOR N=1 TO 50
READ IF MISSING THEN EXIT FOR:A$(N)
NEXT N
LET YMOVE=.002
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT COLOR COLORINDEX(0,0,0)
LET HEIGHT=12
SET TEXT HEIGHT HEIGHT
SET TEXT BACKGROUND "OPAQUE"
MAT MOV=IDN
LET MOV(1,4)=XMOVE
LET MOV(2,4)=YMOVE
LET MOV(3,4)=ZMOVE
FOR I=1 TO 85
SET DRAW MODE HIDDEN
CLEAR
FOR J=I TO 1 STEP -1
IF J=1 AND I<=N THEN
SET DRAW MODE EXPLICIT
FOR K=1 TO LEN(A$(I-J+1))
IF I<=N THEN DRAW WORD(A$(I)(1:K),0,-YSIZE/2+(HEIGHT+5)*(J+6)) WITH MOV
NEXT K
ELSE
IF I-J+1<=N AND -YSIZE/2+(HEIGHT+5)*J<YSIZE/2 THEN DRAW WORD(A$(I-J+1),0,-YSIZE/2+(HEIGHT+5)*(J+6)) WITH MOV
END IF
NEXT J
SET DRAW MODE EXPLICIT
WAIT DELAY .1
NEXT I
DATA "昔々、あるところにお殿様とお姫様がいました。"
DATA "お殿様は山へ鷹狩りに、お姫様は川へお茶会に行きました。"
DATA "お姫様が洗濯をしていると、川から大きなピーチパイがえんやーとっとえんやーとっとと流れてきました。"
DATA "お姫様はお殿様とピーチパイを食べようと思って、大きなピーチパイを家に持ち帰りました。"
DATA "山から帰ってきたお殿様は、大きなピーチパイだと早速包丁で切ろうとしたところ"
DATA "ピーチパイの中から女の赤ん坊が元気よく飛び出してきました。"
DATA "お殿様は赤ん坊に桃姫と名づけました。"
DATA "桃姫はすくすくと育っていき、やがて立派に育つと"
DATA "お殿様とお姫様にダンサーヶ島へダンサー勝負に行きたいと申し出ました。"
DATA "お殿様とお姫様は、恐ろしいダンサーが住んでいるダンサーヶ島へ"
DATA "桃姫を行かせまいと必死になだめますが、桃姫は頑としてききません。"
DATA "仕方なくお殿様は桃姫にLEDサイネージと蛍光塗料を"
DATA "お姫様は、衣装と日本一の旗を揃え桃姫に授けました。"
DATA "桃姫が出発する日に、お姫様は道中の腹ごしらえにと"
DATA "プロテインを桃姫に持たせました。"
DATA "桃姫はお殿様、お姫様に「行って参ります」と元気よく出発しました。"
DATA "桃姫が歩いていると、道の向かいからケンが「ヒャッハー！」桃姫さん"
DATA "お腰につけたプロテインを一つくれたら家来になりましょう「ヒャッハー！」と頼むので"
DATA "桃姫はケンにプロテインを一つ分けてやりました。"
DATA "桃姫とケンが道を歩いて行くと、道の向かいからモンタナが「あらよっと！」桃姫さん"
DATA "お腰につけたプロテインを一つくれたら家来になりましょう「あらよっと！」と頼むので"
DATA "桃姫はモンタナにもプロテインを一つ分けてやりました。"
DATA "桃姫とケンとモンタナが道を歩いて行くと、道の向かいから太郎が（♪♪♪♪♪）桃姫さん"
DATA "お腰につけたプロテインを一つくれたら家来になりましょう（♪♪♪♪♪）と頼むので"
DATA "桃姫は太郎にもプロテインを一つ分けてやりました。"
DATA "こうしてケン、モンタナ、太郎をお供に従えた桃姫は、舟に乗って"
DATA "ダンサーヶ島に着きました。"
DATA "ダンサーヶ島では恐ろしいダンサー達が宴の真っ最中。"
DATA "ダンサー共、この桃姫が成敗してくれる。"
DATA "桃姫はLEDサイネージと蛍光塗料でダンサー達に迫ります。"
DATA "ケン、モンタナ、太郎もそこへ襲いかかります。"
DATA "ケンはダンサーに握手します。"
DATA "モンタナはダンサーに握手します。"
DATA "太郎は空からダンサーと握手します。"
DATA "さすがのダンサー共も降参しました。"
DATA "桃姫さん。助けてください。"
DATA "ダンサーヶ島の宝物を全部差し上げます。"
DATA "もう悪いことは致しません。"
DATA "必死でダンサー達が頼むので、桃姫は"
DATA "「良いだろう。もうダンスはするなよ。」とダンサー達を許してやりました。"
DATA "こうして、宝物を舟に積んでダンサー達に見送られながら"
DATA "桃姫、ケン、モンタナ、太郎の一行はダンサーヶ島をあとにしました。"
DATA "桃姫、ケン、モンタナ、太郎がお殿様とお姫様の家に着くと"
DATA "お殿様とお姫様は大層喜びました。"
DATA "桃姫は、ダンサーヶ島でダンサー達を成敗したこと"
DATA "ダンサー達にもらった宝物のことを話しました。"
DATA "ダンサー達にもらった宝物で桃姫、お殿様、お姫様"
DATA "ケン、モンタナ、太郎はいつまでも楽しく暮らしたということです。"
DATA "めでたしめでたし。"
END

EXTERNAL PICTURE WORD(A$,XS,YS)
DIM M(4,4)
MAT M=TRANSFORM
IF DET(M)<>0 THEN
PLOT LETTERS, AT XS,YS:A$
END IF
END PICTURE

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,0,YSIZE-1
SET POINT STYLE 1
SET COLOR MODE "NATIVE"
CLEAR
END SUB

Re: グラフィックデモ - gnuutera2012or文句うさびょん URL

2025/05/02 (Fri) 10:52:33

恐縮です。十進BASIC初心者です。
今後もどうかよろしくご指導のほど、お願い申しあげます。

日本語化 - しばっち

2025/04/13 (Sun) 07:56:22

日本語化

十進BASICを日本語表示します。

十進BASIC初心者向けにプログラム理解の補助のため
十進BASICの命令を日本語化して表示します。

但し、全ての命令や書き方に対応しているわけではありません。

このプログラムは単純な置換処理です。プログラム構造を解析しているわけではありません。
命令語を含んだ変数名や関数名などを誤変換する場合があります。

Paract Basic(並列処理関係)は未サポートです。

プログラムの処理上の都合により全て小文字に変換しています。

試しに変換してみた。(一部のみ)

開くダイアログ f$,"BASファイル|*.bas"
もし f$="" 成立なら実行停止
ファイルを開く #1: 名前 f$
画面表示 f$
画面表示繰り返し文字("-",60)
DO繰り返し
ラインファイル入力 1 ファイルが終わったら DOループ脱出 :text$
もし前方空白削除(text$)<>"" 成立なら
代入文 text$=changedeclaration$(text$) 注釈宣言文変換
代入文 text$=changefunc$(text$) 注釈関数変換
代入文 text$=changestate$(text$) 注釈命令文変換
代入文 text$=changestate2$(text$) 注釈命令文変換
IF文ここまで
画面表示 text$
LOOP ここまで
ファイルを閉じる #1
主プログラムここまで

外部関数定義 changedeclaration$(text$) 注釈宣言文変換
もし前方空白削除(text$)="" 成立なら
代入文 changedeclaration$=""
関数定義脱出
IF文ここまで
代入文 p=文字列検索(text$,文字コード(34))
もし p>0 成立なら
代入文 p2=文字列検索(text$,文字コード(34),p+1)
代入文 changedeclaration$=changedeclaration$(text$(1:p-1))&text$(p:p2)&changedeclaration$(text$(p2+1:文字列長(text$)))
関数定義脱出
IF文ここまで
代入文 r1=文字列検索(text$,"rem ")
代入文 r2=文字列検索(text$,"!")
もし r1>0 成立なら
代入文 text$=transform$(text$,"rem ","注釈")
IF文ここまで
もし r2>0 成立なら
代入文 text$=transform$(text$,"!","注釈")
IF文ここまで
代入文 r3=文字列検索(text$,"注釈")
もし r3>0 成立なら
代入文 changedeclaration$=changedeclaration$(text$(1:r3-1))&text$(r3:文字列長(text$))
関数定義脱出
IF文ここまで
DO繰り返し
代入文 l=文字列検索(text$," (")
もし l>0 成立なら代入文 text$=transform2$(text$," (","(") 不成立なら DOループ脱出注釈「SQR (」を「SQR(」へ
LOOP ここまで
DO繰り返し
代入文 l=文字列検索(text$," ,")
もし l>0 成立なら代入文 text$=transform2$(text$," ,",",") 不成立なら DOループ脱出
LOOP ここまで
DO繰り返し
代入文 l=文字列検索(text$," :")
もし l>0 成立なら代入文 text$=transform2$(text$," :",":") 不成立なら DOループ脱出
LOOP ここまで
DO繰り返し
代入文 l=文字列検索(text$," #")
もし l>0 成立なら代入文 text$=transform2$(text$," #","#") 不成立なら DOループ脱出
LOOP ここまで
代入文 text$=小文字化(text$) 注釈全て小文字に変換
読み込みリセット
DO繰り返し
データが尽きたら DOループ脱出 :a$,b$
代入文 l=文字列検索(text$,a$)
もし l>0 成立なら代入文 text$=transform$(text$,a$,b$)
LOOP ここまで
代入文 changedeclaration$=text$
注釈 DATA "rem ","注釈 "
注釈 DATA "!","注釈 "
データ文 "randomize","乱数列初期化"
データ文 "dim ","配列宣言"
データ文 "declare ","宣言文"

以下略
---------------------------------------------------------------------------------
FILE GETOPENNAME F$,"BASファイル|*.bas"
IF F$="" THEN STOP
OPEN #1:NAME F$
PRINT F$
PRINT REPEAT$("-",60)
DO
LINE INPUT #1,IF MISSING THEN EXIT DO:TEXT$
PRINT CHANGE$(TEXT$)
LOOP
CLOSE #1
END

EXTERNAL FUNCTION CHANGE$(TEXT$)
IF LTRIM$(TEXT$)="" THEN
LET CHANGE$=""
EXIT FUNCTION
END IF
LET P=POS(TEXT$,CHR$(34))
IF P>0 THEN
LET P2=POS(TEXT$,CHR$(34),P+1)
LET CHANGE$=CHANGE$(TEXT$(1:P-1))&TEXT$(P:P2)&CHANGE$(TEXT$(P2+1:LEN(TEXT$)))
EXIT FUNCTION
END IF
LET R1=POS(TEXT$,"rem ")
LET R2=POS(TEXT$,"!")
LET R3=POS(TEXT$,"REM ")
IF R1>0 THEN
LET TEXT$=TRANSFORM$(TEXT$,"rem ","注釈")
END IF
IF R2>0 THEN
LET TEXT$=TRANSFORM$(TEXT$,"!","注釈")
END IF
IF R3>0 THEN
LET TEXT$=TRANSFORM$(TEXT$,"REM ","注釈")
END IF
LET R3=POS(TEXT$,"注釈")
IF R3>0 THEN
LET CHANGE$=CHANGE$(TEXT$(1:R3-1))&TEXT$(R3:LEN(TEXT$))
EXIT FUNCTION
END IF
DO
LET L=POS(TEXT$," (")
IF L>0 THEN LET TEXT$=TRANSFORM2$(TEXT$," (","(") ELSE EXIT DO
LOOP
DO
LET L=POS(TEXT$," ,")
IF L>0 THEN LET TEXT$=TRANSFORM2$(TEXT$," ,",",") ELSE EXIT DO
LOOP
DO
LET L=POS(TEXT$,", ")
IF L>0 THEN LET TEXT$=TRANSFORM2$(TEXT$,", ",",") ELSE EXIT DO
LOOP
DO
LET L=POS(TEXT$," :")
IF L>0 THEN LET TEXT$=TRANSFORM2$(TEXT$," :",":") ELSE EXIT DO
LOOP
DO
LET L=POS(TEXT$,": ")
IF L>0 THEN LET TEXT$=TRANSFORM2$(TEXT$,": ",":") ELSE EXIT DO
LOOP
DO
LET L=POS(TEXT$," #")
IF L>0 THEN LET TEXT$=TRANSFORM2$(TEXT$," #","#") ELSE EXIT DO
LOOP
LET TEXT$=LCASE$(TEXT$) ! 全て小文字に変換
LET TEXT$=CHANGEDECLARATION$(TEXT$) ! 宣言文変換
LET TEXT$=CHANGEFUNC$(TEXT$) ! 関数変換
LET TEXT$=CHANGEFUNC2$(TEXT$) ! 関数変換
LET TEXT$=CHANGESTATE$(TEXT$) ! 命令文変換
LET CHANGE$=CHANGESTATE2$(TEXT$) ! 命令文変換
!!LET CHANGE$=CHANGESTATE2$(CHANGESTATE$(CHANGEFUNC2$(CHANGEFUNC$(CHANGEDECLARATION$(LCASE$(TEXT$))))))
END FUNCTION

EXTERNAL FUNCTION CHANGEDECLARATION$(TEXT$) !宣言文変換
RESTORE
DO
READ IF MISSING THEN EXIT DO:A$,B$
LET L=POS(TEXT$,A$)
IF L>0 THEN LET TEXT$=TRANSFORM$(TEXT$,A$,B$)
LOOP
LET CHANGEDECLARATION$=TEXT$
!DATA "rem ","注釈 "
!DATA "!","注釈 "
DATA "randomize","乱数列初期化"
DATA "dim ","配列宣言"
DATA "declare ","宣言文"
DATA "program ","プログラム名"
DATA "public ","広域"
DATA "numeric ","数値変数を宣言"
DATA "string ","文字変数を宣言"
DATA "option angle radians","ラジアンモード"
DATA "option angle degrees","度数モード"
DATA "option arithmetic native","2進モード"
DATA "option arithmetic decimal_high","1000桁モード"
DATA "option arithmetic complex","複素数モード"
DATA "option arithmetic rational","有理数モード"
DATA "option character byte","バイト単位モード"
DATA "option character kanji","漢字モード"
DATA "option base","添え字下限指定"
END FUNCTION

EXTERNAL FUNCTION CHANGEFUNC$(TEXT$) ! 関数変換
RESTORE
DO
READ IF MISSING THEN EXIT DO:A$,B$
DO
LET L=POS(TEXT$,A$)
IF L>0 AND POS(" +-*/=()<>,;^:",TEXT$(L-1:L-1))>0 THEN LET TEXT$=TRANSFORM2$(TEXT$,A$,B$) ELSE EXIT DO ! 1つ手前の文字が「 +-*/=()<>,;^:」なら
LOOP
LOOP
LET CHANGEFUNC$=TEXT$
DATA "abs(","絶対値("
DATA "acos(","逆余弦("
DATA "asin(","逆正弦("
DATA "atn(","逆正接("
DATA "arg(","偏角("
DATA "bitand(","論理積("
DATA "bitor(","論理和("
DATA "bitnot(","論理反転("
DATA "bitxor(","排他的論理和("
DATA "blen(","バイト長("
DATA "len(","文字列長("
DATA "ceil(","最小の整数("
DATA "re(","実部("
DATA "im(","虚部("
DATA "conj(","共役複素数("
DATA "intsqr(","整数化平方根("
DATA "intlog2(","整数化2を底とする対数("
DATA "sqr(","平方根("
DATA "sin(","正弦("
DATA "cos(","余弦("
DATA "tan(","正接("
DATA "csc(","余割("
DATA "sec(","正割("
DATA "cot(","余接("
DATA "exp(","指数("
DATA "log(","自然対数("
DATA "log2(","2を底とする対数("
DATA "log10(","常用対数("
DATA "int(","最大の整数("
DATA "ip(","整数部("
DATA "fp(","小数部("
DATA "complex(","複素数("
DATA "ord(","文字コード("
DATA "mod(","余り("
DATA "round(","丸めた値("
DATA "sgn(","符号("
DATA "bstr$(","文字化("
DATA "bval(","数値化("
DATA "str$(","文字化("
DATA "chr$(","文字コード("
DATA "mid$(","部分文字列("
DATA "val(","数値化("
DATA "pos(","文字列検索("
DATA "repeat$(","繰り返し文字("
DATA "using$(","書式化("
DATA "ip(","整数部("
DATA "fp(","小数部("
DATA "remainder(","余り("
DATA "truncate(","四捨五入("
DATA "angel(","角度("
DATA "sinh(","双曲線正弦("
DATA "cosh(","双曲線余弦("
DATA "tanh(","双曲線正接("
DATA "eps(","差の絶対値の大きい方("
DATA "max(","大きい方("
DATA "min(","小さい方("
DATA "deg(","度へ変換("
DATA "rad(","ラジアンへ変換("
DATA "fact(","階乗("
DATA "comb(","二項係数("
DATA "perm(","順列の数("
DATA "lcase$(","小文字化("
DATA "ucase$(","大文字化("
DATA "ltrim$(","前方空白削除("
DATA "rtrim$(","後方空白削除("
DATA "subst$(","部分文字列("
DATA "left$(","始めの文字列("
DATA "right$(","末尾の文字列("
DATA "getkeystate(","キーの状態("
DATA "dot(","内積("
DATA "confirm$(","選択待ち("
DATA "numer(","分子("
DATA "denom(","分母("
DATA "gcd(","最大公約数("
DATA "lbound(","添え字の下限("
DATA "ubound(","添え字の上限("
DATA "maxsize(","要素数の上限("
DATA "size(","全要素数("
DATA "det(","行列式("
DATA "winhandle(","ハンドル値("
DATA "byte$(","8ビット非負整数イメージ("
DATA "dword$(","32ビット非負整数イメージ("
DATA "word$(","16ビット非負整数イメージ("
DATA "packdbl$(","倍精度実数イメージ("
DATA "unpackdbl(","倍精度実数値("
DATA "pixelx(","問題座標xに対応するピクセルx座標("
DATA "pixely(","問題座標yに対応するピクセルy座標("
DATA "worldx(","ピクセルx座標を問題座標に変換("
DATA "worldy(","ピクセルy座標を問題座標に変換("
DATA "problemx(","ピクセルx座標を問題座標に変換("
DATA "problemy(","ピクセルy座標を問題座標に変換("
DATA "colorindex(","色指標("
DATA "inv(","逆行列("
DATA "con(","添え字の上限を変更して全要素を1にする"
DATA "zer(","添え字の上限を変更して全要素を0にする"
DATA "idn(","単位行列を代入"
DATA "trn(","転置行列("
DATA "cross(","外積("
DATA "files(","ファイル名リスト("
END FUNCTION

EXTERNAL FUNCTION CHANGEFUNC2$(TEXT$) ! 関数変換2 "("がつかないもの
RESTORE
DO
READ IF MISSING THEN EXIT DO:A$,B$
DO
LET L=POS(TEXT$,A$)
IF L>0 AND (TEXT$(L+LEN(A$):L+LEN(A$))="" OR POS(" !+-*/=);,^<>",TEXT$(L+LEN(A$):L+LEN(A$)))>0) AND POS(" +-*/=()<>,;^:",TEXT$(L-1:L-1))>0 THEN LET TEXT$=TRANSFORM2$(TEXT$,A$,B$) ELSE EXIT DO
LOOP
LOOP
LET CHANGEFUNC2$=TEXT$
DATA "rnd","乱数"
DATA "maxnum","最大の正の数"
DATA "time$","現在時刻"
DATA "date$","現在日時"
DATA "time","経過秒数"
DATA "date","現在日時"
DATA "pi","円周率"
DATA "zer","配列に0を代入"
DATA "con","配列に1を代入"
DATA "idn","単位行列を代入"
DATA "nul$","空文字列"
END FUNCTION

EXTERNAL FUNCTION CHANGESTATE$(TEXT$) !SET ASK
RESTORE
DO
READ IF MISSING THEN EXIT DO:A$,B$
DO
LET L=POS(TEXT$,A$)
IF L>0 THEN LET TEXT$=TRANSFORM$(TEXT$,A$,B$) ELSE EXIT DO
LOOP
LOOP
LET CHANGESTATE$=TEXT$
DATA "set area style index","塗りつぶし方"
DATA "set area style","塗りつぶし方"
DATA "ask pixel size","画素数"
DATA "ask bitmap size","画素数読み出し"
DATA "set bitmap size","画素数設定"
DATA "ask area color","領域色取得"
DATA "ask character pending","先行入力バッファサイズ"
DATA "set color mix","パレット設定"
DATA "ask color mix","パレット読み出し"
DATA "set line color","ライン色設定"
DATA "set point color","点色設定"
DATA "set area color","領域色設定"
DATA "set color mode","カラーモード設定"
DATA "ask color mode","カラーモード取得"
DATA "ask area color","エリア色指標取得"
DATA "ask line color","線色指標取得"
DATA "ask line style","線種取得"
DATA "set line width","線の太さ設定"
DATA "ask line width","線の太さ取得"
DATA "ask point color","点色指標取得"
DATA "ask point style","点スタイル取得"
DATA "set point style","点スタイル設定"
DATA "set directory","カレントディレクトリ設定"
DATA "ask directory","カレントディレクトリ取得"
DATA "ask pixel array","各画素の色指標"
DATA "ask pixel value","色指標取得"
DATA "ask text color","テキストの色指標取得"
DATA "set text color","テキストの色指標設定"
DATA "set text height","テキストの高さ設定"
DATA "ask text height","テキストの高さ取得"
DATA "set text font","フォント設定"
DATA "set text justify","文字列基準位置設定"
DATA "ask text justify","文字列基準位置取得"
DATA "set text angle","テキストの角度設定"
DATA "ask test angle","テキストの角度取得"
DATA "set text background","文字背景設定"
DATA "ask text background","文字背景取得"
DATA "set window","ウィンドウ設定"
DATA "ask window","ウィンドウ取得"
DATA "set beam mode","描点の状態設定"
DATA "ask beam mode","描点の状態取得"
DATA "set draw mode hidden","ビットマップメモリーにのみ描画"
DATA "set draw mode explicit","内部ビットマップを画面に反映"
DATA "set draw mode overwrite","上書きモード"
DATA "set draw mode mask","減色混合"
DATA "set draw mode merge","加色混合"
DATA "set draw mode xor","二度書きすると戻る XOR"
DATA "set draw mode notxor","二度書きすると戻る NOTXOR"
DATA "set viewport","描画領域設定"
DATA "set margin","出力幅"
DATA "set zonewidth","出力欄の幅"
DATA "set#","ファイルポインター"
END FUNCTION

EXTERNAL FUNCTION CHANGESTATE2$(TEXT$) ! コマンド変換
RESTORE
DO
READ IF MISSING THEN EXIT DO:A$,B$
DO
LET L=POS(TEXT$,A$)
IF L>0 THEN LET TEXT$=TRANSFORM$(TEXT$,A$,B$) ELSE EXIT DO
LOOP
LOOP
LET CHANGESTATE2$=TEXT$
DATA "let ","代入文"
DATA " and","と"
DATA " or","又は"
DATA "not","否定"
DATA "file getname ","開くダイアログ"
DATA "file getopenname","開くダイアログ"
DATA "file getsavename","保存ダイアログ"
DATA "file splitname","ファイル名分割"
DATA "file rename","ファイル名変更"
DATA "file delete","ファイル削除"
DATA "file list","ファイル名リスト"
DATA "open","ファイルを開く"
DATA "close","ファイルを閉じる"
DATA "erase","ファイル消去"
DATA "rectype internal","内部形式"
DATA "organization stream","流れ編成"
DATA "mat print","配列PRINT表示"
DATA "mat write","配列WRITE表示"
DATA "mat read","配列データ読み込み"
DATA "mat redim","配列再定義"
DATA "write#","ファイルWRITE書き出し"
!DATA "write #","ファイルWRITE書き出し"
DATA "assoc print","印刷"
DATA "print#","ファイルPRINT書き出し"
!DATA "print #","ファイルPRINT書き出し"
DATA "print","画面表示"
DATA "exit for","FORループ脱出"
DATA "exit function","関数定義脱出"
DATA "exit sub","副プログラム脱出"
DATA "exit do","DOループ脱出"
DATA "exit picture","絵定義脱出"
DATA "exit handler","例外処理区脱出"
DATA "call ","副プログラム呼び出し"
DATA "clear","画面消去"
DATA "stop","実行停止"
DATA "for ","FOR繰り返し"
DATA " to ","から"
DATA " step","間隔"
DATA "next ","FORループここまで"
DATA "character input#","1文字読み込み"
!DATA "character input #","1文字読み込み"
DATA "character input prompt","1文字入力"
DATA "character input","1文字入力"
!DATA "line input #","ラインファイル入力"
DATA "line input#","ラインファイル入力"
DATA "line input","ライン入力"
DATA "mat line input","文字列配列入力"
DATA "mat input","配列入力"
DATA "access outin","読み書きモード"
DATA "access input","読み込みモード"
DATA "access out","書き込みモード"
DATA "input prompt","入力文"
DATA "input#","ファイル読み込み"
!DATA "input #","ファイル読み込み"
DATA "input","入力文"
DATA ",skip rest","余りを無視する"
DATA "pointer begin","ファイル先頭へ"
DATA "pointer end","ファイル末尾へ"
DATA "pointer same","直前に読み込んだ行へ"
DATA "read if missing then","データが尽きたら"
!DATA ", if missing then","ファイルが終わったら"
DATA ",if missing then","ファイルが終わったら"
!DATA ": if missing then","ファイルが終わったら"
DATA ":if missing then","ファイルが終わったら"
DATA "then","成立なら"
DATA "elseif","不成立ならもし"
DATA "case else","上記以外なら"
DATA "else","不成立なら"
DATA "end if","IF文ここまで"
DATA "end when","例外処理ここまで"
DATA "end select","選択ここまで"
DATA "end sub","副プログラムここまで"
DATA "end function","関数定義ここまで"
DATA "end picture","絵定義ここまで"
DATA "if ","もし"
DATA "do","DO繰り返し"
DATA "loop","LOOP ここまで"
DATA "until","成立するまで"
DATA "while","成立している間"
DATA "def","関数定義"
DATA "use","下記を使う"
DATA "function ","関数定義"
DATA "sub ","副プログラム定義"
DATA "picture ","絵定義"
DATA "draw grid0","格子描画"
DATA "draw axes0","軸描画"
DATA "draw grid","格子描画"
DATA "draw axes","軸描画"
DATA "draw ","図形描画"
DATA "end","主プログラムここまで"
DATA "randomize","乱数列初期化"
DATA "external","外部"
DATA "pause","一時停止"
DATA "wait delay","休止"
DATA "set echo","エコー表示"
DATA "name","名前"
DATA "break","実行中断"
DATA "trace on","追跡可"
DATA "trace off","追跡無効"
DATA "select case","選択"
DATA "case ","照合項目"
DATA "cause exception","例外発生"
DATA "chain","basファイル起動"
DATA "locate choice","数値選択"
DATA "locate value","スライドバー"
DATA "excute","外部プログラム起動"
DATA "when exception in","例外処理"
DATA "data","データ文"
DATA "read","データ文読み込み"
DATA "restore","読み込みリセット"
DATA "debug on","デバッグ活性"
DATA "debug off","デバッグ不活性"
DATA "goto","行番号へ移動"
DATA "gosub","行番号へ移動して戻る"
DATA "return","gosubの次へ戻る"
DATA "mat plot cells","領域塗りつぶし"
DATA "mat plot points","配列点描画"
DATA "mat plot lines","配列線描画"
DATA "mat plot area","配列エリア描画"
DATA "mat ","行列式"
DATA "using","書式指定"
DATA "merge","プログラム追加"
DATA "mouse poll","マウス入力"
DATA "flood","塗りつぶし"
DATA "paint","塗りつぶし"
DATA "plot area","塗りつぶし"
DATA "plot lines","直線描画"
DATA "plot points","点描画"
DATA "plot text","文字描画"
DATA "plot label","文字描画"
DATA "plot bezier","ベジェ曲線"
DATA "get point","座標入力"
DATA "gload","画像ファイル読み込み"
DATA "gsave","画像ファイル保存"
DATA "assign","dll登録"
DATA "playsound","サウンドファイル再生"
DATA "play","関連付けファイル"
DATA "swap ","値交換"
DATA "beep","ビープ音"
DATA "local","局所変数"
END FUNCTION

EXTERNAL FUNCTION TRANSFORM$(A$,B$,C$)
LET N=POS(A$,B$)
IF N>0 THEN
LET L$=LEFT$(A$,N-1)
LET R$=RIGHT$(A$,LEN(A$)-LEN(B$)-N+1)
LET A$=L$&" "&C$&" "&R$
END IF
LET TRANSFORM$=A$
END FUNCTION

EXTERNAL FUNCTION TRANSFORM2$(A$,B$,C$)
LET N=POS(A$,B$)
IF N>0 THEN
LET L$=LEFT$(A$,N-1)
LET R$=RIGHT$(A$,LEN(A$)-LEN(B$)-N+1)
LET A$=L$&C$&R$
END IF
LET TRANSFORM2$=A$
END FUNCTION

スライドパズル - しばっち

2025/03/16 (Sun) 07:48:48

スライドパズル

https://ja.wikipedia.org/wiki/15パズル
 https://mathlog.info/articles/JUlYR5o0T6S7UcVZkfB9
https://manabitimes.jp/math/979

4*4マスによる15パズルゲームです。
空マス(青マス)をテンキーの2,4,6,8キー又は矢印キーで動かして数字を順に揃えるゲームです。
シャッフル回数を入れるとゲーム開始です。

数字を順に揃えればゲームクリアです。(サンプル画像参照)
時間制限はありません。

Gキーを押すとギブアップです。解答を表示して終わります。
Rキーで再スタートします。(リトライ)

変数SPC値を書き換えると空白マスの位置を変更できます。

DECLARE FUNCTION STICK
DECLARE FUNCTION CHECK
RANDOMIZE
DIM M(4,4),ANSWER(50),MM(4,4)
CALL GINIT(600,600)
SET TEXT HEIGHT 50
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT COLOR 7
SET LINE COLOR 2
LET SPC=16 ! 1～16まで
FOR J=1 TO 4
FOR I=1 TO 4
LET M(I,J)=4*(J-1)+I
NEXT I
NEXT J
CALL DISPLAY
INPUT PROMPT "シャッフル回数(5-50)=":N
CALL SHUFFLE(N)
MAT MM=M
FOR J=1 TO 4
FOR I=1 TO 4
IF M(I,J)=SPC THEN
LET XT=I
LET YT=J
END IF
NEXT I
NEXT J
DO
DO
DO
LET S=STICK
IF GETKEYSTATE(ORD("G"))<0 OR GETKEYSTATE(ORD("g"))<0 THEN ! ギブアップ
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
WAIT DELAY .5
FOR I=N TO 1 STEP -1
LET SS=ANSWER(I)
LET P=MOVE(SS)
CALL DISPLAY
WAIT DELAY .5
NEXT I
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Game Over!!"
STOP
END IF
IF GETKEYSTATE(ORD("R"))<0 OR GETKEYSTATE(ORD("r"))<0 THEN ! リスタート(リトライ)
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
END IF
LOOP WHILE S=-1
DO
LET SS=STICK
LOOP WHILE SS>0
LET P=MOVE(S) ! マス移動
LOOP WHILE P=0
CALL DISPLAY
IF CHECK=1 THEN EXIT DO !揃ったら
LOOP
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Congratulations"

SUB DISPLAY ! 表示
FOR YY=1 TO 4
FOR XX=1 TO 4
LET C=M(XX,YY)
IF C<>SPC THEN
CALL BOXFULL(150*(XX-1),150*(YY-1),150*(XX-1)+150,150*(YY-1)+150,4)
PLOT TEXT ,AT 150*(XX-1)+75,150*(YY-1)+75:STR$(C)
ELSE
CALL BOXFULL(150*(XX-1),150*(YY-1),150*(XX-1)+150,150*(YY-1)+150,1)
END IF
NEXT XX
NEXT YY
FOR XX=1 TO 3
PLOT LINES:150*XX,0;150*XX,600
NEXT XX
FOR YY=1 TO 3
PLOT LINES:0,150*YY;600,150*YY
NEXT YY
END SUB

SUB SHUFFLE(N) ! シャッフル
LET S=0
LET X=MOD(SPC-1,4)+1
LET Y=INT((SPC-1)/4)+1
LET XS=X
LET YS=Y
FOR I=1 TO N
DO
DO
LET S=INT(RND*4+1)*2
LOOP WHILE I>1 AND S=ANSWER(I-1) ! 右に行って左や上に行って下等のムダな動きを省く
LOOP WHILE MOVE(S)=0 ! 壁を越えたらやり直し
LET ANSWER(I)=10-S
CALL DISPLAY
WAIT DELAY 1/10
NEXT I
END SUB

FUNCTION MOVE(S) ! マス移動
LET MV=0
SELECT CASE S
CASE 2
IF Y<4 THEN
LET YS=Y+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 4
IF X>1 THEN
LET XS=X-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 6
IF X<4 THEN
LET XS=X+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 8
IF Y>1 THEN
LET YS=Y-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE ELSE
END SELECT
LET MOVE=MV
END FUNCTION

FUNCTION CHECK ! 揃ったか?
FOR I=0 TO 14
LET XA=MOD(I,4)+1
LET YA=INT(I/4)+1
IF M(XA,YA)<>I+1 THEN
LET CHECK=0
EXIT FUNCTION
END IF
NEXT I
LET CHECK=1
END FUNCTION

FUNCTION STICK !'キー入力
LET STICK=-1
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
FOR I=49 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
END FUNCTION
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

Re: スライドパズル - しばっち

2025/03/16 (Sun) 07:50:05

15ゲームを拡張した5*5の24ゲームです。

DECLARE FUNCTION STICK
DECLARE FUNCTION CHECK
RANDOMIZE
DIM M(5,5),ANSWER(100),MM(5,5)
CALL GINIT(600,600)
SET TEXT HEIGHT 40
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT COLOR 7
SET LINE COLOR 2
LET SPC=25
FOR J=1 TO 5
FOR I=1 TO 5
LET M(I,J)=5*(J-1)+I
NEXT I
NEXT J
CALL DISPLAY
INPUT PROMPT "シャッフル回数(5-100)=":N
CALL SHUFFLE(N)
MAT MM=M
FOR J=1 TO 5
FOR I=1 TO 5
IF M(I,J)=SPC THEN
LET XT=I
LET YT=J
END IF
NEXT I
NEXT J
DO
DO
DO
LET S=STICK
IF GETKEYSTATE(ORD("G"))<0 OR GETKEYSTATE(ORD("g"))<0 THEN ! ギブアップ
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
WAIT DELAY .5
FOR I=N TO 1 STEP -1
LET SS=ANSWER(I)
LET P=MOVE(SS)
CALL DISPLAY
WAIT DELAY .5
NEXT I
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Game Over!!"
STOP
END IF
IF GETKEYSTATE(ORD("R"))<0 OR GETKEYSTATE(ORD("r"))<0 THEN ! リスタート
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
END IF
LOOP WHILE S=-1
DO
LET SS=STICK
LOOP WHILE SS>0
LET P=MOVE(S) ! マス移動
LOOP WHILE P=0
CALL DISPLAY
IF CHECK=1 THEN EXIT DO !揃ったら
LOOP
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Congratulations"

SUB DISPLAY ! 表示
FOR YY=1 TO 5
FOR XX=1 TO 5
LET C=M(XX,YY)
IF C<>SPC THEN
CALL BOXFULL(120*(XX-1),120*(YY-1),120*(XX-1)+120,120*(YY-1)+120,4)
PLOT TEXT ,AT 120*(XX-1)+60,120*(YY-1)+60:STR$(C)
ELSE
CALL BOXFULL(120*(XX-1),120*(YY-1),120*(XX-1)+120,120*(YY-1)+120,1)
END IF
NEXT XX
NEXT YY
FOR XX=1 TO 4
PLOT LINES:120*XX,0;120*XX,600
NEXT XX
FOR YY=1 TO 4
PLOT LINES:0,120*YY;600,120*YY
NEXT YY
END SUB

SUB SHUFFLE(N) ! シャッフル
LET S=0
LET X=MOD(SPC-1,5)+1
LET Y=INT((SPC-1)/5)+1
LET XS=X
LET YS=Y
FOR I=1 TO N
DO
DO
LET S=INT(RND*4+1)*2
LOOP WHILE I>1 AND S=ANSWER(I-1)
LOOP WHILE MOVE(S)=0
LET ANSWER(I)=10-S
CALL DISPLAY
WAIT DELAY 1/10
NEXT I
END SUB

FUNCTION MOVE(S) ! マス移動
LET MV=0
SELECT CASE S
CASE 2
IF Y<5 THEN
LET YS=Y+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 4
IF X>1 THEN
LET XS=X-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 6
IF X<5 THEN
LET XS=X+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 8
IF Y>1 THEN
LET YS=Y-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE ELSE
END SELECT
LET MOVE=MV
END FUNCTION

FUNCTION CHECK ! 揃ったか?
FOR I=0 TO 24
LET XA=MOD(I,5)+1
LET YA=INT(I/5)+1
IF M(XA,YA)<>I+1 THEN
LET CHECK=0
EXIT FUNCTION
END IF
NEXT I
LET CHECK=1
END FUNCTION

FUNCTION STICK !'キー入力
LET STICK=-1
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
FOR I=49 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
END FUNCTION
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB
FUNCTION CHECK ! 揃ったか?
FOR I=0 TO 24
LET XA=MOD(I,5)+1
LET YA=INT(I/5)+1
IF M(XA,YA)<>I+1 THEN
LET CHECK=0
EXIT FUNCTION
END IF
NEXT I
LET CHECK=1
END FUNCTION

FUNCTION STICK !'キー入力
LET STICK=-1
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
FOR I=49 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
END FUNCTION
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

Re: スライドパズル - しばっち

2025/03/16 (Sun) 07:51:32

6*6マスによる35パズルです。

DECLARE FUNCTION STICK
DECLARE FUNCTION CHECK
RANDOMIZE
DIM M(6,6),ANSWER(100),MM(6,6)
CALL GINIT(600,600)
SET TEXT HEIGHT 30
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT COLOR 7
SET LINE COLOR 2
LET SPC=36
FOR J=1 TO 6
FOR I=1 TO 6
LET M(I,J)=6*(J-1)+I
NEXT I
NEXT J
CALL DISPLAY
INPUT PROMPT "シャッフル回数(5-100)=":N
CALL SHUFFLE(N)
MAT MM=M
FOR J=1 TO 6
FOR I=1 TO 6
IF M(I,J)=SPC THEN
LET XT=I
LET YT=J
END IF
NEXT I
NEXT J
DO
DO
DO
LET S=STICK
IF GETKEYSTATE(ORD("G"))<0 OR GETKEYSTATE(ORD("g"))<0 THEN ! ギブアップ
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
WAIT DELAY .5
FOR I=N TO 1 STEP -1
LET SS=ANSWER(I)
LET P=MOVE(SS)
CALL DISPLAY
WAIT DELAY .5
NEXT I
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Game Over!!"
STOP
END IF
IF GETKEYSTATE(ORD("R"))<0 OR GETKEYSTATE(ORD("r"))<0 THEN ! リスタート
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
END IF
LOOP WHILE S=-1
DO
LET SS=STICK
LOOP WHILE SS>0
LET P=MOVE(S) ! マス移動
LOOP WHILE P=0
CALL DISPLAY
IF CHECK=1 THEN EXIT DO !揃ったら
LOOP
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Congratulations"

SUB DISPLAY ! 表示
FOR YY=1 TO 6
FOR XX=1 TO 6
LET C=M(XX,YY)
IF C<>SPC THEN
CALL BOXFULL(100*(XX-1),100*(YY-1),100*(XX-1)+100,100*(YY-1)+100,4)
PLOT TEXT ,AT 100*(XX-1)+50,100*(YY-1)+50:STR$(C)
ELSE
CALL BOXFULL(100*(XX-1),100*(YY-1),100*(XX-1)+100,100*(YY-1)+100,1)
END IF
NEXT XX
NEXT YY
FOR XX=1 TO 5
PLOT LINES:100*XX,0;100*XX,600
NEXT XX
FOR YY=1 TO 5
PLOT LINES:0,100*YY;600,100*YY
NEXT YY
END SUB

SUB SHUFFLE(N) ! シャッフル
LET S=0
LET X=MOD(SPC-1,6)+1
LET Y=INT((SPC-1)/6)+1
LET XS=X
LET YS=Y
FOR I=1 TO N
DO
DO
LET S=INT(RND*4+1)*2
LOOP WHILE I>1 AND S=ANSWER(I-1)
LOOP WHILE MOVE(S)=0
LET ANSWER(I)=10-S
CALL DISPLAY
WAIT DELAY 1/10
NEXT I
END SUB

FUNCTION MOVE(S) ! マス移動
LET MV=0
SELECT CASE S
CASE 2
IF Y<6 THEN
LET YS=Y+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 4
IF X>1 THEN
LET XS=X-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 6
IF X<6 THEN
LET XS=X+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 8
IF Y>1 THEN
LET YS=Y-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE ELSE
END SELECT
LET MOVE=MV
END FUNCTION

FUNCTION CHECK ! 揃ったか?
FOR I=0 TO 35
LET XA=MOD(I,6)+1
LET YA=INT(I/6)+1
IF M(XA,YA)<>I+1 THEN
LET CHECK=0
EXIT FUNCTION
END IF
NEXT I
LET CHECK=1
END FUNCTION

FUNCTION STICK !'キー入力
LET STICK=-1
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
FOR I=49 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
END FUNCTION
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

Re: スライドパズル - しばっち

2025/03/16 (Sun) 07:52:41

3*3の8パズル

DECLARE FUNCTION STICK
DECLARE FUNCTION CHECK
RANDOMIZE
DIM M(3,3),ANSWER(50),MM(3,3)
CALL GINIT(600,600)
SET TEXT HEIGHT 50
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT COLOR 7
SET LINE COLOR 2
LET SPC=9
FOR J=1 TO 3
FOR I=1 TO 3
LET M(I,J)=3*(J-1)+I
NEXT I
NEXT J
CALL DISPLAY
INPUT PROMPT "シャッフル回数(5-50)=":N
CALL SHUFFLE(N)
MAT MM=M
FOR J=1 TO 3
FOR I=1 TO 3
IF M(I,J)=SPC THEN
LET XT=I
LET YT=J
END IF
NEXT I
NEXT J
DO
DO
DO
LET S=STICK
IF GETKEYSTATE(ORD("G"))<0 OR GETKEYSTATE(ORD("g"))<0 THEN ! ギブアップ
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
WAIT DELAY .5
FOR I=N TO 1 STEP -1
LET SS=ANSWER(I)
LET P=MOVE(SS)
CALL DISPLAY
WAIT DELAY .5
NEXT I
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Game Over!!"
STOP
END IF
IF GETKEYSTATE(ORD("R"))<0 OR GETKEYSTATE(ORD("r"))<0 THEN ! リスタート
MAT M=MM
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
END IF
LOOP WHILE S=-1
DO
LET SS=STICK
LOOP WHILE SS>0
LET P=MOVE(S) ! マス移動
LOOP WHILE P=0
CALL DISPLAY
IF CHECK=1 THEN EXIT DO !揃ったら
LOOP
SET TEXT HEIGHT 50
SET TEXT COLOR 2
PLOT TEXT ,AT 300,300:"Congratulations"

SUB DISPLAY ! 表示
FOR YY=1 TO 3
FOR XX=1 TO 3
LET C=M(XX,YY)
IF C<>SPC THEN
CALL BOXFULL(200*(XX-1),200*(YY-1),200*(XX-1)+200,200*(YY-1)+200,4)
PLOT TEXT ,AT 200*(XX-1)+100,200*(YY-1)+100:STR$(C)
ELSE
CALL BOXFULL(200*(XX-1),200*(YY-1),200*(XX-1)+200,200*(YY-1)+200,1)
END IF
NEXT XX
NEXT YY
FOR XX=1 TO 2
PLOT LINES:200*XX,0;200*XX,600
NEXT XX
FOR YY=1 TO 2
PLOT LINES:0,200*YY;600,200*YY
NEXT YY
END SUB

SUB SHUFFLE(N) ! シャッフル
LET S=0
LET X=MOD(SPC-1,3)+1
LET Y=INT((SPC-1)/3)+1
LET XS=X
LET YS=Y
FOR I=1 TO N
DO
DO
LET S=INT(RND*4+1)*2
LOOP WHILE I>1 AND S=ANSWER(I-1)
LOOP WHILE MOVE(S)=0
LET ANSWER(I)=10-S
CALL DISPLAY
WAIT DELAY 1/10
NEXT I
END SUB

FUNCTION MOVE(S) ! マス移動
LET MV=0
SELECT CASE S
CASE 2
IF Y<3 THEN
LET YS=Y+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 4
IF X>1 THEN
LET XS=X-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 6
IF X<3 THEN
LET XS=X+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 8
IF Y>1 THEN
LET YS=Y-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE ELSE
END SELECT
LET MOVE=MV
END FUNCTION

FUNCTION CHECK ! 揃ったか?
FOR I=0 TO 8
LET XA=MOD(I,3)+1
LET YA=INT(I/3)+1
IF M(XA,YA)<>I+1 THEN
LET CHECK=0
EXIT FUNCTION
END IF
NEXT I
LET CHECK=1
END FUNCTION

FUNCTION STICK !'キー入力
LET STICK=-1
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
FOR I=49 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
END FUNCTION
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

Re: スライドパズル - しばっち

2025/03/16 (Sun) 07:54:20

数字の代わりに画像ファイルを使ったn*mパズルです。

実際の15パズルではありえない斜め方向への移動もさせるので
テンキー又は数字キーで操作してください。

DECLARE FUNCTION STICK
DECLARE FUNCTION CHECK
RANDOMIZE
FILE GETNAME N$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(N$,XSIZE,YSIZE)
LET NX=INT(RND*6+3)
LET NY=INT(RND*6+3)
LET SPC=INT(RND*NX*NY+1)
! INPUT PROMPT "分割数 NX,NY=":NX,NY
! INPUT PROMPT "スペースの位置 (1-"&STR$(NX*NY)&")=":SPC
DIM M(NX,NY),ANSWER(100),MM(NX,NY),MT(NX,NY)
DIM TEMP(XSIZE/NX,YSIZE/NY),IMG(NX*NY,XSIZE/NX,YSIZE/NY)
SET TEXT JUSTIFY "CENTER","HALF"
FOR Y=0 TO YSIZE-1 STEP YSIZE/NY
FOR X=0 TO XSIZE-1 STEP XSIZE/NX
LET N=N+1
ASK PIXEL ARRAY(X,Y) TEMP
FOR YY=1 TO YSIZE/NY
FOR XX=1 TO XSIZE/NX
LET IMG(N,XX,YY)=TEMP(XX,YY)
NEXT XX
NEXT YY
NEXT X
NEXT Y
FOR J=1 TO NY
FOR I=1 TO NX
LET M(I,J)=NX*(J-1)+I
NEXT I
NEXT J
CALL DISPLAY
INPUT PROMPT "シャッフル回数(5-100)=":N
CALL SHUFFLE(N)
MAT MM=M
FOR J=1 TO NY
FOR I=1 TO NX
IF M(I,J)=SPC THEN
LET XT=I
LET YT=J
END IF
NEXT I
NEXT J
DO
DO
DO
LET S=STICK
IF GETKEYSTATE(ORD("G"))<0 THEN ! ギブアップ ("g"とテンキーの"7"が同一コード)
MAT M=MM
MAT MT=ZER
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
WAIT DELAY .5
FOR I=N TO 1 STEP -1
LET SS=ANSWER(I)
LET P=MOVE(SS)
CALL DISPLAY
WAIT DELAY .5
NEXT I
SET TEXT HEIGHT MIN(XSIZE/12,YSIZE/12)
SET TEXT COLOR COLORINDEX(1,0,0)
PLOT TEXT ,AT XSIZE/2,YSIZE/2:"Game Over!!"
STOP
END IF
IF GETKEYSTATE(ORD("R"))<0 OR GETKEYSTATE(ORD("r"))<0 THEN ! リスタート
MAT M=MM
MAT MT=ZER
LET X,XS=XT
LET Y,YS=YT
CALL DISPLAY
END IF
IF GETKEYSTATE(ORD("S"))<0 OR GETKEYSTATE(ORD("s"))<0 THEN ! 補助
SET TEXT HEIGHT MIN(XSIZE/NX/3,YSIZE/NY/3)
SET TEXT COLOR COLORINDEX(0,1,0)
FOR YY=1 TO NY
FOR XX=1 TO NX
LET C=M(XX,YY)
IF C<>SPC THEN
PLOT TEXT ,AT XSIZE/NX*(XX-1)+XSIZE/NX/2,YSIZE/NY*(YY-1)+YSIZE/NY/2:STR$(C)
END IF
NEXT XX
NEXT YY
DO
LOOP WHILE GETKEYSTATE(ORD("S"))<0 OR GETKEYSTATE(ORD("s"))<0
MAT MT=ZER
CALL DISPLAY
END IF
LOOP WHILE S=-1
DO
LET SS=STICK
LOOP WHILE SS>0
LET P=MOVE(S) ! マス移動
LOOP WHILE P=0
CALL DISPLAY
IF CHECK=1 THEN EXIT DO !揃ったら
LOOP
SET TEXT HEIGHT MIN(XSIZE/12,YSIZE/12)
SET TEXT COLOR COLORINDEX(1,0,0)
PLOT TEXT ,AT XSIZE/2,YSIZE/2:"Congratulations"

SUB DISPLAY ! 表示
FOR YY=1 TO NY
FOR XX=1 TO NX
LET C=M(XX,YY)
IF MT(XX,YY)<>C THEN
IF C<>SPC THEN
FOR YC=1 TO YSIZE/NY
FOR XC=1 TO XSIZE/NX
LET TEMP(XC,YC)=IMG(M(XX,YY),XC,YC)
NEXT XC
NEXT YC
MAT PLOT CELLS ,IN XSIZE/NX*(XX-1),YSIZE/NY*(YY-1);XSIZE/NX*(XX-1)+XSIZE/NX,YSIZE/NY*(YY-1)+YSIZE/NY:TEMP
ELSE
CALL BOXFULL(XSIZE/NX*(XX-1),YSIZE/NY*(YY-1),XSIZE/NX*(XX-1)+XSIZE/NX,YSIZE/NY*(YY-1)+YSIZE/NY,0,0,255)
END IF
END IF
NEXT XX
NEXT YY
MAT MT=M
SET LINE COLOR COLORINDEX(0,1,0)
FOR XX=1 TO NX-1
PLOT LINES:XSIZE/NX*XX,0;XSIZE/NX*XX,YSIZE
NEXT XX
FOR YY=1 TO NY-1
PLOT LINES:0,YSIZE/NY*YY;XSIZE,YSIZE/NY*YY
NEXT YY
END SUB

SUB SHUFFLE(N) ! シャッフル
LET S=0
LET X=MOD(SPC-1,NX)+1
LET Y=INT((SPC-1)/NX)+1
LET XS=X
LET YS=Y
FOR I=1 TO N
DO
DO
LET S=INT(RND*9+1)
LOOP WHILE I>1 AND S=ANSWER(I-1)
LOOP WHILE MOVE(S)=0
LET ANSWER(I)=10-S
CALL DISPLAY
WAIT DELAY 1/10
NEXT I
END SUB

FUNCTION MOVE(S) ! マス移動
LET MV=0
SELECT CASE S
CASE 1
IF Y<NY AND X>1 THEN
LET YS=Y+1
LET XS=X-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 2
IF Y<NY THEN
LET YS=Y+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 3
IF Y<NY AND X<NX THEN
LET YS=Y+1
LET XS=X+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 4
IF X>1 THEN
LET XS=X-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 6
IF X<NX THEN
LET XS=X+1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 7
IF X>1 AND Y>1 THEN
LET XS=X-1
LET YS=Y-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 8
IF Y>1 THEN
LET YS=Y-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE 9
IF X<NX AND Y>1 THEN
LET XS=X+1
LET YS=Y-1
SWAP M(XS,YS),M(X,Y)
LET X=XS
LET Y=YS
LET MV=1
END IF
CASE ELSE
END SELECT
LET MOVE=MV
END FUNCTION

FUNCTION CHECK ! 揃ったか?
FOR I=0 TO NX*NY-1
LET XA=MOD(I,NX)+1
LET YA=INT(I/NX)+1
IF M(XA,YA)<>I+1 THEN
LET CHECK=0
EXIT FUNCTION
END IF
NEXT I
LET CHECK=1
END FUNCTION

FUNCTION STICK !'キー入力
LET STICK=-1
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
FOR I=49 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
!RESTORE
!DATA Z,X,C,A,5,D,Q,W,E
!DATA J,K,L,U,I,O,7,8,9
!FOR I=1 TO 9
! READ A$
! IF GETKEYSTATE(ORD(A$))<0 OR GETKEYSTATE(ORD(LCASE$(A$)))<0 THEN LET STICK=I
!NEXT I
END FUNCTION
END

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB BOXFULL(X0,Y0,X1,Y1,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT AREA:X0,Y0;X1,Y0;X1,Y1;X0,Y1;X0,Y0
END SUB

スロットゲーム - しばっち

2025/02/16 (Sun) 07:53:56

スロットゲーム

スペースキー又は1,2,3キーで各スロットが止まります。

所持コインは1000コインです。1回毎に30コイン消費します。
クリア条件は3000コイン以上で0コイン以下になるとゲームオーバーです。

真ん中(緑線)でVが揃うと1000コイン、それ以外では500コインです。
青線、黄線でVが揃うと400コイン、それ以外では200コインです。

これだけでは難しいので合計値が10になると100コイン
1,2,3又は4,5,6又は7,8,9を揃えると200コイン

?と他2つが揃うと100コイン
?が2つ揃うと100コインです。

※ダブルボーナス(条件が重複)

?が2つとVを揃えると?が0値でVを10値として
合計10になるのと?が2つ揃うのでダブルでコインが増えます。

?が3つ揃うとコインが増え、?が2つでコインが増えて、?1つでもコインが増えるので
トリプルボーナスになります。

狙って出せるわけではありませんが、ぜひ真ん中(緑線)でVを揃えてみてください。
かなりゆるく設定しているので大抵の場合ゲームオーバーにはなりません。(５分～１０分程度でクリアできます)

RANDOMIZE
LET NUM=11
DIM A$(NUM),B$(NUM),C$(NUM),ST(3)
MAT READ A$
MAT B$=A$
MAT C$=A$
FOR I=1 TO NUM
SWAP A$(I),A$(INT(RND*NUM)+1)
SWAP B$(I),B$(INT(RND*NUM)+1)
SWAP C$(I),C$(INT(RND*NUM)+1)
NEXT I
DATA 1,2,3,4,5,6,7,8,9,V,"?" ! コマ
LET COIN=1000 ! 所持コイン
CALL GINIT(800,800)
SET TEXT COLOR 7
SET TEXT BACKGROUND "OPAQUE"
SET TEXT JUSTIFY "CENTER","HALF"
SET LINE WIDTH 10
SET LINE COLOR 6
PLOT LINES:200,150;600,150
PLOT LINES:200,450;600,450
SET LINE COLOR 4
PLOT LINES:200,300;600,300
SET LINE COLOR 1
PLOT LINES:200,100;600,500
PLOT LINES:600,100;200,500
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
!SET TEXT COLOR 5
!SET TEXT HEIGHT 80
!PLOT TEXT ,AT 400,600:"HIT SPACE KEY"
!DO
!LOOP UNTIL GETKEYSTATE(32)<0
!DO
!LOOP WHILE GETKEYSTATE(32)<0
!PLOT TEXT ,AT 400,600:" "
DO ! ゲームスタート
LET COIN=COIN-30
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT HEIGHT 120
LET N=0
MAT ST=ZER
DO
IF ST(1)=0 THEN CALL SLOT1 ! スロット回転
IF ST(2)=0 THEN CALL SLOT2
IF ST(3)=0 THEN CALL SLOT3
IF GETKEYSTATE(32)<0 THEN
LET N=N+1
LET ST(N)=1
DO
LOOP WHILE GETKEYSTATE(32)<0
END IF
IF GETKEYSTATE(ORD("1"))<0 OR GETKEYSTATE(97)<0 THEN LET ST(1)=1
IF GETKEYSTATE(ORD("2"))<0 OR GETKEYSTATE(98)<0 THEN LET ST(2)=1
IF GETKEYSTATE(ORD("3"))<0 OR GETKEYSTATE(99)<0 THEN LET ST(3)=1
WAIT DELAY 1/8
LOOP UNTIL ST(1)=1 AND ST(2)=1 AND ST(3)=1
LET AA$=A$(MOD(N1,NUM)+1) ! 当たり判定(緑)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP1
END IF
IF POS("123456789V",AA$)+POS("123456789V",BB$)+POS("123456789V",CC$)=10 THEN ! 合計値が10。Vを10 ?は0とする
LET COIN=COIN+100
CALL DISP1
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN ! 1,2,3が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN ! 4,5,6が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN ! 7,8,9が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN ! ?と他2つが揃う
LET COIN=COIN+100
CALL DISP1
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN ! ?が2つ揃う
LET COIN=COIN+100
CALL DISP1
END IF

LET AA$=A$(MOD(N1-1,NUM)+1) ! 当たり判定(青)
LET BB$=B$(MOD(N2-1,NUM)+1)
LET CC$=C$(MOD(N3-1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP2
END IF
IF POS("123456789V",AA$)+POS("123456789V",BB$)+POS("123456789V",CC$)=10 THEN
LET COIN=COIN+100
CALL DISP2
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP2
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP2
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP2
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP2
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP2
END IF

LET AA$=A$(MOD(N1+1,NUM)+1) ! 当たり判定(青)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP3
END IF
IF POS("123456789V",AA$)+POS("123456789V",BB$)+POS("123456789V",CC$)=10 THEN
LET COIN=COIN+100
CALL DISP3
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP3
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP3
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP3
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP3
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP3
END IF

LET AA$=A$(MOD(N1-1,NUM)+1) ! クロス当たり判定(黄)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+200 ELSE LET COIN=COIN+100
CALL DISP4
END IF
IF POS("123456789V",AA$)+POS("123456789V",BB$)+POS("123456789V",CC$)=10 THEN
LET COIN=COIN+100
CALL DISP4
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP4
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP4
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP4
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP4
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP4
END IF

LET AA$=A$(MOD(N1+1,NUM)+1) ! クロス当たり判定(黄)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3-1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+200 ELSE LET COIN=COIN+100
CALL DISP5
END IF
IF POS("123456789V",AA$)+POS("123456789V",BB$)+POS("123456789V",CC$)=10 THEN
LET COIN=COIN+100
CALL DISP5
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP5
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP5
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP5
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP5
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP5
END IF
IF COIN>=3000 THEN ! ゲームクリア
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 400,300:"Congratulations"
STOP
END IF
IF COIN<=0 THEN ! ゲームオーバー
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 400,300:"Game Over!!"
STOP
END IF
WAIT DELAY .5
LOOP

SUB SLOT1
LET N1=N1+1
PLOT TEXT ,AT 200,150:A$(MOD(N1-1,NUM)+1)
PLOT TEXT ,AT 200,300:A$(MOD(N1,NUM)+1)
PLOT TEXT ,AT 200,450:A$(MOD(N1+1,NUM)+1)
END SUB

SUB SLOT2
LET N2=N2+1
PLOT TEXT ,AT 400,150:B$(MOD(N2-1,NUM)+1)
PLOT TEXT ,AT 400,300:B$(MOD(N2,NUM)+1)
PLOT TEXT ,AT 400,450:B$(MOD(N2+1,NUM)+1)
END SUB

SUB SLOT3
LET N3=N3+1
PLOT TEXT ,AT 600,150:C$(MOD(N3-1,NUM)+1)
PLOT TEXT ,AT 600,300:C$(MOD(N3,NUM)+1)
PLOT TEXT ,AT 600,450:C$(MOD(N3+1,NUM)+1)
END SUB

SUB DISP1
SET TEXT COLOR 2
PLOT TEXT ,AT 200,300:AA$
PLOT TEXT ,AT 400,300:BB$
PLOT TEXT ,AT 600,300:CC$
END SUB

SUB DISP2
SET TEXT COLOR 2
PLOT TEXT ,AT 200,150:AA$
PLOT TEXT ,AT 400,150:BB$
PLOT TEXT ,AT 600,150:CC$
END SUB

SUB DISP3
SET TEXT COLOR 2
PLOT TEXT ,AT 200,450:AA$
PLOT TEXT ,AT 400,450:BB$
PLOT TEXT ,AT 600,450:CC$
END SUB

SUB DISP4
SET TEXT COLOR 2
PLOT TEXT ,AT 200,150:AA$
PLOT TEXT ,AT 400,300:BB$
PLOT TEXT ,AT 600,450:CC$
END SUB

SUB DISP5
SET TEXT COLOR 2
PLOT TEXT ,AT 200,450:AA$
PLOT TEXT ,AT 400,300:BB$
PLOT TEXT ,AT 600,150:CC$
END SUB
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

Re: スロットゲーム - しばっち

2025/02/16 (Sun) 07:56:20

まず所持金を決めます。200,600,1000,2000コインから選んでください。
数字キー又はテンキーの1,2,3,4キーを押してください。

次にいくらBETするかを決めます。
スペースキー又はリターンキーを1～5回押します。
するとラインが描かれ10コインずつ消費します。最大50コイン消費します。
Sキーでスロットが回転します。
スペースキー又はリターンキーを5回押した時はスロットが回転します。

ラインがあるところで当たり判定されます。
スペースキーかリターンキー又は1,2,3キーで各スロットが止まります。

ゲームクリアは所持金で変わり所持金の5倍の金額を設定しています。
0コイン以下になるとゲームオーバーです。

当たり判定後一時停止するのでスペースキー又はリターンキーを押して再開してください。

緑線でVが揃うと1000コイン、それ以外では500コインです。
他のラインでVが揃うと400コイン、それ以外では200コインです。

それだけではクリアは難しいので合計値が10の倍数になると100コイン (Xは10,Vは11,?は0とする)
1,2,3又は4,5,6又は7,8,9を揃えると200コイン

?と他2つが揃うと100コイン
?が2つ揃うと100コインです。

※ダブルボーナス(条件が重複)

「?と5と5」で合計値10の倍数で100コインに?と他2つが揃うで更に100コイン
「?と?とX」で合計値10の倍数で100コインに?が2つ揃うで更に100コインなど

かなりゆるい設定にしています。暇つぶしに使えます。

BET(賭け金)を10ずつ(計50)ではなく、10,20,30,40,50(計150)のように増やすと
少し難しくなります。また当たり判定を変更したりスロットの回転速度を上げても
難しくできます。

RANDOMIZE
LET NUM=12
DIM A$(NUM),B$(NUM),C$(NUM),ST(3),BET(5)
MAT READ A$
MAT B$=A$
MAT C$=A$
FOR I=1 TO NUM
SWAP A$(I),A$(INT(RND*NUM)+1)
SWAP B$(I),B$(INT(RND*NUM)+1)
SWAP C$(I),C$(INT(RND*NUM)+1)
NEXT I
DATA 1,2,3,4,5,6,7,8,9,X,V,"?" ! コマ
CALL GINIT(800,800)
SET TEXT COLOR 7
SET TEXT BACKGROUND "OPAQUE"
SET TEXT JUSTIFY "CENTER","HALF"
SET LINE WIDTH 10
LET P$="BETしてください"
SET TEXT HEIGHT 30
PLOT TEXT ,AT 400,160:"200 コイン(1)"
PLOT TEXT ,AT 400,320:"600 コイン(2)"
PLOT TEXT ,AT 400,480:"1000 コイン(3)"
PLOT TEXT ,AT 400,640:"2000 コイン(4)"
PLOT TEXT ,AT 400,20:"所持金はいくらにしますか?"
DO
IF GETKEYSTATE(ORD("1"))<0 OR GETKEYSTATE(97)<0 THEN
LET COIN=200
LET GOAL=1000
EXIT DO
END IF
IF GETKEYSTATE(ORD("2"))<0 OR GETKEYSTATE(98)<0 THEN
LET COIN=600
LET GOAL=3000
EXIT DO
END IF
IF GETKEYSTATE(ORD("3"))<0 OR GETKEYSTATE(99)<0 THEN
LET COIN=1000
LET GOAL=5000
EXIT DO
END IF
IF GETKEYSTATE(ORD("4"))<0 OR GETKEYSTATE(100)<0 THEN
LET COIN=2000
LET GOAL=10000
EXIT DO
END IF
LOOP
DO ! ゲームスタート
MAT BET=ZER
CLEAR
SET TEXT COLOR 7
SET TEXT HEIGHT 40
PLOT TEXT ,AT 400,700:P$
LET I=0
DO
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
IF GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0 THEN ! スペースキー又はリターンキーでBET
LET I=I+1
LET BET(I)=1
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
SELECT CASE I
CASE 1
SET LINE COLOR 4 ! 緑線(真ん中)
PLOT LINES:200,300;600,300
LET COIN=COIN-10
CASE 2
SET LINE COLOR 1 ! 青線(上下)
PLOT LINES:200,150;600,150
PLOT LINES:200,450;600,450
LET COIN=COIN-10
CASE 3
SET LINE COLOR 6 ! 黄線(対角線)
PLOT LINES:200,100;600,500
PLOT LINES:600,100;200,500
LET COIN=COIN-10
CASE 4
SET LINE COLOR 3 ! 紫線
PLOT LINES:200,100;400,500;600,100
PLOT LINES:200,500;400,100;600,500
LET COIN=COIN-10
CASE 5
SET LINE COLOR 5 ! 水色線
PLOT LINES:200,300;400,100;600,300
PLOT LINES:200,300;400,500;600,300
LET COIN=COIN-10
END SELECT
END IF
IF I>=1 AND (GETKEYSTATE(ORD("S"))<0 OR GETKEYSTATE(ORD("s"))<0) THEN EXIT DO ! Sキーでスロット回転
LOOP UNTIL I=5

SET TEXT HEIGHT 40
PLOT TEXT ,AT 400,700:REPEAT$(" ",BLEN(P$))
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT HEIGHT 120
LET N=0
MAT ST=ZER
DO
IF ST(1)=0 THEN CALL SLOT1 ! スロット回転
IF ST(2)=0 THEN CALL SLOT2
IF ST(3)=0 THEN CALL SLOT3
IF GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0 THEN ! スペースキー又はリターンキーでスロット停止
LET N=N+1
LET ST(N)=1
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
END IF
IF GETKEYSTATE(ORD("1"))<0 OR GETKEYSTATE(97)<0 THEN LET ST(1)=1 ! 1,2,3キーで各スロット停止
IF GETKEYSTATE(ORD("2"))<0 OR GETKEYSTATE(98)<0 THEN LET ST(2)=1
IF GETKEYSTATE(ORD("3"))<0 OR GETKEYSTATE(99)<0 THEN LET ST(3)=1
WAIT DELAY 1/8
LOOP UNTIL ST(1)=1 AND ST(2)=1 AND ST(3)=1

IF BET(1)=1 THEN
LET AA$=A$(MOD(N1,NUM)+1) ! 当たり判定(緑線)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP1
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP1
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN ! 1,2,3が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN ! 4,5,6が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN ! 7,8,9が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN ! ?と他2つが揃う
LET COIN=COIN+100
CALL DISP1
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN ! ?が2つ揃う
LET COIN=COIN+100
CALL DISP1
END IF
END IF

IF BET(2)=1 THEN
LET AA$=A$(MOD(N1-1,NUM)+1) ! 当たり判定(青線)
LET BB$=B$(MOD(N2-1,NUM)+1)
LET CC$=C$(MOD(N3-1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP2
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN
LET COIN=COIN+100
CALL DISP2
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP2
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP2
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP2
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP2
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP2
END IF

LET AA$=A$(MOD(N1+1,NUM)+1) ! 当たり判定(青線)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP3
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN
LET COIN=COIN+100
CALL DISP3
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP3
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP3
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP3
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP3
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP3
END IF
END IF

IF BET(3)=1 THEN
LET AA$=A$(MOD(N1-1,NUM)+1) ! 当たり判定(黄線)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP4
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN
LET COIN=COIN+100
CALL DISP4
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP4
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP4
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP4
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP4
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP4
END IF

LET AA$=A$(MOD(N1+1,NUM)+1) ! 当たり判定(黄線)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3-1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP5
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN
LET COIN=COIN+100
CALL DISP5
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN
LET COIN=COIN+200
CALL DISP5
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN
LET COIN=COIN+200
CALL DISP5
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN
LET COIN=COIN+200
CALL DISP5
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN
LET COIN=COIN+100
CALL DISP5
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN
LET COIN=COIN+100
CALL DISP5
END IF
END IF

IF BET(4)=1 THEN
LET AA$=A$(MOD(N1-1,NUM)+1) ! 当たり判定(紫線)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3-1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP6
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP6
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN ! 1,2,3が揃う
LET COIN=COIN+200
CALL DISP6
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN ! 4,5,6が揃う
LET COIN=COIN+200
CALL DISP6
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN ! 7,8,9が揃う
LET COIN=COIN+200
CALL DISP6
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN ! ?と他2つが揃う
LET COIN=COIN+100
CALL DISP6
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN ! ?が2つ揃う
LET COIN=COIN+100
CALL DISP6
END IF

LET AA$=A$(MOD(N1+1,NUM)+1) ! 当たり判定(紫線)
LET BB$=B$(MOD(N2-1,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP7
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP7
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN ! 1,2,3が揃う
LET COIN=COIN+200
CALL DISP7
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN ! 4,5,6が揃う
LET COIN=COIN+200
CALL DISP7
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN ! 7,8,9が揃う
LET COIN=COIN+200
CALL DISP7
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN ! ?と他2つが揃う
LET COIN=COIN+100
CALL DISP7
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN ! ?が2つ揃う
LET COIN=COIN+100
CALL DISP7
END IF
END IF

IF BET(5)=1 THEN
LET AA$=A$(MOD(N1,NUM)+1) ! 当たり判定(水色線)
LET BB$=B$(MOD(N2-1,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP8
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP8
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN ! 1,2,3が揃う
LET COIN=COIN+200
CALL DISP8
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN ! 4,5,6が揃う
LET COIN=COIN+200
CALL DISP8
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN ! 7,8,9が揃う
LET COIN=COIN+200
CALL DISP8
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN ! ?と他2つが揃う
LET COIN=COIN+100
CALL DISP8
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN ! ?が2つ揃う
LET COIN=COIN+100
CALL DISP8
END IF

LET AA$=A$(MOD(N1,NUM)+1) ! 当たり判定(水色線)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
IF AA$=BB$ AND BB$=CC$ THEN
IF AA$="V" THEN LET COIN=COIN+400 ELSE LET COIN=COIN+200
CALL DISP9
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP9
END IF
IF AA$="1" AND BB$="2" AND CC$="3" THEN ! 1,2,3が揃う
LET COIN=COIN+200
CALL DISP9
END IF
IF AA$="4" AND BB$="5" AND CC$="6" THEN ! 4,5,6が揃う
LET COIN=COIN+200
CALL DISP9
END IF
IF AA$="7" AND BB$="8" AND CC$="9" THEN ! 7,8,9が揃う
LET COIN=COIN+200
CALL DISP9
END IF
IF (AA$=BB$ AND CC$="?") OR (AA$="?" AND BB$=CC$) OR (BB$="?" AND AA$=CC$) THEN ! ?と他2つが揃う
LET COIN=COIN+100
CALL DISP9
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (BB$="?" AND CC$="?") THEN ! ?が2つ揃う
LET COIN=COIN+100
CALL DISP9
END IF
END IF

IF COIN>=GOAL THEN ! ゲームクリア
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 400,300:"Congratulations"
STOP
END IF
IF COIN<=0 THEN ! ゲームオーバー
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 400,300:"Game Over!!"
STOP
END IF
SET TEXT COLOR 5
SET TEXT HEIGHT 40
PLOT TEXT ,AT 400,700:"一時停止"
DO
LOOP UNTIL GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
LOOP

SUB SLOT1
LET N1=N1+1
PLOT TEXT ,AT 200,150:A$(MOD(N1-1,NUM)+1)
PLOT TEXT ,AT 200,300:A$(MOD(N1,NUM)+1)
PLOT TEXT ,AT 200,450:A$(MOD(N1+1,NUM)+1)
END SUB

SUB SLOT2
LET N2=N2+1
PLOT TEXT ,AT 400,150:B$(MOD(N2-1,NUM)+1)
PLOT TEXT ,AT 400,300:B$(MOD(N2,NUM)+1)
PLOT TEXT ,AT 400,450:B$(MOD(N2+1,NUM)+1)
END SUB

SUB SLOT3
LET N3=N3+1
PLOT TEXT ,AT 600,150:C$(MOD(N3-1,NUM)+1)
PLOT TEXT ,AT 600,300:C$(MOD(N3,NUM)+1)
PLOT TEXT ,AT 600,450:C$(MOD(N3+1,NUM)+1)
END SUB

SUB DISP1 ! 緑線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,300:AA$
PLOT TEXT ,AT 400,300:BB$
PLOT TEXT ,AT 600,300:CC$
END SUB

SUB DISP2 ! 青線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,150:AA$
PLOT TEXT ,AT 400,150:BB$
PLOT TEXT ,AT 600,150:CC$
END SUB

SUB DISP3 ! 青線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,450:AA$
PLOT TEXT ,AT 400,450:BB$
PLOT TEXT ,AT 600,450:CC$
END SUB

SUB DISP4 ! 黄線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,150:AA$
PLOT TEXT ,AT 400,300:BB$
PLOT TEXT ,AT 600,450:CC$
END SUB

SUB DISP5 ! 黄線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,450:AA$
PLOT TEXT ,AT 400,300:BB$
PLOT TEXT ,AT 600,150:CC$
END SUB

SUB DISP6 ! 紫線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,150:AA$
PLOT TEXT ,AT 400,450:BB$
PLOT TEXT ,AT 600,150:CC$
END SUB

SUB DISP7 ! 紫線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,450:AA$
PLOT TEXT ,AT 400,150:BB$
PLOT TEXT ,AT 600,450:CC$
END SUB

SUB DISP8 ! 水色線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,300:AA$
PLOT TEXT ,AT 400,150:BB$
PLOT TEXT ,AT 600,300:CC$
END SUB

SUB DISP9 ! 水色線
SET TEXT COLOR 2
PLOT TEXT ,AT 200,300:AA$
PLOT TEXT ,AT 400,450:BB$
PLOT TEXT ,AT 600,300:CC$
END SUB
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

Re: スロットゲーム - しばっち

2025/02/16 (Sun) 07:58:13

スロットを4つにしてみました。
かなりゆるい設定にしています。たいていの場合はゲームオーバーにならずクリアできます。
当たり判定を変更したりBET金額を増やすと難しくできます。

RANDOMIZE
LET NUM=12
DIM A$(NUM),B$(NUM),C$(NUM),D$(NUM),ST(4),BET(3)
MAT READ A$
MAT B$=A$
MAT C$=A$
MAT D$=A$
FOR I=1 TO NUM
SWAP A$(I),A$(INT(RND*NUM)+1)
SWAP B$(I),B$(INT(RND*NUM)+1)
SWAP C$(I),C$(INT(RND*NUM)+1)
SWAP D$(I),D$(INT(RND*NUM)+1)
NEXT I
DATA 1,2,3,4,5,6,7,8,9,X,V,"?" ! コマ
CALL GINIT(800,800)
SET TEXT COLOR 7
SET TEXT BACKGROUND "OPAQUE"
SET TEXT JUSTIFY "CENTER","HALF"
SET LINE WIDTH 10
LET P$="BETしてください"
SET TEXT HEIGHT 30
PLOT TEXT ,AT 400,160:"200 コイン(1)"
PLOT TEXT ,AT 400,320:"600 コイン(2)"
PLOT TEXT ,AT 400,480:"1000 コイン(3)"
PLOT TEXT ,AT 400,640:"2000 コイン(4)"
PLOT TEXT ,AT 400,20:"所持金はいくらにしますか?"
DO
IF GETKEYSTATE(ORD("1"))<0 OR GETKEYSTATE(97)<0 THEN
LET COIN=200
LET GOAL=1000
EXIT DO
END IF
IF GETKEYSTATE(ORD("2"))<0 OR GETKEYSTATE(98)<0 THEN
LET COIN=600
LET GOAL=3000
EXIT DO
END IF
IF GETKEYSTATE(ORD("3"))<0 OR GETKEYSTATE(99)<0 THEN
LET COIN=1000
LET GOAL=5000
EXIT DO
END IF
IF GETKEYSTATE(ORD("4"))<0 OR GETKEYSTATE(100)<0 THEN
LET COIN=2000
LET GOAL=10000
EXIT DO
END IF
LOOP
DO ! ゲームスタート
MAT BET=ZER
CLEAR
SET TEXT COLOR 7
SET TEXT HEIGHT 40
PLOT TEXT ,AT 400,700:P$
LET I=0
DO
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
IF GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0 THEN
LET I=I+1
LET BET(I)=1
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
SELECT CASE I
CASE 1
SET LINE COLOR 4 ! 緑線
PLOT LINES:160,320;640,320
PLOT LINES:160,480;640,480
LET COIN=COIN-10
CASE 2
SET LINE COLOR 1 ! 青線
PLOT LINES:160,160;640,160
PLOT LINES:160,640;640,640
LET COIN=COIN-10
CASE 3
SET LINE COLOR 6 ! 黄線
PLOT LINES:160,160;640,640
PLOT LINES:160,640;640,160
LET COIN=COIN-10
END SELECT
END IF
IF I>=1 AND (GETKEYSTATE(ORD("S"))<0 OR GETKEYSTATE(ORD("s"))<0) THEN EXIT DO
LOOP UNTIL I=3

SET TEXT HEIGHT 40
PLOT TEXT ,AT 400,700:REPEAT$(" ",BLEN(P$))
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT HEIGHT 120
LET N=0
MAT ST=ZER
DO
IF ST(1)=0 THEN CALL SLOT1 ! スロット回転
IF ST(2)=0 THEN CALL SLOT2
IF ST(3)=0 THEN CALL SLOT3
IF ST(4)=0 THEN CALL SLOT4
IF GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0 THEN
LET N=N+1
LET ST(N)=1
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
END IF
IF GETKEYSTATE(ORD("1"))<0 OR GETKEYSTATE(97)<0 THEN LET ST(1)=1
IF GETKEYSTATE(ORD("2"))<0 OR GETKEYSTATE(98)<0 THEN LET ST(2)=1
IF GETKEYSTATE(ORD("3"))<0 OR GETKEYSTATE(99)<0 THEN LET ST(3)=1
IF GETKEYSTATE(ORD("4"))<0 OR GETKEYSTATE(100)<0 THEN LET ST(4)=1
WAIT DELAY 1/8
LOOP UNTIL ST(1)=1 AND ST(2)=1 AND ST(3)=1 AND ST(4)=1

IF BET(1)=1 THEN
LET AA$=A$(MOD(N1,NUM)+1) ! 当たり判定(緑線)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
LET DD$=D$(MOD(N4,NUM)+1)
IF AA$=BB$ AND BB$=CC$ AND CC$=DD$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP1
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$)+POS("123456789XV",DD$),10)=0 THEN ! Xは10 Vは11 ?は0とする
LET COIN=COIN+100
CALL DISP1
END IF
IF AA$="1" AND BB$="2" AND CC$="3" AND DD$="4" THEN ! 1,2,3,4が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF AA$="5" AND BB$="6" AND CC$="7" AND DD$="8" THEN ! 5,6,7,8が揃う
LET COIN=COIN+200
CALL DISP1
END IF
IF (AA$=BB$ AND BB$=DD$ AND CC$="?") OR (AA$="?" AND BB$=CC$ AND CC$=DD$) OR (BB$="?" AND AA$=CC$ AND CC$=DD$) OR (DD$="?" AND AA$=BB$ AND BB$=CC$) THEN ! ?と他3つが揃う
LET COIN=COIN+100
CALL DISP1
END IF
IF (AA$="?" AND BB$="?" AND CC$="?") OR (AA$="?" AND CC$="?" AND DD$="?") OR (BB$="?" AND CC$="?" AND DD$="?") OR (AA$="?" AND BB$="?" AND DD$="?") THEN ! ?が3つ揃う
LET COIN=COIN+100
CALL DISP1
END IF

LET AA$=A$(MOD(N1+1,NUM)+1) ! 当たり判定(緑線)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
LET DD$=D$(MOD(N4+1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ AND CC$=DD$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP2
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$)+POS("123456789XV",DD$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP2
END IF
IF AA$="1" AND BB$="2" AND CC$="3" AND DD$="4" THEN ! 1,2,3,4が揃う
LET COIN=COIN+200
CALL DISP2
END IF
IF AA$="5" AND BB$="6" AND CC$="7" AND DD$="8" THEN ! 5,6,7,8が揃う
LET COIN=COIN+200
CALL DISP2
END IF
IF (AA$=BB$ AND BB$=DD$ AND CC$="?") OR (AA$="?" AND BB$=CC$ AND CC$=DD$) OR (BB$="?" AND AA$=CC$ AND CC$=DD$) OR (DD$="?" AND AA$=BB$ AND BB$=CC$) THEN ! ?と他3つが揃う
LET COIN=COIN+100
CALL DISP2
END IF
IF (AA$="?" AND BB$="?" AND CC$="?") OR (AA$="?" AND CC$="?" AND DD$="?") OR (BB$="?" AND CC$="?" AND DD$="?") OR (AA$="?" AND BB$="?" AND DD$="?") THEN ! ?が3つ揃う
LET COIN=COIN+100
CALL DISP2
END IF
END IF

IF BET(2)=1 THEN
LET AA$=A$(MOD(N1-1,NUM)+1) ! 当たり判定(青線)
LET BB$=B$(MOD(N2-1,NUM)+1)
LET CC$=C$(MOD(N3-1,NUM)+1)
LET DD$=D$(MOD(N4-1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ AND CC$=DD$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP3
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$)+POS("123456789XV",DD$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP3
END IF
IF AA$="1" AND BB$="2" AND CC$="3" AND DD$="4" THEN ! 1,2,3,4が揃う
LET COIN=COIN+200
CALL DISP3
END IF
IF AA$="5" AND BB$="6" AND CC$="7" AND DD$="8" THEN ! 5,6,7,8が揃う
LET COIN=COIN+200
CALL DISP3
END IF
IF (AA$=BB$ AND BB$=DD$ AND CC$="?") OR (AA$="?" AND BB$=CC$ AND CC$=DD$) OR (BB$="?" AND AA$=CC$ AND CC$=DD$) OR (DD$="?" AND AA$=BB$ AND BB$=CC$) THEN ! ?と他3つが揃う
LET COIN=COIN+100
CALL DISP3
END IF
IF (AA$="?" AND BB$="?" AND CC$="?") OR (AA$="?" AND CC$="?" AND DD$="?") OR (BB$="?" AND CC$="?" AND DD$="?") OR (AA$="?" AND BB$="?" AND DD$="?") THEN ! ?が3つ揃う
LET COIN=COIN+100
CALL DISP3
END IF

LET AA$=A$(MOD(N1+2,NUM)+1) ! 当たり判定(青線)
LET BB$=B$(MOD(N2+2,NUM)+1)
LET CC$=C$(MOD(N3+2,NUM)+1)
LET DD$=D$(MOD(N4+2,NUM)+1)
IF AA$=BB$ AND BB$=CC$ AND CC$=DD$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP4
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$)+POS("123456789XV",DD$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP4
END IF
IF AA$="1" AND BB$="2" AND CC$="3" AND DD$="4" THEN ! 1,2,3,4が揃う
LET COIN=COIN+200
CALL DISP4
END IF
IF AA$="5" AND BB$="6" AND CC$="7" AND DD$="8" THEN ! 5,6,7,8が揃う
LET COIN=COIN+200
CALL DISP4
END IF
IF (AA$=BB$ AND BB$=DD$ AND CC$="?") OR (AA$="?" AND BB$=CC$ AND CC$=DD$) OR (BB$="?" AND AA$=CC$ AND CC$=DD$) OR (DD$="?" AND AA$=BB$ AND BB$=CC$) THEN ! ?と他3つが揃う
LET COIN=COIN+100
CALL DISP4
END IF
IF (AA$="?" AND BB$="?" AND CC$="?") OR (AA$="?" AND CC$="?" AND DD$="?") OR (BB$="?" AND CC$="?" AND DD$="?") OR (AA$="?" AND BB$="?" AND DD$="?") THEN ! ?が3つ揃う
LET COIN=COIN+100
CALL DISP4
END IF
END IF

IF BET(3)=1 THEN
LET AA$=A$(MOD(N1-1,NUM)+1) ! 当たり判定(黄線)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
LET DD$=D$(MOD(N4+2,NUM)+1)
IF AA$=BB$ AND BB$=CC$ AND CC$=DD$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP5
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$)+POS("123456789XV",DD$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP5
END IF
IF AA$="1" AND BB$="2" AND CC$="3" AND DD$="4" THEN ! 1,2,3,4が揃う
LET COIN=COIN+200
CALL DISP5
END IF
IF AA$="5" AND BB$="6" AND CC$="7" AND DD$="8" THEN ! 5,6,7,8が揃う
LET COIN=COIN+200
CALL DISP5
END IF
IF (AA$=BB$ AND BB$=DD$ AND CC$="?") OR (AA$="?" AND BB$=CC$ AND CC$=DD$) OR (BB$="?" AND AA$=CC$ AND CC$=DD$) OR (DD$="?" AND AA$=BB$ AND BB$=CC$) THEN ! ?と他3つが揃う
LET COIN=COIN+100
CALL DISP5
END IF
IF (AA$="?" AND BB$="?" AND CC$="?") OR (AA$="?" AND CC$="?" AND DD$="?") OR (BB$="?" AND CC$="?" AND DD$="?") OR (AA$="?" AND BB$="?" AND DD$="?") THEN ! ?が3つ揃う
LET COIN=COIN+100
CALL DISP5
END IF

LET AA$=A$(MOD(N1+2,NUM)+1) ! 当たり判定(黄線)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
LET DD$=D$(MOD(N4-1,NUM)+1)
IF AA$=BB$ AND BB$=CC$ AND CC$=DD$ THEN
IF AA$="V" THEN LET COIN=COIN+1000 ELSE LET COIN=COIN+500 ! Vが揃うと1000、他なら500
CALL DISP6
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$)+POS("123456789XV",DD$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP6
END IF
IF AA$="1" AND BB$="2" AND CC$="3" AND DD$="4" THEN ! 1,2,3,4が揃う
LET COIN=COIN+200
CALL DISP6
END IF
IF AA$="5" AND BB$="6" AND CC$="7" AND DD$="8" THEN ! 5,6,7,8が揃う
LET COIN=COIN+200
CALL DISP6
END IF
IF (AA$=BB$ AND BB$=DD$ AND CC$="?") OR (AA$="?" AND BB$=CC$ AND CC$=DD$) OR (BB$="?" AND AA$=CC$ AND CC$=DD$) OR (DD$="?" AND AA$=BB$ AND BB$=CC$) THEN ! ?と他3つが揃う
LET COIN=COIN+100
CALL DISP6
END IF
IF (AA$="?" AND BB$="?" AND CC$="?") OR (AA$="?" AND CC$="?" AND DD$="?") OR (BB$="?" AND CC$="?" AND DD$="?") OR (AA$="?" AND BB$="?" AND DD$="?") THEN ! ?が3つ揃う
LET COIN=COIN+100
CALL DISP6
END IF
END IF

IF COIN>=GOAL THEN ! ゲームクリア
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 400,300:"Congratulations"
STOP
END IF
IF COIN<=0 THEN ! ゲームオーバー
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 400,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 400,300:"Game Over!!"
STOP
END IF
SET TEXT COLOR 5
SET TEXT HEIGHT 40
PLOT TEXT ,AT 400,730:"一時停止"
DO
LOOP UNTIL GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
LOOP

SUB SLOT1
LET N1=N1+1
PLOT TEXT ,AT 160,160:A$(MOD(N1-1,NUM)+1)
PLOT TEXT ,AT 160,320:A$(MOD(N1,NUM)+1)
PLOT TEXT ,AT 160,480:A$(MOD(N1+1,NUM)+1)
PLOT TEXT ,AT 160,640:A$(MOD(N1+2,NUM)+1)
END SUB

SUB SLOT2
LET N2=N2+1
PLOT TEXT ,AT 320,160:B$(MOD(N2-1,NUM)+1)
PLOT TEXT ,AT 320,320:B$(MOD(N2,NUM)+1)
PLOT TEXT ,AT 320,480:B$(MOD(N2+1,NUM)+1)
PLOT TEXT ,AT 320,640:B$(MOD(N2+2,NUM)+1)
END SUB

SUB SLOT3
LET N3=N3+1
PLOT TEXT ,AT 480,160:C$(MOD(N3-1,NUM)+1)
PLOT TEXT ,AT 480,320:C$(MOD(N3,NUM)+1)
PLOT TEXT ,AT 480,480:C$(MOD(N3+1,NUM)+1)
PLOT TEXT ,AT 480,640:C$(MOD(N3+2,NUM)+1)
END SUB

SUB SLOT4
LET N4=N4+1
PLOT TEXT ,AT 640,160:D$(MOD(N4-1,NUM)+1)
PLOT TEXT ,AT 640,320:D$(MOD(N4,NUM)+1)
PLOT TEXT ,AT 640,480:D$(MOD(N4+1,NUM)+1)
PLOT TEXT ,AT 640,640:D$(MOD(N4+2,NUM)+1)
END SUB

SUB DISP1 ! 緑線
SET TEXT COLOR 2
PLOT TEXT ,AT 160,320:AA$
PLOT TEXT ,AT 320,320:BB$
PLOT TEXT ,AT 480,320:CC$
PLOT TEXT ,AT 640,320:DD$
END SUB

SUB DISP2 ! 緑線
SET TEXT COLOR 2
PLOT TEXT ,AT 160,480:AA$
PLOT TEXT ,AT 320,480:BB$
PLOT TEXT ,AT 480,480:CC$
PLOT TEXT ,AT 640,480:DD$
END SUB

SUB DISP3 ! 青線
SET TEXT COLOR 2
PLOT TEXT ,AT 160,160:AA$
PLOT TEXT ,AT 320,160:BB$
PLOT TEXT ,AT 480,160:CC$
PLOT TEXT ,AT 640,160:DD$
END SUB

SUB DISP4 ! 青線
SET TEXT COLOR 2
PLOT TEXT ,AT 160,320:AA$
PLOT TEXT ,AT 320,320:BB$
PLOT TEXT ,AT 480,320:CC$
PLOT TEXT ,AT 640,320:DD$
END SUB

SUB DISP5 ! 黄線
SET TEXT COLOR 2
PLOT TEXT ,AT 160,160:AA$
PLOT TEXT ,AT 320,320:BB$
PLOT TEXT ,AT 480,480:CC$
PLOT TEXT ,AT 640,640:DD$
END SUB

SUB DISP6 ! 黄線
SET TEXT COLOR 2
PLOT TEXT ,AT 160,640:AA$
PLOT TEXT ,AT 320,480:BB$
PLOT TEXT ,AT 480,320:CC$
PLOT TEXT ,AT 640,160:DD$
END SUB
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

Re: スロットゲーム - しばっち

2025/02/16 (Sun) 07:59:43

スロット5つにしてみました。

5つ揃えるのは至難の業ですが、かなりゆるい設定にしているのでゲームクリアは可能です。

RANDOMIZE
LET NUM=12
DIM A$(NUM),B$(NUM),C$(NUM),D$(NUM),E$(NUM),ST(5),BET(4)
MAT READ A$
MAT B$=A$
MAT C$=A$
MAT D$=A$
MAT E$=A$
FOR I=1 TO NUM
SWAP A$(I),A$(INT(RND*NUM)+1)
SWAP B$(I),B$(INT(RND*NUM)+1)
SWAP C$(I),C$(INT(RND*NUM)+1)
SWAP D$(I),D$(INT(RND*NUM)+1)
SWAP E$(I),E$(INT(RND*NUM)+1)
NEXT I
DATA 1,2,3,4,5,6,7,8,9,X,V,"?" ! コマ
CALL GINIT(900,900)
SET TEXT COLOR 7
SET TEXT BACKGROUND "OPAQUE"
SET TEXT JUSTIFY "CENTER","HALF"
SET LINE WIDTH 10
LET P$="BETしてください"
SET TEXT HEIGHT 30
PLOT TEXT ,AT 450,160:"200 コイン(1)"
PLOT TEXT ,AT 450,320:"600 コイン(2)"
PLOT TEXT ,AT 450,480:"1000 コイン(3)"
PLOT TEXT ,AT 450,640:"2000 コイン(4)"
PLOT TEXT ,AT 450,20:"所持金はいくらにしますか?"
DO
IF GETKEYSTATE(ORD("1"))<0 OR GETKEYSTATE(97)<0 THEN
LET COIN=200
LET GOAL=1000
EXIT DO
END IF
IF GETKEYSTATE(ORD("2"))<0 OR GETKEYSTATE(98)<0 THEN
LET COIN=600
LET GOAL=3000
EXIT DO
END IF
IF GETKEYSTATE(ORD("3"))<0 OR GETKEYSTATE(99)<0 THEN
LET COIN=1000
LET GOAL=5000
EXIT DO
END IF
IF GETKEYSTATE(ORD("4"))<0 OR GETKEYSTATE(100)<0 THEN
LET COIN=2000
LET GOAL=10000
EXIT DO
END IF
LOOP
DO ! ゲームスタート
MAT BET=ZER
CLEAR
SET TEXT COLOR 7
SET TEXT HEIGHT 40
PLOT TEXT ,AT 450,800:P$
LET I=0
DO
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 450,50:" COIN:"&STR$(COIN)&" "
IF GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0 THEN
LET I=I+1
LET BET(I)=1
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
SELECT CASE I
CASE 1
SET LINE COLOR 4 ! 緑線(真ん中)
PLOT LINES:150,450;750,450
LET COIN=COIN-10
CASE 2
SET LINE COLOR 1 ! 青線(上下)
PLOT LINES:150,300;750,300
PLOT LINES:150,600;750,600
LET COIN=COIN-10
CASE 3
SET LINE COLOR 3 ! 紫線(上下)
PLOT LINES:150,150;750,150
PLOT LINES:150,750;750,750
LET COIN=COIN-10
CASE 4
SET LINE COLOR 6 ! 黄線(対角線)
PLOT LINES:150,150;750,750
PLOT LINES:150,750;750,150
LET COIN=COIN-10
END SELECT
END IF
IF I>=1 AND (GETKEYSTATE(ORD("S"))<0 OR GETKEYSTATE(ORD("s"))<0) THEN EXIT DO
LOOP UNTIL I=4

SET TEXT HEIGHT 40
PLOT TEXT ,AT 450,800:REPEAT$(" ",BLEN(P$))
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 450,50:" COIN:"&STR$(COIN)&" "
SET TEXT HEIGHT 120
LET N=0
MAT ST=ZER
DO
IF ST(1)=0 THEN CALL SLOT1 ! スロット回転
IF ST(2)=0 THEN CALL SLOT2
IF ST(3)=0 THEN CALL SLOT3
IF ST(4)=0 THEN CALL SLOT4
IF ST(5)=0 THEN CALL SLOT5
IF GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0 THEN
LET N=N+1
LET ST(N)=1
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
END IF
IF GETKEYSTATE(ORD("1"))<0 OR GETKEYSTATE(97)<0 THEN LET ST(1)=1
IF GETKEYSTATE(ORD("2"))<0 OR GETKEYSTATE(98)<0 THEN LET ST(2)=1
IF GETKEYSTATE(ORD("3"))<0 OR GETKEYSTATE(99)<0 THEN LET ST(3)=1
IF GETKEYSTATE(ORD("4"))<0 OR GETKEYSTATE(100)<0 THEN LET ST(4)=1
IF GETKEYSTATE(ORD("5"))<0 OR GETKEYSTATE(101)<0 THEN LET ST(5)=1
WAIT DELAY 1/8
LOOP UNTIL ST(1)=1 AND ST(2)=1 AND ST(3)=1 AND ST(4)=1 AND ST(5)=1

IF BET(1)=1 THEN
LET AA$=A$(MOD(N1,NUM)+1) ! 当たり判定(緑線)
LET BB$=B$(MOD(N2,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
LET DD$=D$(MOD(N4,NUM)+1)
LET EE$=E$(MOD(N5,NUM)+1)
CALL CHECK(1)
END IF

IF BET(2)=1 THEN
LET AA$=A$(MOD(N1-1,NUM)+1) ! 当たり判定(青線)
LET BB$=B$(MOD(N2-1,NUM)+1)
LET CC$=C$(MOD(N3-1,NUM)+1)
LET DD$=D$(MOD(N4-1,NUM)+1)
LET EE$=E$(MOD(N5-1,NUM)+1)
CALL CHECK(2)

LET AA$=A$(MOD(N1+1,NUM)+1) ! 当たり判定(青線)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3+1,NUM)+1)
LET DD$=D$(MOD(N4+1,NUM)+1)
LET EE$=E$(MOD(N5+1,NUM)+1)
CALL CHECK(3)
END IF

IF BET(3)=1 THEN
LET AA$=A$(MOD(N1-2,NUM)+1) ! 当たり判定(紫線)
LET BB$=B$(MOD(N2-2,NUM)+1)
LET CC$=C$(MOD(N3-2,NUM)+1)
LET DD$=D$(MOD(N4-2,NUM)+1)
LET EE$=E$(MOD(N5-2,NUM)+1)
CALL CHECK(4)

LET AA$=A$(MOD(N1+2,NUM)+1) ! 当たり判定(紫線)
LET BB$=B$(MOD(N2+2,NUM)+1)
LET CC$=C$(MOD(N3+2,NUM)+1)
LET DD$=D$(MOD(N4+2,NUM)+1)
LET EE$=E$(MOD(N5+2,NUM)+1)
CALL CHECK(5)
END IF

IF BET(4)=1 THEN
LET AA$=A$(MOD(N1-2,NUM)+1) ! 当たり判定(黄線)
LET BB$=B$(MOD(N2-1,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
LET DD$=D$(MOD(N4+1,NUM)+1)
LET EE$=E$(MOD(N5+2,NUM)+1)
CALL CHECK(6)

LET AA$=A$(MOD(N1+2,NUM)+1) ! 当たり判定(黄線)
LET BB$=B$(MOD(N2+1,NUM)+1)
LET CC$=C$(MOD(N3,NUM)+1)
LET DD$=D$(MOD(N4-1,NUM)+1)
LET EE$=E$(MOD(N5-2,NUM)+1)
CALL CHECK(7)
END IF

IF COIN>=GOAL THEN ! ゲームクリア
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 450,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 450,450:"Congratulations"
STOP
END IF
IF COIN<=0 THEN ! ゲームオーバー
SET TEXT HEIGHT 50
SET TEXT COLOR 7
PLOT TEXT ,AT 450,50:" COIN:"&STR$(COIN)&" "
SET TEXT COLOR 5
SET TEXT HEIGHT 70
PLOT TEXT ,AT 450,450:"Game Over!!"
STOP
END IF
SET TEXT COLOR 5
SET TEXT HEIGHT 40
PLOT TEXT ,AT 450,830:"一時停止"
DO
LOOP UNTIL GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
DO
LOOP WHILE GETKEYSTATE(32)<0 OR GETKEYSTATE(13)<0
LOOP

SUB SLOT1
LET N1=N1+1
PLOT TEXT ,AT 150,150:A$(MOD(N1-2,NUM)+1)
PLOT TEXT ,AT 150,300:A$(MOD(N1-1,NUM)+1)
PLOT TEXT ,AT 150,450:A$(MOD(N1,NUM)+1)
PLOT TEXT ,AT 150,600:A$(MOD(N1+1,NUM)+1)
PLOT TEXT ,AT 150,750:A$(MOD(N1+2,NUM)+1)
END SUB

SUB SLOT2
LET N2=N2+1
PLOT TEXT ,AT 300,150:B$(MOD(N2-2,NUM)+1)
PLOT TEXT ,AT 300,300:B$(MOD(N2-1,NUM)+1)
PLOT TEXT ,AT 300,450:B$(MOD(N2,NUM)+1)
PLOT TEXT ,AT 300,600:B$(MOD(N2+1,NUM)+1)
PLOT TEXT ,AT 300,750:B$(MOD(N2+2,NUM)+1)
END SUB

SUB SLOT3
LET N3=N3+1
PLOT TEXT ,AT 450,150:C$(MOD(N3-2,NUM)+1)
PLOT TEXT ,AT 450,300:C$(MOD(N3-1,NUM)+1)
PLOT TEXT ,AT 450,450:C$(MOD(N3,NUM)+1)
PLOT TEXT ,AT 450,600:C$(MOD(N3+1,NUM)+1)
PLOT TEXT ,AT 450,750:C$(MOD(N3+2,NUM)+1)
END SUB

SUB SLOT4
LET N4=N4+1
PLOT TEXT ,AT 600,150:D$(MOD(N4-2,NUM)+1)
PLOT TEXT ,AT 600,300:D$(MOD(N4-1,NUM)+1)
PLOT TEXT ,AT 600,450:D$(MOD(N4,NUM)+1)
PLOT TEXT ,AT 600,600:D$(MOD(N4+1,NUM)+1)
PLOT TEXT ,AT 600,750:D$(MOD(N4+2,NUM)+1)
END SUB

SUB SLOT5
LET N5=N5+1
PLOT TEXT ,AT 750,150:E$(MOD(N5-2,NUM)+1)
PLOT TEXT ,AT 750,300:E$(MOD(N5-1,NUM)+1)
PLOT TEXT ,AT 750,450:E$(MOD(N5,NUM)+1)
PLOT TEXT ,AT 750,600:E$(MOD(N5+1,NUM)+1)
PLOT TEXT ,AT 750,750:E$(MOD(N5+2,NUM)+1)
END SUB

SUB DISP(N) ! 緑線
SET TEXT COLOR 2
SELECT CASE N
CASE 1
PLOT TEXT ,AT 150,450:AA$
PLOT TEXT ,AT 300,450:BB$
PLOT TEXT ,AT 450,450:CC$
PLOT TEXT ,AT 600,450:DD$
PLOT TEXT ,AT 750,450:EE$
CASE 2
PLOT TEXT ,AT 150,300:AA$
PLOT TEXT ,AT 300,300:BB$
PLOT TEXT ,AT 450,300:CC$
PLOT TEXT ,AT 600,300:DD$
PLOT TEXT ,AT 750,300:EE$
CASE 3
PLOT TEXT ,AT 150,600:AA$
PLOT TEXT ,AT 300,600:BB$
PLOT TEXT ,AT 450,600:CC$
PLOT TEXT ,AT 600,600:DD$
PLOT TEXT ,AT 750,600:EE$
CASE 4
PLOT TEXT ,AT 150,150:AA$
PLOT TEXT ,AT 300,150:BB$
PLOT TEXT ,AT 450,150:CC$
PLOT TEXT ,AT 600,150:DD$
PLOT TEXT ,AT 750,150:EE$
CASE 5
PLOT TEXT ,AT 150,750:AA$
PLOT TEXT ,AT 300,750:BB$
PLOT TEXT ,AT 450,750:CC$
PLOT TEXT ,AT 600,750:DD$
PLOT TEXT ,AT 750,750:EE$
CASE 6
PLOT TEXT ,AT 150,150:AA$
PLOT TEXT ,AT 300,300:BB$
PLOT TEXT ,AT 450,450:CC$
PLOT TEXT ,AT 600,600:DD$
PLOT TEXT ,AT 750,750:EE$
CASE 7
PLOT TEXT ,AT 150,750:AA$
PLOT TEXT ,AT 300,600:BB$
PLOT TEXT ,AT 450,450:CC$
PLOT TEXT ,AT 600,300:DD$
PLOT TEXT ,AT 750,150:EE$
END SELECT
END SUB

SUB CHECK(N)
IF AA$=BB$ AND BB$=CC$ AND CC$=DD$ AND DD$=EE$ THEN
IF AA$="V" THEN LET COIN=COIN+2000 ELSE LET COIN=COIN+1000
CALL DISP(N)
END IF
IF (AA$=BB$ AND BB$=CC$ AND CC$=DD$) OR (AA$=BB$ AND BB$=CC$ AND CC$=EE$) OR (AA$=BB$ AND BB$=DD$ AND DD$=EE$) OR (AA$=CC$ AND CC$=DD$ AND DD$=EE$) OR (BB$=CC$ AND CC$=DD$ AND DD$=EE$) THEN ! 4つ揃う
LET COIN=COIN+500
CALL DISP(N)
END IF
IF (AA$=BB$ AND BB$=CC$) OR (AA$=BB$ AND BB$=DD$) OR (AA$=BB$ AND BB$=EE$) OR (AA$=CC$ AND CC$=DD$) OR (AA$=CC$ AND CC$=EE$) THEN ! 3つ揃う
LET COIN=COIN+200
CALL DISP(N)
END IF
IF (AA$=DD$ AND DD$=EE$) OR (BB$=CC$ AND CC$=DD$) OR (BB$=CC$ AND CC$=EE$) OR (BB$=DD$ AND DD$=EE$) OR (CC$=DD$ AND DD$=EE$) THEN
LET COIN=COIN+200
CALL DISP(N)
END IF
IF MOD(POS("123456789XV",AA$)+POS("123456789XV",BB$)+POS("123456789XV",CC$)+POS("123456789XV",DD$)+POS("123456789XV",EE$),10)=0 THEN ! Xは10 Vは11とする
LET COIN=COIN+100
CALL DISP(N)
END IF
IF AA$="1" AND BB$="2" AND CC$="3" AND DD$="4" AND EE$="5" THEN ! 1,2,3,4,5が揃う
LET COIN=COIN+500
CALL DISP(N)
END IF
IF AA$="6" AND BB$="7" AND CC$="8" AND DD$="9" AND EE$="X" THEN ! 6,7,8,9,Xが揃う
LET COIN=COIN+500
CALL DISP(N)
END IF
IF (AA$="?" AND BB$="?") OR (AA$="?" AND CC$="?") OR (AA$="?" AND DD$="?") OR (AA$="?" AND EE$="?") OR (BB$="?" AND CC$="?") THEN ! ?が2つ揃う
LET COIN=COIN+200
CALL DISP(N)
END IF
IF (BB$="?" AND DD$="?") OR (BB$="?" AND EE$="?") OR (CC$="?" AND DD$="?") OR (CC$="?" AND EE$="?") OR (DD$="?" AND EE$="?") THEN ! ?が2つ揃う
LET COIN=COIN+200
CALL DISP(N)
END IF
END SUB
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

多次元配列 - しばっち

2025/01/01 (Wed) 07:51:37

十進BASICでは独自拡張で４次元までの配列が使える。
しかしながら5次元以上の配列が定義できないわけではない。

その要となるのが1次元化である。

まず、2次元配列を1次元化してみる。
配列サイズをXSIZE,YSIZEとする。

各添え字範囲を0～XSIZE-1,0～YSIZE-1とすると

DIM X(0 TO XSIZE-1,0 TO YSIZE-1) この2次元配列定義を1次元化すると

DIM X(0 TO XSIZE*YSIZE-1) となる。

LET I=1 ! 0<=I<=XSIZE-1
LET J=0 ! 0<=J<=YSIZE-1

　とすると

LET X(XSIZE*IP(J)+IP(I))=2

又は

LET X(YSIZE*IP(I)+IP(J))=2

とできる。

各添え字範囲を1～XSIZE,1～YSIZEとすると

DIM Y(XSIZE*YSIZE)
と定義でき、

LET I=1 ! 1<=I<=XSIZE
LET J=1 ! 1<=J<=YSIZE

　として

LET Y(XSIZE*IP(J-1)+IP(I))=2

又は

LET Y(YSIZE*IP(I-1)+IP(J))=2

となる。

また、添え字範囲を

LET MIN1=-3
LET MAX1=2
LET MIN2=-3
LET MAX2=2

のようにすると

DIM W(MIN1 TO MAX1,MIN2 TO MAX2)　これは

DIM W((MAX2-MIN2+1)*(MAX1-MIN1+1))

と定義できる。

LET I=-2 ! MIN1<=I<=MAX1
LET J=1 ! MIN2<=J<=MAX2

として

LET W((MAX1-MIN1+1)*IP(J-MIN2)+IP(I-MIN1+1))=3

とできる。

これを拡張していくと５次元配列は

LET MIN1=-3
LET MAX1=2
LET MIN2=-3
LET MAX2=2
LET MIN3=-3
LET MAX3=2
LET MIN4=-3
LET MAX4=2
LET MIN5=-3
LET MAX5=2
!!DIM X(MIN1 TO MAX1,MIN2 TO MAX2,MIN3 TO MAX3,MIN4 TO MAX4,MIN5 TO MAX5)
DIM X((MAX5-MIN5+1)*(MAX4-MIN4+1)*(MAX3-MIN3+1)*(MAX2-MIN2+1)*(MAX1-MIN1+1))
LET I=-1 ! MIN1<=I<=MAX1
LET J=0 ! MIN2<=J<=MAX2
LET K=2 ! MIN3<=K<=MAX3
LET L=1 ! MIN4<=L<=MAX4
LET M=-2 ! MIN5<=M<=MAX5

LET A1=MAX1-MIN1+1
LET A2=MAX2-MIN2+1
LET A3=MAX3-MIN3+1
LET A4=MAX4-MIN4+1
LET A5=MAX5-MIN5+1
LET C=A1*A2*A3*A4*IP(M-MIN5)+A1*A2*A3*IP(L-MIN4)+A1*A2*IP(K-MIN3)+A1*IP(J-MIN2)+IP(I-MIN1+1)
LET X(C)=5
PRINT A(I,J,K,L,M)

FUNCTION A(I,J,K,L,M)
IF I<MIN1 THEN LET I=MIN1
IF J<MIN2 THEN LET J=MIN2
IF K<MIN3 THEN LET K=MIN3
IF L<MIN4 THEN LET L=MIN4
IF M<MIN5 THEN LET M=MIN5
IF I>MAX1 THEN LET I=MAX1
IF J>MAX2 THEN LET J=MAX2
IF K>MAX3 THEN LET K=MAX3
IF L>MAX4 THEN LET L=MAX4
IF M>MAX5 THEN LET M=MAX5

LET A1=MAX1-MIN1+1
LET A2=MAX2-MIN2+1
LET A3=MAX3-MIN3+1
LET A4=MAX4-MIN4+1
LET A5=MAX5-MIN5+1
LET C=A1*A2*A3*A4*IP(M-MIN5)+A1*A2*A3*IP(L-MIN4)+A1*A2*IP(K-MIN3)+A1*IP(J-MIN2)+IP(I-MIN1+1)

LET A=X(C)
END FUNCTION
END

非常に式が長くなるので読み出しに関して内部関数で上記のように定義すれば
5次元配列のように使用できる。

添え字に使用する変数が実数値の時はおかしなことになるのでIP()で整数値に丸めます。
また、添え字が範囲外になる時、エラーとしてもいいのですがここでは範囲内に収まるようにしています。

6次元以上も同様に定義できます。

Re: 多次元配列 - nagram

2025/01/16 (Thu) 22:13:01

一般化してみました.

既存の配列 A を, bound(m,2) で下限,上限を設定し m次元の仮想配列に再定義する.
仮想配列の次元は何次元でもよい. Aの次元より大きくても小さくてもよい. (次元が同じ場合は MAT REDIM と同等)
仮想配列の全要素数は, Aの全要素数と等しくなくてもよい. (超えた場合はエラー)

◎ 外部関数 remat* … subscript の添字で指定した要素が仮想配列の何番目にあたるかを算出し,
同順位の A の要素を戻り値とする. (remat* の * は 1～4 の数字)
・ remat1(A,bound,subscript)
・ remat2(A,bound,subscript)
・ remat3(A,bound,subscript)
・ remat4(A,bound,subscript)
A … 元の配列. remat に続く数字の次元を持つ.
bound … 2次元配列 bound(m,2). m次元の仮想配列の各次元の下限,上限.
subscript … 1次元配列 subscript(m). 値を求めたい仮想配列の 1～m次の添字を指定.
配列要素の順位は次元の下位から変化する. DIM A(2,2,3) と定義された配列の順位は,
A(1,1,1),A(1,1,2),A(1,1,3),A(1,2,1),A(1,2,2),A(1,2,3),A(2,1,1),A(2,1,2),A(2,1,3),A(2,2,1),A(2,2,2),A(2,2,3)

◎ 外部副プログラム remat_print* … 仮想配列を一括出力する. (remat_print* の * は 1～4 の数字)
・ remat_print1(A,bound,width,intvl)
・ remat_print2(A,bound,width,intvl)
・ remat_print3(A,bound,width,intvl)
・ remat_print4(A,bound,width,intvl)
A … 元の配列. remat_print に続く数字の次元を持つ.
bound … 2次元配列 bound(m,2). m次元の仮想配列の各次元の下限,上限.
width … 仮想配列の出力欄の幅の仕様. width=1 は MAT PRINT V; に, width=2 は MAT PRINT V に相当.
intvl … 3次元以上(m>=3)の仮想配列の出力で, 間隔をあける仕様.
intvl=1 … 間隔を1行に固定 , intvl=2 … 第 j次元内の区切りで (m-j-1)行の間隔をあける
([参考] 十進BASIC の MAT PRINT で4次元配列を出力すると, 第1次元内・第2次元内の間隔は1行固定)

DECLARE EXTERNAL FUNCTION remat1, remat2, remat3, remat4
DECLARE EXTERNAL SUB remat_print1, remat_print2, remat_print3, remat_print4, mat_init
DECLARE NUMERIC m,j

DIM X(1 TO 3, 5 TO 6, 11 TO 15, 31 TO 39) ! X は 4次元配列
CALL mat_init(X) ! 元の配列の値を決定
PRINT SIZE(X,1);SIZE(X,2);SIZE(X,3);SIZE(X,4) ;" 元の配列 X の各次元のサイズ"
MAT PRINT X;
PRINT

LET m=5 ! 仮想配列の次元
DIM virtual(m,2), index(m)
DATA 1,2, 5,7, 11,12, -8,-5, 21,25 ! 仮想配列の下限,上限 (サイズは 2,3,2,4,5)
MAT READ virtual ! DIM V(1 TO 2, 5 TO 7, 11 TO 12, -8 TO -5, 21 TO 25)
PRINT "仮想配列の下限,上限"
MAT PRINT virtual;

DATA 2,7,11,-6,24 ! 値を求めたい仮想配列の指標
MAT READ index
PRINT "仮想配列の添え字を指定"
MAT PRINT index;
PRINT "仮想配列の下限を 1とした位置"
FOR j=1 TO m
PRINT index(j)-virtual(j,1)+1;
NEXT j
PRINT
PRINT
PRINT remat4(X,virtual,index) ;" 関数 remat4 の戻り値"

PRINT
PRINT
FOR j=1 TO m
PRINT virtual(j,2)-virtual(j,1)+1;
NEXT j
PRINT " 仮想配列の各次元のサイズ"
CALL remat_print4(X,virtual,1,2) ! 仮想配列の一括出力
END

EXTERNAL FUNCTION remat1(A(),bound(,),subscript()) ! 1次元配列 A を bound で仮想配列に再定義し,
DECLARE EXTERNAL SUB element_order ! subscript で指定した値
DECLARE NUMERIC n
CALL element_order(SIZE(A),bound,subscript,n)
!PRINT " A(";STR$(n);")" ! 元の配列での位置(下限を1とする)
LET remat1=A(LBOUND(A)+n-1)
END FUNCTION

EXTERNAL FUNCTION remat2(A(,),bound(,),subscript()) ! 2次元配列 A を bound で仮想配列に再定義し,
DECLARE EXTERNAL SUB element_order ! subscript で指定した値
DECLARE NUMERIC n,sz2,a2
CALL element_order(SIZE(A),bound,subscript,n)
LET sz2=SIZE(A,2)
LET a2=MOD(n,sz2)
IF a2=0 THEN LET a2=sz2
!PRINT n;" A(";CEIL(n/sz2);",";a2;")" ! 元の配列での位置(下限を1とする)
LET remat2=A(LBOUND(A,1)+CEIL(n/sz2)-1,LBOUND(A,2)+a2-1)
END FUNCTION

EXTERNAL FUNCTION remat3(A(,,),bound(,),subscript()) ! 3次元配列 A を bound で仮想配列に再定義し,
DECLARE EXTERNAL SUB element_order ! subscript で指定した値
DECLARE NUMERIC n,sz2,sz3,a2,a3
CALL element_order(SIZE(A),bound,subscript,n)
LET sz3=SIZE(A,3)
LET a3=MOD(n,sz3)
LET sz2=SIZE(A,2)
LET a2=MOD(CEIL(n/sz3),sz2)
IF a3=0 THEN LET a3=sz3
IF a2=0 THEN LET a2=sz2
!PRINT n;" A(";CEIL(n/(sz2*sz3));",";a2;",";a3;")" ! 元の配列での位置(下限を1とする)
LET remat3=A(LBOUND(A,1)+CEIL(n/(sz2*sz3))-1,LBOUND(A,2)+a2-1,LBOUND(A,3)+a3-1)
END FUNCTION

EXTERNAL FUNCTION remat4(A(,,,),bound(,),subscript()) ! 4次元配列 A を bound で仮想配列に再定義し,
DECLARE EXTERNAL SUB element_order ! subscript で指定した値
DECLARE NUMERIC n,sz2,sz3,sz4,a2,a3,a4
CALL element_order(SIZE(A),bound,subscript,n)
LET sz4=SIZE(A,4)
LET a4=MOD(n,sz4)
LET sz3=SIZE(A,3)
LET a3=MOD(CEIL(n/sz4),sz3)
LET sz2=SIZE(A,2)
LET a2=MOD(CEIL(n/(sz3*sz4)),sz2)
IF a4=0 THEN LET a4=sz4
IF a3=0 THEN LET a3=sz3
IF a2=0 THEN LET a2=sz2
!PRINT n;" A(";CEIL(n/(sz2*sz3*sz4));",";a2;",";a3;",";a4;")" ! 元の配列での位置(下限を1とする)
LET remat4=A(LBOUND(A,1)+CEIL(n/(sz2*sz3*sz4))-1,LBOUND(A,2)+a2-1,LBOUND(A,3)+a3-1,LBOUND(A,4)+a4-1)
END FUNCTION

EXTERNAL SUB element_order(sza,bd(,),ss(),n) ! 仮想配列中のssで指定した順位 → n
DECLARE NUMERIC m,sr,sz,j
LET m=SIZE(bd,1) ! 仮想配列の次元数
IF m<>SIZE(ss) OR SIZE(bd,2)<>2 THEN CAUSE EXCEPTION 6001 ! 配列の寸法の誤り
FOR j=1 TO m
LET bd(j,1)=ROUND(bd(j,1))
LET bd(j,2)=ROUND(bd(j,2))
LET ss(j)=ROUND(ss(j))
NEXT j
LET n=ss(m)-bd(m,1)+1
LET sr=bd(m,2)-bd(m,1)+1
IF ss(m)<bd(m,1) OR ss(m)>bd(m,2) OR sr<=0 THEN CAUSE EXCEPTION 2001 ! 配列の添字が範囲外
FOR j=m-1 TO 1 STEP -1
LET sz=bd(j,2)-bd(j,1)+1
IF ss(j)<bd(j,1) OR ss(j)>bd(j,2) OR sz<=0 THEN CAUSE EXCEPTION 2001 ! 配列の添字が範囲外
LET n=n+sr*(ss(j)-bd(j,1))
LET sr=sr*sz ! sr=仮想配列の下位からj次までの要素数
NEXT j
IF sr>sza THEN CAUSE EXCEPTION 5001 ! 仮想配列の全要素数が, 元の配列Aの全要素数より多い
END SUB

EXTERNAL SUB remat_print1(A(),bound(,),width,intvl) ! 元の配列が1次元である仮想配列を一括出力
DECLARE EXTERNAL SUB elements
DECLARE NUMERIC m, m1,k, i1, j
LET m=SIZE(bound,1) ! 仮想配列の次元
DIM r(m)
CALL elements(SIZE(A),bound,m,r)
IF intvl=2 THEN LET m1=1 ELSE LET m1=m-1
LET k=0
FOR i1=LBOUND(A) TO UBOUND(A)
LET k=k+1
IF width=1 THEN PRINT A(i1); ELSE PRINT A(i1),
FOR j=m TO m1 STEP -1
IF MOD(k,r(j))=0 THEN
PRINT
IF k=r(1) THEN EXIT SUB
ELSE
EXIT FOR
END IF
NEXT j
NEXT i1
END SUB

EXTERNAL SUB remat_print2(A(,),bound(,),width,intvl) ! 元の配列が2次元である仮想配列を一括出力
DECLARE EXTERNAL SUB elements
DECLARE NUMERIC m, m1,k, i1,i2, j
LET m=SIZE(bound,1) ! 仮想配列の次元
DIM r(m)
CALL elements(SIZE(A),bound,m,r)
IF intvl=2 THEN LET m1=1 ELSE LET m1=m-1
LET k=0
FOR i1=LBOUND(A,1) TO UBOUND(A,1)
FOR i2=LBOUND(A,2) TO UBOUND(A,2)
LET k=k+1
IF width=1 THEN PRINT A(i1,i2); ELSE PRINT A(i1,i2),
FOR j=m TO m1 STEP -1
IF MOD(k,r(j))=0 THEN
PRINT
IF k=r(1) THEN EXIT SUB
ELSE
EXIT FOR
END IF
NEXT j
NEXT i2
NEXT i1
END SUB

EXTERNAL SUB remat_print3(A(,,),bound(,),width,intvl) ! 元の配列が3次元である仮想配列を一括出力
DECLARE EXTERNAL SUB elements
DECLARE NUMERIC m, m1,k, i1,i2,i3, j
LET m=SIZE(bound,1) ! 仮想配列の次元
DIM r(m)
CALL elements(SIZE(A),bound,m,r)
IF intvl=2 THEN LET m1=1 ELSE LET m1=m-1
LET k=0
FOR i1=LBOUND(A,1) TO UBOUND(A,1)
FOR i2=LBOUND(A,2) TO UBOUND(A,2)
FOR i3=LBOUND(A,3) TO UBOUND(A,3)
LET k=k+1
IF width=1 THEN PRINT A(i1,i2,i3); ELSE PRINT A(i1,i2,i3),
FOR j=m TO m1 STEP -1
IF MOD(k,r(j))=0 THEN
PRINT
IF k=r(1) THEN EXIT SUB
ELSE
EXIT FOR
END IF
NEXT j
NEXT i3
NEXT i2
NEXT i1
END SUB

EXTERNAL SUB remat_print4(A(,,,),bound(,),width,intvl) ! 元の配列が4次元である仮想配列を一括出力
DECLARE EXTERNAL SUB elements
DECLARE NUMERIC m, m1,k, i1,i2,i3,i4, j
LET m=SIZE(bound,1) ! 仮想配列の次元
DIM r(m)
CALL elements(SIZE(A),bound,m,r)
IF intvl=2 THEN LET m1=1 ELSE LET m1=m-1
LET k=0
FOR i1=LBOUND(A,1) TO UBOUND(A,1)
FOR i2=LBOUND(A,2) TO UBOUND(A,2)
FOR i3=LBOUND(A,3) TO UBOUND(A,3)
FOR i4=LBOUND(A,4) TO UBOUND(A,4)
LET k=k+1
IF width=1 THEN PRINT A(i1,i2,i3,i4); ELSE PRINT A(i1,i2,i3,i4),
FOR j=m TO m1 STEP -1
IF MOD(k,r(j))=0 THEN
PRINT
IF k=r(1) THEN EXIT SUB
ELSE
EXIT FOR
END IF
NEXT j
NEXT i4
NEXT i3
NEXT i2
NEXT i1
END SUB

EXTERNAL SUB elements(sza,bb(,),m,r())
DECLARE NUMERIC j
IF SIZE(bb,2)<>2 THEN CAUSE EXCEPTION 6001 ! 配列の寸法の誤り
FOR j=1 TO m
LET bb(j,1)=ROUND(bb(j,1))
LET bb(j,2)=ROUND(bb(j,2))
NEXT j
LET r(m)=bb(m,2)-bb(m,1)+1
IF r(m)<=0 THEN CAUSE EXCEPTION 2001 ! 仮想配列の添字が範囲外
IF m>=2 THEN
FOR j=m-1 TO 1 STEP -1
LET r(j)=r(j+1)*(bb(j,2)-bb(j,1)+1)
IF r(j)<=0 THEN CAUSE EXCEPTION 2001 ! 仮想配列の添字が範囲外
NEXT j
END IF
IF r(1)>sza THEN CAUSE EXCEPTION 5001 ! 仮想配列の全要素数が, 元の配列の全要素数より多い
END SUB

EXTERNAL SUB mat_init(A(,,,)) ! 元の配列の値を決定
DECLARE NUMERIC L(4), i, i1,i2,i3,i4
FOR i=1 TO 4
LET L(i)=LBOUND(A,i)
NEXT i
FOR i1=1 TO SIZE(A,1)
FOR i2=1 TO SIZE(A,2)
FOR i3=1 TO SIZE(A,3)
FOR i4=1 TO SIZE(A,4)
LET A(L(1)+i1-1,L(2)+i2-1,L(3)+i3-1,L(4)+i4-1)=1000*i1+100*i2+10*i3+i4
! LET A(L(1)+i1-1,L(2)+i2-1,L(3)+i3-1,L(4)+i4-1)=INT(10000*RND)
NEXT i4
NEXT i3
NEXT i2
NEXT i1
END SUB

無題 - 永野護

2025/01/12 (Sun) 21:31:55

しばっち様、詳しい回答ありがとうございました。
貴重なプログラムをご提供していただきましたことに深く感謝します。

アニメーション - しばっち

2025/01/12 (Sun) 08:01:37

アニメーション
https://graphtoy.com/

SET COLOR MIX(0) 0,0,0
CLEAR
SET WINDOW -8,8,-8,8
FOR T=0 TO 100 STEP 1/2
SET LINE COLOR 12
FOR X=-8 TO 8 STEP 1/16
PLOT LINES:X,F1(X,T);
NEXT X
PLOT LINES
SET LINE COLOR 6
FOR X=-8 TO 8 STEP 1/16
PLOT LINES:X,F2(X,T);
NEXT X
PLOT LINES
SET LINE COLOR 3
FOR X=-8 TO 8 STEP 1/16
PLOT LINES:X,F3(X,T);
NEXT X
PLOT LINES
SET LINE COLOR 2
FOR X=-8 TO 8 STEP 1/16
PLOT LINES:X,F4(X,T);
NEXT X
PLOT LINES
SET LINE COLOR 4
FOR X=-8 TO 8 STEP 1/16
PLOT LINES:X,F5(X,T);
NEXT X
PLOT LINES
SET DRAW MODE EXPLICIT
WAIT DELAY 1/10
SET DRAW MODE HIDDEN
CLEAR
NEXT T
END

EXTERNAL FUNCTION F1(X,T)
LET F1=2+2*SIN(INT(X+T)*4321)
END FUNCTION

EXTERNAL FUNCTION F2(X,T)
LET F2=MAX(SQR(8^2-X^2),F1(X,T))
END FUNCTION

EXTERNAL FUNCTION F3(X,T)
LET F3=-1
END FUNCTION

EXTERNAL FUNCTION F4(X,T)
LET F4=-2
END FUNCTION

EXTERNAL FUNCTION F5(X,T)
LET F5=0
END FUNCTION
--------------------------------------------------------------------------------
SET WINDOW -10,10,-10,10
SET COLOR MIX(0) 0,0,0
CLEAR
FOR T=0 TO 100 STEP 1/4
SET LINE COLOR 12
FOR X=-8 TO 8 STEP 1/8
WHEN EXCEPTION IN
PLOT LINES:X,F1(X,T);
USE
PLOT LINES
END WHEN
NEXT X
PLOT LINES
SET LINE COLOR 6
FOR X=-8 TO 8 STEP 1/8
WHEN EXCEPTION IN
PLOT LINES:X,F2(X,T);
USE
PLOT LINES
END WHEN
NEXT X
PLOT LINES
SET LINE COLOR 3
FOR X=-8 TO 8 STEP 1/8
WHEN EXCEPTION IN
PLOT LINES:X,F3(X,T);
USE
PLOT LINES
END WHEN
NEXT X
PLOT LINES
SET LINE COLOR 2
FOR X=-8 TO 8 STEP 1/8
WHEN EXCEPTION IN
PLOT LINES:X,F4(X,T);
USE
PLOT LINES
END WHEN
NEXT X
PLOT LINES
SET LINE COLOR 14
FOR X=-8 TO 8 STEP 1/8
WHEN EXCEPTION IN
PLOT LINES:X,F5(X,T);
USE
PLOT LINES
END WHEN
NEXT X
PLOT LINES
SET LINE COLOR 4
FOR X=-8 TO 8 STEP 1/8
WHEN EXCEPTION IN
PLOT LINES:X,F6(X,T);
USE
PLOT LINES
END WHEN
NEXT X
PLOT LINES
SET DRAW MODE EXPLICIT
WAIT DELAY 1/8
SET DRAW MODE HIDDEN
CLEAR
NEXT T
END

EXTERNAL FUNCTION F1(X,T)
LET F1=SQR(8^2-X^2)
END FUNCTION

EXTERNAL FUNCTION F2(X,T)
LET F2=-F1(X,T)
END FUNCTION

EXTERNAL FUNCTION F3(X,T)
LET F3=7/2-SQR(3^2-(ABS(X)-3.5)^2)
END FUNCTION

EXTERNAL FUNCTION F4(X,T)
LET F4=7/2+SQR(3^2-(ABS(X)-3.5)^2)/2
END FUNCTION

EXTERNAL FUNCTION F5(X,T)
LET F5=3+SQR(1-(ABS(X+SIN(4*T)/2)-3)^2)*2/3
END FUNCTION

EXTERNAL FUNCTION F6(X,T)
LET F6=-3-SQR(5^2-X^2)*(1/4+POW(.5+.5*SIN(2*PI*T),6)/10)
END FUNCTION

EXTERNAL FUNCTION POW(X,N)
LET POW=X^N
END FUNCTION

数独 - 永野護

2025/01/07 (Tue) 23:53:15

6×６の数独を解くコードが完成しません。
どこがいけないのでしょうか。
ご教示くだされば幸いです。
DECLARE FUNCTION IsValid
DECLARE FUNCTION SolveSudoku
OPTION BASE 0
DIM Board(5, 5)

!' サンプルの6x6数独問題 (0は空きマス)
DATA 1, 0, 3, 0, 0, 0
DATA 0, 0, 0, 0, 0, 4
DATA 0, 0, 0, 0, 2, 0
DATA 0, 5, 0, 0, 0, 0
DATA 3, 0, 0, 0, 0, 0
DATA 0, 0, 0, 4, 0, 0

!' 盤面を初期化
FOR i = 0 TO 5
FOR j = 0 TO 5
READ Board(i, j)
NEXT j
NEXT i

PRINT "元の盤面:"
FOR i = 0 TO 5
FOR j = 0 TO 5
IF Board(i, j) = 0 THEN
PRINT ".";
ELSE
PRINT Board(i, j);
END IF
NEXT j
PRINT
NEXT i

IF SolveSudoku = true THEN
PRINT "解けた盤面:"
FOR i = 0 TO 5
FOR j = 0 TO 5
PRINT Board(i, j);
NEXT j
PRINT
NEXT i
ELSE
PRINT "解けませんでした。"
END IF

FUNCTION IsValid (Row, Col, Num)
!' 行と列をチェック
FOR i = 0 TO 5
IF Board(Row, i) = Num THEN
LET IsValid = 0
EXIT FUNCTION
END IF
IF Board(i, Col) = Num THEN
LET IsValid = 0
EXIT FUNCTION
END IF
NEXT i

LET IsValid = true
END FUNCTION

FUNCTION SolveSudoku
FOR Row = 0 TO 5
FOR Col = 0 TO 5
IF Board(Row, Col) = 0 THEN
FOR Num = 1 TO 6
IF IsValid(Row, Col, Num) = true THEN
LET Board(Row, Col) = Num
IF SolveSudoku = true THEN
LET SolveSudoku = true
EXIT FUNCTION
END IF
LET Board(Row, Col) = 0
END IF
LET SolveSudoku = 0
NEXT Num
LET SolveSudoku = 0
EXIT FUNCTION
END IF
NEXT Col
NEXT Row
LET SolveSudoku = true
END FUNCTION
END

Re: 数独 - SHIRAISHI Kazuo

2025/01/08 (Wed) 08:01:25

とりあえず気になったのが，変数trueの値を変える文が見当たらないことです。十進BASICでは変数の初期値は0に設定されています。

Re: 数独 - 永野護

2025/01/08 (Wed) 14:46:19

アドバイスに感謝します。

Re: 数独 - しばっち

2025/01/12 (Sun) 07:59:52

次のプログラムはバックトラック法(後戻り法)と呼ばれる手法を
使用しています。

このバックトラック法は今回のようなパズル問題を解くのに有効な
方法ですがプログラミング初心者には少々難しいかもしれません。

この手法は覚えておいて損はないと思います。

https://ja.wikipedia.org/wiki/バックトラッキング
 https://www.cc.kyoto-su.ac.jp/~yamada/ap/backtrack.html
http://www.tommylab.ynu.ac.jp/lecture/Algorithm/10/10.pdf
https://sevendays-study.com/algorithm/ex-day4.html

内部関数、内部副プログラムのままではうまくいかず
外部関数、外部副プログラムとするとうまくいったので
パックトラック法を実装する時は外部関数や外部副プログラム
として定義した方がいいかと思います。

OPTION BASE 0
PUBLIC NUMERIC Board(5, 5),True,False,COUNT

!' サンプルの6x6数独問題 (0は空きマス)
DATA 1, 0, 3, 0, 0, 0
DATA 0, 0, 0, 0, 0, 4
DATA 0, 0, 0, 0, 2, 0
DATA 0, 5, 0, 0, 0, 0
DATA 3, 0, 0, 0, 0, 0
DATA 0, 0, 0, 4, 0, 0
LET True=1
LET False=0

!' 盤面を初期化
FOR i = 0 TO 5
FOR j = 0 TO 5
READ Board(i, j)
NEXT j
NEXT i

PRINT "元の盤面:"
FOR i = 0 TO 5
FOR j = 0 TO 5
IF Board(i, j) = 0 THEN
PRINT ".";
ELSE
PRINT STR$(Board(i, j));
END IF
NEXT j
PRINT
NEXT i
CALL SolveSudoku(0)
END

EXTERNAL FUNCTION IsValid (Row, Col, Num)
!' 行と列をチェック
FOR i = 0 TO 5
IF Board(Row, i) = Num THEN
LET IsValid = False
EXIT FUNCTION
END IF
IF Board(i, Col) = Num THEN
LET IsValid = False
EXIT FUNCTION
END IF
NEXT i
LET IsValid = True
END FUNCTION

EXTERNAL SUB SolveSudoku(N)
IF N>35 THEN
LET COUNT=COUNT+1
PRINT "解けた盤面:";COUNT
FOR i = 0 TO 5
FOR j = 0 TO 5
PRINT Board(i, j);
NEXT j
PRINT
NEXT i
IF COUNT=100 THEN STOP
ELSE
LET Col=MOD(N,6)
LET Row=INT(N/6)
IF Board(Row, Col) = 0 THEN
FOR Num = 1 TO 6
IF IsValid(Row, Col, Num) = True THEN
LET Board(Row, Col) = Num
CALL SolveSudoku(N+1) ! 再帰呼び出し
LET Board(Row, Col) = 0
END IF
NEXT Num
ELSE
CALL SolveSudoku(N+1) ! 再帰呼び出し
END IF
END IF
END SUB

再帰呼び出しを使用することで多重ループ(ここではFORループ29個)を代替させることができます。
※下記プログラム参照
-----------------------------------------------------------------------------------
上記のプログラムを総当り法(※厳密には少し違う)で書き換えてみました。

6^29(36845653286788892983296)回という途方もない回数のループですが
if文によってループが制御されています。

プログラム的にやっていることは上記のプログラムと同じです。(プログラムの書き方が違うだけ!?)

OPTION BASE 0
DIM Board(5, 5)

!' サンプルの6x6数独問題 (0は空きマス)
DATA 1, 0, 3, 0, 0, 0
DATA 0, 0, 0, 0, 0, 4
DATA 0, 0, 0, 0, 2, 0
DATA 0, 5, 0, 0, 0, 0
DATA 3, 0, 0, 0, 0, 0
DATA 0, 0, 0, 4, 0, 0
LET True=1
LET False=0

!' 盤面を初期化
FOR i = 0 TO 5
FOR j = 0 TO 5
READ Board(i, j)
NEXT j
NEXT i

PRINT "元の盤面:"
FOR i = 0 TO 5
FOR j = 0 TO 5
IF Board(i, j) = 0 THEN
PRINT ".";
ELSE
PRINT STR$(Board(i, j));
END IF
NEXT j
PRINT
NEXT i

FOR A1=1 TO 6
IF IsValid (0,1,A1)=True THEN
LET Board(0,1)=A1
FOR A2=1 TO 6
IF IsValid (0, 3, A2)=True THEN
LET Board(0,3)=A2
FOR A3=1 TO 6
IF IsValid (0, 4, A3)=True THEN
LET Board(0,4)=A3
FOR A4=1 TO 6
IF IsValid (0, 5, A4)=True THEN
LET Board(0,5)=A4
FOR B1=1 TO 6
IF IsValid (1, 0, B1)=True THEN
LET Board(1,0)=B1
FOR B2=1 TO 6
IF IsValid (1, 1, B2)=True THEN
LET Board(1,1)=B2
FOR B3=1 TO 6
IF IsValid (1, 2, B3)=True THEN
LET Board(1,2)=B3
FOR B4=1 TO 6
IF IsValid (1, 3, B4)=True THEN
LET Board(1,3)=B4
FOR B5=1 TO 6
IF IsValid (1, 4, B5)=True THEN
LET Board(1,4)=B5
FOR C1=1 TO 6
IF IsValid (2, 0, C1)=True THEN
LET Board(2,0)=C1
FOR C2=1 TO 6
IF IsValid (2, 1, C2)=True THEN
LET Board(2,1)=C2
FOR C3=1 TO 6
IF IsValid (2, 2, C3)=True THEN
LET Board(2,2)=C3
FOR C4=1 TO 6
IF IsValid (2, 3, C4)=True THEN
LET Board(2,3)=C4
FOR C5=1 TO 6
IF IsValid (2, 5, C5)=True THEN
LET Board(2,5)=C5
FOR D1=1 TO 6
IF IsValid (3, 0, D1)=True THEN
LET Board(3,0)=D1
FOR D2=1 TO 6
IF IsValid (3, 2, D2)=True THEN
LET Board(3,2)=D2
FOR D3=1 TO 6
IF IsValid (3, 3, D3)=True THEN
LET Board(3,3)=D3
FOR D4=1 TO 6
IF IsValid (3, 4, D4)=True THEN
LET Board(3,4)=D4
FOR D5=1 TO 6
IF IsValid (3, 5, D5)=True THEN
LET Board(3,5)=D5
FOR E1=1 TO 6
IF IsValid (4, 1, E1)=True THEN
LET Board(4,1)=E1
FOR E2=1 TO 6
IF IsValid (4, 2, E2)=True THEN
LET Board(4,2)=E2
FOR E3=1 TO 6
IF IsValid (4, 3, E3)=True THEN
LET Board(4,3)=E3
FOR E4=1 TO 6
IF IsValid (4, 4, E4)=True THEN
LET Board(4,4)=E4
FOR E5=1 TO 6
IF IsValid (4, 5, E5)=True THEN
LET Board(4,5)=E5
FOR F1=1 TO 6
IF IsValid (5, 0, F1)=True THEN
LET Board(5,0)=F1
FOR F2=1 TO 6
IF IsValid (5, 1, F2)=True THEN
LET Board(5,1)=F2
FOR F3=1 TO 6
IF IsValid (5, 2, F3)=True THEN
LET Board(5,2)=F3
FOR F4=1 TO 6
IF IsValid (5, 4, F4)=True THEN
LET Board(5,4)=F4
FOR F5=1 TO 6
IF IsValid (5, 5, F5)=True THEN
LET Board(5,5)=F5
LET COUNT=COUNT+1
PRINT "解けた盤面:";COUNT
FOR i = 0 TO 5
FOR j = 0 TO 5
PRINT Board(i, j);
NEXT j
PRINT
NEXT i
IF COUNT=100 THEN STOP
LET Board(5,5)=0
END IF
NEXT F5
LET Board(5,4)=0
END IF
NEXT F4
LET Board(5,2)=0
END IF
NEXT F3
LET Board(5,1)=0
END IF
NEXT F2
LET Board(5,0)=0
END IF
NEXT F1
LET Board(4,5)=0
END IF
NEXT E5
LET Board(4,4)=0
END IF
NEXT E4
LET Board(4,3)=0
END IF
NEXT E3
LET Board(4,2)=0
END IF
NEXT E2
LET Board(4,1)=0
END IF
NEXT E1
LET Board(3,5)=0
END IF
NEXT D5
LET Board(3,4)=0
END IF
NEXT D4
LET Board(3,3)=0
END IF
NEXT D3
LET Board(3,2)=0
END IF
NEXT D2
LET Board(3,0)=0
END IF
NEXT D1
LET Board(2,5)=0
END IF
NEXT C5
LET Board(2,3)=0
END IF
NEXT C4
LET Board(2,2)=0
END IF
NEXT C3
LET Board(2,1)=0
END IF
NEXT C2
LET Board(2,0)=0
END IF
NEXT C1
LET Board(1,4)=0
END IF
NEXT B5
LET Board(1,3)=0
END IF
NEXT B4
LET Board(1,2)=0
END IF
NEXT B3
LET Board(1,1)=0
END IF
NEXT B2
LET Board(1,0)=0
END IF
NEXT B1
LET Board(0,5)=0
END IF
NEXT A4
LET Board(0,4)=0
END IF
NEXT A3
LET Board(0,3)=0
END IF
NEXT A2
LET Board(0,1)=0
END IF
NEXT A1

FUNCTION IsValid (Row,COL,Num)
!' 行と列をチェック
FOR i = 0 TO 5
IF Board(Row, i) = Num THEN
LET IsValid = False
EXIT FUNCTION
END IF
IF Board(i, Col) = Num THEN
LET IsValid = False
EXIT FUNCTION
END IF
NEXT i
LET IsValid = True
END FUNCTION
END

十進BASIC Ver.7.8.7の計画 - SHIRAISHI Kazuo

2024/12/19 (Thu) 07:19:46

JIS Full BASICの描点がオフになる条件の規定は扱いにくいだけで利点を見出しにくいものです。
https://decimalbasic.web.fc2.com/QA-plot.htm
その制限を緩和するために独自命令 SET BEAM MODE を追加しましたが，beam modeの初期値をJIS非互換の側に振ることにします。
もうひとつ，JIS規格が扱いにくいのが，TEXTが問題座標で指定され，座標系の設定によって文字が歪むという規定です。
利点もあるけれども，数学などの技術系においてラベルを描く目的には適さない規定なので，これも無視するのを初期値にします。

SET LINE WIDTHのバグ - しばっち

2024/12/15 (Sun) 08:35:53

SET LINE WIDTH文のバグです

ループ内にPLOT TEXTとPLOT LINEがあるとSET LINE WIDTH文が無効になるようです。
Lazarus版でも同様の現象を確認しました。

SET BITMAP SIZE 400,400
SET WINDOW 0,399,399,0
SET TEXT HEIGHT 50
SET TEXT COLOR 5
FOR X=0 TO 399
PLOT TEXT ,AT 100,100:"ABCDE" ! ここを注釈にすると太さ20のラインが正常に描かれる
SET LINE WIDTH 20
PLOT LINES:X,X;
NEXT X
END

Re: SET LINE WIDTHのバグ - SHIRAISHI Kazuo

2024/12/15 (Sun) 09:36:35

JIS Full BASICのPLOT LINES文にはやっかいな規定があります。
描点（BEAM）がオフになる条件がいくつか定められていて，PLOT LINES以外の図形出力文の実行時もその一つです。
独自拡張命令の　SET BEAM MODE "IMMORTAL"　を追加すると，この規定を無視します。

SET BITMAP SIZE 400,400
SET WINDOW 0,399,399,0
SET TEXT HEIGHT 50
SET TEXT COLOR 5
SET LINE WIDTH 20
SET BEAM MODE "IMMORTAL"
FOR X=0 TO 399
PLOT POINTS: 0,0
SET LINE WIDTH 20
PLOT TEXT ,AT 100,100:"ABCDE"
PLOT LINES:X,X;
NEXT X
END

スネークゲーム - しばっち

2024/12/15 (Sun) 08:33:59

テンキーの2,4,6,8キー又は矢印キーで緑の壁及び自身から伸びる白い壁にぶつからないように
すばやいキー操作でかわすだけのゲームです。

3秒毎に速度が増し一定時間が経つとクリアになります。

DECLARE EXTERNAL FUNCTION STICK
RANDOMIZE
DIM VEC(4)
LET XSIZE=600 ! 画像サイズ(狭くすると難しくなります)
LET YSIZE=600
LET HEIGHT=50
LET WIDTH=20 ! 外枠の幅
LET SIZE=20 ! 自身のサイズ
LET CLEARTIME=30 ! クリア時間(長くすると難しくなります)
LET INC=.5 ! 速度増加分(増やすと難しくなります)
LET DELAYTIME=1/10 ! ウェイト時間(短くすると難しくなります)
CALL GINIT(XSIZE,YSIZE)
SET TEXT JUSTIFY "CENTER" , "HALF"
SET TEXT BACKGROUND "OPAQUE"
SET TEXT HEIGHT HEIGHT
SET TEXT COLOR 7
PLOT TEXT ,AT XSIZE/2,YSIZE/2:"HIT ANY KEY"
CHARACTER INPUT A$
DO ! ゲームスタート
CLEAR
LET SPEED=2 ! 初期スピード
SET LINE WIDTH WIDTH ! 外枠の幅
CALL BOX(0,HEIGHT+WIDTH/2,XSIZE-1,YSIZE-1,4) ! 外枠
LET X=XSIZE/2+RND*XSIZE/3*COS(2*RND*PI) ! 初期位置
LET Y=YSIZE/2+RND*YSIZE/3*SIN(2*RND*PI)
LET PX=INT(X/(XSIZE/3)) ! 3*3分割
LET PY=INT(Y/(YSIZE/3))
LET N=PX+3*PY ! エリア割り振り
SELECT CASE N
CASE 0
LET VEC(1)=6 ! 向き指定
LET VEC(2)=2
LET SS=VEC(INT(RND*2+1)) ! 初期向き
CASE 1
LET VEC(1)=4
LET VEC(2)=6
LET VEC(3)=2
LET SS=VEC(INT(RND*3+1))
CASE 2
LET VEC(1)=2
LET VEC(2)=4
LET SS=VEC(INT(RND*2+1))
CASE 3
LET VEC(1)=8
LET VEC(2)=6
LET VEC(3)=2
LET SS=VEC(INT(RND*3+1))
CASE 4
LET VEC(1)=2
LET VEC(2)=4
LET VEC(3)=6
LET VEC(4)=8
LET SS=VEC(INT(RND*4+1))
CASE 5
LET VEC(1)=2
LET VEC(2)=4
LET VEC(3)=8
LET SS=VEC(INT(RND*3+1))
CASE 6
LET VEC(1)=6
LET VEC(2)=8
LET SS=VEC(INT(RND*2+1))
CASE 7
LET VEC(1)=4
LET VEC(2)=6
LET VEC(3)=8
LET SS=VEC(INT(RND*3+1))
CASE 8
LET VEC(1)=4
LET VEC(2)=8
LET SS=VEC(INT(RND*2+1))
END SELECT
LET TI=INT(TIME) ! タイマーセット
LET T=TI
DO
SET TEXT HEIGHT HEIGHT-WIDTH
SET TEXT COLOR 7
SET TEXT JUSTIFY "CENTER" , "TOP"
LET SCORE=SCORE+SPEED
PLOT TEXT ,AT XSIZE/2,0:"スコア:"&STR$(INT(SCORE/10))&" 残り:"&STR$(CLEARTIME-INT(TIME-T))&"秒 "
LET S=STICK ! キー操作
IF S=0 THEN
LET S=SS
ELSE
LET SS=S
END IF
SELECT CASE S
CASE 2
LET YS=SPEED
LET XS=0
LET COL=GETPOINT(X-SIZE/2,Y+SIZE/2+YS)+GETPOINT(X+SIZE/2,Y+SIZE/2+YS) ! 当たり判定
CASE 4
LET XS=-SPEED
LET YS=0
LET COL=GETPOINT(X-SIZE/2+XS,Y-SIZE/2)+GETPOINT(X-SIZE/2+XS,Y+SIZE/2)
CASE 6
LET XS=SPEED
LET YS=0
LET COL=GETPOINT(X+SIZE/2+XS,Y-SIZE/2)+GETPOINT(X+SIZE/2+XS,Y+SIZE/2)
CASE 8
LET XS=0
LET YS=-SPEED
LET COL=GETPOINT(X-SIZE/2,Y-SIZE/2+YS)+GETPOINT(X+SIZE/2,Y-SIZE/2+YS)
CASE ELSE
END SELECT
LET XX=X+XS
LET YY=Y+YS
! SET LINE COLOR SPEED
! SET LINE WIDTH SIZE
! PLOT LINES:XX,YY; ! バグ
CALL BOXFULL(MIN(X,XX)-SIZE/2,MIN(Y,YY)-SIZE/2,MAX(X,XX)+SIZE/2,MAX(Y,YY)+SIZE/2,7) ! 自身の表示
! CALL BOXFULL(MIN(X,XX)-SIZE/2,MIN(Y,YY)-SIZE/2,MAX(X,XX)+SIZE/2,MAX(Y,YY)+SIZE/2,SPEED)
LET X=XX
LET Y=YY
IF COL<>0 OR X<0 OR X>XSIZE OR Y<0 OR Y>YSIZE THEN ! 壁にぶつかったら
SET TEXT COLOR 2
SET TEXT HEIGHT HEIGHT*1.5
SET TEXT JUSTIFY "CENTER" , "HALF"
PLOT TEXT ,AT XSIZE/2,YSIZE/2:"GAME OVER!!"
STOP
END IF
IF TIME-T>=CLEARTIME THEN ! 面クリア
SET TEXT COLOR 6
SET TEXT HEIGHT HEIGHT*1.5
SET TEXT JUSTIFY "CENTER" , "HALF"
PLOT TEXT ,AT XSIZE/2,YSIZE/2:"GAME CLEAR"
LET CLEARTIME=CLEARTIME+5 ! クリア毎に5秒ずつ延長
WAIT DELAY 2 ! 待機
EXIT DO
END IF
IF TIME-TI>=3 THEN ! 加速 3秒毎
LET SPEED=SPEED+INC ! 増分
LET INC=INC+.5
LET TI=INT(TIME)
END IF
WAIT DELAY DELAYTIME ! ウェイト
LOOP
LOOP
END

EXTERNAL SUB BOX(XS,YS,XE,YE,C)
SET LINE COLOR C
PLOT LINES:XS,YS;XE,YS
PLOT LINES:XE,YS;XE,YE
PLOT LINES:XE,YE;XS,YE
PLOT LINES:XS,YE;XS,YS
END SUB

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB

EXTERNAL FUNCTION GETPOINT(X,Y)
ASK PIXEL VALUE(X,Y) C
LET GETPOINT=C
END FUNCTION

EXTERNAL FUNCTION STICK
LET STICK=0
FOR I=97 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
FOR I=49 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
END FUNCTION

シミュラクラ現象 - しばっち

2024/11/17 (Sun) 08:08:05

https://ja.wikipedia.org/wiki/シミュラクラ現象
 https://ja.wikipedia.org/wiki/パレイドリア

下記プログラムでは大きな丸(円・楕円)の中に丸(円・楕円)を3つ描いただけのものです(サンプル画像)

もし、これが人の顔のように見えたのならシミュラクラ現象(パレイドリア現象)による錯覚が起きた
といえるのではないでしょうか。

どんな時に錯覚(シミュラクラ現象、パレイドリア現象)が起きるのか検証してみるのも
おもしろいかもしれません。

SET WINDOW -.1,1.1,-.1,1.1
LOCATE VALUE NOWAIT(1) ,RANGE -.5 TO .5,AT 0:MOVEX1
LOCATE VALUE NOWAIT(2) ,RANGE -.5 TO .5,AT 0:MOVEY1
LOCATE VALUE NOWAIT(3) ,RANGE .1 TO 1,AT .45:SCALEX1
LOCATE VALUE NOWAIT(4) ,RANGE .1 TO 1,AT .57:SCALEY1
LOCATE VALUE NOWAIT(5) ,RANGE 3 TO 120,AT 3:N1
LOCATE VALUE NOWAIT(6) ,RANGE 0 TO 360,AT 0:ANG1

LOCATE VALUE NOWAIT(7) ,RANGE 0 TO .5,AT .21:MOVEX2
LOCATE VALUE NOWAIT(8) ,RANGE -.5 TO .5,AT 0:MOVEY2
LOCATE VALUE NOWAIT(9) ,RANGE .1 TO .5,AT .11:SCALEX2
LOCATE VALUE NOWAIT(10) ,RANGE .1 TO .5,AT .1:SCALEY2
LOCATE VALUE NOWAIT(11) ,RANGE 3 TO 120,AT 3:N2
LOCATE VALUE NOWAIT(12) ,RANGE 0 TO 360,AT 0:ANG2

LOCATE VALUE NOWAIT(13) ,RANGE -.5 TO .5,AT 0:MOVEX3
LOCATE VALUE NOWAIT(14) ,RANGE -.5 TO .5,AT 0:MOVEY3
LOCATE VALUE NOWAIT(15) ,RANGE .1 TO .5,AT .18:SCALEX3
LOCATE VALUE NOWAIT(16) ,RANGE .1 TO .5,AT .1:SCALEY3
LOCATE VALUE NOWAIT(17) ,RANGE 3 TO 120,AT 3:N3
LOCATE VALUE NOWAIT(18) ,RANGE 0 TO 360,AT 0:ANG3
DO
LOCATE VALUE NOWAIT(1):MOVEX1
LOCATE VALUE NOWAIT(2):MOVEY1
LOCATE VALUE NOWAIT(3):SCALEX1
LOCATE VALUE NOWAIT(4):SCALEY1
LOCATE VALUE NOWAIT(5):N1
LOCATE VALUE NOWAIT(6):ANG1
LET R1=INT(360/INT(N1))

LOCATE VALUE NOWAIT(7):MOVEX2
LOCATE VALUE NOWAIT(8):MOVEY2
LOCATE VALUE NOWAIT(9):SCALEX2
LOCATE VALUE NOWAIT(10):SCALEY2
LOCATE VALUE NOWAIT(11):N2
LOCATE VALUE NOWAIT(12):ANG2
LET R2=INT(360/INT(N2))

LOCATE VALUE NOWAIT(13):MOVEX3
LOCATE VALUE NOWAIT(14):MOVEY3
LOCATE VALUE NOWAIT(15):SCALEX3
LOCATE VALUE NOWAIT(16):SCALEY3
LOCATE VALUE NOWAIT(17):N3
LOCATE VALUE NOWAIT(18):ANG3
LET R3=INT(360/INT(N3))

DRAW POLY(R1) WITH SCALE(SCALEX1,SCALEY1)*ROTATE(ANG1)*SHIFT(.5+MOVEX1,.5+MOVEY1)
DRAW POLY(R2) WITH SCALE(SCALEX2,SCALEY2)*ROTATE(ANG2)*SHIFT(.5-MOVEX2,.7+MOVEY2)
DRAW POLY(R2) WITH SCALE(SCALEX2,SCALEY2)*ROTATE(ANG2)*SHIFT(.5+MOVEX2,.7+MOVEY2)
DRAW POLY(R3) WITH SCALE(SCALEX3,SCALEY3)*ROTATE(ANG3)*SHIFT(.5+MOVEX3,.2+MOVEY3)
SET DRAW MODE EXPLICIT
WAIT DELAY .2
SET DRAW MODE HIDDEN
CLEAR
LOOP
END

EXTERNAL PICTURE POLY(N)
OPTION ANGLE DEGREES
FOR T=0 TO 360+N STEP 360/N
PLOT LINES: COS(T),SIN(T);
NEXT T
PLOT LINES
END PICTURE

Collatz problem 6*n + 4.と奇数列の関係 - Tarosa

2024/11/05 (Tue) 09:30:32

!!Collatz problem Displaying 1-2 of 2 results found.
!A016957 a(n) = 6*n + 4.
!6*n + 4.と奇数列の関係
LET nn=0
FOR n=1 TO 100
LET s=2*n
LET s1=6*nn+4
IF MOD((s-1),3)=0 THEN
PRINT s;(s-1)/3;s1
LET nn=nn+1
END IF
NEXT n
END

!2*nならば　2n/2n=1　は必ず1になる。つまり、奇数列は1になる。この照明は?

Re: Collatz problem 6*n + 4.と奇数列の関係 - Tarosa

2024/11/05 (Tue) 09:34:52

計算結果出力
4 1 4
10 3 10
16 5 16
22 7 22
28 9 28
34 11 34
40 13 40
46 15 46
52 17 52
58 19 58
64 21 64
70 23 70
76 25 76
82 27 82
88 29 88
94 31 94
100 33 100

2n の　IF MOD((s-1),3)=0 　は　6*n + 4

Re: Collatz problem 6*n + 4.と奇数列の関係 - Tarosa

2024/11/05 (Tue) 17:50:10

!Collatz problem 3
OPTION ARITHMETIC NATIVE
!OPTION ARITHMETIC DECIMAL_HIGH
LET t0=TIME
LET cc=1
LET c1=0
LET odd=0
LET eve=0
FOR n= 0 TO 1E8
LET a1=3*3*n+2
IF MOD(a1,2)=0 THEN
LET b1=a1/2
ELSE
LET b1=a1*3+1
END IF
!PRINT a1; b1 !1

IF MOD(b1,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF

LET a2=3*3*n+4
IF MOD(a2,2)=0 THEN
LET b2=a2/2
ELSE
LET b2=a2*3+1
END IF

!PRINT a2;b2 !2

IF MOD(b2,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF

IF MOD(n,2)=0 THEN
LET a31=3*c1+1
IF MOD(a31,2)=0 THEN
LET b31=a31/2
ELSE
LET b31=a31*3+1
END IF
!PRINT a31;b31 !3-1
LET c1=c1+1
IF MOD(b31,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF

END IF

IF MOD(n,2)=1 THEN
LET a32=18*cc-2
IF MOD(a32,2)=0 THEN
LET b32=a32/2
ELSE
LET b32=a32*3+1
END IF

!PRINT a32;b32 !3-2
LET cc=cc+1
IF MOD(b32,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF

END IF

LET a4=3*3*6*n+52
IF MOD(a4,2)=0 THEN
LET b4=a4/2
ELSE
LET b4=a4*3+1
END IF
!PRINT a4;b4 !4
IF MOD(b4,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF

NEXT n

PRINT
PRINT "eve";eve
PRINT "odd";odd

LET TM=TIME-t0
PRINT USING"####." & REPEAT$("#",2):TM;
PRINT "秒"

END

6n+4は全て偶数

even number/2 or odd number*3+1

(6n+4)/2 ～　3n+2 更に　3n+1 と　18n+16 その後の数列は

計算結果出力

FOR n= 0 TO 100
eve 266
odd 138

FOR n= 0 TO 1000
eve 2628
odd 1376

FOR n= 0 TO 1E4
eve 26253
odd 13751

FOR n= 0 TO 1E5
eve 262503
odd 137501

FOR n= 0 TO 1E6
eve 2625003
odd 1375001

FOR n= 0 TO 1E7
eve 26250003
odd 13750001
5.24秒
eve 26250003
odd 13750001
154.43秒　　　　1000桁モード

FOR n= 0 TO 1E8
eve 262500003
odd 137500001
51.54秒

FOR n= 0 TO 1E9
eve 2625000003
odd 1375000001

eve 2625000003
odd 1375000001
39.87秒

FOR n= 0 TO 1E10
eve 26250000003
odd 13750000001
399.59秒

規則正しく偶数が多い。事は照明可能か?

Re: Collatz problem 6*n + 4.と奇数列の関係 - Tarosa

2024/11/10 (Sun) 21:23:53

!Collatz problem 3
OPTION ARITHMETIC NATIVE
LET t0=TIME
LET cc=1
LET c1=0
LET eve=0
LET odd=0
FOR n= 0 TO 1E5
LET a1=3*3*n+2
IF MOD (a1,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF
!PRINT !1
LET a2=3*3*n+4
IF MOD (a2,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF
!PRINT !2
IF MOD(n,2)=0 THEN
LET a31=3*c1+1
IF MOD (a31,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF
!PRINT !31
LET c1=c1+1
END IF
IF MOD(n,2)=1 THEN
LET a32=18*cc-2
IF MOD (a32,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF
!PRINT !32
LET cc=cc+1
END IF
LET a4=3*3*6*n+52
IF MOD (a4,2)=0 THEN
LET eve=eve+1
ELSE
LET odd=odd+1
END IF
!PRINT !4
NEXT n

PRINT "eve=";eve
PRINT "odd=";odd
LET TM=TIME-t0
PRINT USING"####." & REPEAT$("#",2):TM;
PRINT "秒"

END

!Collatz problem

FOR n= 0 TO 100
eve= 278
odd= 126

FOR n= 0 TO 1000
eve= 2753
odd= 1251

FOR n= 0 TO 10000
eve= 27503
odd= 12501

FOR n= 0 TO 1E5
eve= 275003
odd= 125001

FOR n= 0 TO 1E6
eve= 2750003
odd= 1250001

FOR n= 0 TO 1E7
eve= 27500003
odd= 12500001

FOR n= 0 TO 1E8
eve= 275000003
odd= 125000001

FOR n= 0 TO 1E9
eve= 2750000003
odd= 1250000001

FOR n= 0 TO 1E10
eve= 27500000003
odd= 12500000001
348.82秒

FOR n= 0 TO 1E11
eve= 275000000003
odd= 125000000001
3458.11秒

(((6n+4)/2)even/2 or odd*3+1)even/2 or odd*3+1
2,4,1,52,11,13,16,106,20,22,4,160,29,31,34,214,38,

偶数が多い。2の倍数の次に3の倍数が多いのは自明
不思議なのは・・・

6n-1,6n+1と五角数の関係 - Tarosa

2024/10/29 (Tue) 21:56:33

!6n-1,6n+1と五角数の関係
!A001318 Generalized pentagonal numbers: m*(3*m - 1)/2, m = 0, +-1, +-2, +-3, ....
OPTION ARITHMETIC NATIVE
FOR n=1 TO 1000/3
LET p=n*(3*n-1)/2
LET k=((6*n-1)^2-1)/24
LET p1=n*(3*n+1)/2
LET k1=((6*n+1)^2-1)/24
PRINT p;k
PRINT p1;k1
NEXT n
END

計算結果出力

1 1
2 2
5 5
7 7
12 12
15 15
22 22
26 26
35 35
40 40
51 51
57 57
70 70
77 77
92 92
100 100

6n+1 の数列を眺めていたら・・・
5以上のすべての素数のPn^2 が・・・

Re: 6n-1,6n+1と五角数の関係 - Tarosa

2024/10/29 (Tue) 22:03:58

!6n-1,6n+1
OPTION ARITHMETIC NATIVE
FOR n=1 TO 10000/6
LET p=SQR((n*(3*n-1)/2)*24+1)
!LET p=SQR(12*n*(3*n-1)+ 1)
LET k=6*n-1
LET p1=SQR((n*(3*n+1)/2)*24+1)
!LET p1=SQR(12*n*(3*n+1)+ 1)
LET k1=6*n+1
PRINT p;k
PRINT p1;k1
NEXT n
END

計算結果出力
5 5
7 7
11 11
13 13
17 17
19 19
23 23
25 25
29 29
31 31
35 35
37 37
41 41
43 43
47 47
49 49
53 53
55 55
59 59

確率的素数と5角数の関係

Re: 6n-1,6n+1と五角数の関係 - Tarosa

2024/10/29 (Tue) 22:08:50

!https://oeis.org/A001318
!A001318 Generalized pentagonal numbers: m*(3*m - 1)/2, m = 0, +-1, +-2, +-3, ....
OPTION ARITHMETIC NATIVE
LET t0=TIME
LET k6=1299709 !31607 !10億,31607 1億,9973
LET k2=100000 !3401 !10億,3401 1億,1229
!エラトステネスの篩

DIM P(k6)
DIM A(k2) !素数
MAT P=ZER
MAT A=ZER
LET A(1)=2
LET H1=1
FOR I=3 TO SQR(k6) STEP 2
IF P(I)=0 THEN
FOR J=I*I TO k6 STEP I
LET P(J)=1
NEXT J
END IF
NEXT I
FOR I=3 TO k6 STEP 2
IF P(I)=0 THEN
LET H1=H1+1
LET A(H1)=I
END IF
NEXT I

LET Z=10000
DIM Pn(z)
DIM Pm(z)
MAT Pn = ZER

LET cc=1
FOR n=1 TO z/2
LET pp=n*(3*n-1)/2
LET Pn(cc)=pp
LET cc=cc+1
LET p1=n*(3*n+1)/2
LET Pn(cc)=p1
LET cc=cc+1
NEXT n

LET S=0
FOR n=1 TO z
LET Pm(n)=SQR(Pn(n)*24+1)
!PRINT
next n

LET c1=1
LET cc=3
FOR n=1 TO z
LET DD=Pm(n)
FOR nn=c1 TO z
IF DD=A(nn) THEN
PRINT cc;A(nn)
LET cc=cc+1
LET c1=c1+1
EXIT FOR
END IF
NEXT nn
NEXT n

LET TM=TIME-t0
PRINT USING"####." & REPEAT$("#",2):TM;
PRINT "秒"

END

計算結果出力
3 5
4 7
5 11
6 13
7 17
8 19
9 23
10 29
11 31
12 37
13 41
14 43
15 47
16 53
17 59
18 61
19 67
20 71
21 73
22 79
23 83
24 89
25 97
26 101

素数の個数と素数　　

双２次フィルタ - しばっち

2024/10/13 (Sun) 08:23:02

双２次フィルタ

双２次フィルタ(IIRフィルタ)でフィルタ処理してみました。

https://ufcpp.net/study/sp/digital_filter/biquad/
https://www.wizard-notes.com/entry/music-analysis/biquad-filter-frequency-responses
https://www.utsbox.com/?page_id=523
https://www.utsbox.com/?page_id=728
https://qiita.com/Micochan/items/6be0034a9f75bb0706cd
https://qiita.com/fukuroder/items/e1cd551b7492020da992

https://nettyukobo.com/bilinear_transform/
https://qiita.com/fukuroder/items/e1cd551b7492020da992

https://hp.vector.co.jp/authors/VA009014/jp/my_sticker_file_01.html

2進モードで実行してください。

LET M=8
LET N=2^M
LET SAMPLINGFREQ=44100 ! サンプリング周波数
LET FREQ=1000
LET Q=1/SQR(2) ! Q>0
LET BW=1 ! BW>0
LET GAIN=3
DIM IN(N),OUT(N)
LET FILTER=0
SET WINDOW 1,N,-1.5,1.5
DRAW GRID(N/8,.3)
FOR I=1 TO N
LET IN(I)=SIN(600/SAMPLINGFREQ*I*2*PI)+.2*SIN(2000/SAMPLINGFREQ*I*2*PI) ! 600Hzと2000Hzの合成波形
PLOT LINES:I,IN(I);
NEXT I
CALL BIQUAD(IN,FILTER,N,SAMPLINGFREQ,FREQ,Q,BW,GAIN,OUT) ! 双２次フィルタ
PLOT LINES
PAUSE
CLEAR
DRAW GRID(N/8,.3)
FOR I=1 TO N
PLOT LINES:I,OUT(I); ! 結果表示
NEXT I
END

SUB BIQUAD(IN(),FILTER,NUM,SAMPLINGFREQ,FREQ,Q,BW,GAIN,OUT())
SELECT CASE FILTER
CASE 0 ! LPF
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)/(2*Q)
LET A0=1+ALPHA
LET A1=-2*COS(OMEGA)
LET A2=1-ALPHA
LET B0=(1-COS(OMEGA))/2
LET B1=1-COS(OMEGA)
LET B2=(1-COS(OMEGA))/2
CASE 1 ! HPF
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)/(2*Q)
LET A0=1+ALPHA
LET A1=-2*COS(OMEGA)
LET A2=1-ALPHA
LET B0=(1+COS(OMEGA))/2
LET B1=-(1+COS(OMEGA))
LET B2=(1+COS(OMEGA))/2
CASE 2 ! BPF
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)*SINH(LOG(2)/2*BW*OMEGA/SIN(OMEGA))
LET A0=1+ALPHA
LET A1=-2*COS(OMEGA)
LET A2=1-ALPHA
LET B0=ALPHA
LET B1=0
LET B2=-ALPHA
CASE 3 ! NOTCH
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)*SINH(LOG(2)/2*BW*OMEGA/SIN(OMEGA))
LET A0=1+ALPHA
LET A1=-2*COS(OMEGA)
LET A2=1-ALPHA
LET B0=1
LET B1=-2*COS(OMEGA)
LET B2=1
CASE 4 ! LOWSHELF
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)/(2*Q)
LET A=10^(GAIN/40)
LET BETA=SQR(A)/Q
LET A0=(A+1)+(A-1)*COS(OMEGA)+BETA*SIN(OMEGA)
LET A1=-2*((A-1)+(A+1)*COS(OMEGA))
LET A2=(A+1)+(A-1)*COS(OMEGA)-BETA*SIN(OMEGA)
LET B0=A*((A+1)-(A-1)*COS(OMEGA)+BETA*SIN(OMEGA))
LET B1=2*A*((A-1)-(A+1)*COS(OMEGA))
LET B2=A*((A+1)-(A-1)*COS(OMEGA)-BETA*SIN(OMEGA))
CASE 5 ! HIGHSHELF
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)/(2*Q)
LET A=10^(GAIN/40)
LET BETA=SQR(A)/Q
LET A0=(A+1)-(A-1)*COS(OMEGA)+BETA*SIN(OMEGA)
LET A1=2*((A-1)-(A+1)*COS(OMEGA))
LET A2=(A+1)-(A-1)*COS(OMEGA)-BETA*SIN(OMEGA)
LET B0=A*((A+1)+(A-1)*COS(OMEGA)+BETA*SIN(OMEGA))
LET B1=-2*A*((A-1)+(A+1)*COS(OMEGA))
LET B2=A*((A+1)+(A-1)*COS(OMEGA)-BETA*SIN(OMEGA))
CASE 6 ! PEAKING
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)*SINH(LOG(2)/2*BW*OMEGA/SIN(OMEGA))
LET A=10^(GAIN/40)
LET A0=1+ALPHA/A
LET A1=-2*COS(OMEGA)
LET A2=1-ALPHA/A
LET B0=1+ALPHA*A
LET B1=-2*COS(OMEGA)
LET B2=1-ALPHA*A
CASE 7 ! ALL PASS
LET OMEGA=2*PI*FREQ/SAMPLINGFREQ
LET ALPHA=SIN(OMEGA)/(2*Q)
LET A0=1+ALPHA
LET A1=-2*COS(OMEGA)
LET A2=1-ALPHA
LET B0=1-ALPHA
LET B1=-2*COS(OMEGA)
LET B2=1+ALPHA
END SELECT
FOR I=1 TO NUM
LET OUT(I)=B0/A0*IN(I)+B1/A0*IN1+B2/A0*IN2-A1/A0*OUT1-A2/A0*OUT2
LET IN2=IN1
LET IN1=IN(I)
LET OUT2=OUT1
LET OUT1=OUT(I)
NEXT
END SUB
--------------------------------------------------------------------------------------------------
wavファイルに書き出して聞き比べられるようにしてみました。

※スピーカーのボリュームに気を付けてください

LET SAMPLINGFREQ=44100 ! サンプリング周波数
LET N=SAMPLINGFREQ*3 ! 再生時間3秒
DIM IN(N),OUT(N)
LET VOL=.5
FOR I=1 TO N
LET IN(I)=.6*SIN(800/SAMPLINGFREQ*I*2*PI)+.3*SIN(4000/SAMPLINGFREQ*I*2*PI)+.1*SIN(12000/SAMPLINGFREQ*I*2*PI) ! 800Hz 4000Hz 12000Hzの合成波形
LET IN(I)=IN(I)*VOL
NEXT I
CALL WRITEWAV("元音.wav",N,1,SAMPLINGFREQ,16,IN)
LET FILTER=0
!INPUT PROMPT "LPF(0) HPF(1) BPF(2) NOTCH(3) LOWSHELF(4) HIGHSHELF(5) PEAKING(6) ALL PASS(7) ":FILTER
CALL BIQUAD(IN,FILTER,N,SAMPLINGFREQ,1000,1/SQR(2),1,3,OUT)
CALL WRITEWAV("処理後.wav",N,SAMPLINGFREQ,16,OUT)
END

以下略
--------------------------------------------------------------------------------------------------
音声合成(フォルマント合成)

https://ja.wikipedia.org/wiki/フォルマント
 https://smartsoundlab.com/2019/01/000047.html
https://moge32.blogspot.com/2012/08/3c.html
https://qiita.com/MuAuan/items/7958ca655a7f143deb29

https://nettyukobo.com/ieaou/
https://smartsoundlab.com/2019/01/000047.html

フィルタ処理によって「あいうえお」を発声します。

OPTION BASE 0
LET SAMPLINGFREQ = 8000
LET NUM=SAMPLINGFREQ
DIM A(0 TO 3), B(0 TO 3)
DIM PCM0(NUM),PCM1(NUM),S(NUM),OUT(NUM*5)
FOR P=0 TO 4
READ F1,F2,F3,F4 ! フォルマント周波数
DATA 800,1200,2500,3500 ! あ
DATA 300,2300,2900,3500 ! い
DATA 300,1200,2500,3500 ! う
DATA 500,1900,2500,3500 ! え
DATA 500,800,2500,3500 ! お
LET B1 = 100
LET B2 = 100
LET B3 = 100
LET B4 = 100
MAT PCM0=ZER
MAT PCM1=ZER
FOR I=1 TO NUM
FOR J=1 TO 32
LET PCM0(I)=PCM0(I)+SIN(125*J*I*2*PI/SAMPLINGFREQ)/32
NEXT J
NEXT I
MAT S=ZER
CALL IIR_RESONATOR(F1 / SAMPLINGFREQ, F1 / B1, A, B)
CALL IIR_FILTERING(PCM0, S, NUM,A, B)
FOR N = 1 TO NUM
LET PCM1(N) = PCM1(N)+S(N)
NEXT N
MAT S=ZER
CALL IIR_RESONATOR(F2 / SAMPLINGFREQ, F2 / B2, A, B)
CALL IIR_FILTERING(PCM0, S, NUM,A, B)
FOR N = 1 TO NUM
LET PCM1(N) =PCM1(N)+ S(N)
NEXT N
MAT S=ZER
CALL IIR_RESONATOR(F3 / SAMPLINGFREQ, F3 / B3, A, B)
CALL IIR_FILTERING(PCM0, S, NUM,A, B)
FOR N = 1 TO NUM
LET PCM1(N) =PCM1(N)+S(N)
NEXT N
MAT S=ZER
CALL IIR_RESONATOR(F4 / SAMPLINGFREQ, F4 / B4, A, B)
CALL IIR_FILTERING(PCM0, S, NUM,A, B)
FOR N = 1 TO NUM
LET PCM1(N) =PCM1(N)+ S(N)
NEXT N
MAT S=ZER
LET S(1) = PCM1(1)
FOR N = 2 TO NUM
LET S(N) = 0.98 * S(N - 1) + PCM1(N)
NEXT N
FOR N = 1 TO NUM
LET PCM1(N)= S(N)
NEXT N
FOR N = 1 TO NUM * 0.01
LET PCM1(N) =PCM1(N)*N / (SAMPLINGFREQ * 0.01)
LET PCM1(NUM - N + 1)=PCM1(NUM-N+1) *N / (SAMPLINGFREQ * 0.01)
NEXT N
FOR I=1 TO NUM
LET OUT(I+NUM*P)=PCM1(I)
NEXT I
NEXT P
CALL WRITEWAV("あいうえお.wav",NUM*5,SAMPLINGFREQ,16,OUT)
END

EXTERNAL SUB IIR_RESONATOR(FC, Q, A(), B())
LET FC = TAN(PI * FC) / (2.0 * PI)
LET A(0) = 1.0 + 2.0 * PI * FC / Q+ 4.0 * PI * PI * FC * FC
LET A(1) = (8.0 * PI * PI * FC * FC - 2.0)/ A(0)
LET A(2) = (1.0 - 2.0 * PI * FC / Q+ 4.0 * PI * PI * FC * FC) / A(0)
LET B(0) = 2.0 * PI * FC / Q / A(0)
LET B(1) = 0.0
LET B(2) = -2.0 * PI * FC / Q / A(0)
LET A(0) = 1.0
END SUB

EXTERNAL SUB IIR_FILTERING(X(), Y(), L, A(), B())
FOR N = 0 TO L-1
FOR M = 0 TO 2
IF N - M >= 0 THEN
LET Y(N)=Y(N) + B(M) * X(N - M)
END IF
NEXT M
FOR M = 1 TO 2
IF N - M >= 0 THEN
LET Y(N)=Y(N) -A(M) * Y(N - M)
END IF
NEXT M
NEXT N
END SUB

以下略
--------------------------------------------------------------------------------------------------
「あ」(フォルマント合成)

https://qiita.com/rild/items/339c5c36f4c1ad8d4325

LET SAMPLINGFREQ=44100
LET PLAYTIME=1
LET NUM=SAMPLINGFREQ*PLAYTIME
DIM LIN(NUM)
FOR I=1 TO NUM
LET S=.19*SIN(2*PI*I*1040/SAMPLINGFREQ)
LET S=S+.09*SIN(2*PI*I*520/SAMPLINGFREQ)
LET S=S+.08*SIN(2*PI*I*780/SAMPLINGFREQ)
LET S=S+.08*SIN(2*PI*I*1300/SAMPLINGFREQ)
LET S=S+.07*SIN(2*PI*I*260/SAMPLINGFREQ)
LET S=S+.07*SIN(2*PI*I*1560/SAMPLINGFREQ)
LET LIN(I)=S
NEXT I
SET WINDOW 0,NUM/50,-1,1
DRAW GRID(NUM/500,.2)
FOR I=1 TO NUM/50
PLOT LINES:I,LIN(I);
NEXT I
CALL WRITEWAV("あ.wav",NUM,SAMPLINGFREQ,16,LIN)
END

以下略

なお、今回の大量書き込み(300KB超え)につきましてはご容赦くださいますようお願いします。

FIRフィルタ - しばっち

2024/10/13 (Sun) 08:14:44

FIRフィルタ

FIRフィルタによるフィルタ処理

https://ja.wikipedia.org/wiki/有限インパルス応答
 http://marchan.e5.valueserver.jp/cabin/comp/jbox/arc300/doc3020.html
https://nettyukobo.com/window_function_method/

https://ryukau.github.io/filter_notes/basic_fir/basic_fir.html

まずは画像処理でぼかし処理に使用される移動平均でローパスフィルタ作ってみた。

フィルタ適用後波形が変化していることを確認してください。

2進モードで実行してください。

LET TAP=5 ! 次数
LET SAMPLINGFREQ=2000 ! サンプリング周波数
LET N=SAMPLINGFREQ
DIM IN(N),OUT(N)
FOR I=1 TO N
LET IN(I)=SIN(30*I/SAMPLINGFREQ*2*PI)*.8+SIN(800*I/SAMPLINGFREQ*2*PI)*.2
NEXT I
SET WINDOW 1,N/10,-1.5,1.5
DRAW GRID(N/20,.3)
FOR I=1 TO N/10
PLOT LINES:I,IN(I);
NEXT I
PLOT LINES
CALL FIR(IN,N,TAP,OUT)
SET LINE COLOR "RED"
FOR I=1 TO N/10
PLOT LINES:I,OUT(I);
NEXT I
END

EXTERNAL SUB FIR(IN(),N,TAPSIZE,OUT())
FOR J=1 TO N
LET S=0
FOR I=0 TO TAPSIZE-1
IF I+J<=N THEN LET S=S+IN(I+J)
NEXT I
LET OUT(J)=S/TAPSIZE
NEXT J
END SUB
-------------------------------------------------------------------------------
フィルタ係数をFFTするとフィルタ特性が分かります。

横軸が周波数、縦軸がdb(デシベル)です。
https://ja.wikipedia.org/wiki/デシベル

LET M=8
LET SAMPLINGFREQ=44100
DIM RR(2^M),II(2^M)
FOR N=2 TO 15
MAT RR=ZER
MAT II=ZER
FOR I=1 TO N
LET RR(I)=1/N
NEXT I
CALL FFT(M,RR,II,1)
CLEAR
SET WINDOW -1000,SAMPLINGFREQ/2,-80,0
DRAW GRID(SAMPLINGFREQ/10,10)
LET LL=SAMPLINGFREQ/2^M
FOR I=1 TO 2^M/2
IF RR(I)=0 AND II(I)=0 THEN
PLOT LINES:I*LL,-80;
ELSE
PLOT LINES:I*LL, 10*LOG10(RR(I)^2+II(I)^2);
END IF
NEXT I
PLOT LINES
WAIT DELAY 1
NEXT N
END

以下略
-------------------------------------------------------------------------------
ガウシアンによるFIRフィルタ

https://ja.wikipedia.org/wiki/ガウス関数

LET M=8
LET SAMPLINGFREQ=44100
DIM RR(2^M),II(2^M)
FOR N=2 TO 15
MAT RR=ZER
MAT II=ZER
FOR I=1 TO N
LET RR(I)=GAUSSION(I,0,N)
NEXT I
CALL FFT(M,RR,II,1)
CLEAR
SET WINDOW -1000,SAMPLINGFREQ/2,-80,0
DRAW GRID(SAMPLINGFREQ/10,10)
LET LL=SAMPLINGFREQ/2^M
FOR I=1 TO 2^M/2
IF RR(I)=0 AND II(I)=0 THEN
PLOT LINES:I*LL,-80;
ELSE
PLOT LINES:I*LL, 10*LOG10(RR(I)^2+II(I)^2);
END IF
NEXT I
PLOT LINES
WAIT DELAY 1
NEXT N
END

FUNCTION GAUSSION(X,U,A)
LET GAUSSION=1/SQR(2*PI)/A*EXP(-(X-U)^2/(2*A^2))
END FUNCTION

以下略
-------------------------------------------------------------------------------
各種フィルタを試してみた。

LET TAP=16 ! 次数(偶数)
LET M=200 ! サンプル数
DIM DAT(M),OUT(M)
LET SAMPLINGFREQ=44100 ! サンプリング周波数
SET WINDOW 1,M,-1.5,1.5
DRAW GRID(M/4,.3)
FOR I=1 TO M
LET DAT(I)=SIN(1500*I/SAMPLINGFREQ*2*PI)+.3*SIN(12000*I/SAMPLINGFREQ*2*PI) ! 1500Hzと12000Hzの合成波形
PLOT LINES:I,DAT(I);
NEXT I
PLOT LINES
SET LINE COLOR "RED"
LET FILTER=1
CALL FIR(FILTER,DAT,M,TAP,SAMPLINGFREQ,3000,20000,OUT) ! FIRフィルタ処理
FOR I=1 TO M
PLOT LINES:I,OUT(I); ! 結果表示
NEXT I
END

EXTERNAL SUB FIR(FILTER,IN(),SIZE,TAPSIZE,SAMPLINGFREQ,FREQ1,FREQ2,OUT())
DIM COEF(0 TO TAPSIZE)
SELECT CASE FILTER
CASE 1
CALL GETCOEFFICIENTLPF(FREQ1,SAMPLINGFREQ,TAPSIZE,COEF) ! LPF
CASE 2
CALL GETCOEFFICIENTHPF(FREQ1,SAMPLINGFREQ,TAPSIZE,COEF) ! HPF
CASE 3
CALL GETCOEFFICIENTBPF(FREQ1,FREQ2,SAMPLINGFREQ,TAPSIZE,COEF) ! BPF
CASE 4
CALL GETCOEFFICIENTBEF(FREQ1,FREQ2,SAMPLINGFREQ,TAPSIZE,COEF) ! BSF(BEF)
END SELECT
FOR J=1 TO SIZE
LET S=0
FOR I=0 TO TAPSIZE
IF I+J<=SIZE THEN LET S=S+COEF(I)*IN(I+J)
NEXT I
LET OUT(J)=S
NEXT J
END SUB

EXTERNAL SUB GETCOEFFICIENTLPF(FE,SAMPLING,N,H())
LET F = FE /SAMPLING
FOR I=-N/2 TO N/2
IF I = 0 THEN
LET H(N/2+I) = 2.0 * F
ELSE
LET H(N/2+I) = 2.0 * F * SIN(2.0 * PI * F * I)/(2.0 * PI * F *I)
END IF
NEXT I
FOR I=0 TO N
LET H(I)=H(I)*W(I,N) ! 窓関数をかける
NEXT I
END SUB

EXTERNAL SUB GETCOEFFICIENTHPF(FE,SAMPLING,N,H())
LET F = FE /SAMPLING
FOR I=-N/2 TO N/2
IF I = 0 THEN
LET H(N/2+I) = 1.0 - 2.0 * F
ELSE
LET H(N/2+I) = SIN(PI * I) / (PI *I)- 2.0 * F * SIN(2.0 * PI * F * I) / (2.0 * PI * F * I)
END IF
NEXT I
FOR I=0 TO N
LET H(I)=H(I)*W(I,N)
NEXT I
END SUB

EXTERNAL SUB GETCOEFFICIENTBPF(F1,F2,SAMPLING,N,H())
LET FE1 = F1 / SAMPLING
LET FE2 = F2 / SAMPLING
FOR I=-N/2 TO N/2
IF I = 0 THEN
LET H(N/2+I) = 2.0 * (FE2 - FE1)
ELSE
LET H(N/2+I) = 2.0 * FE2 * SIN(2.0 * PI * FE2 * I) / (2.0 * PI * FE2 * I)- 2.0 * FE1 * SIN(2.0 * PI * FE1 * I) / (2.0 * PI * FE1 * I)
END IF
NEXT I
FOR I=0 TO N
LET H(I)=H(I)*W(I,N)
NEXT I
END SUB

EXTERNAL SUB GETCOEFFICIENTBEF(F1,F2,SAMPLING,N,H())
LET FE1 = F1 / SAMPLING
LET FE2 = F2 / SAMPLING
FOR I=-N/2 TO N/2
IF I = 0 THEN
LET H(N/2+I) = 1-2.0 * (FE2 - FE1)
ELSE
LET H(N/2+I) = SIN(2*PI*I)-2.0 * FE2 * SIN(2.0 * PI * FE2 * I) / (2.0 * PI * FE2 * I)+ 2.0 * FE1 * SIN(2.0 * PI * FE1 * I) / (2.0 * PI * FE1 * I)
END IF
NEXT I
FOR I=0 TO N
LET H(I)=H(I)*W(I,N)
NEXT I
END SUB

以下略
-------------------------------------------------------------------------------
上記のフィルタ特性調べてみた。

横軸が周波数、縦軸がdbです。

OPTION BASE 0
LET TAPSIZE=32 ! 次数(偶数)
LET M=8
DIM COEF(TAPSIZE),RR(2^M),II(2^M)
LET SAMPLINGFREQ=44100 ! サンプリング周波数
LET FREQ=10000
LET FREQ1=8000
LET FREQ2=12000
LET FILTER=1
SELECT CASE FILTER
CASE 1
CALL GETCOEFFICIENTLPF(FREQ,SAMPLINGFREQ,TAPSIZE,COEF)
CASE 2
CALL GETCOEFFICIENTHPF(FREQ,SAMPLINGFREQ,TAPSIZE,COEF)
CASE 3
CALL GETCOEFFICIENTBPF(FREQ1,FREQ2,SAMPLINGFREQ,TAPSIZE,COEF)
CASE 4
CALL GETCOEFFICIENTBEF(FREQ1,FREQ2,SAMPLINGFREQ,TAPSIZE,COEF)
END SELECT
FOR I=0 TO TAPSIZE
LET RR(I+1)=COEF(I)
NEXT I
CALL FFT(M,RR,II,1)
SET WINDOW -1000,SAMPLINGFREQ/2,-80,0
DRAW GRID(SAMPLINGFREQ/10,10)
LET LL=SAMPLINGFREQ/2^M
FOR I=1 TO 2^M/2
IF RR(I)=0 AND II(I)=0 THEN
PLOT LINES:I*LL,-80;
ELSE
PLOT LINES:I*LL, 10*LOG10(RR(I)^2+II(I)^2);
END IF
NEXT I
END

以下略
-------------------------------------------------------------------------------
SIN波をFIRフィルタ代わりにしてみた。

RANDOMIZE
LET SAMPLINGFREQ=44100
LET M=12
LET N=2^M
LET SIZE=50
LET FREQ1=1000
LET FREQ2=8000
LET FREQ3=17000
DIM LIN(N)
DIM RR(N),II(N)
FOR I=1 TO N
LET LIN(I)=2*RND-1
! FOR J=1 TO 210
! LET LIN(I)=LIN(I)+SIN(100*J/SAMPLINGFREQ*2*I*PI)/210
! NEXT J
NEXT I
FOR I=1 TO N
LET L=0
FOR J=0 TO SIZE-1
IF I+J<=N THEN
LET S1=SIN(FREQ1/SAMPLINGFREQ*J*2*PI) ! SIN波
LET S2=SIN(FREQ2/SAMPLINGFREQ*J*2*PI)
LET S3=SIN(FREQ3/SAMPLINGFREQ*J*2*PI)
LET L=L+(S1+S2+S3)*LIN(I+J)
END IF
NEXT J
LET RR(I)=L/SIZE
NEXT I
CALL FFT(M,RR,II,1)
SET WINDOW 0,SAMPLINGFREQ/2,-80,30
DRAW GRID(SAMPLINGFREQ/10,10)
LET LL=SAMPLINGFREQ/2^M
FOR I=1 TO 2^M/2
IF RR(I)=0 AND II(I)=0 THEN
PLOT LINES:I*LL,-80;
ELSE
PLOT LINES:I*LL, 10*LOG10(RR(I)^2+II(I)^2);
END IF
NEXT I
END

以下略

Re: FIRフィルタ - しばっち

2024/10/13 (Sun) 08:16:05

下記のようにすれば移動平均(LPF)から別のフィルタを生成できる。

https://vision.kuee.kyoto-u.ac.jp/lecture/dsp/pdf/2013/dsp2013_12.pdf

LET TAP=5 ! 次数
LET SAMPLINGFREQ=2000 ! サンプリング周波数
LET N=SAMPLINGFREQ
DIM IN(N),OUT(N),COEF(TAP)
FOR I=1 TO N
LET IN(I)=SIN(30*I/SAMPLINGFREQ*2*PI)*.8+SIN(800*I/SAMPLINGFREQ*2*PI)*.2
NEXT I
FOR I=1 TO TAP ! 移動平均
LET COEF(I)=1/TAP
NEXT I
LET W0=SAMPLINGFREQ/4
LET MODE=0
SELECT CASE MODE
CASE 0 ! LPF
CASE 1 ! HPF
FOR I=1 TO TAP
LET COEF(I)=(-1)^I*COEF(I)
NEXT I
CASE 2 ! BPF
FOR I=1 TO TAP
LET COEF(I)=2*COS(TAP*W0/SAMPLINGFREQ)*COEF(I)
NEXT I
CASE 3 ! BSF
LET COEF(1)=1-2*COEF(1)
FOR I=2 TO TAP
LET COEF(I)=2*COS(TAP*W0/SAMPLINGFREQ)*COEF(I)
NEXT I
END SELECT
SET WINDOW 1,N/10,-1.5,1.5
DRAW GRID(N/20,.3)
FOR I=1 TO N/10
PLOT LINES:I,IN(I);
NEXT I
PLOT LINES
CALL FIR(IN,N,COEF,TAP,OUT)
SET LINE COLOR "RED"
FOR I=1 TO N/10
PLOT LINES:I,OUT(I);
NEXT I
END

以下略

Re: FIRフィルタ - しばっち

2024/10/13 (Sun) 08:17:07

DCT(離散COS変換)によるフィルタ処理

CALL DCT(X,N,Y)を実行するとN個の配列Xを配列YにDCT変換します。
Y(0)はDC(直流成分)でY(1),Y(2),Y(3)と添え字が大きくなるとAC(交流成分)が高くなり
Y(N-1)が一番高い高周波成分になります。

つまりN=8ではY(7)が一番高い高周波成分になります。
Y(0)=0とすると直流成分遮断になります。
Y(7)=0,Y(6)=0,Y(5)=0のようにすると高周波成分遮断となります。

また、Y(0)=Y(0)*1.2のようにすると増幅となり、Y(0)=Y(0)*.8のように1より小さくすると減衰させることができます。

※NUMはNで割り切れる必要があります。MOD(NUM,N)=0

DECLARE EXTERNAL FUNCTION C
PUBLIC NUMERIC N
LET N=8 ! DCTフィルタ次数
OPTION BASE 0
LET NUM=200
DIM X(N),Y(N),OUT(NUM)
FOR I=1 TO NUM
LET OUT(I)=SIN(400/48000*I*2*PI)*.6+SIN(15000/48000*I*2*PI)*.4
NEXT I
SET WINDOW 0,NUM,-1,1
DRAW GRID(NUM/5,.2)
LET MODE=0
FOR I=1 TO NUM
PLOT LINES:I,OUT(I);
NEXT I
PLOT LINES
FOR I=1 TO NUM STEP N
FOR J=0 TO N-1
LET X(J)=OUT(I+J)
NEXT J
CALL DCT2(X,N,Y) !'離散COSINE変換
SELECT CASE MODE ! フィルタ処理
CASE 0
LET Y(0)=0
CASE 1
LET Y(N-3)=0
LET Y(N-2)=0
LET Y(N-1)=0
CASE 2
LET Y(0)=Y(0)*.7
CASE 3
LET Y(N-3)=Y(N-3)*.5
LET Y(N-2)=Y(N-2)*.5
LET Y(N-1)=Y(N-1)*.5
END SELECT
CALL DCT3(Y,N,X) !'離散COSINE逆変換
FOR J=0 TO N-1
LET OUT(I+J)=X(J)
NEXT J
NEXT I
SET LINE COLOR "RED"
FOR I=1 TO NUM
PLOT LINES:I,OUT(I);
NEXT I
END

EXTERNAL FUNCTION C(X)
IF X=0 OR X=N THEN LET C=SQR(.5) ELSE LET C=1
END FUNCTION

EXTERNAL SUB DCT2(A(),N,B())
FOR I=0 TO N-1
LET S=0
FOR K=0 TO N-1
LET S=S+A(K)*COS((2*K+1)*I*PI/2/N)
NEXT K
LET B(I)=S*SQR(2/N)*C(I)
NEXT I
END SUB

EXTERNAL SUB DCT3(A(),N,B())
FOR I=0 TO N-1
LET S=0
FOR K=0 TO N-1
LET S=S+C(K)*A(K)*COS((2*I+1)*K*PI/2/N)
NEXT K
LET B(I)=S*SQR(2/N)
NEXT I
END SUB
-----------------------------------------------------------------------------------
周波数特性調べてみた。

RANDOMIZE
DECLARE EXTERNAL FUNCTION C
LET M=12
OPTION BASE 0
LET SAMPLINGFREQ=44100
LET NUM=2^M
DIM RR(NUM),II(NUM),X(64),Y(64)
LET NN=8
DO
CLEAR
MAT RR=ZER
MAT II=ZER
FOR I=1 TO NUM
LET RR(I)=2*RND-1
NEXT I
LET MODE=1
FOR I=1 TO NUM STEP NN
FOR J=0 TO NN-1
LET X(J)=RR(I+J)
NEXT J
CALL DCT2(X,NN,Y) !'離散COSINE変換
SELECT CASE MODE
CASE 0
LET Y(0)=0
LET Y(1)=0
LET Y(2)=0
CASE 1
FOR J=1 TO NN-1
LET Y(J)=0
NEXT J
END SELECT
CALL DCT3(Y,NN,X) !'離散COSINE逆変換
FOR J=0 TO NN-1
LET RR(I+J)=X(J)
NEXT J
NEXT I
CALL FFT(M,RR,II,1)
SET WINDOW -15,SAMPLINGFREQ/2,-30,40
DRAW GRID(SAMPLINGFREQ/10,10)
LET LL=SAMPLINGFREQ/NUM
FOR I=1 TO NUM/2
IF RR(I)=0 AND II(I)=0 THEN
PLOT LINES:I*LL,-30;
ELSE
PLOT LINES:I*LL, 10*LOG10(RR(I)^2+II(I)^2);
END IF
NEXT I
WAIT DELAY 1
LET NN=NN*2
LOOP UNTIL NN>64
END

以下略

Re: FIRフィルタ - しばっち

2024/10/13 (Sun) 08:18:06

下記プログラムはDCTフィルタ次数を8として逆DCTの次数を増減させている。
これは画像処理でいう拡大・縮小処理にあたります。

つまり拡大にあたる処理では周波数は減衰し縮小では周波数が増大します。
これは全体のサイズが変化しているためです。

黒線が処理前のパワースペクトルで200Hzが高くなっています。
赤線がDCT処理後のパワースペクトルです。

DECLARE EXTERNAL FUNCTION C
PUBLIC NUMERIC NN
LET NN=8 ! DCT次数
LET M=8 ! FFT次数
OPTION BASE 0
LET NUM=2^M
LET SAMPLINGFREQ=1000 ! サンプリング周波数
DIM X(NN*2),Y(NN*2),RR(NUM*2),II(NUM*2)
DIM TR(NUM*2)
CALL SETDATA
CALL DISPLAY

CALL SETDATA
FOR I=1 TO NUM STEP NN
FOR J=0 TO NN-1
LET X(J)=RR(I+J)
NEXT J
LET MM=NN/2 ! 縮小
!LET MM=NN*2 ! 拡大
CALL DCT2(X,NN,Y) !'離散COSINE変換
CALL DCT3(Y,MM,X) !'離散COSINE逆変換
FOR J=0 TO MM-1
LET TR(JJ+J)=X(J)
NEXT J
LET JJ=JJ+MM
NEXT I
MAT RR=TR
SET LINE COLOR "RED"
CALL DISPLAY

SUB SETDATA
MAT II=ZER
FOR I=1 TO NUM
LET RR(I)=SIN(200/SAMPLINGFREQ*I*2*PI)
NEXT I
END SUB

SUB DISPLAY
MAT II=ZER
CALL FFT(M,RR,II,1)
SET WINDOW -15,SAMPLINGFREQ/2,-10,40
DRAW GRID(SAMPLINGFREQ/10,10)
LET LL=SAMPLINGFREQ/NUM
FOR I=1 TO 2^M/2
IF RR(I)=0 AND II(I)=0 THEN
PLOT LINES:I*LL,-10;
ELSE
PLOT LINES:I*LL, 10*LOG10(RR(I)^2+II(I)^2);
END IF
NEXT I
PLOT LINES
END SUB
END

以下略

Re: FIRフィルタ - しばっち

2024/10/13 (Sun) 08:19:23

ウェーブレット変換の周波数特性を調べてみた。

RANDOMIZE
OPTION BASE 0
LET M=16
LET NUM=2^M
FOR LEV=1 TO 4
LET SIZE=INT((NUM+2^LEV-1)/2^LEV)*2^LEV
DIM DAT1(SIZE),DAT2(SIZE),II(SIZE)
FOR I=0 TO NUM-1
LET DAT1(I)=2*RND-1
LET DAT2(I+1)=DAT1(I)
NEXT I
MAT II=ZER
CALL FFT(M,DAT2,II,1)
CLEAR
SET WINDOW 1,NUM/2,-50,70
DRAW GRID(NUM/10,10)
FOR I=1 TO NUM/2
IF DAT2(I)<>0 OR II(I)<>0 THEN
PLOT LINES:I,10*LOG10(DAT2(I)^2+II(I)^2);
ELSE
PLOT LINES:I,-50;
END IF
NEXT I
PLOT LINES
MAT DAT2=ZER
WAIT DELAY 1
CLEAR
CALL WAVELET1D(LEV,1,SIZE,DAT1,DAT2)
LET MODE=1
SELECT CASE MODE
CASE 0
FOR I=0 TO SIZE/2^LEV-1
LET DAT2(I)=0
NEXT I
CASE 1
FOR I=SIZE/2^LEV TO SIZE-1
LET DAT2(I)=0 ! フィルタ処理
NEXT I
END SELECT
MAT DAT1=ZER
CALL IWAVELET1D(LEV,1,SIZE,DAT2,DAT1)
FOR I=0 TO SIZE-1
LET DAT2(I+1)=DAT1(I)
NEXT I
MAT II=ZER
CALL FFT(M,DAT2,II,1)
SET WINDOW 1,NUM/2,-50,70
DRAW GRID(NUM/10,10)
FOR I=1 TO NUM/2
IF DAT2(I)<>0 OR II(I)<>0 THEN
PLOT LINES:I,10*LOG10(DAT2(I)^2+II(I)^2);
ELSE
PLOT LINES:I,-50;
END IF
NEXT I
NEXT LEV
END

EXTERNAL SUB WAVELET1D(LEV,XS,SIZE,DAT1(),DAT2())
OPTION BASE 0
DIM X(SIZE),Y(SIZE)
IF LEV>0 THEN
FOR I=0 TO SIZE-1
LET X(I)=DAT1(I+XS)
NEXT I
CALL WAVELET(SIZE,X,Y)
FOR I=0 TO SIZE-1
LET DAT2(I+XS)=Y(I)
NEXT I
FOR I=0 TO SIZE-1
LET DAT1(I+XS)=DAT2(I+XS)
NEXT I
CALL WAVELET1D(LEV-1,XS,SIZE/2,DAT1,DAT2)
CALL WAVELET1D(LEV-1,XS+SIZE/2,SIZE/2,DAT1,DAT2)
END IF
END SUB

EXTERNAL SUB IWAVELET1D(LEV,XS,SIZE,DAT1(),DAT2())
OPTION BASE 0
DIM X(SIZE),Y(SIZE)
IF LEV>0 THEN
CALL IWAVELET1D(LEV-1,XS,SIZE/2,DAT1,DAT2)
CALL IWAVELET1D(LEV-1,XS+SIZE/2,SIZE/2,DAT1,DAT2)
FOR I=0 TO SIZE-1
LET X(I)=DAT1(I+XS)
NEXT I
CALL IWAVELET(SIZE,X,Y)
FOR I=0 TO SIZE-1
LET DAT2(I+XS)=Y(I)
NEXT I
FOR I=0 TO SIZE-1
LET DAT1(I+XS)=DAT2(I+XS)
NEXT I
END IF
END SUB

EXTERNAL SUB WAVELET(SIZE,DAT1(),DAT2())
FOR I=0 TO SIZE/2-1
LET DAT2(I)=.5*DAT1(I*2)+.5*DAT1(I*2+1)
LET DAT2(I+SIZE/2)=.5*DAT1(I*2)-.5*DAT1(I*2+1)
NEXT I
END SUB

EXTERNAL SUB IWAVELET(SIZE,DAT2(),DAT1())
FOR I=0 TO SIZE/2-1
LET DAT1(I*2)=DAT2(I)+DAT2(I+SIZE/2)
LET DAT1(I*2+1)=DAT2(I)-DAT2(I+SIZE/2)
NEXT I
END SUB

以下略

Re: FIRフィルタ - しばっち

2024/10/13 (Sun) 08:20:36

アダマール変換の周波数特性調べてみた。

LET M=12
LET SAMPLINGFREQ=44100
OPTION BASE 0
RANDOMIZE
LET NUM=2^M
DIM RR(NUM),II(NUM),X(2^8),Y(2^8)
LET LL=SAMPLINGFREQ/NUM
FOR BIT=3 TO 8
CLEAR
MAT RR=ZER
MAT II=ZER
LET N=2^BIT
FOR I=1 TO NUM
LET RR(I)=2*RND-1
NEXT I
FOR I=1 TO NUM STEP N
FOR J=0 TO N-1
LET X(J)=RR(I+J)
NEXT J
CALL FASTHADAMARD(X,N,Y)
FOR J=1 TO N-1
LET K=SEQUENCY(BIT,J)
LET Y(K)=0
NEXT J
CALL FASTHADAMARD(Y,N,X)
FOR J=0 TO N-1
LET RR(I+J)=X(J)/N
NEXT J
NEXT I
CALL FFT(M,RR,II,1)
SET WINDOW 1,SAMPLINGFREQ/2,-60,40
DRAW GRID(SAMPLINGFREQ/10,10)
FOR I=1 TO NUM/2
IF RR(I)=0 AND II(I)=0 THEN
PLOT LINES:I*LL,-60;
ELSE
PLOT LINES:I*LL,10*LOG10(RR(I)^2+II(I)^2);
END IF
NEXT I
WAIT DELAY 1
NEXT BIT
END

EXTERNAL SUB FASTHADAMARD(X(),N,A()) ! 高速アダマール変換
LET BIT=LOG2(N)
FOR J=1 TO BIT
LET K=0
LET L=0
FOR I=0 TO N-1
IF I<N/2 THEN
LET A(I)=X(2*K)+X(2*K+1)
LET K=K+1
ELSE
LET A(I)=X(2*L)-X(2*L+1)
LET L=L+1
END IF
NEXT I
MAT X=A
NEXT J
END SUB

EXTERNAL FUNCTION SEQUENCY(BIT,N)
FOR I=1 TO BIT
LET G=BITAND(N,1)
LET N=INT(N/2)
LET L=BITXOR(G,B)
LET A=A*2+L
LET B=L
NEXT I
LET SEQUENCY=A
END FUNCTION

Re: FIRフィルタ - しばっち

2024/10/13 (Sun) 08:21:53

位相シフト

位相を任意のシフト幅でずらします。

LET SAMPLINGFREQ=50 ! サンプリング周波数
SET WINDOW 1,SAMPLINGFREQ,-1,1
DRAW GRID(SAMPLINGFREQ/10,.2)
LET TH=PI/6 ! シフト幅
LET FREQ=4 ! 周波数
LET D=SAMPLINGFREQ/(4*FREQ)
DIM A(SAMPLINGFREQ+D)
FOR I=1 TO SAMPLINGFREQ+D
LET A(I)=SIN(FREQ/SAMPLINGFREQ*I*2*PI)
PLOT LINES:I,A(I); ! 元波形
NEXT I
PLOT LINES
SET LINE COLOR "BLUE"
FOR I=1 TO SAMPLINGFREQ
PLOT LINES:I,SIN(FREQ/SAMPLINGFREQ*I*2*PI+TH); !位相シフトした波形
NEXT I
PLOT LINES
SET LINE COLOR "RED"
FOR I=1 TO SAMPLINGFREQ
! PLOT LINES:I,SIN(FREQ/SAMPLINGFREQ*I*2*PI)*COS(TH)+COS(FREQ/SAMPLINGFREQ*I*2*PI)*SIN(TH); ! 加法定理 SIN(A+B)=SIN(A)*COS(B)+COS(A)*SIN(B)
PLOT LINES:I,A(I)*COS(TH)+A(I+D)*SIN(TH);
NEXT I
END

FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:00:23

FFTフィルタ処理

https://decimalbasic.ninja-web.net/bbs2/4366.html
https://decimalbasic.ninja-web.net/bbs2/4367.html
https://decimalbasic.ninja-web.net/bbs2/4368.html

https://decimalbasic.ninja-web.net/bbs2/4559.html

FFTによるフィルタを定義してみました。
処理前と処理後の違いをグラフ表示しています。

サンプリング周波数を400Hzとし、合成波形を生成して
各種フィルタ処理してみました。

(※フィルタ処理可能域はサンプリング定理によりサンプリング周波数の半分までです。ナイキスト周波数)
https://ja.wikipedia.org/wiki/標本化定理
 https://ja.wikipedia.org/wiki/ナイキスト周波数
 https://ja.wikipedia.org/wiki/ローパスフィルタ

フィルタ処理により波形が変化していることを確認してください。

2進モードで実行してください。

サンプル数2^24個のFFT演算が600秒あまりでした。

LET M=8
LET N=2^M ! FFTサンプル数
DIM RR(N),II(N),T(N)
MAT T=CON
LET FREQ=400 ! サンプリング周波数
FOR I=1 TO N
LET RR(I)=SIN(20/FREQ*I*2*PI)*.5+.3*SIN(120/FREQ*I*2*PI)+.1*SIN(180/FREQ*I*2*PI) ! 20Hz,120Hz,180Hzの合成波形
NEXT I
SET WINDOW -3,64,-1.5,1.5
DRAW GRID(4,.2)
FOR I=1 TO 64
PLOT LINES: I,RR(I); ! グラフ表示
NEXT I
CALL FFT(M,RR,II,1) ! FFT
LET FILTER=0
SELECT CASE FILTER
CASE 0
LET F=100/FREQ*N ! 遮断域周波数 100Hz～
FOR I=F TO N-F ! ローパスフィルタ LPF
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
CASE 1
LET F=150/FREQ*N ! 通過域周波数 150Hz～
FOR I=1 TO F ! ハイパスフィルタ HPF
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
FOR I=N-F TO N
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
CASE 2
LET FS=80/FREQ*N ! 通過域周波数 80Hz～150Hz
LET FE=150/FREQ*N
FOR I=1 TO FS ! バンドパスフィルタ BPF
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
FOR I=FE TO N-FE
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
FOR I=N-FS TO N
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
CASE 3
LET FS=80/FREQ*N ! 遮断域周波数 80Hz～150Hz
LET FE=150/FREQ*N
FOR I=FS TO FE ! バンドストップフィルタ BSF(BEF)
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
FOR I=N-FE TO N-FS
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
CASE 4
LET F=120/FREQ*N
FOR I=F-1 TO F+1 ! ノッチ
LET RR(I)=0
LET II(I)=0
LET T(I)=0
LET RR(N-I)=0
LET II(N-I)=0
LET T(N-I)=0
NEXT I
CASE 5
LET F=120/FREQ*N
FOR I=1 TO F-2 ! 逆ノッチ
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
FOR I=F+2 TO N-F-1
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
FOR I=N-F+1 TO N
LET RR(I)=0
LET II(I)=0
LET T(I)=0
NEXT I
CASE 6
LET FS=80/FREQ*N
LET FE=150/FREQ*N
FOR I=FS TO FE ! オールパスフィルタ
LET II(I)=-II(I) ! 位相反転
NEXT I
FOR I=N-FE TO N-FS
LET II(I)=-II(I)
NEXT I
FOR I=N-FS TO N
LET II(I)=-II(I)
NEXT I
END SELECT
PAUSE
CLEAR
SET WINDOW -10,N/2,-.1,1.1
DRAW GRID(16,.2)
FOR X=1 TO N/2
PLOT LINES:X,T(X); ! フィルタ形状(0=遮断,1=通過)
NEXT X
PAUSE
CLEAR
CALL FFT(M,RR,II,-1) ! 逆FFT
SET WINDOW -3,64,-1.5,1.5
DRAW GRID(4,.2)
FOR I=1 TO 64
PLOT LINES: I,RR(I); ! 波形表示
NEXT I
END

EXTERNAL SUB FFT(M,XR(),XI(),INVERSE)
LET N=2^M
LET L=N/2
LET J=L+1
FOR I=2 TO N-2
IF I<J THEN
SWAP XR(I),XR(J)
SWAP XI(I),XI(J)
END IF
LET K=L
DO WHILE K<J
LET J=J-K
LET K=K/2
LOOP
LET J=J+K
NEXT I
IF INVERSE=1 THEN
LET PX=-PI
ELSE
FOR I=1 TO N
LET XR(I)=XR(I)/N
LET XI(I)=XI(I)/N
NEXT I
LET PX=PI
END IF
LET L=1
FOR K=1 TO M
LET LL=L+L
LET P=PX/L
FOR J=1 TO L
LET W=(J-1)*P
LET WR=COS(W)
LET WI=SIN(W)
FOR I=J TO N STEP LL
LET IL=I+L
LET TR=XR(IL)*WR-XI(IL)*WI
LET TI=XR(IL)*WI+XI(IL)*WR
LET XR(IL)=XR(I)-TR
LET XI(IL)=XI(I)-TI
LET XR(I)=XR(I)+TR
LET XI(I)=XI(I)+TI
NEXT I
NEXT J
LET L=LL
NEXT K
END SUB
-------------------------------------------------------------------------
グラフ表示だけではおもしろくないのでwavファイルに書き出して
聞き比べられるようにしてみました。※スピーカーのボリュームは小さめにしてください。

サンプル数2^17(131072)でサンプリング周波数44100Hzなので再生時間は131072/44100=2.97215でおよそ3秒になります。

LET M=17
LET N=2^M ! FFTサンプル数
DIM RR(N),II(N)
LET SAMPLINGFREQ=44100 ! サンプリング周波数
LET VOL=.5 ! ボリューム
FOR I=1 TO N
LET RR(I)=SIN(800/SAMPLINGFREQ*I*2*PI)+.3*SIN(4000/SAMPLINGFREQ*I*2*PI)+.1*SIN(12000/SAMPLINGFREQ*I*2*PI) ! 800Hzと4000Hzと12000Hzの合成波形
LET RR(I)=RR(I)*VOL
NEXT I
CALL WRITEWAV("元音.wav",N,SAMPLINGFREQ,16,RR) ! モノラル版
CALL FFT(M,RR,II,1) ! FFT
LET FILTER=0
SELECT CASE FILTER
CASE 0
LET F=1000/SAMPLINGFREQ*N
FOR I=F+1 TO N-F-1 ! ローパスフィルタ LPF
LET RR(I)=0
LET II(I)=0
NEXT I
CASE 1
LET F=10000/SAMPLINGFREQ*N
FOR I=1 TO F ! ハイパスフィルタ HPF
LET RR(I)=0
LET II(I)=0
NEXT I
FOR I=N-F TO N
LET RR(I)=0
LET II(I)=0
NEXT I
CASE 2
LET FS=1000/SAMPLINGFREQ*N
LET FE=5000/SAMPLINGFREQ*N
FOR I=1 TO FS-1 ! バンドパスフィルタ BPF
LET RR(I)=0
LET II(I)=0
NEXT I
FOR I=FE+1 TO N-FE
LET RR(I)=0
LET II(I)=0
NEXT I
FOR I=N-FS TO N
LET RR(I)=0
LET II(I)=0
NEXT I
CASE 3
LET FS=1000/SAMPLINGFREQ*N
LET FE=5000/SAMPLINGFREQ*N
FOR I=FS TO FE ! バンドストップフィルタ BSF(BEF)
LET RR(I)=0
LET II(I)=0
NEXT I
FOR I=N-FE TO N-FS
LET RR(I)=0
LET II(I)=0
NEXT I
END SELECT
CALL FFT(M,RR,II,-1) ! 逆FFT
CALL WRITEWAV("処理後.wav",N,SAMPLINGFREQ,16,RR)
END

以下略
-------------------------------------------------------------------------
FFT係数を増幅して元信号を増幅できるか試してみた。

LET M=8
LET N=2^M
DIM RR(N),II(N)
LET SAMPLINGFREQ=1000 ! サンプリング周波数
SET WINDOW 1,N/2,-1.5,1.5
DRAW GRID(N/8,.5)
FOR I=1 TO N
LET RR(I)=SIN(50/SAMPLINGFREQ*I*2*PI)*.8+SIN(300/SAMPLINGFREQ*I*2*PI)*.2
NEXT I
FOR I=1 TO N/2
PLOT LINES:I,RR(I);
NEXT I
LET DB=10
LET GAIN=10^(DB/20) ! 増幅率10db
LET FILTER=0
CALL FFTFILTER(M,FILTER,SAMPLINGFREQ,100,400,GAIN,RR,II)
PAUSE
CLEAR
SET WINDOW 1,N/2,-1.5,1.5
DRAW GRID(N/8,.5)
FOR I=1 TO N/2
PLOT LINES:I,RR(I);
NEXT I
END

EXTERNAL SUB FFTFILTER(M,FILTER,SAMPLINGFREQ,FREQ1,FREQ2,GAIN,RR(),II())
LET N=2^M
LET F=FREQ1/SAMPLINGFREQ*N
LET FS=FREQ1/SAMPLINGFREQ*N
LET FE=FREQ2/SAMPLINGFREQ*N
CALL FFT(M,RR,II,1) ! FFT
SELECT CASE FILTER
CASE 0
FOR I=F+1 TO N-F-1 ! ハイシェルフ
LET RR(I)=RR(I)*GAIN
NEXT I
CASE 1
FOR I=1 TO F ! ロ－シェルフ
LET RR(I)=RR(I)*GAIN
NEXT I
FOR I=N-F TO N
LET RR(I)=RR(I)*GAIN
NEXT I
CASE 2
FOR I=1 TO FS-1 ! 反バンド増幅
LET RR(I)=RR(I)*GAIN
NEXT I
FOR I=FE+1 TO N-FE
LET RR(I)=RR(I)*GAIN
NEXT I
FOR I=N-FS TO N
LET RR(I)=RR(I)*GAIN
NEXT I
CASE 3
FOR I=FS TO FE ! バンド増幅
LET RR(I)=RR(I)*GAIN
NEXT I
FOR I=N-FE TO N-FS
LET RR(I)=RR(I)*GAIN
NEXT I
END SELECT
CALL FFT(M,RR,II,-1) ! 逆FFT
END SUB

以下略
-------------------------------------------------------------------------
FFT係数をシフトすることで元周波数を変更(ピッチシフト)できるか試してみた。

このプログラムではシフト幅100Hzとすると
100Hz→200Hz
200Hz→300Hz
400Hz→500Hz
800Hz→900Hz
のようにするので和音などの響きが乱れることになります。

次のように
100Hz→200Hz
200Hz→400Hz
400Hz→800Hz
800Hz→1600Hz
とすれば乱れることなく音程を1オクターブ上げる(ピッチアップ)ことができます。

※赤線と青線が一致するのが理想ですが、実際には一致しません。

LET M=10
LET N=2^M ! FFTポイント数
DIM RR(N),II(N)
DIM AR(N),AI(N)
LET SAMPLINGFREQ=2000 ! サンプリング周波数
LET LL=SAMPLINGFREQ/N
LET FREQ=300 ! 周波数
LET SHIFTFREQ=300 ! シフト幅周波数
LET SHIFT=SHIFTFREQ/SAMPLINGFREQ*N
FOR I=1 TO N
LET RR(I)=SIN(FREQ/SAMPLINGFREQ*I*2*PI)
NEXT I
SET WINDOW 1,N/16,-3,3
DRAW GRID(N/64,1)
FOR I=1 TO N/16
PLOT LINES:I,RR(I); ! 元波形表示
NEXT I
PAUSE
CLEAR
PLOT LINES
CALL FFT(M,RR,II,1) ! FFT
SET WINDOW 1,SAMPLINGFREQ/2,-30,50
DRAW GRID(SAMPLINGFREQ/10,10)
FOR I=1 TO N/2
PLOT LINES:I*LL,10*LOG10(RR(I)^2+II(I)^2); ! 振幅スペクトル
NEXT I
PLOT LINES
LET MODE=1
SELECT CASE MODE
CASE 1 ! ピッチシフトアップ
FOR I=1 TO N/2-SHIFT
LET AR(I+SHIFT)=RR(I)
LET AI(I+SHIFT)=II(I)
NEXT I
FOR I=N/2 TO N-SHIFT
LET AR(I)=RR(I+SHIFT)
LET AI(I)=II(I+SHIFT)
NEXT I
CASE 2 ! ピッチシフトダウン
FOR I=1 TO N/2-SHIFT
LET AR(I)=RR(I+SHIFT)
LET AI(I)=II(I+SHIFT)
NEXT I
FOR I=N/2 TO N-SHIFT
LET AR(I+SHIFT)=RR(I)
LET AI(I+SHIFT)=II(I)
NEXT I
END SELECT
SET LINE COLOR "RED"
FOR I=1 TO N/2
PLOT LINES:I*LL,10*LOG10(AR(I)^2+AI(I)^2+1); ! シフトした振幅スペクトル
NEXT I
PAUSE
CLEAR
PLOT LINES
CALL FFT(M,AR,AI,-1) ! 逆FFT
CALL FFT(M,RR,II,-1) ! 逆FFT
SET WINDOW 1,N/16,-3,3
DRAW GRID(N/64,1)
SET LINE COLOR "BLACK"
FOR I=1 TO N/16
PLOT LINES:I,RR(I); ! 元波形
NEXT I
PLOT LINES
SET LINE COLOR "RED"
FOR I=1 TO N/16
PLOT LINES:I,AR(I); ! シフト波形
NEXT I
PLOT LINES
SET LINE COLOR "BLUE"
FOR I=1 TO N
LET RR(I)=SIN((FREQ+SHIFTFREQ)/SAMPLINGFREQ*I*2*PI) ! ピッチシフトした理想的な波形
NEXT I
FOR I=1 TO N/16
PLOT LINES:I,RR(I);
NEXT I
END

以下略
----------------------------------------------------------------------------------
位相シフトできるか試してみた。

LET M=8
LET N=2^M
DIM RR(N),II(N),FI(N)
LET FREQ=400
FOR I=1 TO N
LET RR(I)=SIN(20/FREQ*I*2*PI)+.2*SIN(180/FREQ*I*2*PI)
NEXT I
SET WINDOW 1,N,-1,1
DRAW GRID(N/10,.2)
FOR I=1 TO N
PLOT LINES: I,RR(I);
NEXT I
PLOT LINES
CALL FFT(M,RR,II,1)
LET SHIFT=3
FOR I=1 TO N
IF I+SHIFT<=N THEN LET FI(I)=II(I+SHIFT) ELSE LET FI(I)=II(I)
NEXT I
CALL FFT(M,RR,FI,-1)
SET LINE COLOR "RED"
FOR I=1 TO N
PLOT LINES: I,RR(I);
NEXT I
END

以下略
----------------------------------------------------------------------------------
ノイズ生成

https://ja.wikipedia.org/wiki/ホワイトノイズ
 https://moge32.blogspot.com/2019/01/blog-post.html
https://achapi2718.blogspot.com/2014/03/c_4061.html
https://ja.wikipedia.org/wiki/カラードノイズ
 http://www.finetune.co.jp/~lyuka/technote/pinknoise/
https://zenn.dev/shin1007/articles/d0a1e59d8ca69c

ホワイトノイズ

ホワイトノイズは全ての周波数で同じ強度となるノイズです。

※再生時、スピーカーのボリュームに気を付けてください。

RANDOMIZE
LET SAMPLINGFREQ=44100 ! サンプリング周波数
LET PLAYTIME=2
LET NUM=SAMPLINGFREQ*PLAYTIME
LET M=INT(LOG2(NUM))+1
LET N=2^M ! FFTサンプル数
DIM RR(N),II(N)
LET VOL=.4
SET WINDOW 1,NUM,-1,1
DRAW GRID(NUM/8,.2)
FOR I=1 TO NUM
LET RR(I)=(2*RND-1)*VOL
PLOT LINES:I,RR(I);
NEXT I
CALL WRITEWAV("ホワイトノイズ.wav",NUM,SAMPLINGFREQ,16,RR)
CALL FFT(M,RR,II,1) ! FFT
PLOT LINES
CLEAR
SET WINDOW 1,SAMPLINGFREQ/2,0,60
DRAW GRID(SAMPLINGFREQ/10,10)
LET LL=SAMPLINGFREQ/N
FOR I=1 TO N/2
PLOT LINES:I*LL,10*LOG10(RR(I)^2+II(I)^2);
NEXT I
END

以下略
----------------------------------------------------------------------------------
ピンクノイズ

周波数が10倍ごとに10dB減衰します(-10dB/decade)

https://ja.wikipedia.org/wiki/ピンクノイズ
 https://marui.hatenablog.com/entry/2017/07/17/173904

※再生時、スピーカーのボリュームに気を付けてください。

RANDOMIZE
LET SAMPLINGFREQ=44100 ! サンプリング周波数
LET PLAYTIME=2 ! 演奏時間
LET NUM=SAMPLINGFREQ*PLAYTIME
LET M=INT(LOG2(NUM))+1
LET N=2^M ! FFTサンプル数
DIM RR(N),II(N)
LET VOL=.4
FOR I=1 TO NUM
LET RR(I)=(2*RND-1)*VOL ! ホワイトノイズ
NEXT I
CALL FFT(M,RR,II,1) ! FFT
FOR I=1 TO N ! フィルタ処理
LET RR(I)=RR(I)/I ! ピンクノイズ 1/f
LET II(I)=II(I)/I
NEXT I
SET WINDOW 1,LOG10(SAMPLINGFREQ/2),-60,10
SET LINE STYLE 3
FOR Y=-60 TO 10 STEP 3
PLOT LINES:1,Y;LOG10(SAMPLINGFREQ/2),Y
NEXT Y
FOR I=1 TO 5
FOR J=1 TO 9
LET X=J*10^I
PLOT LINES:LOG10(X),10;LOG10(X),-60
NEXT J
NEXT I
SET LINE STYLE 1
LET LL=SAMPLINGFREQ/N ! 分解能
FOR I=1 TO N/2
PLOT LINES:LOG10(I*LL),-60;LOG10(I*LL),10*LOG10(RR(I)^2+II(I)^2) ! 対数振幅グラフ
NEXT I
CALL FFT(M,RR,II,-1) ! 逆FFT
FOR I=1 TO NUM
LET LMAX=MAX(ABS(RR(I)),LMAX)
NEXT I
FOR I=1 TO NUM ! 正規化
LET RR(I)=RR(I)/LMAX
NEXT I
CALL WRITEWAV("ピンクノイズ.wav",NUM,SAMPLINGFREQ,16,RR)
END

以下略
----------------------------------------------------------------------------------
ケプストラム分析

https://ja.wikipedia.org/wiki/ケプストラム
 https://nettyukobo.com/cepstrum/
https://ja.wikipedia.org/wiki/フォルマント

 https://contest.japias.jp/tqj17/170282/home/h04-2.html
https://www.gavo.t.u-tokyo.ac.jp/~mine/japanese/nlp+slp/I-RO-HA.pdf

マイクからサウンドレコーダーで録音した「あ」のwavファイルを読み込み
スペクトル包絡を求めています。(サンプル画像　赤線グラフ)

それらから極大値(ピーク)を幾つか抽出できれば「あ」の
フォルマント周波数が求められる。(音声「あ」を構成する周波数)

LET SIZE=44100*20
DIM LIN(SIZE),RIN(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET M=INT(LOG2(NUM)+1)
LET NN=2^M
LET L=72
LET EPS=1E-15
DIM LR(NN),LI(NN),LLOG(NN),LTMP(NN)
DIM LCL(NN)
FOR I=1 TO NUM
LET LR(I)=LIN(I)*W(I,NUM)
NEXT I
CALL FFT(M,LR,LI,1)
LET LL=SAMPLINGFREQ/NUM
SET WINDOW -1000,SAMPLINGFREQ/2,-50,30
DRAW GRID(SAMPLINGFREQ/8,10)
FOR I=1 TO NN
LET LLOG(I)=LOG(LR(I)^2+LI(I)^2+EPS)
NEXT I
FOR I=1 TO NN/2
PLOT LINES:I*LL,10*LOG10(LLOG(I)^2+EPS);
NEXT I
PLOT LINES
MAT LTMP=ZER
CALL FFT(M,LLOG,LTMP,-1)
MAT LCL=LLOG
FOR I=L TO NN-L
LET LCL(I)=0
NEXT I
MAT LTMP=ZER
CALL FFT(M,LCL,LTMP,1)
SET LINE COLOR "RED"
SET LINE WIDTH 3
FOR I=1 TO NN/2
PLOT LINES:I*LL,10*LOG10(LCL(I)^2+EPS);
NEXT I
END

以下略

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:02:05

ナイキスト周波数

https://ja.wikipedia.org/wiki/ナイキスト周波数

ナイキスト周波数(サンプリング周波数の半分)を超えると下記のようになります。

LET SAMPLINGFREQ=8000 ! サンプリング周波数
LET FREQ1=1000
LET FREQ2=SAMPLINGFREQ-FREQ1 ! SAMPLINGFREQ/2<FREQ2
LET NUM=30
SET WINDOW 1,NUM,-1,1
DRAW GRID(NUM/5,.2)
FOR I=1 TO NUM
PLOT LINES:I,SIN(FREQ1/SAMPLINGFREQ*I*2*PI);
NEXT I
PLOT LINES
SET LINE COLOR "RED"
FOR I=1 TO NUM
PLOT LINES:I,SIN(FREQ2/SAMPLINGFREQ*I*2*PI);
NEXT I
END

位相がずれていますが、周期は同じになります。

位相のずれは画像では表示位置のずれとして認知できますが
音の位相ずれは聞き分けられません。

LET SAMPLINGFREQ=8000 ! サンプリング周波数
LET FREQ1=1000
LET FREQ2=SAMPLINGFREQ-FREQ1 ! SAMPLINGFREQ/2<FREQ2
LET NUM=SAMPLINGFREQ*3
LET VOL=.5
DIM LOUT(NUM)
FOR I=1 TO NUM
LET LOUT(I)=SIN(FREQ1/SAMPLINGFREQ*I*2*PI)*VOL
NEXT I
CALL WRITEWAV("原音.WAV",NUM,SAMPLINGFREQ,16,LOUT)
FOR I=1 TO NUM
LET LOUT(I)=SIN(FREQ2/SAMPLINGFREQ*I*2*PI)*VOL
NEXT I
CALL WRITEWAV("位相ずれ.WAV",NUM,SAMPLINGFREQ,16,LOUT)
END

以下略

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:03:18

周波数解析

FFTを使用しない簡易的な方法ですが周期性を探し出しています。

LET SAMPLINGFREQ=48000
!LET SAMPLINGFREQ=44100
LET N=20
LET SMIN=1E+10
LET FREQ=400
LET START=1
LET NUM=SAMPLINGFREQ
DIM IN(NUM)
FOR I=1 TO NUM
LET IN(I)=SIN(FREQ/SAMPLINGFREQ*I*2*PI)
NEXT I
FOR K=3 TO SAMPLINGFREQ/2-1 !ナイキスト周波数まで探索
LET S=0
FOR J=0 TO N-1
LET S=S+(IN(START+J)-IN(START+J+K))^2 ! S=0なら周期一致
NEXT J
IF S<SMIN THEN
IF SMIN<1E+10 THEN PRINT SAMPLINGFREQ/K;"Hz"
LET SMIN=S
END IF
NEXT K
END
-----------------------------------------------------------------------------
相関係数で周期性を探し出します。

LET SAMPLINGFREQ=48000
LET NUM=SAMPLINGFREQ
LET FREQ=400
LET N=50
DIM IN(NUM),A(N),B(N)
FOR I=1 TO NUM
LET IN(I)=SIN(FREQ/SAMPLINGFREQ*I*2*PI)
NEXT I
FOR K=3 TO 1000
FOR J=1 TO N
LET A(J)=IN(J)
LET B(J)=IN(J+K)
NEXT J
!LET S1=ABS(CORREL(N,A,B))
LET S2=ABS(RSQ(N,A,B))
LET S3=ABS(PEARSON(N,A,B))
LET S4=ABS(CORR(N,A,B))
IF S2=1 OR S3=1 OR S4=1 THEN PRINT SAMPLINGFREQ/K;"Hz"
NEXT K
END

EXTERNAL FUNCTION CORREL(N,X(),Y())
!'相関係数 -1<=R<=1
LET COV=COVARIANCE(N,X,Y)
LET PX=STDEV(N,X)
LET PY=STDEV(N,Y)
LET CORREL=COV/(PX*PY)
END FUNCTION

EXTERNAL FUNCTION RSQ(N,A(),B())
!'相関係数 0<=R<=1
LET RSQ=PEARSON(N,A,B)^2
END FUNCTION

EXTERNAL FUNCTION PEARSON(N,A(),B())
!'相関係数 -1<=R<=1
FOR I=1 TO N
LET X=X+A(I)
LET XX=XX+A(I)*A(I)
LET Y=Y+B(I)
LET YY=YY+B(I)*B(I)
LET XY=XY+A(I)*B(I)
NEXT I
LET PEARSON=(N*XY-X*Y)/SQR((N*XX-X*X)*(N*YY-Y*Y))
END FUNCTION

EXTERNAL FUNCTION CORR(N,A(),B())
!'相関係数 -1<=R<=1
FOR I=1 TO N
LET XX=XX+A(I)*A(I)
LET YY=YY+B(I)*B(I)
LET XY=XY+A(I)*B(I)
NEXT I
LET CORR=XY/SQR(XX)/SQR(YY)
END FUNCTION

EXTERNAL FUNCTION COVARIANCE(N,X(),Y())
!'共分散
LET NX=MEAN(N,X)
LET NY=MEAN(N,Y)
FOR K=1 TO N
LET S=S+(X(K)-NX)*(Y(K)-NY)
NEXT K
LET COVARIANCE=S/N
END FUNCTION

EXTERNAL FUNCTION STDEV(N,A())
!'標準偏差
FOR I=1 TO N
LET X=X+A(I)
LET XX=XX+A(I)*A(I)
NEXT I
LET STDEV=SQR((N*XX-X*X)/N/(N-1))
END FUNCTION

EXTERNAL FUNCTION MEAN(N,A())
!'相加平均
FOR I=1 TO N
LET X=X+A(I)
NEXT I
LET MEAN=X/N
END FUNCTION

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:04:26

通常FFTを行う場合は実数値なので虚部を0として処理しますが
偶数、奇数に分けることでFFTを半分のサンプル数で行えます。
メモリーの節約にもなります。

LET M=8
LET N=2^M
DIM RR(N),II(N)
FOR I=1 TO N
LET RR(I)=I ! 通常虚部は0とする
LET II(I)=0
NEXT I
CALL FFT(M,RR,II,1)
CALL FFT(M,RR,II,-1)
FOR I=1 TO N
PRINT RR(I);II(I)
NEXT I
MAT RR=ZER
MAT II=ZER
LET M=M-1
LET N=2^M
FOR I=1 TO N
LET RR(I)=2*I-1 ! 偶数、奇数に分ける
LET II(I)=2*I
NEXT I
CALL FFT(M,RR,II,1)
CALL FFT(M,RR,II,-1)
FOR I=1 TO N
PRINT RR(I);II(I)
NEXT I
END

以下略
---------------------------------------------------------------------
LET SAMPLINGFREQ=44100
LET M=10
LET N=2^M
LET LL=SAMPLINGFREQ/N
DIM RR(N),II(N)
FOR I=1 TO N
LET RR(I)=SIN(400/SAMPLINGFREQ*I*2*PI)*.5+SIN(5000/SAMPLINGFREQ*I*2*PI)*.5
LET II(I)=0 ! 通常虚部は0とする
NEXT I
CALL FFT(M,RR,II,1)
SET WINDOW 1,SAMPLINGFREQ/2,-40,70
DRAW GRID(SAMPLINGFREQ/10,10)
FOR I=1 TO N/2
PLOT LINES:I*LL,10*LOG10(RR(I)^2+II(I)^2);
NEXT I
PLOT LINES
MAT RR=ZER
MAT II=ZER
LET N=2^(M-1)
LET LL=SAMPLINGFREQ/N
FOR I=1 TO N
LET RR(I)=SIN(400/SAMPLINGFREQ*(I-1)*2*PI)*.5+SIN(5000/SAMPLINGFREQ*(I-1)*2*PI)*.5
LET II(I)=SIN(400/SAMPLINGFREQ*I*2*PI)*.5+SIN(5000/SAMPLINGFREQ*I*2*PI)*.5 ! 偶数、奇数に分けることで半分のサンプル数でできる
NEXT I
CALL FFT(M-1,RR,II,1)
SET LINE COLOR "RED"
FOR I=1 TO N/2
PLOT LINES:I*LL,10*LOG10(RR(I)^2+II(I)^2);
NEXT I
END

以下略

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:05:53

窓関数

https://ja.wikipedia.org/wiki/窓関数

窓関数はサンプル画像のような山型をしています。
正規化するとグラフの赤線のようになるようです。

https://watlab-blog.com/2019/04/20/window-correction/

LET N=128
FOR X=0 TO N
LET S=S+W(X,N)
NEXT X
LET ACF=1/(S/N)
SET WINDOW -N/20,N,-.1,ACF
DRAW GRID(N/10,.5)
FOR X=0 TO N
PLOT LINES:X,W(X,N);
NEXT X
PLOT LINES
SET LINE COLOR "RED"
FOR X=0 TO N
PLOT LINES:X,W(X,N)*ACF;
NEXT X
PRINT ACF
END

EXTERNAL FUNCTION W(X,N)
LET W=HANNING(X,N)
!LET W=TRIANGULAR(X,N)
!LET W=HAMMING(X,N)
!LET W=BARTLETT(X,N)
!LET W=BARTLETTHANN(X,N)
!LET W=NUTTALL(X,N)
!LET W=BLACKMANHARRIS(X,N)
!LET W=BLACKMANNUTTALL(X,N)
!LET W=FLATTOP(X,N)
!LET W=PARZAN(X)
!LET W=AKAIKE(X,N)
!LET W=WELCH(X,N)
!LET W=SINE(X,N)
!LET W=VORBIS(X,N)
END FUNCTION

EXTERNAL FUNCTION TRIANGULAR(X,N)
LET TRIANGULAR=1-2*ABS((2*X-N)/(2*N))
END FUNCTION

EXTERNAL FUNCTION HANNING(X,N)
LET XX=X/N
LET HANNING=0.5-0.5*COS(2*PI*XX)
END FUNCTION

EXTERNAL FUNCTION HAMMING(X,N)
LET XX=X/N
LET HAMMING=0.54-0.46*COS(2*PI*XX)
END FUNCTION

EXTERNAL FUNCTION BARTLETT(X,N)
LET XX=X/N
LET BARTLETT=1-2*ABS(XX-0.5)
END FUNCTION

EXTERNAL FUNCTION BARTLETTHANN(X,N)
LET XX=X/N
LET BARTLETTHANN=0.62-0.48*ABS(XX-0.5)-0.38*COS(2*PI*XX)
END FUNCTION

EXTERNAL FUNCTION NUTTALL(X,N)
LET XX=X/N
LET NUTTALL=0.355768-0.487396*COS(2*PI*XX)+0.144232*COS(4*PI*XX)-0.012604*COS(6*PI*XX)
END FUNCTION

EXTERNAL FUNCTION BLACKMANHARRIS(X,N)
LET XX=X/N
LET BLACKMANHARRIS=0.35875-0.48829*COS(2*PI*XX)+0.144128*COS(4*PI*XX)-0.01168*COS(6*PI*XX)
END FUNCTION

EXTERNAL FUNCTION BLACKMANNUTTALL(X,N)
LET XX=X/N
LET BLACKMANNUTTALL=0.3635819-0.4891775*COS(2*PI*XX)+0.1365995*COS(4*PI*XX)-0.0106411*COS(6*PI*XX)
END FUNCTION

EXTERNAL FUNCTION FLATTOP(X,N)
LET XX=X/N
LET FLATTOP=1-1.93*COS(2*PI*XX)+1.29*COS(4*PI*XX)+0.388*COS(6*PI*XX)+0.032*COS(8*PI*XX)
END FUNCTION

EXTERNAL FUNCTION PARZAN(X)
IF ABS(X)<=1 THEN
LET PARZAN=1-1.5*X^2+0.75*ABS(X^3)
ELSEIF ABS(X)>1 AND ABS(X)<=2 THEN
LET PARZAN=0.25*(2-ABS(X))^3
END IF
END FUNCTION

EXTERNAL FUNCTION AKAIKE(X,N)
LET XX=X/N
LET AKAIKE=0.625-0.5*COS(2*PI*XX)-0.125*COS(4*PI*XX)
END FUNCTION

EXTERNAL FUNCTION WELCH(X,N)
LET XX=X/N
LET WELCH=4*XX*(1-XX)
END FUNCTION

EXTERNAL FUNCTION SINE(X,N)
LET XX=X/N
LET SINE=SIN(PI*XX)
END FUNCTION

EXTERNAL FUNCTION VORBIS(X,N)
LET XX=X/N
LET VORBIS=SIN(PI/2*SIN(PI*XX)^2)
END FUNCTION
---------------------------------------------------------------------
LET N=1
SET WINDOW 0,N,0,1
FOR B=1 TO 32
FOR X=0 TO N STEP 1/256
LET Y=KAISER(B,X,N)
PLOT LINES:X,Y;
NEXT X
PLOT LINES
NEXT B
END

EXTERNAL FUNCTION BESSEL0(X)
!'I0(X)=Σ(X^M/2^M/M!)^2
LET A=1
LET S=1
FOR M=1 TO 1000
LET A=A*X/M/2
LET S=S+A*A
IF A*A<1E-8 THEN EXIT FOR
NEXT M
LET BESSEL0=S
END FUNCTION

EXTERNAL FUNCTION KAISER(B,X,N) !'カイザー窓
LET KAISER=BESSEL0(B*PI*SQR(1-(2*X/N-1)^2))/BESSEL0(B*PI)
END FUNCTION
---------------------------------------------------------------------
FOR A=.7 TO .1 STEP -1/16
FOR X=0 TO 1 STEP 1/64
LET Y=GAUSS(A,X,1)
PLOT LINES:X,Y;
NEXT X
PLOT LINES
NEXT A
END

EXTERNAL FUNCTION GAUSS(A,Y,N) ! 指数窓
LET X=2*Y-1
LET GAUSS=EXP(-(X/N*X/N)/A/A)
END FUNCTION

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:07:44

wavファイルを読み込んでフィルタ処理を行います。

バッファーサイズを最大2^24(32ビット版十進BASIC)として
サンプリング周波数44100Hzとすると2^24(16777216)/44100=約380秒迄の
PCMデータを読み込みできます。

また高速なFFTライブラリーの移植版を用意しました。
https://www.kurims.kyoto-u.ac.jp/~ooura/fft-j.html

サンプル数2^24個のFFT演算が500秒あまりでした。

※曲の始めは無音状態から始まり徐々に音量が増え(フェードイン)
曲の終わりは徐々に音量が減り(フェードアウト)無音状態で終わるものと想定して
窓関数は使用していません。この想定に反する場合は窓関数を使用してください。

2進モードで実行してください。

LET SIZE=2^24
DIM LIN(SIZE),RIN(SIZE)
DIM LI(SIZE),RI(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET NN=2^INT(LOG2(NUM)+1) !'FFTポイント数
INPUT PROMPT "ローパス(1) ハイパス(2) バンドパス(3) バンドストップ(4) ":MODE
SELECT CASE MODE
CASE 1
INPUT PROMPT "通過域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
CASE 2
INPUT PROMPT "遮断域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
CASE 3
INPUT PROMPT "遮断域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
INPUT PROMPT "通過域周波数"&STR$(FREQ1)&"～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ2
CASE 4
INPUT PROMPT "通過域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
INPUT PROMPT "遮断域周波数 "&STR$(FREQ1)&"～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ2
END SELECT
CALL FFTFILTER(MODE,NN,SAMPLINGFREQ,FREQ1,FREQ2,LIN,LI)
IF CHANNEL=2 THEN CALL FFTFILTER(MODE,NN,SAMPLINGFREQ,FREQ1,FREQ2,RIN,RI)
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN)
END

EXTERNAL SUB FFTFILTER(MODE,NN,SAMPLINGFREQ,FREQ1,FREQ2,FR(),FI())
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
SELECT CASE MODE
CASE 1
LET F=FREQ1/SAMPLINGFREQ*NN
FOR I=F TO NN-F
LET FR(I)=0
LET FI(I)=0
NEXT I
CASE 2
LET F=FREQ1/SAMPLINGFREQ*NN
FOR I=1 TO F
LET FR(I)=0
LET FI(I)=0
NEXT I
FOR I=NN-F TO NN
LET FR(I)=0
LET FI(I)=0
NEXT I
CASE 3
LET FS=FREQ1/SAMPLINGFREQ*NN
LET FE=FREQ2/SAMPLINGFREQ*NN
FOR I=1 TO FS
LET FR(I)=0
LET FI(I)=0
NEXT I
FOR I=FE TO NN-FE
LET FR(I)=0
LET FI(I)=0
NEXT I
FOR I=NN-FS TO NN
LET FR(I)=0
LET FI(I)=0
NEXT I
CASE 4
LET FS=FREQ1/SAMPLINGFREQ*NN
LET FE=FREQ2/SAMPLINGFREQ*NN
FOR I=FS TO FE
LET FR(I)=0
LET FI(I)=0
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=0
LET FI(I)=0
NEXT I
END SELECT
CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),FR,FI)
END SUB

EXTERNAL SUB CDFT(N,WR,WI,AR(),AI())
OPTION BASE 0
DIM A(N)
FOR I=0 TO N/2-1
LET A(2*I)=AR(I+1)
LET A(2*I+1)=AI(I+1)
NEXT I
LET WMR=WR
LET WMI=WI
LET M=N
DO WHILE M>4
LET L=M/2
LET WKR=1
LET WKI=0
LET WDR=1-2*WMI*WMI
LET WDI=2*WMI*WMR
LET SS=2*WDI
LET WMR=WDR
LET WMI=WDI
FOR J=0 TO N-M STEP M
LET I=J+L
LET XR=A(J)-A(I)
LET XI=A(J+1)-A(I+1)
LET A(J)=A(J)+A(I)
LET A(J+1)=A(J+1)+A(I+1)
LET A(I)=XR
LET A(I+1)=XI
LET XR=A(J+2)-A(I+2)
LET XI=A(J+3)-A(I+3)
LET A(J+2)=A(J+2)+A(I+2)
LET A(J+3)=A(J+3)+A(I+3)
LET A(I+2)=WDR*XR-WDI*XI
LET A(I+3)=WDR*XI+WDI*XR
NEXT J
FOR K=4 TO L-4 STEP 4
LET WKR=WKR-SS*WDI
LET WKI=WKI+SS*WDR
LET WDR=WDR-SS*WKI
LET WDI=WDI+SS*WKR
FOR J=K TO N-M+K STEP M
LET I=J+L
LET XR=A(J)-A(I)
LET XI=A(J+1)-A(I+1)
LET A(J)=A(J)+A(I)
LET A(J+1)=A(J+1)+A(I+1)
LET A(I)=WKR*XR-WKI*XI
LET A(I+1)=WKR*XI+WKI*XR
LET XR=A(J+2)-A(I+2)
LET XI=A(J+3)-A(I+3)
LET A(J+2)=A(J+2)+A(I+2)
LET A(J+3)=A(J+3)+A(I+3)
LET A(I+2)=WDR*XR-WDI*XI
LET A(I+3)=WDR*XI+WDI*XR
NEXT J
NEXT K
LET M=L
LOOP
IF M>2 THEN
FOR J=0 TO N-4 STEP 4
LET XR=A(J)-A(J+2)
LET XI=A(J+1)-A(J+3)
LET A(J)=A(J)+A(J+2)
LET A(J+1)=A(J+1)+A(J+3)
LET A(J+2)=XR
LET A(J+3)=XI
NEXT J
END IF
IF N>4 THEN CALL BITRV2(N,A)
FOR I=0 TO N/2-1
LET AR(I+1)=A(2*I)/SQR(N)
LET AI(I+1)=A(2*I+1)/SQR(N)
NEXT I
END SUB

EXTERNAL SUB BITRV2(N,A())
LET M=N/4
LET M2=2*M
LET N2=N-2
LET K=0
FOR J=0 TO M2-4 STEP 4
IF J<K THEN
LET XR=A(J)
LET XI=A(J+1)
LET A(J)=A(K)
LET A(J+1)=A(K+1)
LET A(K)=XR
LET A(K+1)=XI
ELSEIF J>K THEN
LET J1=N2-J
LET K1=N2-K
LET XR=A(J1)
LET XI=A(J1+1)
LET A(J1)=A(K1)
LET A(J1+1)=A(K1+1)
LET A(K1)=XR
LET A(K1+1)=XI
END IF
LET K1=M2+K
LET XR=A(J+2)
LET XI=A(J+3)
LET A(J+2)=A(K1)
LET A(J+3)=A(K1+1)
LET A(K1)=XR
LET A(K1+1)=XI
LET L=M
DO WHILE K>=L
LET K=K-L
LET L=L/2
LOOP
LET K=K+L
NEXT J
END SUB

以下略
---------------------------------------------------------------------------
上記FFTフィルタ処理では全体に対してFFTしていましたが
下記プログラムでは短時間FFT(STFT)によるフィルタ処理しています。
但し、実行結果は上記プログラムとは異なります。

FFTポイント数とFFT実行回数の違いに注目してください。

https://ja.wikipedia.org/wiki/短時間フーリエ変換

LET SIZE=44100*200
DIM LIN(SIZE),RIN(SIZE),LOUT(SIZE),ROUT(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET NN=2^10 !'FFTポイント数短時間FFT
LET SFT=NN/8
DIM LR(NN),LI(NN),RR(NN),RI(NN)
INPUT PROMPT "ローパス(1) ハイパス(2) バンドパス(3) バンドストップ(4) ":MODE
SELECT CASE MODE
CASE 1
INPUT PROMPT "通過域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
CASE 2
INPUT PROMPT "遮断域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
CASE 3
INPUT PROMPT "遮断域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
INPUT PROMPT "通過域周波数"&STR$(FREQ1)&"～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ2
CASE 4
INPUT PROMPT "通過域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
INPUT PROMPT "遮断域周波数 "&STR$(FREQ1)&"～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ2
END SELECT
FOR K=1 TO NUM-NN STEP SFT ! オーバーラップさせる
MAT LI=ZER
MAT RI=ZER
MAT LR=ZER
MAT RR=ZER
FOR J=0 TO NN-1
IF K+J>=1 AND K+J<=NUM THEN
LET LR(J+1)=LIN(K+J)*W(J,NN) ! 窓関数をかける
LET RR(J+1)=RIN(K+J)*W(J,NN)
END IF
NEXT J
CALL FFTFILTER(MODE,NN,SAMPLINGFREQ,FREQ1,FREQ2,LR,LI)
IF CHANNEL=2 THEN CALL FFTFILTER(MODE,NN,SAMPLINGFREQ,FREQ1,FREQ2,RR,RI)
FOR J=0 TO NN-1
LET LOUT(K+J)=LOUT(K+J)+LR(J+1)/4
LET ROUT(K+J)=ROUT(K+J)+RR(J+1)/4
NEXT J
NEXT K
FOR K=1 TO NUM
LET LMAX=MAX(LMAX,ABS(LOUT(K)))
LET RMAX=MAX(RMAX,ABS(ROUT(K)))
NEXT K
MAT LOUT=(1/LMAX)*LOUT
IF CHANNEL=2 THEN MAT ROUT=(1/RMAX)*ROUT
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LOUT,ROUT)
END

以下略
---------------------------------------------------------------------------
こちらも短時間FFTによるフィルタ処理です。

LET SIZE=44100*200
DIM LIN(SIZE),RIN(SIZE),LOUT(SIZE),ROUT(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET NN=256 !'FFTポイント数短時間FFT
DIM LR(NN),LI(NN),RR(NN),RI(NN)
INPUT PROMPT "ローパス(1) ハイパス(2) バンドパス(3) バンドストップ(4) ":MODE
SELECT CASE MODE
CASE 1
INPUT PROMPT "通過域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
CASE 2
INPUT PROMPT "遮断域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
CASE 3
INPUT PROMPT "遮断域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
INPUT PROMPT "通過域周波数"&STR$(FREQ1)&"～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ2
CASE 4
INPUT PROMPT "通過域周波数 0 ～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ1
INPUT PROMPT "遮断域周波数 "&STR$(FREQ1)&"～"&STR$(SAMPLINGFREQ/2)&"Hz まで":FREQ2
END SELECT
FOR K=1 TO NUM
MAT LI=ZER
MAT RI=ZER
FOR J=-NN/2 TO NN/2-1
IF K+J>=1 AND K+J<=NUM THEN
LET FL=1
LET LR(NN/2+J+1)=LIN(K+J)*W(J+NN/2,NN) ! 窓関数をかける
IF CHANNEL=2 THEN LET RR(NN/2+J+1)=RIN(K+J)*W(J+NN/2,NN)
ELSE
LET FL=0
LET LOUT(K)=LIN(K)
LET ROUT(K)=RIN(K)
EXIT FOR
END IF
NEXT J
IF FL=1 THEN
CALL FFTFILTER(MODE,NN,SAMPLINGFREQ,FREQ1,FREQ2,LR,LI)
LET LOUT(K)=LR(NN/2)
IF CHANNEL=2 THEN
CALL FFTFILTER(MODE,NN,SAMPLINGFREQ,FREQ1,FREQ2,RR,RI)
LET ROUT(K)=RR(NN/2)
END IF
END IF
NEXT K
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LOUT,ROUT)
END

以下略
---------------------------------------------------------------------------
アニメーション振幅表示
但し、リアルタイム表示ではありません。

LET SIZE=44100*200
DIM LIN(SIZE),RIN(SIZE)
FILE GETOPENNAME F$,"読み込み WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET ST=SAMPLINGFREQ/30 ! 1/30秒毎
LET NN=2^INT(LOG2(ST)+1) !'FFTポイント数
LET JJ=SAMPLINGFREQ/NN ! 分解能
DIM LR(NN),RR(NN),LI(NN),RI(NN)
FOR I=1 TO NUM STEP ST
MAT LI=ZER
MAT RI=ZER
MAT LR=ZER
MAT RR=ZER
FOR J=0 TO ST-1
LET LR(J+1)=LIN(I+J)*W(J,ST) ! 窓関数を掛ける
LET RR(J+1)=RIN(I+J)*W(J,ST)
NEXT J
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),LR,LI)
IF CHANNEL=2 THEN CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),RR,RI)
SET VIEWPORT 0,1,0,.49
SET WINDOW 1,SAMPLINGFREQ/2,-50,30
DRAW GRID0(SAMPLINGFREQ/10,10)
FOR J=1 TO NN/2
IF LR(J)<>0 OR LI(J)<>0 THEN
PLOT LINES:J*JJ,-50;J*JJ,10*LOG10(LR(J)^2+LI(J)^2)
END IF
NEXT J
IF CHANNEL=2 THEN
SET VIEWPORT 0,1,.51,1
SET WINDOW 1,SAMPLINGFREQ/2,-50,30
DRAW GRID0(SAMPLINGFREQ/10,10)
FOR J=1 TO NN/2
IF RR(J)<>0 OR RI(J)<>0 THEN
PLOT LINES:J*JJ,-50;J*JJ,10*LOG10(RR(J)^2+RI(J)^2)
END IF
NEXT J
END IF
SET DRAW MODE EXPLICIT
WAIT DELAY .1
SET DRAW MODE HIDDEN
CLEAR
NEXT I
END

以下略
---------------------------------------------------------------------------
スペクトログラム表示

https://ja.wikipedia.org/wiki/スペクトログラム

カラーマップを定義してスペクトログラムを表示します。

サンプル画像参照

LET SIZE=44100*200
DIM LIN(SIZE),RIN(SIZE)
ASK COLOR MIX(15) RED,GREEN,BLUE
CALL JETCOLORMAP
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET ST=NUM/200
LET NN=2^INT(LOG2(ST)+1)
DIM LR(NN),RR(NN),LI(NN),RI(NN)
LET JJ=SAMPLINGFREQ/NN ! 分解能
LET VMIN=-70 ! db範囲
LET VMAX=0
FOR I=1 TO NUM STEP ST
MAT LI=ZER
MAT RI=ZER
MAT LR=ZER
MAT RR=ZER
FOR J=0 TO ST-1
LET LR(J+1)=LIN(I+J)*W(J,ST) ! 窓関数を掛ける
LET RR(J+1)=RIN(I+J)*W(J,ST)
NEXT J
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),LR,LI)
IF CHANNEL=2 THEN CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),RR,RI)
FOR J=1 TO NN/2-1
SET VIEWPORT 0,1,0,.49
SET WINDOW -NUM/20,NUM,-1000,SAMPLINGFREQ/2
IF LR(J)<>0 OR LI(J)<>0 THEN
LET DB=10*LOG10(LR(J)^2+LI(J)^2)
ELSE
LET DB=VMIN
END IF
LET C=INT(INTERPOLATE(DB,VMIN,VMAX,0,255))
SET AREA COLOR C
PLOT AREA:I,J*JJ;I+ST,J*JJ;I+ST,(J+1)*JJ;I,(J+1)*JJ
IF CHANNEL=2 THEN
SET VIEWPORT 0,1,.51,1
SET WINDOW -NUM/20,NUM,-1000,SAMPLINGFREQ/2
IF RR(J)<>0 OR RI(J)<>0 THEN
LET DB=10*LOG10(RR(J)^2+RI(J)^2)
ELSE
LET DB=VMIN
END IF
LET C=INT(INTERPOLATE(DB,VMIN,VMAX,0,255))
SET AREA COLOR C
PLOT AREA:I,J*JJ;I+ST,J*JJ;I+ST,(J+1)*JJ;I,(J+1)*JJ
END IF
NEXT J
NEXT I
SET COLOR MIX(15) RED,GREEN,BLUE
SET VIEWPORT 0,1,0,.49
SET WINDOW -NUM/20/SAMPLINGFREQ,NUM/SAMPLINGFREQ,-1000,SAMPLINGFREQ/2
DRAW GRID(NUM/10/SAMPLINGFREQ,5000)
SET VIEWPORT 0,1,.51,1
SET WINDOW -NUM/20/SAMPLINGFREQ,NUM/SAMPLINGFREQ,-1000,SAMPLINGFREQ/2
DRAW GRID(NUM/10/SAMPLINGFREQ,5000)
END

EXTERNAL FUNCTION INTERPOLATE(X,XMIN,XMAX,YMIN,YMAX) ! XMIN<=X<=XMAX → YMIN(0)～YMAX(255)
LET X=MIN(XMAX,MAX(X,XMIN))
LET INTERPOLATE=(X-XMIN)*(YMAX-YMIN)/(XMAX-XMIN) + YMIN
END FUNCTION

以下略
---------------------------------------------------------------------------
3バンドグラフィックイコライザー

低音域、中音域、高音域でイコライジング処理をします。

上記想定により窓関数は使用していません。

LET SIZE=2^23
DIM LIN(SIZE),RIN(SIZE)
DIM LI(SIZE),RI(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET NN=2^INT(LOG2(NUM)+1) !'FFTポイント数
INPUT PROMPT "低音 db=":DB
LET GAIN1=10^(DB/20)
INPUT PROMPT "中音 db=":DB
LET GAIN2=10^(DB/20)
INPUT PROMPT "高音 db=":DB
LET GAIN3=10^(DB/20)
CALL FFTFILTER(NN,SAMPLINGFREQ,SAMPLINGFREQ/12,SAMPLINGFREQ*3/12,SAMPLINGFREQ*5/12,SAMPLINGFREQ/12,GAIN1,GAIN2,GAIN3,LIN,LI)
IF CHANNEL=2 THEN CALL FFTFILTER(NN,SAMPLINGFREQ,SAMPLINGFREQ/12,SAMPLINGFREQ*3/12,SAMPLINGFREQ*5/12,SAMPLINGFREQ/12,GAIN1,GAIN2,GAIN3,RIN,RI)
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN)
END

EXTERNAL SUB FFTFILTER(NN,SAMPLINGFREQ,FREQ1,FREQ2,FREQ3,WIDTH,GAIN1,GAIN2,GAIN3,FR(),FI())
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
IF FREQ1<SAMPLINGFREQ/2 THEN
LET F=FREQ1/SAMPLINGFREQ*NN
LET FS=F-WIDTH
LET FE=F+WIDTH
IF FS<0 THEN LET FS=0
IF FE>SAMPLINGFREQ/2*NN THEN LET FE=SAMPLINGFREQ/2*NN
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN1
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN1
NEXT I
END IF
IF FREQ2<SAMPLINGFREQ/2 THEN
LET F=FREQ2/SAMPLINGFREQ*NN
LET FS=F-WIDTH
LET FE=F+WIDTH
IF FS<0 THEN LET FS=0
IF FE>SAMPLINGFREQ/2*NN THEN LET FE=SAMPLINGFREQ/2*NN
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN2
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN2
NEXT I
END IF
IF FREQ3<SAMPLINGFREQ/2 THEN
LET F=FREQ3/SAMPLINGFREQ*NN
LET FS=F-WIDTH
LET FE=F+WIDTH
IF FS<0 THEN LET FS=0
IF FE>SAMPLINGFREQ/2*NN THEN LET FE=SAMPLINGFREQ/2*NN
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN3
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN3
NEXT I
END IF
CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),FR,FI)
END SUB
以下略
---------------------------------------------------------------------------
8バンドグラフィックイコライザー

100Hz,200Hz,400Hz,800Hz,1600Hz,3200Hz,6400Hz,12800Hz付近の増減によるイコライジング処理をします。

※6400Hzはサンプリング周波数16000Hz以上、12800Hzはサンプリング周波数32000Hz以上の時に有効です。

上記想定により窓関数は使用していません。

LET SIZE=2^23
DIM LIN(SIZE),RIN(SIZE)
DIM LI(SIZE),RI(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET NN=2^INT(LOG2(NUM)+1) !'FFTポイント数
INPUT PROMPT "100Hz db=":DB ! -10db～10db
LET GAIN1=10^(DB/20)
INPUT PROMPT "200Hz db=":DB
LET GAIN2=10^(DB/20)
INPUT PROMPT "400Hz db=":DB
LET GAIN3=10^(DB/20)
INPUT PROMPT "800Hz db=":DB
LET GAIN4=10^(DB/20)
INPUT PROMPT "1600Hz db=":DB
LET GAIN5=10^(DB/20)
INPUT PROMPT "3200Hz db=":DB
LET GAIN6=10^(DB/20)
IF SAMPLINGFREQ>=16000 THEN
INPUT PROMPT "6400Hz db=":DB
LET GAIN7=10^(DB/20)
IF SAMPLINGFREQ>=32000 THEN
INPUT PROMPT "12800Hz db=":DB
LET GAIN8=10^(DB/20)
END IF
END IF
CALL FFTFILTER(NN,SAMPLINGFREQ,100,200,400,800,1600,3200,6400,12800,GAIN1,GAIN2,GAIN3,GAIN4,GAIN5,GAIN6,GAIN7,GAIN8,LIN,LI)
IF CHANNEL=2 THEN CALL FFTFILTER(NN,SAMPLINGFREQ,100,200,400,800,1600,3200,6400,12800,GAIN1,GAIN2,GAIN3,GAIN4,GAIN5,GAIN6,GAIN7,GAIN8,RIN,RI)
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN)
END

EXTERNAL SUB FFTFILTER(NN,SAMPLINGFREQ,FREQ1,FREQ2,FREQ3,FREQ4,FREQ5,FREQ6,FREQ7,FREQ8,GAIN1,GAIN2,GAIN3,GAIN4,GAIN5,GAIN6,GAIN7,GAIN8,FR(),FI())
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
IF FREQ1<SAMPLINGFREQ/2 THEN
LET F=FREQ1/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN1
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN1
NEXT I
END IF
IF FREQ2<SAMPLINGFREQ/2 THEN
LET F=FREQ2/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN2
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN2
NEXT I
END IF
IF FREQ3<SAMPLINGFREQ/2 THEN
LET F=FREQ3/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN3
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN3
NEXT I
END IF
IF FREQ4<SAMPLINGFREQ/2 THEN
LET F=FREQ4/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN4
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN4
NEXT I
END IF
IF FREQ5<SAMPLINGFREQ/2 THEN
LET F=FREQ5/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN5
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN5
NEXT I
END IF
IF FREQ6<SAMPLINGFREQ/2 THEN
LET F=FREQ6/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN6
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN6
NEXT I
END IF
IF FREQ7<SAMPLINGFREQ/2 THEN
LET F=FREQ7/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN7
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN7
NEXT I
END IF
IF FREQ8<SAMPLINGFREQ/2 THEN
LET F=FREQ8/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN8
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN8
NEXT I
END IF
CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),FR,FI)
END SUB

以下略
---------------------------------------------------------------------------
パラメトリックイコライザー

中心周波数からバンド幅域内の周波数帯を増減させます。

上記想定により窓関数は使用していません。

LET SIZE=2^23
DIM LIN(SIZE),RIN(SIZE)
DIM LI(SIZE),RI(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET NN=2^INT(LOG2(NUM)+1) !'FFTポイント数
INPUT PROMPT "中心周波数 (0～"&STR$(SAMPLINGFREQ/2)&")=":FREQ
INPUT PROMPT "バンド幅(0～"&STR$(SAMPLINGFREQ/4)&")=":WIDTH
INPUT PROMPT "増幅率(-10～10)=":DB
LET GAIN=10^(DB/20)
CALL FFTFILTER(NN,SAMPLINGFREQ,FREQ,WIDTH,GAIN,LIN,LI)
IF CHANNEL=2 THEN CALL FFTFILTER(NN,SAMPLINGFREQ,FREQ,WIDTH,GAIN,RIN,RI)
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,16,LIN,RIN)
END

EXTERNAL SUB FFTFILTER(N,SAMPLINGFREQ,FREQ,WIDTH,GAIN,RR(),II()) ! パラメトリックEQ
CALL CDFT(2*N,COS(PI/N),SIN(PI/N),RR,II)
LET FS=(FREQ-WIDTH/2)/SAMPLINGFREQ*N
LET FE=(FREQ+WIDTH/2)/SAMPLINGFREQ*N
IF FS<0 THEN LET FS=0
IF FE>SAMPLINGFREQ/2*N THEN LET FE=SAMPLINGFREQ/2*N
FOR I=FS TO FE
LET RR(I)=RR(I)*GAIN
NEXT I
FOR I=N-FE TO N-FS
LET RR(I)=RR(I)*GAIN
NEXT I
CALL CDFT(2*N,COS(-PI/N),SIN(-PI/N),RR,II)
END SUB

以下略
---------------------------------------------------------------
16バンドグラフィックイコライザー

LET SIZE=44100*200
LET NN=1024 !'FFTポイント数
LET SFT=NN/8
LET M=16
DIM LIN(SIZE),RIN(SIZE),LOUT(SIZE),ROUT(SIZE)
DIM LR(NN),LI(NN),RR(NN),RI(NN),FREQ(M),GAIN(M)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
FOR K=1 TO M
READ FREQ(K)
IF FREQ(K)<SAMPLINGFREQ/2 THEN
INPUT PROMPT STR$(FREQ(K))&"Hz db=":DB
LET GAIN(K)=10^(DB/20)
END IF
NEXT K
FOR K=1 TO NUM-NN STEP SFT
MAT LI=ZER
MAT RI=ZER
MAT LR=ZER
MAT RR=ZER
FOR J=0 TO NN-1
LET LR(J+1)=LIN(K+J)*W(J,NN) ! 窓関数を掛ける
LET RR(J+1)=RIN(K+J)*W(J,NN)
NEXT J
CALL FFTFILTER(NN,SAMPLINGFREQ,FREQ,GAIN,M,LR,LI)
IF CHANNEL=2 THEN CALL FFTFILTER(NN,SAMPLINGFREQ,FREQ,GAIN,M,RR,RI)
FOR J=0 TO NN-1
LET LOUT(K+J)=LOUT(K+J)+LR(J+1)/4
LET ROUT(K+J)=ROUT(K+J)+RR(J+1)/4
NEXT J
NEXT K
FOR K=1 TO NUM
LET LMAX=MAX(LMAX,ABS(LOUT(K)))
LET RMAX=MAX(RMAX,ABS(ROUT(K)))
NEXT K
MAT LOUT=(1/LMAX)*LOUT
IF CHANNEL=2 THEN MAT ROUT=(1/RMAX)*ROUT
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN)
DATA 50,100,200,400,600,800,1000,1200,1600,2000,2500,3000,4000,8000,12000,16000
END

EXTERNAL SUB FFTFILTER(NN,SAMPLINGFREQ,FREQ(),GAIN(),M,FR(),FI())
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
FOR K=1 TO M
IF FREQ(K)<SAMPLINGFREQ/2 THEN
LET F=FREQ(K)/SAMPLINGFREQ*NN
LET FS=F-1
LET FE=F+1
FOR I=FS TO FE
LET FR(I)=FR(I)*GAIN(K)
NEXT I
FOR I=NN-FE TO NN-FS
LET FR(I)=FR(I)*GAIN(K)
NEXT I
END IF
NEXT K
CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),FR,FI)
END SUB

以下略
---------------------------------------------------------------
ヘリウムボイス(ドナルドダック効果、ボイスチェンジャー)

https://nettyukobo.com/helium_voice/
https://ja.wikipedia.org/wiki/音速

 https://www.balloonworld.jp/column/voice/

OPTION BASE 0
LET SIZE=44100*200
DIM LIN(SIZE),RIN(SIZE),LOUT(SIZE),ROUT(SIZE)
FILE GETOPENNAME F$,"読み込み　WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL READWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LIN,RIN,ERR)
IF ERR>0 THEN STOP
LET NN=2^10 !'FFTポイント数短時間FFT
LET SFT=NN/8
LET LL=26
LET EPS=1E-15
! 音速(1気圧0度) 空気=331m/s 水素=1269m/s ヘリウム=970m/s 窒素=337m/s 酸素=317m/s 塩素=205m/s アルゴン=319m/s 二酸化炭素=258m/s
LET RATE=2 ! 空気中の音速との速度比ヘリウム/空気=2.93 水素/空気=3.83 塩素/空気=0.61 二酸化炭素/空気=0.77
DIM LR(NN),LI(NN),RR(NN),RI(NN),LLOG(NN),RLOG(NN),LTMP(NN),RTMP(NN)
DIM LCL(NN),LCH(NN),RCL(NN),RCH(NN),L(NN),R(NN),LAMP(NN),RAMP(NN)
FOR K=1 TO NUM-NN STEP SFT
MAT LI=ZER
MAT RI=ZER
MAT LR=ZER
MAT RR=ZER
FOR J=0 TO NN-1
IF K+J>=1 AND K+J<=NUM THEN
LET LR(J+1)=LIN(K+J)*W(J,NN) ! 窓関数をかける
LET RR(J+1)=RIN(K+J)*W(J,NN)
END IF
NEXT J
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),LR,LI)
IF CHANNEL=2 THEN CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),RR,RI)
FOR I=1 TO NN
LET LLOG(I)=LOG(SQR(LR(I)^2+LI(I)^2)+EPS)
IF CHANNEL=2 THEN LET RLOG(I)=LOG(SQR(RR(I)^2+RI(I)^2)+EPS)
NEXT I
FOR I=1 TO NN
IF LR(I)=0 AND LI(I)=0 THEN LET LI(I)=0 ELSE LET LI(I)=ANGLE(LR(I),LI(I))
IF RR(I)=0 AND RI(I)=0 THEN LET RI(I)=0 ELSE LET RI(I)=ANGLE(RR(I),RI(I))
NEXT I
MAT LTMP=ZER
MAT RTMP=ZER
CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),LLOG,LTMP)
IF CHANNEL=2 THEN CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),RLOG,RTMP)
MAT LCL=LLOG
MAT LCH=LLOG
MAT RCL=RLOG
MAT RCH=RLOG
FOR I=LL TO NN-LL
LET LCL(I)=0
LET RCL(I)=0
NEXT I
FOR I=1 TO LL
LET LCH(I)=0
LET RCH(I)=0
NEXT I
FOR I=NN-LL TO NN
LET LCH(I)=0
LET RCH(I)=0
NEXT I
MAT LTMP=ZER
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),LCL,LTMP)
MAT LTMP=ZER
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),LCH,LTMP)
IF CHANNEL=2 THEN
MAT RTMP=ZER
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),RCL,RTMP)
MAT RTMP=ZER
CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),RCH,RTMP)
END IF
MAT LAMP=(-1000)*CON
MAT RAMP=(-1000)*CON
FOR I=1 TO NN/2
LET CN=IP(I/RATE)
LET CR=FP(I/RATE)
IF CN<NN/2 THEN
LET LAMP(I)=(1-CR)*LCL(CN)+CR*LCL(CN+1)
LET RAMP(I)=(1-CR)*RCL(CN)+CR*RCL(CN+1)
END IF
NEXT I
FOR I=1 TO NN
LET L(I)=EXP(LAMP(I)+LCH(I))
LET R(I)=EXP(RAMP(I)+RCH(I))
NEXT I
FOR I=1 TO NN
LET LI(I)=L(I)*SIN(LI(I))
LET L(I)=L(I)*COS(L(I))
LET RI(I)=R(I)*SIN(RI(I))
LET R(I)=R(I)*COS(R(I))
NEXT I
CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),L,LI)
IF CHANNEL=2 THEN CALL CDFT(2*NN,COS(-PI/NN),SIN(-PI/NN),R,RI)
FOR J=0 TO NN-1
LET LOUT(K+J)=LOUT(K+J)+L(J+1)/4
LET ROUT(K+J)=ROUT(K+J)+R(J+1)/4
NEXT J
NEXT K
FOR K=1 TO NUM
LET LMAX=MAX(LMAX,ABS(LOUT(K)))
LET RMAX=MAX(RMAX,ABS(ROUT(K)))
NEXT K
MAT LOUT=(1/LMAX)*LOUT
IF CHANNEL=2 THEN MAT ROUT=(1/RMAX)*ROUT
FILE GETSAVENAME F$,"保存 WAVファイル|*.WAV"
IF F$="" THEN STOP
CALL WRITEWAV(F$,NUM,CHANNEL,SAMPLINGFREQ,SAMPLEBIT,LOUT,ROUT)
END

以下略

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:09:40

高速なFFTライブラリーFFTWを使用したFFTルーチンも用意した。

https://www.fftw.org/

VC++2022でコンパイルしました。32bit版のみです。

実行には別途libfftw3-3.dllが必要です。

サンプル数2^24個のFFT演算が約2分程でした。

LET N=2^20
DIM RR(N),II(N)
FOR I=1 TO N
LET RR(I)=I
LET II(I)=0
NEXT I
CALL FFTW(N,RR,II,0) ! FFT
FOR I=1 TO 100
PRINT RR(I);II(I)
NEXT I
CALL FFTW(N,RR,II,1) ! IFFT
FOR I=1 TO 100
PRINT RR(I);II(I)
NEXT I
END

EXTERNAL SUB FFTW(N,RR(),II(),SW)
OPTION CHARACTER BYTE
LET RE$=REPEAT$(CHR$(0),N*8)
LET IM$=REPEAT$(CHR$(0),N*8)
FOR I=0 TO N-1
LET RE$(8*I+1:8*I+8)=PACKDBL$(RR(I+1)) !'実部
LET IM$(8*I+1:8*I+8)=PACKDBL$(II(I+1)) !'虚部
NEXT I
CALL FFTW_(N,RE$,IM$,SW)
FOR I=0 TO N-1
LET RR(I+1)=UNPACKDBL(RE$(8*I+1:8*I+8))
LET II(I+1)=UNPACKDBL(IM$(8*I+1:8*I+8))
IF SW<>0 THEN
LET RR(I+1)=RR(I+1)/N
LET II(I+1)=II(I+1)/N
END IF
NEXT I

SUB FFTW_(N,RE$,IM$,SW) ! SW=0...FFT SW<>0...IFFT
OPTION CHARACTER BYTE
ASSIGN ".\DLL\fftw.dll","fftwsub"
END SUB
END SUB
-----------------------------------------------------------------------
fftw.c

#include <stdio.h>
#include <stdlib.h>
#include <complex.h>
#include <fftw3.h>

__declspec(dllexport) void fftwsub(int n,double *re,double *im,int sw)
{
int i;
fftw_complex *a, *b;
a = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * n);
b = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * n);
if (a==NULL || b==NULL) exit(1);

fftw_plan plan;
for (i=0; i<n; i++)
{
a[i][0]=re[i];
a[i][1]=im[i];
}
if (sw==0)
{
plan = fftw_plan_dft_1d( n, a, b, FFTW_FORWARD, FFTW_ESTIMATE);
}
else
{
plan = fftw_plan_dft_1d( n, a, b, FFTW_BACKWARD, FFTW_ESTIMATE);
}
fftw_execute(plan);
for (i=0; i<n; i++) {
re[i]=b[i][0];
im[i]=b[i][1];
}
if(plan) fftw_destroy_plan(plan);
fftw_free(a);
fftw_free(b);
}

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:11:08

高速なfftライブラリーによるfftルーチン

https://www.kurims.kyoto-u.ac.jp/~ooura/fft-j.html

VC++2022でコンパイルしました。32bit版のみです。

サンプル数2^24個のFFT演算が100秒あまりでした。

LET N=2^16
DIM RR(N),II(N)
FOR I=1 TO N
LET RR(I)=I
LET II(I)=0
NEXT I
CALL CDFT(N,RR,II,1) ! FFT
FOR I=1 TO 100
PRINT RR(I);II(I)
NEXT I
CALL CDFT(N,RR,II,-1) ! IFFT
FOR I=1 TO 100
PRINT RR(I);II(I)
NEXT I
END

EXTERNAL SUB CDFT(N,RR(),II(),SW)
OPTION CHARACTER BYTE
LET A$=REPEAT$(CHR$(0),N*8*2)
LET IP$=REPEAT$(CHR$(0),(2+SQR(N))*4)
LET W$=REPEAT$(CHR$(0),N/2*8)
FOR I=0 TO N-1
LET A$(2*8*I+1:2*8*I+8)=PACKDBL$(RR(I+1)) !RE
LET A$(2*8*I+9:2*8*I+16)=PACKDBL$(II(I+1)) !IM
NEXT I
CALL CDFT_(2*N,SW,A$,IP$,W$) ! SW=1...FFT SW=-1...IFFT
FOR I=0 TO N-1
LET RR(I+1)=UNPACKDBL(A$(2*8*I+1:2*8*I+8))
LET II(I+1)=UNPACKDBL(A$(2*8*I+9:2*8*I+16))
IF SW=-1 THEN
LET RR(I+1)=RR(I+1)/N
LET II(I+1)=II(I+1)/N
END IF
NEXT I

SUB CDFT_(N,ISGN,A$,IP$,W$)
IF BITAND(N,N-1)<>0 THEN STOP
ASSIGN ".\DLL\fftsg.dll","cdft"
END SUB

!SUB CDFT_(N,ISGN,A$,IP$,W$)
! IF BITAND(N,N-1)<>0 THEN STOP
! ASSIGN ".\DLL\fft8g.dll","cdft"
!END SUB

!SUB CDFT(N,ISGN,A$,IP$,W$)
! OPTION CHARACTER BYTE
! IF BITAND(N,N-1)<>0 THEN STOP
! ASSIGN ".\DLL\fft4g.dll","cdft"
!END SUB
END SUB
----------------------------------------------------------------------------
fftsg.c

__declspec(dllexport) void cdft(int n, int isgn, double *a, int *ip, double *w)
{
void makewt(int nw, int *ip, double *w);
void cftfsub(int n, double *a, int *ip, int nw, double *w);
void cftbsub(int n, double *a, int *ip, int nw, double *w);
int nw;

nw = ip[0];
if (n > (nw << 2)) {
nw = n >> 2;
makewt(nw, ip, w);
}
if (isgn >= 0) {
cftfsub(n, a, ip, nw, w);
} else {
cftbsub(n, a, ip, nw, w);
}
}

以下略

Re: FFTフィルタ処理 - しばっち

2024/10/13 (Sun) 08:12:29

cによるDFTのDLL版です。OPENMPのマルチスレッド化による力技で高速化しています。(※CPU使用率が100%になります)
数千個程度なら個数Nに制約なしで実行できます。

VC++2022でコンパイルしました。32bit版のみです。

実行にはVCのOPEN MPランタイムvcomp140.dllが別途必要です。

EXTERNAL SUB DFT(N,RR(),II())
OPTION CHARACTER BYTE
LET AR$=REPEAT$(CHR$(0),N*8)
LET AI$=REPEAT$(CHR$(0),N*8)
FOR I=0 TO N-1
LET AR$(8*I+1:8*I+8)=PACKDBL$(RR(I+1)) !RE
LET AI$(8*I+1:8*I+8)=PACKDBL$(II(I+1)) !IM
NEXT I
CALL DFT_(N,AR$,AI$)
FOR I=0 TO N-1
LET RR(I+1)=UNPACKDBL(AR$(8*I+1:8*I+8))
LET II(I+1)=UNPACKDBL(AI$(8*I+1:8*I+8))
NEXT I

SUB DFT_(N,AR$,AI$)
OPTION CHARACTER BYTE
ASSIGN ".\DLL\dft.dll","dft"
END SUB
END SUB

EXTERNAL SUB IDFT(N,RR(),II())
OPTION CHARACTER BYTE
LET AR$=REPEAT$(CHR$(0),N*8)
LET AI$=REPEAT$(CHR$(0),N*8)
FOR I=0 TO N-1
LET AR$(8*I+1:8*I+8)=PACKDBL$(RR(I+1)) !RE
LET AI$(8*I+1:8*I+8)=PACKDBL$(II(I+1)) !IM
NEXT I
CALL IDFT_(N,AR$,AI$)
FOR I=0 TO N-1
LET RR(I+1)=UNPACKDBL(AR$(8*I+1:8*I+8))
LET II(I+1)=UNPACKDBL(AI$(8*I+1:8*I+8))
NEXT I

SUB IDFT_(N,AR$,AI$)
ASSIGN ".\DLL\dft.dll","idft"
END SUB
END SUB

!EXTERNAL SUB DFT2D(M,N,AR(,),AI(,),SW) ! SW=1...DFT SW=-1...IDFT
!OPTION CHARACTER BYTE
!LET AR$=REPEAT$(CHR$(0),M*N*8)
!LET AI$=REPEAT$(CHR$(0),M*N*8)
!FOR J=0 TO N-1
! FOR I=0 TO M-1
! LET AR$(8*(J*M+I)+1:8*(J*M+I)+8)=PACKDBL$(AR(I+1,J+1))
! LET AI$(8*(J*M+I)+1:8*(J*M+I)+8)=PACKDBL$(AI(I+1,J+1))
! NEXT I
!NEXT J
!CALL DFT2(M,N,SW,AR$,AI$)
!FOR J=0 TO N-1
! FOR I=0 TO M-1
! LET AR(I+1,J+1)=UNPACKDBL(AR$(8*(J*M+I)+1:8*(J*M+I)+8))
! LET AI(I+1,J+1)=UNPACKDBL(AI$(8*(J*M+I)+1:8*(J*M+I)+8))
! NEXT I
!NEXT J
!
!SUB DFT2(M,N,FLAG,AR$,AI$)
! ASSIGN ".\DLL\dft.dll","dft2"
!END SUB
!END SUB

!EXTERNAL SUB DFT2D(M,N,AR(,),AI(,))
!OPTION CHARACTER BYTE
!LET AR$=REPEAT$(CHR$(0),M*8)
!LET AI$=REPEAT$(CHR$(0),M*8)
!FOR J=0 TO N-1
! FOR I=0 TO M-1
! LET AR$(8*I+1:8*I+8)=PACKDBL$(AR(I,J))
! LET AI$(8*I+1:8*I+8)=PACKDBL$(AI(I,J))
! NEXT I
! CALL DFT(M,AR$,AI$)
! FOR I=0 TO M-1
! LET AR(I,J)=UNPACKDBL(AR$(8*I+1:8*I+8))
! LET AI(I,J)=UNPACKDBL(AI$(8*I+1:8*I+8))
! NEXT I
!NEXT J
!LET AR$=REPEAT$(CHR$(0),N*8)
!LET AI$=REPEAT$(CHR$(0),N*8)
!FOR J=0 TO M-1
! FOR I=0 TO N-1
! LET AR$(8*I+1:8*I+8)=PACKDBL$(AR(J,I))
! LET AI$(8*I+1:8*I+8)=PACKDBL$(AI(J,I))
! NEXT I
! CALL DFT(N,AR$,AI$)
! FOR I=0 TO N-1
! LET AR(J,I)=UNPACKDBL(AR$(8*I+1:8*I+8))
! LET AI(J,I)=UNPACKDBL(AI$(8*I+1:8*I+8))
! NEXT I
!NEXT J
!END SUB

!EXTERNAL SUB IDFT2D(M,N,AR(,),AI(,))
!OPTION CHARACTER BYTE
!LET AR$=REPEAT$(CHR$(0),M*8)
!LET AI$=REPEAT$(CHR$(0),M*8)
!FOR J=0 TO N-1
! FOR I=0 TO M-1
! LET AR$(8*I+1:8*I+8)=PACKDBL$(AR(I,J))
! LET AI$(8*I+1:8*I+8)=PACKDBL$(AI(I,J))
! NEXT I
! CALL IDFT(M,AR$,AI$)
! FOR I=0 TO M-1
! LET AR(I,J)=UNPACKDBL(AR$(8*I+1:8*I+8))
! LET AI(I,J)=UNPACKDBL(AI$(8*I+1:8*I+8))
! NEXT I
!NEXT J
!LET AR$=REPEAT$(CHR$(0),N*8)
!LET AI$=REPEAT$(CHR$(0),N*8)
!FOR J=0 TO M-1
! FOR I=0 TO N-1
! LET AR$(8*I+1:8*I+8)=PACKDBL$(AR(J,I))
! LET AI$(8*I+1:8*I+8)=PACKDBL$(AI(J,I))
! NEXT I
! CALL IDFT(N,AR$,AI$)
! FOR I=0 TO N-1
! LET AR(J,I)=UNPACKDBL(AR$(8*I+1:8*I+8))
! LET AI(J,I)=UNPACKDBL(AI$(8*I+1:8*I+8))
! NEXT I
!NEXT J
!END SUB
------------------------------------------------------------------------------
dft.c

#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <omp.h>
#define PI 3.14159265358979323846

__declspec(dllexport) void dft(int m, double *xr, double *xi)
{
double *rr,*ii;
double p;
int i,j;
rr = malloc(m * sizeof(double));
ii = malloc(m * sizeof(double));
if (rr == NULL || ii == NULL) exit(1);
#pragma omp parallel for
for (i=0; i<m; i++) {
rr[i]=0;
ii[i]=0;
}
p = 2*PI/(double)m;
#pragma omp parallel for private(i,j)
for (j=0; j<m; j++) {
for (i=0; i<m; i++) {
rr[j] += xr[i] * cos(p * j * i) - xi[i] * sin(p * j * i);
ii[j] += xr[i] * sin(p * j * i) + xi[i] * cos(p * j * i);
}
}
#pragma omp parallel for
for(i = 0; i<m; i++) {
xr[i] = rr[i];
xi[i] = ii[i];
}
free(rr);
free(ii);
}

__declspec(dllexport) void idft(int m, double *xr, double *xi)
{
double *rr,*ii;
double p;
int i,j;
rr = malloc(m * sizeof(double));
ii = malloc(m * sizeof(double));
if (rr == NULL || ii == NULL) exit(1);

p = 2*PI/(double)m;
#pragma omp parallel for
for (i=0; i<m; i++) {
rr[i]=0;
ii[i]=0;
}
#pragma omp parallel for private(i,j)
for (j=0; j<m; j++) {
for (i=0; i<m; i++) {
rr[j] += xr[i] * cos(-p * j * i) - xi[i] * sin(-p * j * i);
ii[j] += xr[i] * sin(-p * j * i) + xi[i] * cos(-p * j * i);
}
}
#pragma omp parallel for
for(i = 0; i<m; i++) {
xr[i] = rr[i]/(double)m;
xi[i] = ii[i]/(double)m;
}
free(rr);
free(ii);
}

__declspec(dllexport) void dft2(int m,int n,int flag,double *rr, double *ii)
{
void idft(int m, double *xr, double *xi);
void dft(int m, double *xr, double *xi);

double *xr,*xi;
int x,y;
xr = malloc(m * sizeof(double));
xi = malloc(m * sizeof(double));
if (rr == NULL || ii == NULL) return;
for(y = 0; y<n; y++) {
#pragma omp parallel for
for(x = 0; x<m; x++) {
xr[x] = rr[y*m+x];
xi[x] = ii[y*m+x];
}
if(flag>0) dft(m, xr, xi);
else idft(m, xr, xi);
#pragma omp parallel for
for(x = 0; x<m; x++) {
rr[y*m+x] = xr[x];
ii[y*m+x] = xi[x];
}
}
free(xr);
free(xi);
xr = malloc(n * sizeof(double));
xi = malloc(n * sizeof(double));

for(x = 0; x<m; x++) {
#pragma omp parallel for
for(y = 0; y<n; y++) {
xr[y] = rr[y*m+x];
xi[y] = ii[y*m+x];
}
if(flag>0) dft (n, xr, xi);
else idft (n, xr, xi);
#pragma omp parallel for
for(y = 0; y<n; y++) {
rr[y*m+x] = xr[y];
ii[y*m+x] = xi[y];
}
}
free(xr);
free(xi);
}

名前
件名
メッセージ

画像
メールアドレス
URL
編集/削除キー	（半角英数字のみで４～８文字）
プレビューする（投稿前に、内容をプレビューして確認できます）