home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 3 / FreeSoftwareCollection3pd199x-jp.img / fb386 / uno_25 / uno.bas < prev    next >
BASIC Source File  |  1980-01-02  |  49KB  |  976 lines

  1. 1 CLS:WIDTH 80,25:COLOR 7:LOCATE 0,0:GOTO 10
  2. 5 CLS:WIDTH 80,25:COLOR 7:LOCATE 0,0:GOTO 10
  3. 10 PRINT "    *********************************************************************"
  4. 13 PRINT "   ***********************************************************************"
  5. 14 PRINT "   **********                                                   **********"
  6. 15 PRINT "   *********         <<< カードゲーム『UNO』>>>               *********"
  7. 20 PRINT "   ********                                                       ********"
  8. 25 PRINT "   *******    平成2年度旺文社主催                               *******"
  9. 30 PRINT "   ******                                                           ******"
  10. 35 PRINT "   *****        全国中学生パソコンソフトウェアコンクール参加作品     *****"
  11. 40 PRINT "   ****                                                               ****"
  12. 45 PRINT "   ***        製作:幸田町立北部中学校  【科学技術部】                 ***"
  13. 50 PRINT "   ****               (愛知県額田郡幸田町大字高力字越丸34)        ****"
  14. 52 PRINT "   *****                                                             *****"
  15. 53 PRINT "   ******           プログラム:只野 伸高、山本 祐輔              ******"
  16. 55 PRINT "   *******                                                         *******"
  17. 60 PRINT "   ********           顧 問  :廣野 守                          ********"
  18. 65 PRINT "   *********                                                     *********"
  19. 70 PRINT "   ***********************************************************************"
  20. 75 PRINT "    ********************************************************************* "
  21. 80 PRINT:PRINT:PRINT "                          しばらくお待ち下さい."
  22. 90 '========================= イニシャライズ・・・・・
  23. 100 '------------------------ 配列の定義など
  24. 105 CD PLAY 3,3
  25. 110 CLEAR ,,8000,1024*900:MOUSE 0:DEFINT A-Z
  26. 115 KOJIN_MAX=20:WF=0:PF=0:XS=0:NANKAI=0
  27. 130 RANDOMIZE VAL(LEFT$(TIME$,2)+MID$(TIME$,4,2))+VAL(RIGHT$(TIME$,2))
  28. 140 'ON STOP GOSUB *STOP.KEYIN:STOP ON
  29. 150 DIM CARD(108),M_CARD(4,30),SCORE(4),WAO(4),K(4),P_NAME$(4),PSUB(4),PINDX(4)
  30. 160 DIM COL(5),DISP_C$(14),CARD$(14),KAI$(39),T(20,2)
  31. 165 DIM GA%(6000),CB%(42000),CR%(42000),CG%(42000),CY%(42000),CWI%(6000)
  32. 166 DIM CTE%(6000),PL(8)
  33. 167 DIM UNO1(20000),UNO2(20000),UNO3(20000),UNO4(20000),HAKUSYU(40000),BUUING(40000)
  34. 170 '------------------------ 画面の初期設定
  35. 180 PALETTE 
  36. 181 GOSUB *BRACK:GOSUB *ONSEI
  37. 190 GOSUB *INIT.CARD:CLS:PALETTE:GOSUB *TITLE.DISP
  38. 191 MOUSE 1,0,0,1
  39. 192 PASTEL
  40. 195 FOR I=0 TO 1000:NEXT
  41. 200 '----------------------- 初期設定1
  42. 210     P_NAME$(1)="COM1":P_NAME$(2)="COM2"
  43. 220     P_NAME$(3)="COM3":P_NAME$(4)="YOU!"
  44. 270     COLOR 4:LOCATE 0,22:PRINT"説明が必要ですか? 不要・左 / 必要・右"
  45. 280     IF MOUSE(2,0)<>-1 AND MOUSE(2,1)<>-1 THEN 280 ELSE 285
  46. 285     IF MOUSE(2,0)=-1 THEN BEEP 1:BEEP 0 ELSE GOSUB *SETSUMEI
  47. 290     'COL(1)=2:COL(2)=4:COL(3)=1:COL(4)=6:COL(5)=0:COL1$="RGBY*"
  48. 300     COL(1)=1:COL(2)=2:COL(3)=4:COL(4)=6:COL(5)=0:COL1$="BRGY*"
  49. 310     RESTORE 320:FOR I=1 TO 14:READ CARD$(I):NEXT I
  50. 320     DATA 0,1,2,3,4,5,6,7,8,9,S,R,D,W,WDF 
  51. 330     RESTORE *K.DATA:FOR I=0 TO 39:READ KAI$(I):NEXT
  52. 340 '------------------------ 初期設定2
  53. 350 *INIT.2
  54. 360     FOR I=1 TO 4:SCORE(I)=0:NEXT
  55. 370     PLAYER=4:ROUND=0:TAKO=INT(RND*4)
  56. 380     GOTO *INIT.3
  57. 450 '------------------------ 解説のデータ
  58. 460 *K.DATA
  59. 470     DATA 難しい所ですね ,逆襲が恐いねえ ,説明のしようもないですねえ
  60. 475     DATA いやあ、どうでしょうねえ?
  61. 480     DATA わて賢ないからわからへん,不吉じゃのう!!!
  62. 485     DATA この人、天才じゃ!!  ,おっ、恐ろしい・・
  63. 490     DATA なんなんだよ~ ,すこ~~~ん! ,だめだ、こりゃ ,痛ったいなあ
  64. 500     DATA 悲惨だ。まいった、まいった ,なんとあさはかな
  65. 505     DATA あっははは・・,まあ、いいじゃないの
  66. 510     DATA えっとー、うんむう,ブラボー!! ,ばちがあたるよ ,知りませんよ
  67. 520     DATA これがさだめじゃ,知るかってーの!!
  68. 525     DATA おー!ビューティフル,この世の終わりじゃ
  69. 530     DATA ガガガチョ~ン ,疑問を感じますねえ,いやあやんなった,おぉっ!?ん?
  70. 540     DATA ばちあたりもんがあ,よくできました
  71. 545     DATA 荒業に持っていった,個人的には嫌だね
  72. 550     DATA おじさんはまいりました,市場最悪のケースだぜ!
  73. 555     DATA ベストだぜっ!,燃えてますなあ
  74. 560     DATA こりゃまたどっこい,ヌオー頭いてー!
  75. 565     DATA タワケこのやろー!,そんなーあ
  76. 760 '------------------------ ゲームの説明画面
  77. 770 *SETSUMEI
  78. 780     WIDTH 80:COLOR 7:CLS 
  79. 830     LOCATE 1,1:PRINT"* プレーヤー4人のうち3人をComputerが受け持ちます。"
  80. 840     LOCATE 1,3:PRINT"* 早く ";:COLOR 5:PRINT"500点取った人の勝ち";
  81. 850     COLOR 7:PRINT"です。(ここでのルール)"
  82. 870     LOCATE 1,5:PRINT"* 「UNO」の宣言を忘れると2枚取るという罰があります。"
  83. 875     PRINT ""
  84. 880     LOCATE 1,7:PRINT"* このゲームでは、";:COLOR 5:PRINT"誰か一人でも持っているカードが20枚越えたときか、":PRINT "   山のカードを全部使いきって引くカードが無くなったときには、流れになります。":COLOR 7
  85. 890     LOCATE 1,10:PRINT"* カードを出すときは";:COLOR 5:PRINT "マウスの左をクリック";:COLOR 7:PRINT "してください."
  86. 900     LOCATE 1,12:PRINT"* 出せるカードのないときは,";:COLOR 5:PRINT "山のカードの所にマウスカーソルをもっていき"
  87. 905     LOCATE 2,13:PRINT " 左をクリックしてください.":COLOR 7
  88. 910     LOCATE 1,15:PRINT"* WILD, WILD DRAW FOURを出したら,何色(青,赤,黄,緑)にするか聞くので"
  89. 915     LOCATE 2,16:PRINT" 変えたい色を中から選んでください."
  90. 925     LOCATE 1,18:PRINT"* ゲーム中に出てくるメッセージも,何かの参考にしてください."
  91. 930     COLOR 6:LOCATE 24,20:PRINT"マウスの左をクリックしてください."
  92. 940     R=RND:IF MOUSE(2,0)=0 THEN 940
  93. 950     CLS:COLOR 2
  94. 960     LOCATE 26,1:PRINT "カードの説明":COLOR 5
  95. 970     LOCATE 1,3:PRINT "* 0~9・・・";:COLOR 7:PRINT "数字のカードです."
  96. 980     COLOR 5:LOCATE 3,4:PRINT "色が同じか,数字が同じ";:COLOR 7:PRINT "で出すことができます.":COLOR 5
  97. 990     LOCATE 1,6:PRINT "* DRAW  TWO・・・";:COLOR 7:PRINT "自分が出すと次の番の敵に";:COLOR 5:PRINT "2枚取らせる";:COLOR 7:PRINT "ことができます."
  98. 1000    LOCATE 3,7:PRINT"自分がくらうと";:COLOR 5:PRINT "2枚取る";:COLOR 7:PRINT "ことになり,自分の番はなくなります.":COLOR 5
  99. 1010    LOCATE 1,9:PRINT"* SKIP・・・";:COLOR 7:PRINT "出すと,";:COLOR 5:PRINT "次の番の敵を飛ばす";:COLOR 7:PRINT "ことができます.":COLOR 5
  100. 1020    LOCATE 1,11:PRINT "* REVERSE・・・回る方向を逆";:COLOR 7:PRINT "にできます.":COLOR 5
  101. 1030    LOCATE 1,13:PRINT "* WILD・・・色を変える";:COLOR 7:PRINT "ことができます."
  102. 1040    LOCATE 3,14:PRINT "普通は,出せるカードのないときに出します.":COLOR 5
  103. 1050    LOCATE 1,16:PRINT "* WILD DRAWFOUR・・・";:COLOR 7:PRINT"WILDと同じように";:COLOR 5:PRINT"色を変える";:COLOR 7:PRINT "ことができます."
  104. 1060    LOCATE 3,17:PRINT "そして次の番の敵に,";:COLOR 5:PRINT "4枚取らせる";:COLOR 7:PRINT "ことができます."
  105. 1070    LOCATE 3,18:PRINT "但し”チャレンジ”され成功すると,自分が";:COLOR 5:PRINT"4枚取る";:COLOR 7:PRINT "ことになります."
  106. 1080    LOCATE 1,20:PRINT "* 自分が”チャレンジ”し成功すると出した敵に";:COLOR 5:PRINT "4枚取らせる";:COLOR 7:PRINT "ことができ"
  107. 1090    LOCATE 3,21:PRINT "失敗すると,自分が";:COLOR 5:PRINT "6枚取る";:COLOR 7:PRINT "ことになります."
  108. 1100    COLOR 6:LOCATE 24,22:PRINT "マウスの左をクリックしてください."
  109. 1110    R=RND:IF MOUSE(2,0)=0 THEN 1110
  110. 1120 CLS:RETURN
  111. 1130 '----------------------- 初期設定3/中間報告
  112. 1140 *INIT.3
  113. 1280 '---------------------------カ-ドを,シャッフルする
  114. 1285    FOR I=1 TO 4:K(I)=7:NEXT:REVERSE=1
  115. 1290    ERASE CARD:DIM CARD(108)
  116. 1300    FOR I=0 TO 12
  117. 1303      FOR C=1 TO 4
  118. 1305        FOR J=1 TO 1-(I>0)
  119. 1310          X=INT(RND(1)*108)+1:IF CARD(X)<>0 THEN 1310
  120. 1320          CARD(X)=C*100+I
  121. 1330        NEXT
  122. 1333      NEXT
  123. 1335    NEXT
  124. 1340    FOR J=1 TO 4
  125. 1345      FOR I=13 TO 14
  126. 1350        FOR X=1 TO 108
  127. 1355          IF CARD(X)=0 THEN 1370
  128. 1360        NEXT
  129. 1370        CARD(X)=500+I
  130. 1380        XS=INT(RND(1)*108)+1
  131. 1385        IF XS=X OR CARD(XS)=0 THEN 1380
  132. 1390        SWAP CARD(X),CARD(XS)
  133. 1400      NEXT I
  134. 1405    NEXT J
  135. 1410 '----------------------- カードを配る
  136. 1420    FOR I=1 TO KOJIN_MAX:FOR J=1 TO 4:M_CARD(J,I)=0:NEXT:NEXT
  137. 1430    D_POINT=1
  138. 1440    FOR I=1 TO 7:FOR J=1 TO 4:M_CARD(J,I)=CARD(D_POINT):D_POINT=D_POINT+1:NEXT:NEXT
  139. 1450    CARD=D_POINT:GOSUB *CARD.FNC:IF CARD_N=11 THEN GOSUB 1520:GOTO 1470
  140. 1460    IF CARD_N>12 THEN 1490
  141. 1470    BA_N=CARD_N:BA_C=CARD_C:D_POINT=D_POINT+1:P_POINT=1
  142. 1480    GOTO *MAIN1
  143. 1485    '
  144. 1490    C1=CARD:FOR CARD=30 TO 108:GOSUB *CARD.FNC:IF CARD_N<13 THEN 1510
  145. 1500    NEXT
  146. 1510    SWAP CARD(C1),CARD(CARD):CARD=C1:GOSUB *CARD.FNC:GOTO 1470
  147. 1520    PLAYER=PLAYER+1:IF PLAYER>4 THEN PLAYER=1
  148. 1530 RETURN
  149. 1540 '----------------------- カードの種類を調べる
  150. 1550 *CARD.FNC
  151. 1560    CARD_C=CARD(CARD)\100:CARD_N=CARD(CARD)MOD 100:RETURN
  152. 1660 '----------------------- STOPキー入力
  153. 1670 *STOP.KEYIN
  154. 1680    SENTAKU1$="終了しますか?":SENTAKU2$="YES  NO":GOSUB *SENTAKU:'BEEP 1:STOP OFF:COLOR 7:SCREEN,3:WIDTH 80:BEEP 0
  155. 1681    IF SEN=1 THEN 1690
  156. 1682    IF SEN=2 THEN RETURN
  157. 1690    PRINT"* プログラムを終了します !!":PRINT:PRINT
  158. 1700 END
  159. 1710 '----------------------- MAINルーチン1
  160. 1720 *MAIN1:
  161. 1730    GOSUB *MAKE.S
  162. 1830    PL=PLAYER
  163. 1840    FOR I=1 TO 3:FOR J=1 TO 7:CPUT_X=J*40:CPUT_Y=(I-1)*82+15
  164. 1850      PLAYER=I:CARD_P=0:GOSUB *CARD.DISP
  165. 1860    NEXT J,I
  166. 1865    PLAYER=4
  167. 1870    FOR J=1 TO 7
  168. 1875      CPUT_X=(J-1)*64+40:CPUT_Y=282:CARD_P=-1
  169. 1877      CARD=M_CARD(4,J):GOSUB *CARD.FNC2:GOSUB *CARD.DISP
  170. 1879    NEXT J
  171. 1880    GOSUB *CARD.DRAW:PLAYER=PL
  172. 1960    S=BA_N:GOSUB *H.SEARCH
  173. 2030 '----------------------- MAINルーチン・ループ
  174. 2050 *MAIN
  175. 2055    CDSTAT PL:IF PL(1)=0 THEN CD PLAY 3,3 
  176. 2060    '-------------------- UNOになったときの処置
  177. 2065    IF PLAYER=4 AND WAO(PLAYER)=-1 THEN 2080
  178. 2070    IF K(PLAYER)=1 AND RND(1)<.9! AND WAO(PLAYER)=0 THEN WAO(PLAYER)=-1:BEEP 1:GOTO 2072:ELSE WAO(PLAYER)=0:GOTO 2080
  179. 2072      IF PLAYER=1 THEN PCMPLAY UNO1,127
  180. 2073      IF PLAYER=2 THEN PCMPLAY UNO2,127
  181. 2074      IF PLAYER=3 THEN PCMPLAY UNO3,127
  182. 2075      IF PLAYER=4 THEN PCMPLAY UNO4,127
  183. 2076    BEEP 0
  184. 2080    '
  185. 2084    IF K(PLAYER)=1 AND WAO(PLAYER)=0 THEN GOSUB *UNO.BATU:WAO(PLAYER)=0
  186. 2090    '-------------------- 回る方向を表示する
  187. 2100    GOSUB *SIKAKU.KESU
  188. 2110    PLAYER=PLAYER+REVERSE
  189. 2120    IF PLAYER>4 THEN PLAYER=1
  190. 2123    IF PLAYER<1 THEN PLAYER=4
  191. 2125    GOSUB *SIKAKU.KAKU
  192. 2150    IF HAPPEN THEN *HAPPENNING
  193. 2160    IF PLAYER<4 THEN *COM.THINK
  194. 2170    GOTO *MAN
  195. 2180 '----------------------- あがり
  196. 2190 *AGARI
  197. 2200    IF BA_N=14 THEN MAI=4:GOTO 2220 ELSE IF BA_N=12 THEN MAI=2:GOTO 2220
  198. 2210    GOTO 2250
  199. 2220    PLAYER1=PLAYER:PLAYER=PLAYER+REVERSE
  200. 2230    IF PLAYER>4 THEN PLAYER=1 ELSE IF PLAYER<1 THEN PLAYER=4
  201. 2240    GOSUB *ERASE.LINE
  202. 2243    PRINT "「";P_NAME$(PLAYER); "」さん";MAI;"枚ひいて下さい。";
  203. 2245    IF PLAYER1=4 THEN CARD_P=0
  204. 2248    GOSUB 4450:GOSUB *CARD.DRAW:PLAYER=PLAYER1
  205. 2250    COLOR=(3,2):BEEP:COLOR=(3,6):BEEP:COLOR=(3,1):BEEP:COLOR 7
  206. 2260    GOSUB *ERASE.LINE:PRINT"「";P_NAME$(AGARI_P);"」があがりました!!";
  207. 2261    IF AGARI_P=1 THEN 2262 ELSE IF AGARI_P=2 THEN 2263 ELSE IF AGARI_P=3 THEN 2264 ELSE 2265
  208. 2262    LINE(37,11)-(449,82),PSET,0,BF:GOTO 2265
  209. 2263    LINE(37,90)-(449,165),PSET,0,BF:GOTO 2265
  210. 2264    LINE(37,173)-(449,245),PSET,0,BF
  211. 2265    IF AGARI_P=4 THEN PCMPLAY HAKUSYU,127 ELSE PCMPLAY BUUING,127
  212. 2270    FOR LP=1 TO 100:COLOR=(0,INT(RND*7)+1):BEEP 1:BEEP 0:NEXT
  213. 2280    COLOR=(0,3):COLOR=(3,4)
  214. 2290    FOR LP=1 TO 2700:NEXT:BEEP
  215. 2300    TOTAL=0:AG_PLAYER=AGARI_P
  216. 2310    FOR PLAYER=1 TO 4
  217. 2315      IF PLAYER=AG_PLAYER THEN SC=0:GOTO 2400
  218. 2320      'CHA=-1:GOSUB *CARD.DRAW:CHA=0
  219. 2330      SC=0
  220. 2335      FOR LP=1 TO KOJIN_MAX
  221. 2337        IF M_CARD(PLAYER,LP)=0 THEN 2370
  222. 2340        CARD_N=M_CARD(PLAYER,LP)MOD 100:IF CARD_N>12 THEN SC=SC+50
  223. 2350        IF CARD_N>9 AND CARD_N<13 THEN SC=SC+20
  224. 2360        IF CARD_N<10 THEN SC=SC+CARD_N
  225. 2370      NEXT
  226. 2380      GOSUB *ERASE.LINE:PRINT"「";P_NAME$(PLAYER);"」のカードの合計点は、";SC; "点です。";:SCORE(PLAYER)=SCORE(PLAYER)-SC
  227. 2390      FOR LP=1 TO 2700:NEXT
  228. 2400      TOTAL=TOTAL+SC
  229. 2405    NEXT
  230. 2410    COLOR 5:LOCATE 6,(AG_PLAYER-1)*4+1+(AG_PLAYER=3):PRINT"<------------------- あがり!!"
  231. 2411    IF AG_PLAYER=3 THEN 2421 
  232. 2420    LOCATE 6,(AG_PLAYER-1)*4+2:PRINT"得点 : ";TOTAL;"点":GOTO 2430
  233. 2421    LOCATE 6,9:PRINT "得点  :  ";TOTAL;"点"
  234. 2430    SCORE(AG_PLAYER)=SCORE(AG_PLAYER)+TOTAL:COLOR=(0,0):COLOR=(2,2):COLOR=(3,3)
  235. 2440    IF SCORE(AG_PLAYER)>=500 THEN *GAME.SET
  236. 2450    FOR LP=1 TO 10000:NEXT
  237. 2460    PLAYER=AG_PLAYER
  238. 2470    TAKO=INT(RND*4):IF TAKO=AG_PLAYER THEN TAKO=0
  239. 2480 GOTO *INIT.3
  240. 2490 '----------------------- ゲームセット
  241. 2500 *GAME.SET
  242. 2510    GOSUB *ERASE.LINE:COLOR 6:PRINT "***** 「";P_NAME$(AG_PLAYER);"」が500点を越えました!";:BEEP
  243. 2515    FOR I=1 TO 5000:NEXT
  244. 2520    CLS:LINE(0,0)-(639,479),PSET,1,BF
  245. 2530    SYMBOL (224,60),"**** 総合結果 ****",1,1,5,,,1:'28,3
  246. 2540    FOR I=1 TO 4:PINDX(I)=I:PSUB(I)=SCORE(I):NEXT I
  247. 2545    FOR J=3 TO 1 STEP -1
  248. 2550      FOR I=1 TO J
  249. 2560        IF PSUB(I)<PSUB(I+1) THEN SWAP PSUB(I),PSUB(I+1):SWAP PINDX(I),PINDX(I+1)
  250. 2565      NEXT I
  251. 2570    NEXT J
  252. 2580    LINE( 0, 0)-(639,479),PSET,7,B:LINE( 1, 1)-(638,478),PSET,7,B
  253. 2590    LINE(10,10)-(629,469),PSET,7,B:LINE(11,11)-(628,468),PSET,7,B
  254. 2600    LINE(20,20)-(619,459),PSET,7,B:LINE(21,21)-(618,458),PSET,7,B
  255. 2605    SYMBOL (184,100),"優勝・・・"+P_NAME$(PINDX(1))+"  : 得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(1))),4))+"点",1,1,7,,,1
  256. 2610    SYMBOL (184,140),"2位・・・"+P_NAME$(PINDX(2))+"  : 得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(2))),4))+"点",1,1,7,,,1
  257. 2620    SYMBOL (184,160),"3位・・・"+P_NAME$(PINDX(3))+"  : 得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(3))),4))+"点",1,1,7,,,1
  258. 2630    SYMBOL (184,180),"4位・・・"+P_NAME$(PINDX(4))+"  : 得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(4))),4))+"点",1,1,7,,,1
  259. 2700    SENTAKU1$="もう一度やりますか?":SENTAKU2$="YES  NO"
  260. 2705    SX=140:SY=260:GOSUB *SENTAKU2
  261. 2710    IF SEN=1 THEN BEEP:GOTO *INIT.2
  262. 2720    COLOR=(0,0):COLOR 7:END
  263. 2840 '----------------------- 人間の入力
  264. 2850 *MAN
  265. 2880    GOSUB *INPUT_CARD2:IF TAKE=0 THEN *GET_CARD
  266. 2890    GOSUB *CAN_PUT:IF CAN THEN GOSUB *PUT_CARD:GOTO *NEXT.P ELSE 2880
  267. 3080 '----------------------- カードを出す
  268. 3090 *PUT_CARD
  269. 3100    SITA_C=BA_C:SITA_N=BA_N:CARD=P_POINT:CARD(P_POINT)=M_CARD(PLAYER,CAN)
  270. 3105    M_CARD(PLAYER,CAN)=0:P_POINT=P_POINT+1
  271. 3110    GOSUB *CARD.FNC:S=CARD_N:GOSUB *H.SEARCH
  272. 3120    BA_C=CARD_C:BA_N=CARD_N:BA_P=PLAYER:BA_X=P_POINT:K(PLAYER)=K(PLAYER)-1
  273. 3130    IF WAO(PLAYER) THEN *NEXT.P
  274. 3140    KAI=INT(RND*40):COLOR 7:LOCATE 19,11:PRINT SPC(59)
  275. 3145    LOCATE 19,11:COLOR 4:PRINT KAI$(KAI)
  276. 3147 RETURN
  277. 3150 '----------------------- 一人分の処理終了
  278. 3160 *NEXT.P
  279. 3170    GOSUB *CARD.SORT:GOSUB *CARD.DRAW:GET_C=0
  280. 3173    IF K(4)<>1   THEN 3178
  281. 3175    IF WAO(4)=-1 THEN 3178 ELSE GOSUB *UNO.BATU
  282. 3178    IF K(PLAYER)=0 THEN AGARI_P=PLAYER   :GOTO *AGARI
  283. 3180    GOTO *MAIN
  284. 3190 '----------------------- メッセージ表示部の消去
  285. 3200 *ERASE.LINE
  286. 3205    LOCATE 19,11:PRINT SPC(59):LOCATE 19,11
  287. 3210 RETURN
  288. 3220 '----------------------- カードを出せるかどうか
  289. 3230 *CAN_PUT
  290. 3240    IF M_CARD(PLAYER,TAKE)\100   =BA_C THEN CAN=TAKE:GOTO 3275
  291. 3250    IF M_CARD(PLAYER,TAKE)MOD 100=BA_N THEN CAN=TAKE:GOTO 3275
  292. 3260    IF M_CARD(PLAYER,TAKE)MOD 100>12   THEN CAN=TAKE:GOTO 3275
  293. 3270    CAN=0
  294. 3275 RETURN
  295. 3280 '----------------------- 人間が1枚ひく
  296. 3290 *GET_CARD
  297. 3300    FOR X=1 TO KOJIN_MAX:PF=0
  298. 3305      IF M_CARD(PLAYER,X)=0 THEN PF=-1:XS=X:X=KOJIN_MAX:'3320
  299. 3310    NEXT
  300. 3311    IF PF=-1 THEN PF=0:X=XS:GOTO 3320
  301. 3315    GOTO *NAGARE
  302. 3320    COLOR 7:LOCATE 58,4:PRINT "残り":LOCATE 66,4:PRINT "枚"
  303. 3325    M_CARD(PLAYER,X)=CARD(D_POINT):D_POINT=D_POINT+1:COLOR 7:LOCATE 62,4:PRINT USING"####";109-D_POINT:IF D_POINT>108 THEN *OVER.108
  304. 3330    FOR GC=1 TO 3:BEEP 1:BEEP 0:FOR GC0=1 TO 50:NEXT:NEXT
  305. 3340    K(PLAYER)=K(PLAYER)+1
  306. 3350    CARD=D_POINT-1:GOSUB *CARD.FNC
  307. 3355    IF PLAYER=4 THEN CPUT_X=560:CPUT_Y=143:ELSE CPUT_X=565:CPUT_Y=176
  308. 3360    CARD_P=-1:GOSUB *CARD.DISP
  309. 3370    IF CARD_C=BA_C OR CARD_N=BA_N OR CARD_N>12 THEN 3380 ELSE 3395
  310. 3380    GOSUB *ERASE.LINE:PRINT"山のところに表示されたのがめくったカードです。"
  311. 3382    SENTAKU1$="カードを出しますか?":SENTAKU2$="YES  NO"
  312. 3383    GOSUB *SENTAKU
  313. 3390    IF SEN=1 THEN GET_C=-1:CAN=X:GOSUB *DRAW.KESU:GOSUB *PUT_CARD:GOTO *NEXT.P
  314. 3395    FOR LP=1 TO 1000:NEXT LP:    GOSUB *DRAW.KESU:GOTO *NEXT.P
  315. 3400 '----------------------- ひいたカードを消して元に戻す
  316. 3403 *DRAW.KESU:
  317. 3405    IF PLAYER=4 THEN LINE(560,143)-(624,243),PSET,0,BF:CPUT_X=565:CPUT_Y=176:CARD_P=0:GOSUB *CARD.DISP
  318. 3406    IF K(4)<>1 THEN LINE(595,270)-(619,381),PSET,0,BF
  319. 3407 RETURN
  320. 3410 '----------------------- カードの1人分の表示、及び場のカードの表示
  321. 3420 *CARD.DRAW
  322. 3430    IF WF=-1 THEN CARD_C=5:CARD_P=-1 ELSE CARD_P=-1:CARD_C=BA_C:CARD_N=BA_N
  323. 3435    CPUT_X=480:CPUT_Y=143:GOSUB *CARD.DISP
  324. 3440    IF WF=-1 THEN CARD_C=TK_C:WF=0
  325. 3450    CARD_P=0
  326. 3460    CPUT_X=565:CPUT_Y=176:GOSUB *CARD.DISP
  327. 3461    ON CARD_C GOTO 3462,3463,3464,3465
  328. 3462      COLOR 1:LOCATE 62,5:PRINT "青色":COLOR 7:BA_C=1:GOTO 3470
  329. 3463      COLOR 2:LOCATE 62,5:PRINT "赤色":COLOR 7:BA_C=2:GOTO 3470
  330. 3464      COLOR 4:LOCATE 62,5:PRINT "緑色":COLOR 7:BA_C=3:GOTO 3470
  331. 3465      COLOR 6:LOCATE 62,5:PRINT "黄色":COLOR 7:BA_C=4:GOTO 3470
  332. 3470    IF GET_C  THEN RETURN
  333. 3480    IF CHA=-1 THEN CARD_P=-1
  334. 3490    IF PLAYER=4 THEN CARD_P=-1:X0PU=0:GOSUB *CARD.SORT:ELSE 3510
  335. 3500      IF K(4)=>8 THEN HA=INT(448/K(4)):HA1=HA ELSE HA=64:HA1=HA
  336. 3502      HX=40:LINE(37,282)-(550,382),PSET,0,BF:GOSUB *CARD.DRAW2:GOTO 3516
  337. 3505      '-----------------
  338. 3510      CARD_P=0:IF K(PLAYER)=>8 THEN HA=INT(280/K(PLAYER)) ELSE HA=40
  339. 3512      HX=40:LINE(40,15+(PLAYER-1)*82)-(380,15+(PLAYER-1)*82+64),PSET,0,BF
  340. 3514      GOSUB *CARD.DRAW2
  341. 3516 RETURN
  342. 3518 '----------------------
  343. 3520 *CARD.DRAW2
  344. 3525    K=0:PF=0
  345. 3528    FOR CARD=1 TO KOJIN_MAX
  346. 3530      IF M_CARD(PLAYER,CARD)=0 THEN 3580
  347. 3540      CARD_C=M_CARD(PLAYER,CARD)\100
  348. 3545      CARD_N=M_CARD(PLAYER,CARD)-CARD_C*100
  349. 3550      CPUT_X=40+HA*(CARD-1)
  350. 3553      CPUT_Y=((PLAYER=4)*267+(PLAYER<>4)*(PLAYER-1)*82-15)*-1
  351. 3555      IF PLAYER=4 THEN CARD_P=-1 ELSE CARD_P=0
  352. 3560      GOSUB *CARD.DISP
  353. 3570      K=K+1:IF K=K(PLAYER) THEN PF=-1:XS=CARD:CARD=KOJIN_MAX
  354. 3580    NEXT
  355. 3585    IF PF=-1 THEN PF=0:CARD=XS
  356. 3590 RETURN
  357. 3690 '----------------------- WDF / W / D / R / S のカードを出したときの処理
  358. 3700 *H.SEARCH
  359. 3710    HAPPEN=0
  360. 3715    IF S<10 THEN GOTO 3765
  361. 3720    IF S=10 THEN HAPPEN=3                   :GOTO 3765
  362. 3730    IF S=11 THEN HAPPEN=4:REVERSE=REVERSE*-1:GOTO 3765
  363. 3740    IF S=12 THEN HAPPEN=2                   :GOTO 3765
  364. 3750    IF S=13 THEN GOSUB *H.SEARCH2           :GOTO 3765
  365. 3760    HAPPEN=1:GOSUB *H.SEARCH2
  366. 3765 RETURN
  367. 3770 *H.SEARCH2
  368. 3775    IF WAO(PLAYER) AND K(PLAYER)=1 THEN 3840
  369. 3780    GOSUB *ERASE.LINE:WF=-1:IF PLAYER<4 THEN 3830
  370. 3790    GOSUB *WILD.CO:GOTO 3840:
  371. 3830    PRINT P_NAME$(PLAYER);" : ";CARD$(S);" !  色を 「";AKCNV$(MID$(COL1$,TK_C,1));"」 にする!";:FOR LP=1 TO 2700:NEXT
  372. 3831    ON TK_C GOTO 3832,3833,3834,3835
  373. 3832      COLOR 1:LOCATE 62,5:PRINT "青色":COLOR 7:BA_C=1:GOTO 3840
  374. 3833      COLOR 2:LOCATE 62,5:PRINT "赤色":COLOR 7:BA_C=2:GOTO 3840
  375. 3834      COLOR 4:LOCATE 62,5:PRINT "緑色":COLOR 7:BA_C=4:GOTO 3840
  376. 3835      COLOR 6:LOCATE 62,5:PRINT "黄色":COLOR 7:BA_C=6:GOTO 3840
  377. 3840 RETURN
  378. 3850 '----------------------- WDF / D / R / S 処理の分岐
  379. 3860 *HAPPENNING
  380. 3880    HAP=HAPPEN:HAPPEN=0:ON HAP GOTO *WDF,*TDRAW,*SKIP,*REVERSE
  381. 3890 '----------------------- DRAW TWO の処理
  382. 3900 *TDRAW
  383. 3910    GOSUB *ERASE.LINE:IF PLAYER=4 THEN 3930
  384. 3920    PRINT "CM";AKCNV$(RIGHT$(STR$(PLAYER),1));
  385. 3925    PRINT "さんはカードを2枚取ります。";:GOTO 3940
  386. 3930    PRINT "YOUには、カードを2枚取ってもらいます。";
  387. 3940    FOR LP=1 TO 1000:NEXT:MAI=2:GOSUB *TDRAW.CARD
  388. 3950    GOSUB *ERASE.LINE:IF PLAYER<4 THEN PRINT"あ-あ・・・・";
  389. 3960    GOTO *NEXT.P
  390. 3970 '----------------------- SKIP の処理
  391. 3980 *SKIP
  392. 3990    GOSUB *ERASE.LINE:IF PLAYER=4 THEN 4010
  393. 4000    PRINT "CM";AKCNV$(RIGHT$(STR$(PLAYER),1));
  394. 4005    PRINT "さんはSKIPされました。";:GOTO 4020
  395. 4010    PRINT "YOUは、SKIPされました。";
  396. 4020    FOR LP=1 TO 2700:NEXT:GOSUB *ERASE.LINE:GOTO *MAIN
  397. 4030 '----------------------- REVERSE の処理
  398. 4040 *REVERSE
  399. 4050    GOSUB *ERASE.LINE:PRINT"REVERSEが出たので、回り方が";
  400. 4060    IF REVERSE=1 THEN PRINT"上から下"; ELSE PRINT"下から上";
  401. 4070    PRINT"となります";:FOR LP=1 TO 2700:NEXT:GOTO 2160
  402. 4080 '----------------------- WILD DRAW FOUR の処理
  403. 4090 *WDF
  404. 4100    GOSUB *ERASE.LINE:IF PLAYER<4 THEN *COM.WDF
  405. 4110   'PRINT P.NAME$(4);"は、チャレンジをしますか? : ";
  406. 4113    SENTAKU1$="チャレンジしますか?":SENTAKU2$="YES  NO"
  407. 4115    GOSUB *SENTAKU
  408. 4120    IF SEN=1 THEN 4160
  409. 4130    GOSUB *ERASE.LINE:PRINT P_NAME$(4);"は、カードを4枚取ってもらいます!"
  410. 4140    FOR LP=1 TO 1000:NEXT
  411. 4150    MAI=4:GOSUB *TDRAW.CARD:GOTO *NEXT.P
  412. 4160    PLAYER1=PLAYER:PLAYER=BA_P
  413. 4170    PLAYER=PLAYER1:CHA=0
  414. 4180    DF_PLAYER=BA_P
  415. 4190    CHARENGE=0:PF=0
  416. 4193    FOR X=1 TO KOJIN_MAX
  417. 4195      IF M_CARD(DF_PLAYER,X)\100=SITA_C THEN PF=-1:CHARENGE=-1:XS=X:PUT_X=X:X=KOJIN_MAX
  418. 4200    NEXT
  419. 4205    IF PF=-1 THEN PF=0:X=XS
  420. 4210    FOR LP=1 TO 2700:NEXT
  421. 4215    GOSUB *ERASE.LINE:COLOR 7:IF CHARENGE THEN 4230
  422. 4220    PRINT"チャレンジ失敗!";:BEEP:MAI=6:GOSUB *TDRAW.CARD:GOTO *NEXT.P
  423. 4230    PRINT"チャレンジ成功!";:BEEP:MAI=4:PLAYER=DF_PLAYER
  424. 4240    PF=0:FOR X=1 TO KOJIN_MAX:IF M_CARD(PLAYER,X)=0 THEN PF=-1:XS=X:X=KOJIN_MAX:'4260
  425. 4250    NEXT:IF PF=-1 THEN PF=0:X=XS:GOTO 4260:'GOTO *NAGARE
  426. 4255    GOTO *NAGARE
  427. 4260    M_CARD(PLAYER,X)=514:K(PLAYER)=K(PLAYER)+1:P_POINT=P_POINT-1:BA_C=SITA_C:BA_N=SITA_N:IF PLAYER<4 THEN GOSUB *POOR.COM ELSE GOSUB *POOR.MAN
  428. 4270    GOSUB *TDRAW.CARD:GOTO *NEXT.P
  429. 4275 '-----------------------
  430. 4280 *POOR.MAN
  431. 4290    FOR X=PUT_X TO KOJIN_MAX
  432. 4295     IF NOT M_CARD(PLAYER,X)\100=BA_C THEN 4310
  433. 4300     GOSUB *ERASE.LINE:COLOR COL(BA_C):PRINT"※";:COLOR 7
  434. 4305     PRINT MID$(COL1$,BA_C,1);"の";AKCNV$(CARD$(M_CARD(PLAYER,X)MOD 100));
  435. 4307     PRINT "を出していいですか? (Y/N) : ";
  436. 4308     SENTAKU1$="出してもいい":SENTAKU2$="YES    NO"
  437. 4309     PF=0:IF SEN=1 THEN PF=-1:XS=X:X=KOJIN_MAX:'4340
  438. 4310   NEXT
  439. 4315  IF PF=-1 THEN PF=0:X=XS:GOTO 4340 ELSE 4290
  440. 4318 '-----------------------
  441. 4320 *POOR.COM
  442. 4330    X=PUT_X
  443. 4340    SITA_C=BA_C:SITA_N=BA_N:CARD=P_POINT
  444. 4345    CARD(P_POINT)=M_CARD(PLAYER,X):M_CARD(PLAYER,X)=0:P_POINT=P_POINT+1
  445. 4350    GOSUB *CARD.FNC:S=CARD_N:GOSUB *H.SEARCH:BA_C=CARD_C:BA_N=CARD_N
  446. 4355    BA_P=PLAYER:BA_X=P_POINT:K(PLAYER)=K(PLAYER)-1:GET_C=0
  447. 4358 RETURN
  448. 4360    GOSUB *H.SEARCH:BEEP 1:BA_C=CARD_C:BA_N=CARD_N:BA_P=PLAYER
  449. 4370    K(PLAYER)=K(PLAYER)-1:K1(PLAYER,CARD_C)=K1(PLAYER,CARD_C)-1:BEEP 0
  450. 4380 *COM.WDF
  451. 4390    IF WAO(PLAYER) THEN 4410
  452. 4400    IF K(BA_P)>=10 OR RND<.5! OR PLAYER=TAKO THEN GOSUB *ERASE.LINE:PRINT P_NAME$(PLAYER);" : チャレンジだ!!";:GOTO 4180
  453. 4410    PRINT P_NAME$(PLAYER);" : ちぇっ!しゃあない。4枚もらうとするか・・・。";:GOTO 4140
  454. 4420 '----------------------- カードをひくSUBルーチン
  455. 4430 *TDRAW.CARD
  456. 4440    CARD_P=0:IF PLAYER=4 THEN CARD_P=-1
  457. 4450    FOR LP=1 TO MAI:PF=0
  458. 4460      FOR X=1 TO KOJIN_MAX:PF=0
  459. 4465        IF M_CARD(PLAYER,X)=0 THEN XS=X:X=KOJIN_MAX:PF=-1
  460. 4470      NEXT X
  461. 4475      IF PF=-1 THEN PF=0:X=XS:GOTO 4480 ELSE X=XS:PF=-2:LP=MAI:GOTO 4633
  462. 4480      COLOR 7:LOCATE 58,4:PRINT "残り":LOCATE 66,4:PRINT "枚"
  463. 4485      M_CARD(PLAYER,X)=CARD(D_POINT):D_POINT=D_POINT+1:COLOR 7
  464. 4487      LOCATE 62,4:PRINT USING"####";109-D_POINT
  465. 4489      IF D_POINT>108 THEN PF=-3:LP=MAI:GOTO 4633
  466. 4500      K(PLAYER)=K(PLAYER)+1
  467. 4510      CARD=D_POINT-1:GOSUB *CARD.FNC:C=CARD_C:N=CARD_N
  468. 4515      IF PLAYER=4 THEN CPUT_X=560:CPUT_Y=143:ELSE CPUT_X=565:CPUT_Y=176
  469. 4520      GOSUB *CARD.DISP
  470. 4530      'GOSUB *ERASE.LINE:COLOR 4:PRINT LP;"マイ ・・・・・  ";
  471. 4535      IF PLAYER=4 THEN LINE(560,143)-(624,243),PSET,0,BF:CPUT_X=565:CPUT_Y=176:CARD_P=0:GOSUB *CARD.DISP
  472. 4540      IF PLAYER=4 OR MAI=1 THEN 4620
  473. 4550      IF PLAYER<>TAKO AND RND<.5! THEN IF RND<.2! THEN N=INT(RND*15) ELSE GOSUB *ERASE.LINE:PRINT"うぅ~む・・・";:GOTO 4620
  474. 4560      IF N=14 THEN GOSUB *ERASE.LINE:PRINT"げげげぇ~! うおぉぉ!!"
  475. 4570      IF N=13 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"へへへぇーだ!"; ELSE GOSUB *ERASE.LINE:PRINT"あらまあ、きたきた!"
  476. 4580      IF N=12 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"今に見とれよぉ~ !"; ELSE GOSUB *ERASE.LINE:PRINT"おのれ~、ぶっ殺すぞ~!!"
  477. 4590      IF N<12 AND N>9 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"おっとー!  "; ELSE GOSUB *ERASE.LINE:PRINT"来てしまったぞ~!";
  478. 4600      IF N<10 AND N>4 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"んったくもうーやだなあ!!";ELSE GOSUB *ERASE.LINE:PRINT"いらねーのがきたなあ!";
  479. 4610      IF N<5 THEN GOSUB *ERASE.LINE:PRINT"あららあぁ";:IF N=0 THEN GOSUB *ERASE.LINE:PRINT "まあ、なんとかなるでしょう・・";
  480. 4620      FOR LPLP=1 TO 300:NEXT
  481. 4625      IF PLAYER=4 THEN LINE(595,270)-(619,381),PSET,0,BF
  482. 4630      X1=X
  483. 4633    NEXT LP
  484. 4634    IF PF=-2 THEN PF=0:RETURN *NAGARE
  485. 4635    IF PF=-3 THEN PF=0:RETURN *OVER.108
  486. 4639 RETURN
  487. 4640 '----------------------- 山のカードをすべて使いきったので流れる
  488. 4650 *OVER.108
  489. 4660    BEEP:GOSUB *ERASE.LINE
  490. 4665    PRINT "山のカードが無くなったので、これで流れです。";
  491. 4670    FOR LP=1 TO 10000:NEXT:GOTO *INIT.3
  492. 4680 '----------------------- 個人のカードが多すぎて流れ
  493. 4690 *NAGARE
  494. 4700    BEEP:GOSUB *ERASE.LINE:PRINT"これ以上カードは持てません。";
  495. 4705    FOR LP=1 TO 5000:NEXT
  496. 4710    BEEP:GOSUB *ERASE.LINE:PRINT"「";P_NAME$(PLAYER);
  497. 4715    PRINT "」のカードが20枚を越えたので流れです。";
  498. 4720    FOR LP=1 TO 10000:NEXT:GOTO *INIT.3
  499. 4730 '----------------------- COMput@ aER PLAYER の思考ルーチン
  500. 4740 *COM.THINK
  501. 4750    'GOSUB *ERASE.LINE:PRINT"COM 「";P.NAME$(PLAYER);"」 ノ バンデス !";
  502. 4760    IF WAO(PLAYER) THEN GOSUB *THINK.CARD:IF X>=0 THEN 4890
  503. 4770    IF PLAYER=TAKO THEN 4820
  504. 4780    UP=PLAYER+REVERSE:IF UP>4 THEN UP=1 ELSE IF UP<1 THEN UP=4
  505. 4790    IF WAO(UP) THEN *THINK.WAO
  506. 4800    F=-1:GOSUB *THINK.CARD:F=0:X_SUB=X
  507. 4805    IF S=14 AND RND<.2! THEN GOSUB *THINK.WDF:GOTO 4840
  508. 4810    X=X_SUB:IF X>=0 THEN 4890
  509. 4820    GOSUB *THINK.CARD:IF X>=0 THEN 4890
  510. 4830    CAN=0:IF S=14 THEN GOSUB *THINK.WDF ELSE IF S=13 THEN GOSUB *THINK.W
  511. 4840    IF CAN THEN 4890
  512. 4850    GOSUB *ERASE.LINE:COLOR 7
  513. 4855    PRINT P_NAME$(PLAYER);:
  514. 4857    PRINT " : しゃあない、1枚取るとするかあ。あ~あ・・・・";
  515. 4858    GET_C=-1:FOR WT=1 TO 1000:NEXT
  516. 4860    MAI=1:GOSUB *TDRAW.CARD:X=X1:IF N<13 AND(C=BA_C OR N=BA_N)THEN 4890
  517. 4870    IF N=13 THEN S=13:GOSUB *THINK.W:IF CAN THEN 4890
  518. 4880    GET_C=0:GOTO *NEXT.P
  519. 4890    GOSUB *ERASE.LINE:PRINT P_NAME$(PLAYER);" : ヨッシャー! だすぞ!!";:IF GET_C THEN PRINT"出せるものをつもったぜ!";:FOR WT=1 TO 1000:NEXT
  520. 4900    CAN=X:GOSUB *PUT_CARD
  521. 4905    GOTO *NEXT.P
  522. 4910 '----------------------- 0-9,DT,RVS,S を出すかどうか
  523. 4920 *THINK.CARD
  524. 4930    K=0:S=0:MAX=0:X1=0:FOR X=1 TO KOJIN_MAX:IF M_CARD(PLAYER,X)=0 THEN 4980
  525. 4940    CARD_C=M_CARD(PLAYER,X)\100:CARD_N=M_CARD(PLAYER,X)MOD 100:IF CARD_N>12 THEN S=CARD_N:IF WAO(PLAYER) THEN IF S=14 THEN *THINK.WDF ELSE *THINK.W
  526. 4950    IF CARD_C=BA_C AND CARD_N>=MAX THEN MAX=CARD_N:X1=X:IF PLAYER=TAKO AND RND<.5! THEN X=X1:RETURN
  527. 4960    IF CARD_C=BA_C AND CARD_N=0 AND NOT F THEN RETURN
  528. 4970    IF CARD_N=BA_N AND BA_N<13 THEN RETURN
  529. 4980    NEXT:IF X1>0 THEN X=X1:RETURN
  530. 4990    X=-1:RETURN
  531. 5000 '----------------------- WDF を出すかどうか
  532. 5010 *THINK.WDF
  533. 5020    IF K(PLAYER)=2 THEN CAN=0:GOTO 5085
  534. 5030    X=0:PF=0
  535. 5035    FOR I=1 TO KOJIN_MAX
  536. 5040      IF M_CARD(PLAYER,I) MOD 100=14 THEN X=I
  537. 5050      IF M_CARD(PLAYER,I)\100=BA_C THEN PF=-1:XS=I:I=KOJIN_MAX
  538. 5060    NEXT
  539. 5065    IF PF=-1 THEN PF=0:I=XS:GOTO 5080
  540. 5070    GOSUB *THINK.COLOR:CARD_N=14:CAN=-1:GOTO 5085
  541. 5080    IF X=0 THEN ELSE IF PLAYER=TAKO OR RND<.5! THEN 5070 ELSE CAN=0
  542. 5085 RETURN
  543. 5090 '----------------------- W を出すかどうか
  544. 5100 *THINK.W
  545. 5105    PF=0
  546. 5110    IF K(PLAYER)>5 OR K(PLAYER)=2 THEN 5150
  547. 5120    FOR I=1 TO KOJIN_MAX
  548. 5125      IF M_CARD(PLAYER,I)  \  100=BA_C THEN PF=-1:XS=I:I=KOJIN_MAX:'5150
  549. 5130      IF M_CARD(PLAYER,I) MOD 100=13   THEN X=I
  550. 5140    NEXT
  551. 5142    IF PF=-1 THEN PF=0:I=XS:GOTO 5150
  552. 5145    GOSUB *THINK.COLOR:CARD_N=13:CAN=-1:RETURN
  553. 5150    CAN=0:RETURN
  554. 5160 '----------------------- W / WDF の色を何にするのかを考える
  555. 5170 *THINK.COLOR
  556. 5180    DIM K1(5)
  557. 5183    FOR I=1 TO KOJIN_MAX
  558. 5185      K1=M_CARD(PLAYER,I)\100:K1(K1)=K1(K1)+1
  559. 5188    NEXT
  560. 5190    TK_C=0:K1=0
  561. 5195    FOR I=1 TO 4
  562. 5198      IF K1(I)>K1 THEN TK_C=I:K1=K1(I)
  563. 5200    NEXT
  564. 5210    IF TK_C=BA_C OR TK_C=0 OR TK_C=5 OR (PLAYER=TAKO AND RND<.2!)THEN TK_C=INT(RND*4)+1:GOTO 5210
  565. 5220    ERASE K1
  566. 5225 RETURN
  567. 5230 '----------------------- 次の人がUNOになっている時
  568. 5240 *THINK.WAO
  569. 5245    PF=0
  570. 5250    FOR X=1 TO KOJIN_MAX
  571. 5255      CARD_C=M_CARD(PLAYER,X)\ 100:CARD_N=M_CARD(PLAYER,X) MOD 100
  572. 5260      IF CARD_N=14 THEN GOSUB *THINK.COLOR:PF=-1:XS=X:X=KOJIN_MAX:GOTO 5300
  573. 5270      IF CARD_C<>BA_C THEN 5290
  574. 5280      IF CARD_N<13 AND CARD_N>9 THEN PF=-1:XS=X:X=KOJIN_MAX:GOTO 5300
  575. 5290      IF CARD_N=13 THEN GOSUB *THINK.COLOR:PF=-1:XS=X:X=KOJIN_MAX
  576. 5300    NEXT
  577. 5302    X=XS:IF PF=-1 THEN PF=0:GOTO 4890
  578. 5305 GOTO 4800
  579. 5310 '-----------------------------------------------------------
  580. 5320 '          プログラムはこれで終わりです
  581. 5350 '-----------------------------------------------------------
  582. 10000 *INIT.CARD :'*********  カードの図柄を読み込む  ***********
  583. 10010 '------------------------------------------------ Suuji Torikomi
  584. 10030   FOR IR=0 TO 7:COLOR=(IR,IR):NEXT IR
  585. 10040   LOAD @"A:UNOWAO_S.TIF"
  586. 10070 '------------------------------------------------ Hensuu Dimenjon
  587. 10080   HE=VAL(RIGHT$(TIME$,2)):RANDOMIZE HE
  588. 10090   'DIM GA%(2700)
  589. 10100 '------------------------------------------------ Blue get@ a
  590. 10110   'DIM CB%(19500)
  591. 10120   FOR GB=0 TO 630 STEP 63
  592. 10130     GET@ A(GB,0)-(GB+63,95),CB%,BG:BG=BG+2700
  593. 10140     IF BG>24300 THEN 10160 ELSE 10150
  594. 10150   NEXT GB
  595. 10160 '------------------------------------------------ Red get@ a
  596. 10170   'DIM CR%(19500)
  597. 10180   FOR GR=0 TO 630 STEP 63
  598. 10190     GET@ A(GR,95)-(GR+63,190),CR%,RG:RG=RG+2700
  599. 10200     IF RG>24300 THEN 10220 ELSE 10210
  600. 10210   NEXT GR
  601. 10220 '------------------------------------------------ Green get@ a
  602. 10230   'DIM CG%(19500)
  603. 10240   FOR GG=0 TO 630 STEP 63
  604. 10250     GET@ A(GG,190)-(GG+63,285),CG%,GGG:GGG=GGG+2700
  605. 10260     IF GGG>24300 THEN 10280 ELSE 10270
  606. 10270   NEXT GG
  607. 10280 '------------------------------------------------ Yellow get@ a
  608. 10290   'DIM CY%(19500)
  609. 10300   FOR GY=0 TO 630 STEP 63
  610. 10310     GET@ A(GY,285)-(GY+63,380),CY%,YG:YG=YG+2700
  611. 10320     IF YG>24300 THEN 10340 ELSE 10330
  612. 10330   NEXT GY
  613. 10340 '------------------------------------------------ Moji Torikomi
  614. 10350   CLS 5
  615. 10355   GOSUB *BRACK
  616. 10360   LOAD @"A:UNOWAO_M.tif"
  617. 10390 '------------------------------------------------ Draw Two get@ a
  618. 10400   GET@ A(0,  0)-(63, 95),CB%,BG:BG=BG+2700
  619. 10410   GET@ A(0, 95)-(63,190),CR%,RG:RG=RG+2700
  620. 10420   GET@ A(0,190)-(63,285),CG%,GGG:GGG=GGG+2700
  621. 10430   GET@ A(0,285)-(63,380),CY%,YG:YG=YG+2700
  622. 10440 '------------------------------------------------ Skip get@ a
  623. 10450   GET@ A(63,  0)-(126, 95),CB%,BG:BG=BG+2700
  624. 10460   GET@ A(63, 95)-(126,190),CR%,RG:RG=RG+2700
  625. 10470   GET@ A(63,190)-(126,285),CG%,GGG:GGG=GGG+2700
  626. 10480   GET@ A(63,285)-(126,380),CY%,YG:YG=YG+2700
  627. 10490 '------------------------------------------------ Reverse get@ a
  628. 10500   GET@ A(126,  0)-(189, 95),CB%,BG
  629. 10510   GET@ A(126, 95)-(189,190),CR%,RG
  630. 10520   GET@ A(126,190)-(189,285),CG%,GGG
  631. 10530   GET@ A(126,285)-(189,380),CY%,YG
  632. 10540 '------------------------------------------------ Wild Wild Draw Four get@ a
  633. 10550   'DIM CWI%(2700)
  634. 10560   FOR GWI=0 TO 399 STEP 95
  635. 10570     GET@ A(189,GWI)-(252,GWI+95),CWI%,WIG:WIG=WIG+2700
  636. 10580     IF WIG>2700 THEN 10600 ELSE 10590
  637. 10590   NEXT GWI
  638. 10600 '------------------------------------------------ Teki Card get@ a
  639. 10610   'DIM CTE%(2700)
  640. 10620   GET@ A(300,0)-(337,62),CTE%
  641. 10630 RETURN
  642. 10640 '*****************************************************************
  643. 10650 *TITLE.DISP:'*******  ゲームのタイトルを表示する  *******
  644. 10660 '------------------------------------------------ On Goto 1
  645. 10670   CLS
  646. 10680   SI=INT(RND(1)*6)+1:'IF SI=5 THEN SU=INT(RND(1)*2)+13 ELSE SU=INT(RND(1)*13)
  647. 10690   X=INT(RND(1)*570):Y=INT(RND(1)*95):CM=CM+1
  648. 10700   IF CM=50 THEN GOTO 11000 ELSE 10710
  649. 10710   ON SI GOTO *BLUE,*RED,*GREEN,*YELL,*WILD,*TEKI
  650. 10720 '------------------------------------------------ Blue put@ a
  651. 10730 *BLUE
  652. 10740   BH=INT(RND(1)*13)
  653. 10750   BLA=BH*2700
  654. 10760   PUT@ A(X,Y)-(X+63,Y+96),CB%,,,,,BLA:GOTO 10680
  655. 10770 '------------------------------------------------ Red put@ a
  656. 10780 *RED
  657. 10790   RH=INT(RND(1)*13)
  658. 10800   REA=RH*2700
  659. 10810   PUT@ A(X,Y)-(X+63,Y+96),CR%,,,,,REA:GOTO 10680
  660. 10820 '------------------------------------------------ Green put@ a
  661. 10830 *GREEN
  662. 10840   GH=INT(RND(1)*13)
  663. 10850   GEA=GH*2700
  664. 10860   PUT@ A(X,Y)-(X+63,Y+96),CG%,,,,,GEA:GOTO 10680
  665. 10870 '------------------------------------------------ Yellow put@ a
  666. 10880 *YELL
  667. 10890   YH=INT(RND(1)*13)
  668. 10895   YH=12
  669. 10900   YEA=YH*2700
  670. 10910   PUT@ A(X,Y)-(X+63,Y+96),CY%,,,,,YEA:GOTO 10680
  671. 10920 '------------------------------------------------ Wild Wild Draw Four put@ a
  672. 10930 *WILD
  673. 10940   WHE=INT(RND(1)*2)
  674. 10950   WHA=WHE*2700
  675. 10960   PUT@ A(X,Y)-(X+63,Y+96),CWI%,,,,,WHA:GOTO 10680
  676. 10970 '------------------------------------------------ Teki Card put@ a
  677. 10980 *TEKI
  678. 10990   PUT@ A(X,Y)-(X+38,Y+63),CTE%:GOTO 10680
  679. 11000 '------------------------------------------------ Gamen 1
  680. 11010   ::WIDTH 80,25
  681. 11020   LINE(11,200)-(11,315),PSET,1:LINE(11,200)-(26,200),PSET,1
  682. 11030   LINE(201,200)-(201,315),PSET,1:LINE(201,200)-(187,200),PSET,1
  683. 11040   LINE(26,200)-(26,315),PSET,1:LINE(187,200)-(187,315),PSET,1
  684. 11050   CIRCLE(106,315),94,1,.87!,0,.5!:CIRCLE(106,315),80,1,.87!,0,.5!
  685. 11060   PAINT(20,205),1,1
  686. 11070   LINE(225,200)-(225,396),PSET,2:LINE(225,200)-(240,200),PSET,2
  687. 11080   LINE(225,396)-(240,396),PSET,2:LINE(414,200)-(414,396),PSET,2
  688. 11090   LINE(414,200)-(399,200),PSET,2:LINE(414,396)-(399,396),PSET,2
  689. 11100   LINE(240,220)-(240,396),PSET,2:LINE(399,376)-(399,200),PSET,2
  690. 11110   LINE(240,200)-(399,376),PSET,2
  691. 11120   LINE(240,220)-(399,396),PSET,2:PAINT(233,210),2,2
  692. 11130   CIRCLE(532,300),97,4,1,0,1
  693. 11140   CIRCLE(532,300),83,4,1,0,1:PAINT(532,206),4,4
  694. 11150   RETURN
  695. 11300 '---------------------- 初期画面設定
  696. 11310 *MAKE.S
  697. 11320   WIDTH 80,20:CLS:LINE(0,0)-(639,399),PSET,5,B:LINE(10,10)-(450,83),PSET,5,B
  698. 11330   LINE(10,89)-(450,166),PSET,5,B:LINE(10,172)-(450,246),PSET,5,B
  699. 11340   LINE(460,10)-(629,246),PSET,5,B:LINE(10,256)-(629,389),PSET,5,B
  700. 11350   LINE(594,269)-(620,382),PSET,7,B:LINE(475,140)-(548,241),PSET,7,B
  701. 11360   LINE(36,10)-(36,83),PSET,5,,&H8888:LINE(36,92)-(36,167),PSET,5,,&H8888
  702. 11370   LINE(36,175)-(36,245),PSET,5,,&H8888:LINE(36,260)-(36,390),PSET,5,,&H8888
  703. 11380   LINE(36,280)-(486,280),PSET,5,,&H8888:PAINT(2,2),1,5
  704. 11390   COLOR 7
  705. 11400   SYMBOL(2*7.9875!,1*19.2!),"C",1,1,7:SYMBOL(2*7.9875!,2*19.2!),"M",1,1,7:SYMBOL(2*7.9875!,3*19.2!),"1",1,1,7
  706. 11410   SYMBOL(2*7.9875!,(5*19.2!)+2),"C",1,1,7:SYMBOL(2*7.9875!,(6*19.2!)+3),"M",1,1,7:SYMBOL(2*7.9875!,(7*19.2!)+5),"2",1,1,7
  707. 11420   SYMBOL(2*7.9875!,(9*19.2!)+5),"C",1,1,7:SYMBOL(2*7.9875!,(10*19.2!)+7!),"M",1,1,7:SYMBOL(2*7.9875!,(11*19.2!)+9),"3",1,1,7
  708. 11430   LOCATE  2,12:PRINT "Y":LOCATE  2,13:PRINT "O":LOCATE  2,14:PRINT "U"
  709. 11440   LOCATE 75,12:PRINT "U":LOCATE 75,13:PRINT "N":LOCATE 75,14:PRINT "O"
  710. 11450   COLOR 5:LOCATE  5,11:PRINT "メッセージ:":COLOR 7:Z=1:COLOR 7
  711. 11460  'FOR G=1 TO 3:LOCATE 46,Z:PRINT "SCORE":Z=Z+2.7!:NEXT G
  712. 11461   LOCATE 46,1:PRINT "SCORE":LOCATE 46,4:PRINT "SCORE":LOCATE 46,8:PRINT "SCORE"
  713. 11463   LOCATE 65,12:PRINT "SCORE":U=1
  714. 11465   FOR G=1 TO 3:Z=-(G=1)*1-(G=2)*4-(G=3)*8:LOCATE 44,Z+1
  715. 11466     PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(U)),4));"点":U=U+1
  716. 11467   NEXT G
  717. 11468   LOCATE 63,13:PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(4)),4));"点"
  718. 11470  LINE(464,15)-(464,70),PSET,1:LINE(468,15)-(468,70),PSET,1:LINE(510,15)-(510,70),PSET,1
  719. 11480   LINE(514,15)-(514,70),PSET,1:LINE(464,15)-(468,15),PSET,1:LINE(510,15)-(514,15),PSET,1
  720. 11490   CIRCLE(489,70),25,1,1,0,.5!:CIRCLE(489,70),21,1,1,0,.5!
  721. 11500   PAINT(466,18),1,1
  722. 11510   LINE(519,15)-(519,94),PSET,2:LINE(519,15)-(523,15),PSET,2:LINE(569,15)-(569,94),PSET,2
  723. 11520   LINE(569,94)-(565,94),PSET,2:LINE(519,94)-(523,94),PSET,2:LINE(569,15)-(565,15),PSET,2
  724. 11530   LINE(523,94)-(523,22),PSET,2:LINE(565,15)-(565,87),PSET,2:LINE(523,22)-(565,94),PSET,2
  725. 11540   LINE(523,15)-(565,87),PSET,2
  726. 11550   PAINT(520,18),2,2:CIRCLE(599,55),26,4,1.5!,0,1
  727. 11560   CIRCLE(599,55),22,4,1.5!,0,1:PAINT(600,18),4,4
  728. 11570  RETURN
  729. 12670 *INPUT_CARD2:'----------------------------------- Card Wo Dasu(Hantei)
  730. 12680   XX=MOUSE(0):YY=MOUSE(1)
  731. 12685   IF MOUSE(2,0)=0 THEN 12680
  732. 12687   DCE=(K(4)*HA1)+(64-HA1)+40
  733. 12690   IF (MOUSE(0)>= 40 AND MOUSE(0)<=DCE) AND (MOUSE(1)>=282 AND MOUSE(1)<=377) THEN 12700 ELSE 12695
  734. 12695   IF (MOUSE(0)>=565 AND MOUSE(0)<=603) AND (MOUSE(1)>=176 AND MOUSE(1)<=239) THEN AA=0:GOTO 12720 ELSE 12696
  735. 12696   IF (MOUSE(0)>=549 AND MOUSE(0)<=620) AND (MOUSE(1)>=269 AND MOUSE(1)<=382) THEN GOSUB *UNO.SENGEN:GOTO 12680 ELSE 12680
  736. 12700   AA=INT((XX-40)/HA1)+1:IF AA<1 OR AA>K(4) THEN 12680:
  737. 12720   TAKE=AA:CARD=AA
  738. 12750 RETURN
  739. 14160 '------------------------------------------------
  740. 14165 *SENTAKU
  741. 14166   LOCATE 46,9:PRINT SPC(8):LOCATE 47,10:PRINT SPC(8)
  742. 14170   GET@ A(240,150)-(405,240),GA%
  743. 14175   LINE(240,150)-(405,240),PSET,0,BF
  744. 14180   LINE(240,150)-(405,240),PSET,7,B:LINE(241,151)-(404,239),PSET,2,BF
  745. 14190   LINE(262,200)-(312,219),PSET,7,B:LINE(263,201)-(311,218),PSET,1,BF
  746. 14200   LINE(332,200)-(384,219),PSET,7,B:LINE(333,201)-(383,218),PSET,1,BF
  747. 14205   COLOR 7
  748. 14210   SYMBOL(31*8,7*24),SENTAKU1$+"       ",1,1,7
  749. 14220   SYMBOL(33*(639/79),8*(480/20)+10),SENTAKU2$,1,1,7
  750. 14225   LOCATE 31, 8:PRINT "                          " 
  751. 14230   XX=MOUSE(0):YY=MOUSE(1):
  752. 14240   IF MOUSE(2,0)=-1 AND XX=>262 AND XX=<312 THEN 14250 ELSE 14260
  753. 14250   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<219 THEN 14350 ELSE 14260
  754. 14260   XX=MOUSE(0):YY=MOUSE(1)
  755. 14270   IF MOUSE(2,0)=-1 AND XX=>332 AND XX=<384 THEN 14280 ELSE 14230
  756. 14280   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<219 THEN 14290 ELSE 14230
  757. 14290   '
  758. 14300   LINE(333,201)-(383,218),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  759. 14310   LINE(333,201)-(383,218),PSET,1,BF:PUT@ A(240,150)-(405,240),GA%,PSET
  760. 14320   LOCATE 27, 7:PRINT SPC(30)
  761. 14330   LOCATE 33, 8:PRINT SPC(20):SEN=2
  762. 14340   GOTO 14365
  763. 14345   '
  764. 14350   LINE(263,201)-(311,218),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  765. 14360   LINE(263,201)-(311,218),PSET,1,BF:PUT@ A(240,150)-(405,240),GA%,PSET
  766. 14362   LOCATE 27, 7:PRINT SPC(30)
  767. 14363   LOCATE 33, 8:PRINT SPC(20):SEN=1
  768. 14365   LOCATE 44,8:PRINT "SCORE":LOCATE 44,9:PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(3)),4));"点"
  769. 14366 RETURN
  770. 14460 '------------------------------------------------ End / Game ?
  771. 14465 *SENTAKU2
  772. 14466   SSX=SX-150:SSY=SY-150
  773. 14470   GET@ A(240+SSX,150+SSY)-(405+SSX,240+SSY),GA%
  774. 14475   LINE(240+SSX,150+SSY)-(405+SSX,240+SSY),PSET,0,BF
  775. 14480   LINE(240+SSX,150+SSY)-(405+SSX,240+SSY),PSET,7,B:LINE(241+SSX,151+SSY)-(404+SSX,239+SSY),PSET,2,BF
  776. 14490   LINE(262+SSX,200+SSY)-(312+SSX,219+SSY),PSET,7,B:LINE(263+SSX,201+SSY)-(311+SSX,218+SSY),PSET,1,BF
  777. 14500   LINE(332+SSX,200+SSY)-(384+SSX,219+SSY),PSET,7,B:LINE(333+SSX,201+SSY)-(383+SSX,218+SSY),PSET,1,BF
  778. 14505   COLOR 7
  779. 14510   SYMBOL(31*8+SSX,8*20+SSY),SENTAKU1$,1,1,7,,,1
  780. 14520   SYMBOL(33*(639/79)+SSX,8*(480/20)+10+SSY),SENTAKU2$,1,1,7,,,1
  781. 14530   XX=MOUSE(0):YY=MOUSE(1):
  782. 14540   IF MOUSE(2,0)=-1 AND XX=>262+SSX AND XX=<312+SSX THEN 14550 ELSE 14560
  783. 14550   IF MOUSE(2,0)=-1 AND YY=>200+SSY AND YY=<219+SSY THEN 14650 ELSE 14560
  784. 14560   XX=MOUSE(0):YY=MOUSE(1)
  785. 14570   IF MOUSE(2,0)=-1 AND XX=>332+SSX AND XX=<384+SSX THEN 14580 ELSE 14530
  786. 14580   IF MOUSE(2,0)=-1 AND YY=>200+SSY AND YY=<219+SSY THEN 14590 ELSE 14530
  787. 14590   '
  788. 14600   LINE(333,201)-(383,218),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  789. 14610   LINE(333,201)-(383,218),PSET,1,BF:PUT@ A(240,150)-(405,240),GA%,PSET
  790. 14630   SEN=2
  791. 14640   GOTO 14665
  792. 14645   '
  793. 14650   LINE(263+SSX,201+SSY)-(311+SSX,218+SSY),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  794. 14660   LINE(263+SSX,201+SSY)-(311+SSX,218+SSY),PSET,1,BF:PUT@ A(240+SSX,150+SSY)-(405+SSX,240+SSY),GA%,PSET
  795. 14663   SEN=1
  796. 14666 RETURN
  797. 15170 '------------------------------------------------ Wild No Iro
  798. 15175 *WILD.CO
  799. 15176   LOCATE 46,9:PRINT SPC(8):LOCATE 47,10:PRINT SPC(8)
  800. 15180   GET@ A(250,150)-(395,250),GA%
  801. 15185   LINE(250,150)-(395,240),PSET,7,B:LINE(251,151)-(394,239),PSET,2,BF
  802. 15190   LINE(269,200)-(289,220),PSET,7,B:LINE(293,200)-(313,220),PSET,7,B
  803. 15195   LINE(317,200)-(337,220),PSET,7,B:LINE(341,200)-(361,220),PSET,7,B
  804. 15200   LINE(270,201)-(288,219),PSET,1,BF:LINE(294,201)-(312,219),PSET,1,BF
  805. 15205   LINE(318,201)-(336,219),PSET,1,BF:LINE(342,201)-(360,219),PSET,1,BF
  806. 15210   SYMBOL(33*7.9875!,8*19.2!),"何色にしますか?",1,1,7
  807. 15215   SYMBOL(33*7.9875!,10*19.2!+10)," 青 赤 緑 黄",1,1,7
  808. 15216   LOCATE 44,8:PRINT "        "
  809. 15225   XX=MOUSE(0):YY=MOUSE(1)
  810. 15230   IF MOUSE(2,0)=-1 AND XX=>269 AND XX=<289 THEN 15235 ELSE 15240
  811. 15235   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15288 ELSE 15240
  812. 15240   XX=MOUSE(0):YY=MOUSE(1)
  813. 15245   IF MOUSE(2,0)=-1 AND XX=>293 AND XX=<313 THEN 15250 ELSE 15255
  814. 15250   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15300 ELSE 15255
  815. 15255   XX=MOUSE(0):YY=MOUSE(1)
  816. 15260   IF MOUSE(2,0)=-1 AND XX=>317 AND XX=<337 THEN 15265 ELSE 15270
  817. 15265   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15315 ELSE 15270
  818. 15270   XX=MOUSE(0):YY=MOUSE(1)
  819. 15275   IF MOUSE(2,0)=-1 AND XX=>341 AND XX=<361 THEN 15280 ELSE 15225
  820. 15280   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15330 ELSE 15225
  821. 15288   CARD_C=1:LINE(270,201)-(288,219),PSET,3,BF
  822. 15290     FOR G=1 TO 500:NEXT G
  823. 15292     LINE(270,201)-(288,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  824. 15295     COLOR 1:LOCATE 62,5:PRINT "青色":COLOR 7:TK_C=1:GOTO 15345
  825. 15300   CARD_C=2:LINE(294,201)-(312,219),PSET,3,BF
  826. 15305     FOR G=1 TO 500:NEXT G
  827. 15307     LINE(294,201)-(312,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  828. 15310     COLOR 2:LOCATE 62,5:PRINT "赤色":COLOR 7:TK_C=2:GOTO 15345
  829. 15315   CARD_C=3:LINE(318,201)-(336,219),PSET,3,BF
  830. 15320     FOR G=1 TO 500:NEXT G
  831. 15323     LINE(318,201)-(336,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  832. 15325     COLOR 4:LOCATE 62,5:PRINT "緑色":COLOR 7:TK_C=3:GOTO 15345
  833. 15330   CARD_C=4:LINE(342,201)-(360,219),PSET,3,BF
  834. 15335     FOR G=1 TO 500:NEXT G
  835. 15338     LINE(342,201)-(360,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  836. 15340     COLOR 6:LOCATE 62,5:PRINT "黄色":COLOR 7:TK_C=4:GOTO 15345
  837. 15345   LOCATE 33,8:PRINT SPC(16):LOCATE 33,10:PRINT SPC(16)
  838. 15360   LOCATE 46,8:PRINT "SCORE":LOCATE 44,9:PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(3)),4));"点"
  839. 15363   COLOR 7
  840. 15365 RETURN
  841. 15440 '----------------------------------------------------
  842. 15450 *CARD.DISP:'----------- カードを1枚表示する
  843. 15460            'Cput@ a.X=カードの右上のX座標 Cput@ a.Y=カードの右上のY座標
  844. 15470   IF CARD_C<>5 AND CARD_N>=13 THEN 15490
  845. 15480   IF NOT CARD_P THEN GOSUB *TEKI.CARD ELSE GOSUB *JIBUN.CARD
  846. 15490 RETURN
  847. 15500 '----------------------------------------------------
  848. 15510 *TEKI.CARD
  849. 15520   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+38,CPUT_Y+63),CTE%,PSET
  850. 15530 RETURN
  851. 15540 '----------------------------------------------------
  852. 15550 *JIBUN.CARD
  853. 15555   IF CARD_C<>5 AND CARD_N>=13 THEN 15570
  854. 15560   ON CARD_C GOSUB *CARD.B,*CARD.R,*CARD.G,*CARD.Y,*CARD.W
  855. 15570 RETURN
  856. 15580 '----------------------------------------------------
  857. 15590 *CARD.B
  858. 15600   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CB%,,,,,CARD_N*2700
  859. 15610 RETURN
  860. 15620 '----------------------------------------------------
  861. 15630 *CARD.R
  862. 15640   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CR%,,,,,CARD_N*2700
  863. 15650 RETURN
  864. 15660 '----------------------------------------------------
  865. 15670 *CARD.G
  866. 15680   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CG%,,,,,CARD_N*2700
  867. 15690 RETURN
  868. 15700 '----------------------------------------------------
  869. 15710 *CARD.Y
  870. 15720   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CY%,,,,,CARD_N*2700
  871. 15730 RETURN
  872. 15740 '----------------------------------------------------
  873. 15750 *CARD.W
  874. 15760   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CWI%,,,,,(CARD_N-13)*2700
  875. 15770 RETURN
  876. 15780 '----------------------------------------------------
  877. 15790 *CARD.FNC2
  878. 15800    CARD_C=CARD\100:CARD_N=CARD MOD 100:RETURN
  879. 15810 '----------------------------------------------------
  880. 15820 *SIKAKU.KAKU
  881. 15830   ON PLAYER GOSUB 15860,15870,15880,15890
  882. 15840 RETURN
  883. 15850 '-----------------------  誰の番かを示す四角を書く
  884. 15860 XA=10:YA= 10:XB=450:YB= 83:IRO=6:GOSUB *SIKAKU:RETURN
  885. 15870 XA=10:YA= 89:XB=450:YB=166:IRO=6:GOSUB *SIKAKU:RETURN
  886. 15880 XA=10:YA=172:XB=450:YB=246:IRO=6:GOSUB *SIKAKU:RETURN
  887. 15890 XA=10:YA=256:XB=629:YB=389:IRO=6:GOSUB *SIKAKU:RETURN
  888. 15900 RETURN
  889. 15910 '----------------------------------------------------
  890. 15920 *SIKAKU
  891. 15930  LINE(XA+1,YA+1)-(XB-1,YB-1),PSET,IRO,B
  892. 15940  LINE(XA+2,YA+2)-(XB-2,YB-2),PSET,IRO,B
  893. 15950  LINE(XA+3,YA+3)-(XB-3,YB-3),PSET,IRO,B
  894. 15960  LINE(XA+4,YA+4)-(XB-4,YB-4),PSET,IRO,B
  895. 15970 RETURN
  896. 15980 '----------------------------------------------------
  897. 15990 *SIKAKU.KESU
  898. 16030   XA=10:YA= 10:XB=450:YB= 83:IRO=0:GOSUB *SIKAKU
  899. 16040   XA=10:YA= 89:XB=450:YB=166:IRO=0:GOSUB *SIKAKU
  900. 16050   XA=10:YA=172:XB=450:YB=246:IRO=0:GOSUB *SIKAKU
  901. 16060   XA=10:YA=256:XB=629:YB=389:IRO=0:GOSUB *SIKAKU
  902. 16070 RETURN
  903. 16080 '----------------------------------------------------
  904. 16090 '======================  カードをすべて並べ換える
  905. 16100 *CARD.SORT
  906. 16110   FOR I=1 TO 4:ZERO=0
  907. 16120     FOR J=1 TO K(I)+1
  908. 16130       IF M_CARD(I,J)=0 THEN ZERO=J
  909. 16140     NEXT J
  910. 16150     IF ZERO<>0 THEN SWAP M_CARD(I,K(I)+1),M_CARD(I,ZERO)
  911. 16160   NEXT I
  912. 16170   FOR D=1 TO 4
  913. 16180     SW=1:CMAX=K(D)
  914. 16190     T=1:T(T,1)=1:T(T,2)=K(D)
  915. 16200     IF T=0 THEN GOTO 16370
  916. 16210       L=T(T,1) : R=T(T,2) : T=T-1
  917. 16220       IF L>=R THEN GOTO 16350
  918. 16230       I=L : J=R : SC=M_CARD(D,(L+R)\2)
  919. 16240       IF I>J THEN GOTO 16310
  920. 16250       IF M_CARD(D,I)<SC          THEN I=I+1:GOTO 16250
  921. 16260       IF SC         <M_CARD(D,J) THEN J=J-1:GOTO 16260
  922. 16270       IF I=<J THEN GOTO 16280 ELSE GOTO 16240
  923. 16280       SWAP M_CARD(D,I),M_CARD(D,J)
  924. 16290       I=I+1 : J=J-1
  925. 16300       GOTO 16240
  926. 16310       IF I<R THEN GOTO 16320 ELSE GOTO 16330
  927. 16320       T=T+1 : T(T,1)=I : T(T,2)=R
  928. 16330       R=J
  929. 16340       GOTO 16220
  930. 16350       GOTO 16200
  931. 16360     IF I<MAX THEN 16280
  932. 16370   NEXT D
  933. 16380 RETURN
  934. 17000 '----------------------  UNOの宣言をしたときの処理
  935. 17010 *UNO.SENGEN
  936. 17015   LINE(595,270)-(619,381),PSET,2,BF:'LINE(595,270)-(619,381),0,BF
  937. 17020   IF K(4)<>2 THEN 17040
  938. 17030   'WAO(4)=-1
  939. 17032   UNO=0:FOR I=1 TO K(4)
  940. 17033     IF (M_CARD(4,I) MOD 100=BA_C) OR (M_CARD(4,I)\100) THEN UNO=UNO+1
  941. 17034     IF  M_CARD(4,I)>=13                                THEN UNO=UNO+1
  942. 17035   NEXT I
  943. 17037   IF UNO<>0 THEN WAO(4)=-1:PCMPLAY UNO4,127:GOTO 17050
  944. 17040   WAO(4)= 0:GOSUB *ERASE.LINE:PRINT "無理なことを言わないでくださいよ。"
  945. 17045   FOR PL=1 TO 1000:NEXT PL
  946. 17048   LINE(595,270)-(619,381),PSET,0,BF
  947. 17050 RETURN
  948. 17100 '----------------------  UNOの宣言をしなかったときの罰(2枚取る)
  949. 17110 *UNO.BATU
  950. 17120   GOSUB *ERASE.LINE
  951. 17125   FOR J=1 TO 10000:NEXT
  952. 17130   COLOR 2:PRINT P_NAME$(PLAYER);
  953. 17140   PRINT "はUNOを言いませんでした。"
  954. 17142   FOR J=1 TO 2700:NEXT
  955. 17143   GOSUB *ERASE.LINE
  956. 17144   PRINT "罰として2枚取ってもらいます。";
  957. 17145   FOR J=1 TO 2700:NEXT
  958. 17150   COLOR 4:MAI=2:GOSUB *TDRAW.CARD:GOSUB *CARD.DRAW
  959. 17155   LINE(595,270)-(619,381),PSET,0,BF
  960. 17160 RETURN
  961. 17165 '音声デ-タ-をとりこむ
  962. 17170   *ONSEI
  963. 17180   LOAD@"A:UNO1.SND",UNO1
  964. 17190   LOAD@"A:UNO2.SND",UNO2
  965. 17200   LOAD@"A:UNO3.SND",UNO3
  966. 17210   LOAD@"A:UNO4.SND",UNO4
  967. 17220   LOAD@"A:HAKUSYU.SND",HAKUSYU
  968. 17230   LOAD@"A:BUUING.SND",BUUING
  969. 17240  RETURN
  970. 17250 'パレットを,黒に
  971. 17260 *BRACK
  972. 17270   FOR I=0 TO 15
  973. 17280    PALETTE I,[0,0,0]
  974. 17290   NEXT I
  975. 17300  RETURN
  976.