パソコンが相手をする「オセロ・ゲーム」勝...

　　パソコンが相手をする「オセロ・ゲーム」勝てるか？ SECOND 2008/08/23 07:49:16 
　　├!続き1 SECOND 2008/08/23 07:50:29 
　　│└!続き2 SECOND 2008/08/23 07:51:40 
　　│　└!続き3 SECOND 2008/08/23 07:52:45 
　　│　　└!続き4 SECOND 2008/08/23 07:53:45 
　　├Win98SEの方で「0th33p.dllをロードできない... SECOND 2008/09/13 18:00:37 
　　└!コンピューターの打つ手を、ゆっくり確認出... SECOND 2008/09/13 18:50:45  (修正1回)
　　　└!続き1 SECOND 2008/09/13 18:52:22  (修正1回)
　　　　└!続き2 SECOND 2008/09/13 18:53:47  (修正1回)
　　　　　└!続き3 SECOND 2008/09/13 18:55:17  (修正2回)
　　　　　　└!続き4 SECOND 2008/09/13 18:56:52  (修正1回)
　　　　　　　└DELETED  SECOND  2008/09/13 19:28:19  (削除)

　　パソコンが相手をする「オセロ・ゲーム」勝てるか？ SECOND 2008/08/23 07:49:16  ツリーへ

パソコンが相手をする「オセロ・ゲーム」勝てるか？	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/08/23 07:49:16
!パソコンが相手をする「オセロ・ゲーム」勝てるか？ !このプログラムは、uBASIC 用の、小山オセロを、十進BASIC に移植したものです。 !対戦する「知能」の部分が、機械語( oth33p.dll ) になっていますので、 !下記から DownLoad し、このプログラムと同じフォルダーに置いて下さい。 !レジストリーは使用せず、汚しません。 !DownLoad の時の警告は、心配要りません、無視してください。 !http://homepage2.nifty.com/neutro/asm/oth33p.dll !-------------------希望者のみ---------------------- !ソース.asm が入用な方。 !http://homepage2.nifty.com/neutro/asm/oth33p.asm ! !その他、全ファイルの欲しい方。 !http://homepage2.nifty.com/neutro/asm/othello.htm !--------------------------------------------------- !　1984/03/10 for N88BASIC　　　by Yoichi KOYAMA !　modified for UBASIC(98) 1989 by Yuji KIDA !　1989/10/02 modified　　　　　by Yoichi KOYAMA !　modified for UBASIC(AT) 1994 by Yuji KIDA ! !------------------------------------------- !　modified for 十進BASIC 2008 by バットマン ! !　 KOYAMA OTHELLO GAME for 十進BASIC FUNCTION oth33p(dx,r$) ASSIGN "oth33p.dll", "start00" ! DOS版の機械語を逆アセンブルして移植した。 END FUNCTION !　ASSIGN 文が、時々、”文法の誤り　0th33p.dll をロードできない” !　という警告を出す場合がある(win98SE)。RUN し直すと動作します。原因不明？ !　winXP では全くない、が、わからない。 OPTION CHARACTER byte SET TEXT BACKGROUND "OPAQUE" ! plot text with background color 0 SET WINDOW -1,13,13,-1 LET xc=(13+1)/(501/7) !　半角/全角=7/14pix /桁、screen=501x501pix. LET xc2=xc+xc LET xc4=xc2+xc2 LET XL=9 LET YY=5.5 LET YC=2 DIM U(2),GT(2) LET CIN=BVAL("1000",16) LET CCH=BVAL("2000",16) LET CPL=BVAL("3000",16) LET CFN=BVAL("4000",16) LET CMN=BVAL("6000",16) LET INI=BVAL("8001",16) LET CCHexe=BVAL("9000",16) LET LTB=BVAL("a000",16) LET RAN=BVAL("b000",16) LET OWT=BVAL("c000",16) LET r$=r$&REPEAT$(CHR$(0),38) !----- SUB RANDOM RANDOMIZE ! 620 ! 引数有りは「再現」する。(整数0～4294967295) LET r$="" FOR j=1 TO 8 LET x=1 LET y=0 FOR i=1 TO 8 IF RND<0.5 THEN LET y=y+x LET x=x2 NEXT i LET r$=r$&CHR$(y) NEXT j LET r$=r$&REPEAT$(CHR$(0),38-8) !----- CALL printr LET AR0=oth33p( RAN,r$) CALL printA32 CALL printr !----- END SUB !----- SUB set_WT DATA 1000,100,100,100,1000,-1200,-10, -20, -20,-10, 80,-120, -80, -60 LET r$="" FOR i=1 TO 14 READ w IF w<0 THEN LET w=w+BVAL("10000",16) LET r$=r$&CHR$(MOD(w,256))&CHR$(IP(w/256)) NEXT i LET r$=r$&REPEAT$(CHR$(0),38-142) !----- CALL printr LET AR0=oth33p( OWT,r$) CALL printA32 CALL printr !----- END SUB ! 続き1

　　├!続き1 SECOND 2008/08/23 07:50:29  ツリーへ

Re: パソコンが相手をする「オセロ・ゲーム」勝てるか？	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/08/23 07:50:29
! 続き1 SUB SEL(wx,wy,w$, vx,vy,v$, xs,xp,n,r) LET xe=xs+xpABS(n) SET LINE COLOR "red" DO WHILE NOT( 0<r AND r<=ABS(n) ) PLOT TEXT,AT vx,vy :v$ PLOT TEXT,AT wx,wy :w$ FOR i=xs TO xe-xp/2 STEP xp PLOT LINES: i,wy; i+xp,wy; i+xp,wy-0.5; i,wy-0.5; i,wy NEXT i DO WAIT DELAY 0.04 MOUSE POLL mx,my,mlb,mrb LOOP UNTIL mlb=1 AND xs<mx AND mx<xe AND wy-0.5<my AND my<wy OR mrb=1 IF mlb=0 THEN STOP LET r=INT((mx-xs)/xp)+1 PLOT TEXT,AT vx,vy :REPEAT$(" ",LEN(v$)) SET AREA COLOR 0 PLOT AREA: wx,wy; xe,wy; xe,wy-0.5; wx,wy-0.5 LOOP IF 0<n THEN PLOT TEXT,AT wx,wy :w$ LET i=xs+rxp PLOT LINES: i,wy; i-xp,wy; i-xp,wy-0.5; i,wy-0.5; i,wy END IF SET LINE COLOR 1 END SUB !CALL RANDOM CALL set_WT CALL note0 DO !START0 LET L=0 LET TB=0 CALL board !-----CIN LET AR0=oth33p( CIN,r$) CALL printA32 CALL printr ! !---- Level CALL SEL(XL,1,"Level : 1 2 3 4 5", XL,2,"レベルは、1~5 ?", XL+xc7.4,xc2, 5,L) ! CALL RANDOM ! !---- TB(先手番号)=１or２( 1=YOU 2=COMP ) LET t_=TB-1 ! T<>TB 白、後手。(打者番号t_：1=YOU 2=COMPUTER) LET x=4 LET y=4 CALL pt1 LET x=5 LET y=5 CALL pt1 LET t_=TB ! t_=TB 黒、先手。(打者番号t_：1=YOU 2=COMPUTER) LET x=4 LET y=5 CALL pt1 LET x=5 LET y=4 CALL pt1 ! CALL SEL(XL,YY-1,"先手(黒)は貴方　私", XL,YY,"どちらにしますか ?", XL+xc11,xc4, -2,TB) ! !----- LET AR0=oth33p( LTB+L256+TB,r$) CALL printA32 CALL printr !----- LET t_=2 LET x=XL+3.5 LET y=YC+1 CALL pt1 ! COMP コマのサンプル描画 LET t_=1 LET x=XL+3.5 LET y=YY+1 CALL pt1 ! YOU コマのサンプル描画 LET K=0 LET U(1)=2 LET U(2)=2 LET GT(1)=0 LET GT(2)=0 CALL TM0 LET GG=GTM LET t_=3-TB !Branch DO CALL clock LET GG=GTM LET GT(t_)=GT1 LET t_=3-t_ !----- LET AR0=oth33p( CFN,r$) CALL printA32 CALL printr !----- IF AR0<>0 THEN SET TEXT COLOR 64 PLOT TEXT,AT XL+0.4,YY+3:"第"&STR$(U(1)+U(2)-3)&"手目" SET TEXT COLOR 1 !----- IF t_=1 THEN SET COLOR MIX(0) 0.5,1,1 PLOT TEXT,AT XL,YY :" 貴方 " SET COLOR MIX(0) 1,1,1 PLOT TEXT,AT XL,YC :" 私 " CALL YOU0 ELSE SET COLOR MIX(0) 0.5,1,1 PLOT TEXT,AT XL,YC :" 私 " SET COLOR MIX(0) 1,1,1 PLOT TEXT,AT XL,YY :" 貴方 " CALL COMP0 END IF !----- IF PP>0 THEN ! コマの書き換え ( t_,X,Y ) !----- LET AR0=oth33p( CCHexe+t_256+Y16+X,r$) CALL printA32 CALL printr !----- LET U(t_)=U(t_)+AR0+1 LET U(3-t_)=U(3-t_)-AR0 ! 打コマの描画 CALL PT1 ! 獲得コマの描画、裏返す。 FOR i=1 TO AR0 LET Z=ORD(mid$(r$,20+i,1)) LET Y=IP(Z/16) LET X=MOD(Z,16) LET t_=3-t_ FOR θ=0 TO PI/2 STEP PI/16 LET a=0.45COS(θ) DRAW koma WAIT DELAY 0 ! 0.04 ! 続き2

　　│└!続き2 SECOND 2008/08/23 07:51:40  ツリーへ

Re: !続き1	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/08/23 07:51:40
! 続き2 NEXT θ LET t_=3-t_ FOR θ=PI/2 TO 0 STEP -PI/16 LET a=0.45COS(θ) DRAW koma WAIT DELAY 0 ! 0.04 NEXT θ NEXT i ELSEIF PP<0 THEN CALL QUIT ! 放棄終了。(未) EXIT DO END IF ELSE CALL GAMEOV0 CALL QUIT ! 正常終了、もう一度 OK で戻る。 EXIT DO END IF LOOP LOOP !----- SUB GAMEOV0 SET AREA COLOR 0 PLOT AREA: XL,YC-0.9; 13,YC-0.9; 13,13; XL,13 IF U(1)=0 THEN LET U(2)=64 IF U(2)=0 THEN LET U(1)=64 LET w1$="貴方" LET w2$="私" IF TB<>1 THEN swap w1$,w2$ PLOT TEXT,AT XL,YC+1:"先手："&w1$ LET GT1=GT(TB) CALL prtime(XL+2.3,YC+1) PLOT TEXT,AT XL,YC+2:"後手："&w2$ LET GT1=GT(3-TB) CALL prtime(XL+2.3,YC+2) PLOT TEXT,AT XL,YC+3:STR$(U(TB))&":"&STR$(U(3-TB))&" ("&STR$(ABS(U(2)-U(1)))&"石差)" IF U(1)=U(2) THEN LET w$="引分け" ELSEIF U(1)>U(2) THEN LET w$="貴方の勝ち" ELSE LET w$="私の勝ち" END IF PLOT TEXT,AT XL,YC+4:w$ END SUB !----- SUB QUIT CALL ack(4,10, "もう一度やりますか?　") END SUB !----- SUB TM0 LET GTM=IP(TIME) END SUB SUB clock CALL TM0 LET GD=GTM-GG IF GD<0 THEN LET GD=GD+86400 LET GT1=GT(t_)+GD IF t_=1 THEN CALL prtime(XL+2.3,YY) ELSE CALL prtime(XL+2.3,YC) END SUB SUB prtime(x,y) PLOT TEXT,AT x,y:USING$("##",IP(GT1/60))&"分"&USING$("##",MOD(GT1,60))&"秒" END SUB !---------- SUB mousexy DO LET rb=mrb LET lb=mlb MOUSE POLL mx,my,mlb,mrb IF rb<mrb THEN STOP IF lb<mlb AND 0.5<mx AND mx<8.5 AND 0.5<my AND my<8.5 THEN DO LET x=ROUND(mx) LET y=ROUND(my) !----- PLOT TEXT,AT XL+1.37,YY+2 :CHR$(64+x)&CHR$(48+y) LET AR0=oth33p( CCH+t_256+y16+x,r$) IF AR0=0 THEN beep CALL messYOU2("そこは打てません。") EXIT DO ELSE CALL messYOU2("　　　　　　　　　") END IF !----- CALL blink IF rb<mrb THEN STOP LOOP UNTIL mlb=1 AND x=ROUND(mx) AND y=ROUND(my) IF AR0<>0 THEN CALL pt1 EXIT SUB END IF END IF WAIT DELAY 0 CALL clock LOOP END SUB SUB blink LET θ=0 DO LET a=0.45COS(θ) LET θ=θ+PI/10 DRAW koma WAIT DELAY 0.02 CALL clock LET rb=mrb LET lb=mlb MOUSE POLL mx,my,mlb,mrb LOOP UNTIL lb<mlb AND 0.5<mx AND mx<8.5 AND 0.5<my AND my<8.5 OR rb<mrb ! erase koma SET AREA COLOR 64 PLOT AREA:x-0.45,y-0.45;x+0.45,y-0.45;x+0.45,y+0.45;x-0.45,y+0.45 END SUB SUB pt1 LET a=0.45 DRAW koma END SUB PICTURE koma SET DRAW mode hidden !裏ページに書く SET AREA COLOR 64 PLOT AREA:x-0.45,y-0.45;x+0.45,y-0.45;x+0.45,y+0.45;x-0.45,y+0.45 SET LINE COLOR ABS(SGN(t_-TB)) DRAW circle WITH SCALE(0.45,a)SHIFT(x,y) SET AREA COLOR 1-ABS(SGN(t_-TB)) DRAW disk WITH SCALE(0.92)SCALE(0.45,a)*SHIFT(x,y) SET DRAW mode explicit !裏ページの表示 ! 続き3

　　│　└!続き3 SECOND 2008/08/23 07:52:45  ツリーへ

Re: !続き2	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/08/23 07:52:45
! 続き3 END PICTURE SUB messYOU(w$) SET TEXT COLOR "red" PLOT TEXT,AT XL,YY+0.5:w$ SET TEXT COLOR 1 END SUB SUB messYOU2(w$) SET TEXT COLOR "red" PLOT TEXT,AT XL,YY+2.5:w$ SET TEXT COLOR 1 END SUB !----- SUB YOU0 !----- LET PP=oth33p( CPL+t_,r$) CALL printA32 CALL printr !----- CALL messYOU("　　　　　　　　　　") IF PP<3 THEN IF PP=0 THEN LET w$="パスですね。" ELSE IF PP=2 THEN LET w=ORD(mid$(r$,17,1)) LET w$=CHR$(64+MOD(w,16))&CHR$(48+IP(w/16))&"と" ELSE LET w$="" END IF LET w=ORD(mid$(r$,16,1)) LET w$=w$&CHR$(64+MOD(w,16))&CHR$(48+IP(w/16))&"だけです。" END IF CALL messYOU(w$) END IF PLOT TEXT,AT XL,YY+2 :"何処 ? ＿ " IF PP=0 THEN CALL SEL(7.5, 9.5," PASS", 7.5, 10,"クリックして下さい。", 7.5,xc6,-1,0) LET Y=9 LET X=9 EXIT SUB ! Pass ok. END IF CALL mousexy END SUB !----- SUB COMP0 PLOT TEXT,AT XL,YC+0.5 :"考えています " CALL TM0 LET G3=GTM !----- LET AR0=oth33p( CMN,r$) CALL printA32 CALL printr !----- LET Z0=AR0 LET PP=ORD(mid$(r$,1,1)) !----ステータス表示 LET nu2$=CHR$(0)&CHR$(0) LET nu3$=nu2$&CHR$(0) LET G1=0 IF mid$(r$,18,3)>nu3$ THEN LET G1=ORD(r$(18:18))+256ORD(r$(19:19))+65536ORD(r$(20:20)) LET G2=0 IF mid$(r$,14,2)>nu2$ THEN LET G2=( ORD(r$(14:14))+256ORD(r$(15:15))-32768 )/256 CALL TM0 LET G3=GTM-G3 IF G3<0 THEN LET G3=G3+86400 IF G3<1 THEN LET G3=1 PLOT TEXT,AT XL,YC+2 :"\|"&USING$("#######",G1)&USING$("#######",G3)&" sec \|" IF G1=0 THEN PLOT TEXT,AT XL,YC+2.5 :"\| ------" ELSE PLOT TEXT,AT XL,YC+2.5 :"\|"&USING$("####.##",G2) END IF PLOT TEXT,AT XL+1.56,YC+2.5 :USING$("#######.##",G1/G3)&" \|" !----返答 PLOT TEXT,AT XL,YC+0.5 :REPEAT$(" ",16) IF PP=0 THEN SET TEXT COLOR "red" PLOT TEXT,AT XL,YC+0.5 :"パスです。" SET TEXT COLOR 1 LET Y=9 LET X=9 EXIT SUB END IF PLOT TEXT,AT XL,YC+0.5: CHR$(64+MOD(Z0,16))&CHR$(48+IP(Z0/16))&" です。" LET Y=IP(Z0/16) LET X=MOD(Z0,16) END SUB !----- SUB board CLEAR SET LINE COLOR 1 SET AREA COLOR 64 PLOT AREA:0.3,0.3;8.7,0.3;8.7,8.7;0.3,8.7 FOR i=0.5 TO 8.5 FOR j=0.5 TO 8.5 PLOT LINES:0.5,j ;8.5,j PLOT LINES:i ,0.5;i ,8.5 NEXT j NEXT i SET AREA COLOR 1 FOR i=2.5 TO 6.5 STEP 4 FOR j=2.5 TO 6.5 STEP 4 DRAW disk WITH SCALE(0.05)SHIFT(i,j) NEXT j NEXT i FOR i=1 TO 8 PLOT TEXT,AT i-.07,.17:CHR$(i+64) PLOT TEXT,AT -.17,i+.25:CHR$(i+48) NEXT i END SUB !----- SUB note0 CLEAR PLOT TEXT,AT xc4,0.5:"　　小山オセロ　ver.6.0　*" ! PLOT TEXT,AT xc4,1.5:"１．　コンピュータの強さ" PLOT TEXT,AT xc4,2.0:"　レベル１または２　　初級" ! 続き4

　　│　　└!続き4 SECOND 2008/08/23 07:53:45  ツリーへ

Re: !続き3	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/08/23 07:53:45
! 続き4 PLOT TEXT,AT xc4,2.5:"　レベル３または４　　中級" PLOT TEXT,AT xc4,3.0:"　レベル５　　　　　　　上級" ! PLOT TEXT,AT xc4,4.0:"２．　入力方法" PLOT TEXT,AT xc4,4.5:"　打つ手は、盤面に直接、左クリック入力して下さい。" PLOT TEXT,AT xc4,5.0:"　盤面上で、コマが回転しますから、" PLOT TEXT,AT xc4,5.5:"　重ねてクリックすると、入力決定します。" PLOT TEXT,AT xc4,6.5:"　他の位置に移動するとキャンセルして、やり直せます。" PLOT TEXT,AT xc4,7.0:"　右クリックは、中止になります。" ! PLOT TEXT,AT xc4,8.0:"　２００８年８月１１日" ! CALL ack(xc4+xc2, 9, "<読み終ったら>　") END SUB SUB ack(x,y,w$) LET x1=x+LEN(w$)*xc PLOT TEXT,AT x,y :w$ PLOT TEXT,AT x1,y :"左クリック：ＯＫ．" PLOT TEXT,AT x1,y+0.5 :"右クリック：中止。" DO MOUSE POLL mx,my,mlb,mrb WAIT DELAY 0 LOOP UNTIL mlb=1 OR mrb=1 IF mlb=0 THEN SET TEXT COLOR "red" !SET TEXT HEIGHT 0.6 PLOT TEXT,AT x, y+1.5:"中止しました。" STOP END IF END SUB !-------------------- SUB printA32 PRINT right$("0000000"&BSTR$(AR0,16),8) END SUB SUB printr FOR i=1 TO 20 STEP 2 PRINT right$("0"&BSTR$(ORD(r$(i+1:i+1)),16),2);right$("0"&BSTR$(ORD(r$(i:i)),16),2);" "; NEXT i FOR i=21 TO LEN(r$) PRINT right$("0"&BSTR$(ORD(r$(i:i)),16),2);" "; NEXT i PRINT END SUB END

　　├Win98SEの方で「0th33p.dllをロードできない... SECOND 2008/09/13 18:00:37  ツリーへ

Re: パソコンが相手をする「オセロ・ゲーム」勝てるか？	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/09/13 18:00:37
Win98SE の方で「0th33p.dllをロードできない」の対策。 oth33p.dll → oth34p.dll に取り替えてから、 FUNCTION oth33p(dx,r$) ASSIGN "oth34p.dll", "start00" !　←ファイル名のみ、変更して下さい。 END FUNCTION 　http://homepage2.nifty.com/neutro/asm/oth34p.dll 　-------------------希望者のみ---------------------- 　ソース.asm が入用な方。　http://homepage2.nifty.com/neutro/asm/oth34p.asm 　その他、全ファイルの欲しい方。　http://homepage2.nifty.com/neutro/asm/othello.htm 　--------------------------------------------------- nasm の出力フォーマットを、obj(OMF) → win32 に変更してから、リンカーを、alink → golink に変更したら、良くなった。 oth33p.dll は、ＲＡＭ型のプログラムなため、format win32 にすると、 .code セクション内に、write が一切出来なくなって、動かなくなる。（ＣＰＵのプロテクトモード、書込み保護動作に登録される。）そのため、エントリー部を除く、大部分の code エリアを、 .data セクションとして、アセンブルするように、ソースを書き直した。本来は、ＲＯＭ化できるプログラムに直すべき所で、ズボラをした。出力フォーマット obj(OMF) の場合、.code セクション内に、いくらワークデータを置いても、なんらの書込み保護動作が無いので、この方が異常かも知れません。winXP でも保護動作が無いので、今のところ、支障はありませんが、 win32 の oth34p.dll の方が良いと思います。

　　└!コンピューターの打つ手を、ゆっくり確認出... SECOND 2008/09/13 18:50:45  (修正1回) ツリーへ

Re: パソコンが相手をする「オセロ・ゲーム」勝てるか？	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/09/13 18:50:45 ** この記事は1回修正されてます
!コンピューターの打つ手を、ゆっくり確認出来るようにした。 !続「パソコンが相手のオセロ・ゲーム」Ver7.0 ! oth34p.dll に更新。98SE での「0th33p.dllをロードできない」を解消。 !このプログラムは、uBASIC 用の、小山オセロを、十進BASIC に移植したものです。 !対戦する「知能」の部分が、機械語( oth34p.dll ) になっていますので、 !下記から DownLoad し、このプログラムと同じフォルダーに置いて下さい。 !レジストリーは使用せず、汚しません。 !DownLoad の時の警告は、心配要りません、無視してください。 !http://homepage2.nifty.com/neutro/asm/oth34p.dll !-------------------希望者のみ---------------------- !ソース.asm が入用な方。 !http://homepage2.nifty.com/neutro/asm/oth34p.asm ! !その他、全ファイルの欲しい方。 !http://homepage2.nifty.com/neutro/asm/othello.htm !--------------------------------------------------- !　1984/03/10 for N88BASIC　　　by Yoichi KOYAMA !　modified for UBASIC(98) 1989 by Yuji KIDA !　1989/10/02 modified　　　　　by Yoichi KOYAMA !　modified for UBASIC(AT) 1994 by Yuji KIDA ! !------------------------------------------- !　modified for 十進BASIC　2008 by バットマン ! !　　KOYAMA OTHELLO GAME for 十進BASIC FUNCTION oth33p(dx,r$) ASSIGN "oth34p.dll", "start00" ! DOS版の機械語を逆アセンブルして移植した。 END FUNCTION OPTION CHARACTER byte SET TEXT BACKGROUND "OPAQUE" !　plot text with background color 0 SET WINDOW -0.8, 13.2, 13,-1 LET xc=(13+1)/(501/7) !　半角/全角=7/14pix /桁、screen=501x501pix. LET xc2=xc+xc LET xc4=xc2+xc2 !---- LET XL=9 LET YY=5.5 LET YC=2 DIM U(2),GT(2) ! LET CIN=BVAL("1000",16) LET CCH=BVAL("2000",16) LET CPL=BVAL("3000",16) LET CFN=BVAL("4000",16) LET CMN=BVAL("6000",16) LET INI=BVAL("8001",16) LET CCHexe=BVAL("9000",16) LET LTB=BVAL("a000",16) LET RAN=BVAL("b000",16) LET OWT=BVAL("c000",16) LET r$=r$&REPEAT$(CHR$(0),38) ! RANDOMIZE !----- SUB RANDOM LET r$="" FOR j=1 TO 8 LET x=1 LET y=0 FOR i=1 TO 8 IF RND<0.5 THEN LET y=y+x LET x=x2 NEXT i LET r$=r$&CHR$(y) NEXT j LET r$=r$&REPEAT$(CHR$(0),38-8) !----- CALL printr CALL sens( RAN) !----- END SUB !----- SUB set_WT DATA 1000,100,100,100,1000,-1200,-10, -20, -20,-10, 80,-120, -80, -60 LET r$="" FOR i=1 TO 14 READ w IF w<0 THEN LET w=w+BVAL("10000",16) LET r$=r$&CHR$(MOD(w,256))&CHR$(IP(w/256)) NEXT i LET r$=r$&REPEAT$(CHR$(0),38-142) !----- CALL printr CALL sens( OWT) !----- END SUB SUB SEL(wx,wy,w$, vx,vy,v$, xs,xp,n,r) LET xe=xs+xp*ABS(n) SET LINE COLOR "red" DO WHILE NOT( 0<r AND r<=ABS(n) ) PLOT TEXT,AT vx,vy :v$ PLOT TEXT,AT wx,wy :w$ ! 続き1

　　　└!続き1 SECOND 2008/09/13 18:52:22  (修正1回) ツリーへ

Re: !コンピューターの打つ手を、ゆっくり確認出...	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/09/13 18:52:22 ** この記事は1回修正されてます
! 続き1 FOR i=xs TO xe-xp/2 STEP xp PLOT LINES: i,wy; i+xp,wy; i+xp,wy-0.5; i,wy-0.5; i,wy NEXT i DO WAIT DELAY 0.04 LET rb=mrb LET lb=mlb MOUSE POLL mx,my,mlb,mrb LOOP UNTIL lb<mlb AND xs<mx AND mx<xe AND wy-0.5<my AND my<wy OR rb<mrb IF mlb=0 THEN LET PP=-1 EXIT SUB END IF LET r=INT((mx-xs)/xp)+1 PLOT TEXT,AT vx,vy :REPEAT$(" ",LEN(v$)) SET AREA COLOR 0 PLOT AREA: wx,wy; xe,wy; xe,wy-0.5; wx,wy-0.5 LOOP IF 0<n THEN PLOT TEXT,AT wx,wy :w$ LET i=xs+rxp PLOT LINES: i,wy; i-xp,wy; i-xp,wy-0.5; i,wy-0.5; i,wy END IF SET LINE COLOR 1 END SUB CALL set_WT CALL note0 !----- DO CALL GAME00 IF PP<0 THEN CALL ack(4,10, "始めから、やり直します。") LOOP SUB GAME00 CALL RANDOM LET PP=0 LET L=0 LET TB=0 CALL board !-----CIN CALL sens( CIN) ! !---- Level CALL SEL(XL,1,"Level : 1 2 3 4 5", XL,2,"レベルは、1~5 ?", XL+xc7.4,xc2, 5,L) IF PP<0 THEN EXIT SUB ! !---- TB(先手番号)=１or２( 1=YOU　2=COMP ) LET t_=TB-1 ! T<>TB 白、後手。(打者番号t_：1=YOU　2=COMPUTER) LET x=4 LET y=4 CALL pt1 LET x=5 LET y=5 CALL pt1 LET t_=TB ! t_=TB 黒、先手。(打者番号t_：1=YOU　2=COMPUTER) LET x=4 LET y=5 CALL pt1 LET x=5 LET y=4 CALL pt1 ! CALL SEL(XL,YY-1,"先手(黒)は貴方　私", XL,YY,"どちらにしますか ?", XL+xc11,xc4, -2,TB) IF PP<0 THEN EXIT SUB ! !----- CALL sens( LTB+L256+TB) !----- LET t_=2 LET x=XL+3.5 LET y=YC+1 CALL pt1 ! COMP コマのサンプル描画 LET t_=1 LET x=XL+3.5 LET y=YY+1 CALL pt1 ! YOU コマのサンプル描画 LET K=0 LET U(1)=2 LET U(2)=2 LET GT(1)=0 LET GT(2)=0 CALL TM0( GG,0) LET t_=3-TB ! !----- DO CALL clock LET GG=GTM LET GT(t_)=GT1 LET t_=3-t_ !----- CALL sens( CFN) !----- IF AR0<>0 THEN SET TEXT COLOR 64 PLOT TEXT,AT XL+0.4,YY+3:"第"&STR$(U(1)+U(2)-3)&"手目" SET TEXT COLOR 1 !----- IF t_=1 THEN SET COLOR MIX(0) 0.5,1,1 PLOT TEXT,AT XL,YY :"* 貴方 " SET COLOR MIX(0) 1,1,1 PLOT TEXT,AT XL,YC :" 私 " CALL YOU0 ELSE SET COLOR MIX(0) 0.5,1,1 PLOT TEXT,AT XL,YC :" 私 " SET COLOR MIX(0) 1,1,1 PLOT TEXT,AT XL,YY :" 貴方 " CALL COMP0 END IF IF PP<0 THEN EXIT SUB !　放棄終了。 IF PP>0 THEN !　コマの書き換え ( t_,X,Y ) !----- CALL sens( CCHexe+t_256+Y16+X) !----- LET U(t_)=U(t_)+AR0+1 LET U(3-t_)=U(3-t_)-AR0 !　打コマの描画 CALL PT1 !　獲得コマの描画、裏返す。 IF fast=1 THEN LET stp=PI/2 ELSE LET stp=PI/16 FOR i=1 TO AR0 LET Z=ORD(mid$(r$,20+i,1)) LET Y=IP(Z/16) LET X=MOD(Z,16) LET t_=3-t_ FOR θ=stp TO PI/2+0.001 STEP stp LET a=0.45COS(θ) DRAW koma WAIT DELAY 0 NEXT θ LET t_=3-t_ FOR θ=PI/2-stp TO -0.001 STEP -stp ! 続き2

　　　　└!続き2 SECOND 2008/09/13 18:53:47  (修正1回) ツリーへ

Re: !続き1	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/09/13 18:53:47 ** この記事は1回修正されてます
! 続き2 LET a=0.45COS(θ) DRAW koma WAIT DELAY 0 NEXT θ NEXT i END IF ELSE CALL GAMEOV0 !　正常終了。AR0=0 CALL ack(4,10, "もう一度やりますか? ") EXIT SUB END IF LOOP END SUB !----- SUB GAMEOV0 SET AREA COLOR 0 PLOT AREA: XL,YC-0.9; 13,YC-0.9; 13,13; XL,13 IF U(1)=0 THEN LET U(2)=64 IF U(2)=0 THEN LET U(1)=64 LET w1$="貴方" LET w2$="私" IF TB<>1 THEN swap w1$,w2$ PLOT TEXT,AT XL,YC+1:"先手："&w1$ LET GT1=GT(TB) CALL prtime(XL+2.3,YC+1) PLOT TEXT,AT XL,YC+2:"後手："&w2$ LET GT1=GT(3-TB) CALL prtime(XL+2.3,YC+2) PLOT TEXT,AT XL,YC+3:STR$(U(TB))&":"&STR$(U(3-TB))&" ("&STR$(ABS(U(2)-U(1)))&"石差)" IF U(1)=U(2) THEN LET w$="引分け" ELSEIF U(1)>U(2) THEN LET w$="貴方の勝ち" ELSE LET w$="私の勝ち" END IF PLOT TEXT,AT XL,YC+4:w$ END SUB !----- SUB TM0(t,t0) LET GTM=IP(TIME) LET t=GTM-t0 IF t<0 THEN LET t=t+86400 END SUB SUB clock CALL TM0( GD,GG) LET GT1=GT(t_)+GD IF t_=1 THEN CALL prtime(XL+2.3,YY) ELSE CALL prtime(XL+2.3,YC) END SUB SUB prtime(x,y) PLOT TEXT,AT x,y:USING$("##",IP(GT1/60))&"分"&USING$("##",MOD(GT1,60))&"秒" END SUB !---------- SUB mousexy DO LET rb=mrb LET lb=mlb MOUSE POLL mx,my,mlb,mrb IF rb<mrb THEN LET PP=-1 EXIT SUB END IF IF lb<mlb AND 0.5<mx AND mx<8.5 AND 0.5<my AND my<8.5 THEN DO LET x=ROUND(mx) LET y=ROUND(my) !----- PLOT TEXT,AT XL+1.37,YY+2 :CHR$(64+x)&CHR$(48+y) CALL sens( CCH+t_256+y16+x) IF AR0=0 THEN beep CALL messYOU2("そこは打てません。") EXIT DO ELSE CALL messYOU2("　　　　　　　　　") END IF !----- CALL blink IF PP<0 THEN EXIT SUB IF NOT(0.5<mx AND mx<8.5 AND 0.5<my AND my<8.5) THEN LET AR0=0 EXIT DO END IF LOOP UNTIL mlb=1 AND x=ROUND(mx) AND y=ROUND(my) IF AR0<>0 THEN CALL pt1 EXIT SUB END IF END IF WAIT DELAY 0 CALL clock LOOP END SUB SUB blink LET θ=0 DO LET a=0.45COS(θ) LET θ=θ+PI/10 DRAW koma WAIT DELAY 0.02 CALL clock LET rb=mrb LET lb=mlb MOUSE POLL mx,my,mlb,mrb LOOP UNTIL lb<mlb OR rb<mrb IF rb<mrb THEN LET PP=-1 ! erase koma SET AREA COLOR 64 PLOT AREA:x-0.45,y-0.45;x+0.45,y-0.45;x+0.45,y+0.45;x-0.45,y+0.45 END SUB SUB pt1 LET a=0.45 DRAW koma END SUB PICTURE koma SET DRAW mode hidden !裏ページに書く SET AREA COLOR 64 PLOT AREA:x-0.45,y-0.45;x+0.45,y-0.45;x+0.45,y+0.45;x-0.45,y+0.45 SET LINE COLOR ABS(SGN(t_-TB)) DRAW circle WITH SCALE(0.45,a)SHIFT(x,y) SET AREA COLOR 1-ABS(SGN(t_-TB)) DRAW disk WITH SCALE(0.92)SCALE(0.45,a)*SHIFT(x,y) SET DRAW mode explicit !裏ページの表示 END PICTURE SUB messYOU(w$) SET TEXT COLOR "red" PLOT TEXT,AT XL,YY+0.5:w$ ! 続き3

　　　　　└!続き3 SECOND 2008/09/13 18:55:17  (修正2回) ツリーへ

Re: !続き2	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/09/13 18:55:17 ** この記事は2回修正されてます
! 続き3 SET TEXT COLOR 1 END SUB SUB messYOU2(w$) SET TEXT COLOR "red" PLOT TEXT,AT XL,YY+2.5:w$ SET TEXT COLOR 1 END SUB !----- SUB YOU0 !----- CALL sens( CPL+t_) LET PP=AR0 !----- CALL messYOU("　　　　　　　　　　") IF PP<3 THEN IF PP=0 THEN LET w$="パスですね。" ELSE IF PP=2 THEN LET w=ORD(r$(17:17)) LET w$=CHR$(64+MOD(w,16))&CHR$(48+IP(w/16))&"と" ELSE LET w$="" END IF LET w=ORD(r$(16:16)) LET w$=w$&CHR$(64+MOD(w,16))&CHR$(48+IP(w/16))&"だけです。" END IF CALL messYOU(w$) END IF PLOT TEXT,AT XL,YY+2 :"何処 ? ＿　　　　　 " IF PP=0 THEN CALL SEL(7.5, 9.5," PASS", 7.5, 10,"クリックして下さい。", 7.5,xc6,-1,0) LET Y=9 LET X=9 ! Pass ok. ELSE CALL mousexy END IF END SUB !----- SUB COMP0 PLOT TEXT,AT XL,YC+0.5 :"考えています　" CALL TM0( G3,0) !----- CALL sens( CMN) !----- LET Z0=AR0 LET PP=ORD(r$(1:1)) !----ステータス表示 LET G1=ORD(r$(18:18))+256ORD(r$(19:19))+65536ORD(r$(20:20)) LET G2=( ORD(r$(14:14))+256ORD(r$(15:15))-32768 )/256 CALL TM0( G3,G3) IF G3<1 THEN LET G3=1 PLOT TEXT,AT XL,YC+2 :"\|"&USING$("#######",G1)&USING$("#######",G3)&" sec \|" IF G1=0 THEN PLOT TEXT,AT XL,YC+2.5 :"\| ------" ELSE PLOT TEXT,AT XL,YC+2.5 :"\|"&USING$("####.##",G2) END IF PLOT TEXT,AT XL+1.56,YC+2.5 :USING$("#######.##",G1/G3)&"　\|" !----返答 PLOT TEXT,AT XL,YC+0.5 :REPEAT$(" ",16) IF PP=0 THEN SET TEXT COLOR "red" PLOT TEXT,AT XL,YC+0.5 :"パスです。" SET TEXT COLOR 1 LET Y=9 LET X=9 ELSE LET Y=IP(Z0/16) LET X=MOD(Z0,16) END IF PLOT TEXT,AT XL,YC+0.5: CHR$(64+X)&CHR$(48+Y)&" です。" IF pp<>0 THEN CALL ackB("私の手、確認して、左クリック") END SUB SUB ackB(w$) PLOT TEXT,AT 4,10: w$ CALL blink PLOT TEXT,AT 4,10: REPEAT$(" ",LEN(w$)) END SUB SUB ack(x,y,w$) LET x1=x+LEN(w$)xc+xc2 PLOT TEXT,AT x,y :w$ PLOT TEXT,AT x1,y :"左クリック：ＯＫ．" PLOT TEXT,AT x1,y+0.5 :"右クリック：終了。" DO LET rb=mrb LET lb=mlb MOUSE POLL mx,my,mlb,mrb WAIT DELAY 0 LOOP UNTIL lb<mlb OR rb<mrb IF rb<mrb THEN SET TEXT COLOR "red" PLOT TEXT,AT x, y+1.5:"終了しました。" STOP END IF END SUB !----- SUB note0 CLEAR PLOT TEXT,AT xc4,0.5:"　　小山オセロ　ver.7.0　*" ! PLOT TEXT,AT xc4,1.5:"１．　コンピュータの強さ" PLOT TEXT,AT xc4,2.0:"　レベル１または２　　初級" PLOT TEXT,AT xc4,2.5:"　レベル３または４　　中級" PLOT TEXT,AT xc4,3.0:"　レベル５　　　　　　　上級" ! PLOT TEXT,AT xc4,4.0:"２．　入力方法" PLOT TEXT,AT xc4,4.5:"　打つ手は、盤面に直接、左クリック入力して下さい。" PLOT TEXT,AT xc4,5.0:"　盤面上で、コマが回転しますから、" ! 続き4

　　　　　　└!続き4 SECOND 2008/09/13 18:56:52  (修正1回) ツリーへ

Re: !続き3	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/09/13 18:56:52 ** この記事は1回修正されてます
! 続き4 PLOT TEXT,AT xc4,5.5:"　重ねてクリックすると、入力決定します。" ! PLOT TEXT,AT xc4,6.5:"　他の位置に移動するとキャンセルして、やり直せます。" PLOT TEXT,AT xc4,7.0:"　右クリックは、中止になります。" ! PLOT TEXT,AT xc4,8.0:"　２００８年９月１３日" ! CALL ack(xc4+xc2, 9, "<読み終ったら>") END SUB !----- SUB board CLEAR SET LINE COLOR 1 SET AREA COLOR 64 PLOT AREA:0.3,0.3;8.7,0.3;8.7,8.7;0.3,8.7 FOR i=0.5 TO 8.5 FOR j=0.5 TO 8.5 PLOT LINES:0.5,j ;8.5,j PLOT LINES:i ,0.5;i ,8.5 NEXT j NEXT i SET AREA COLOR 1 FOR i=2.5 TO 6.5 STEP 4 FOR j=2.5 TO 6.5 STEP 4 DRAW disk WITH SCALE(0.05)*SHIFT(i,j) NEXT j NEXT i FOR i=1 TO 8 PLOT TEXT,AT i-.07,.17:CHR$(i+64) PLOT TEXT,AT -.17,i+.25:CHR$(i+48) NEXT i END SUB !-------------------- SUB sens( com) LET AR0=oth33p( com, r$) PRINT right$("0000000"&BSTR$(AR0,16),8) !　ax32 CALL printr END SUB SUB printr !　r$ FOR i=1 TO 20 STEP 2 PRINT right$("0"&BSTR$(ORD(r$(i+1:i+1)),16),2);right$("0"&BSTR$(ORD(r$(i:i)),16),2);" "; NEXT i FOR i=21 TO LEN(r$) PRINT right$("0"&BSTR$(ORD(r$(i:i)),16),2);" "; NEXT i PRINT END SUB END

　　　　　　　└DELETED  SECOND  2008/09/13 19:28:19  (削除) ツリーへ

Re: !続き4	返事を書く
SECOND <jjqdmekgpt> 2008/09/13 19:28:19 ** この記事は削除されました

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。