From 17d3a7edd766918e7e2a938125e3f72efc829222 Mon Sep 17 00:00:00 2001
From: Sam Moore <matches@ucc.asn.au>
Date: Tue, 5 Mar 2013 18:25:33 +0800
Subject: [PATCH] Added Fortran sample Agent
It occasionally gets confused and breaks. Fixing is an excercise for any fools that decide to use FORTRAN.
---
agents/fortran/Makefile | 12 ++
agents/fortran/agent | Bin 0 -> 21488 bytes
agents/fortran/agent.f90 | 446 +++++++++++++++++++++++++++++++++++++++
3 files changed, 458 insertions(+)
create mode 100644 agents/fortran/Makefile
create mode 100755 agents/fortran/agent
create mode 100644 agents/fortran/agent.f90
diff --git a/agents/fortran/Makefile b/agents/fortran/Makefile
new file mode 100644
index 0000000..99d32c3
--- /dev/null
+++ b/agents/fortran/Makefile
@@ -0,0 +1,12 @@
+
+SRC = agent.f90
+
+BIN = agent
+
+$(BIN) : $(SRC)
+ gfortran -o $(BIN) $(SRC)
+
+clean :
+ rm -f $(BIN)
+ rm -f *~
+ rm -f *.mod
diff --git a/agents/fortran/agent b/agents/fortran/agent
new file mode 100755
index 0000000000000000000000000000000000000000..f21333eb20ea44d7ff692c204fc355fadf63a723
GIT binary patch
literal 21488
zcmeHP4|r77mA^9y5Cxe?aRqhD)P|b4GA0l)kya+czzZE9VraG6j+10aQYM*n{y^x8
zpu<?7)2Z2Aspz^by8VOu+1Bo^ZKNtmY@LYRZq&A>*1C~Jof!NY1T`W$`#bl~n>Ujg
zpnl!`cE9C9-nr-8bI!f@+;h);_r5o8o6EhzYOyettn5lgnEgyACy6U#m2QqoS`9mc
zIoUk+aW)l{V*ELI2|<xla6+n9utf3|0g_yeRS;^dPM%Tl0zqa9sumKQBFhADN=(3p
zg#uNOl?t5XsI7CZ6!@GqPM%TlcG-?y5-K@DNzN(doKjA~-Lhc{s{T>m=&w=gYqUCn
z5$+_wmh)={5-+8OSHmrof2oS2fKHxKFf7PSK_z!J<fxs0YFa1d3fUzk`=_Al-=+Tc
zrp48l`db$G+dCuO3%Y9-FIZgd2n8GqdB4f*B)W3Vdfp^u$2q{L&9m`GK0xK~J3U{1
zZ%b46+VkIR{?z@yzW48!{tL0?O{8;Ho{|dC?0M)l1?c3?`SipJ(C;Wff1m*U!2<Nh
z3ebO3fc|;`dNB-<ul?s2pjQ{5*B7AQP=J0%0r~?4=#Lkm4;7#@j|ZOB><NXv!LX;p
z+uq4my6dl6=2_@i=(vng89CWv@U?aXIwhZnc~))mtn;<Dhr+(#GQT$z@`aeEbweN+
z4thI1!ANJgy~F461%rX0#~WrVSFByvxUO!Er^-=DN);#RUc@#8eZE4{ti$W~2bxXA
zfsoK^BB9QfK!+#f^R;-|t4#%=uqWvAwwNf?zR(6=(9_)J4SJi=d{d!h_p}5$%?)Y}
zbaZ)xK6F0V-q~v6hX!78FsIJV!S=9Ofl+CDXV}+@$_0bTD)|)THX~PysUaa>*y9bh
zn#X`hfv#|Spfd!Y#_+RqBm~GwB4`#dD`EuwW&bNSaMEMJI>dOmwgX1aYd?cQ=3`Q$
z1$l~<av5OTeeXee5o?vS9UL!aTd6@vBWs-;QY;m%;3xvKpicuTS$RQ;iLPQX6_lFj
z=JjfhiEfV9b`zcIP^sKRSFxAMDou2B*hn=d`k4lmF{g<>-9*<+^cg04gNc5YiGHn#
zKGQ_M(L}eI=xrvt8UrfsGSSaA@pqf(vrP2uCb}A1D!$!Br!_?-EqbUVwGktgI!2dQ
zKgpOD{dvig>C29-U@SfVIIcZN>G_1Wk=W=+8fpGpgwqg@4srYq!pRjz`#64pa9X-X
zALjUrgwxQE?&kP&gwv3Z_HcYZ;Zq6U&hY`lX^2O=IKG!~8rsntIsVUt(~yofaQvSL
zr=c8ma{K|pX$VIvIestUG<2hOj{hy;G-RWt9KVBb8mdvo@mmR}AsQY35QO<(C7gz4
zbcEwU!f8lGhk#eTS+76)B~3q|MGuZQG}b5k`Yv%YE!khmLGtilIa%tbU_82^hitCJ
zr|2%&I@TAqriZx6Hy}A|^L9WbW9v2j)oX}x`)BN^h($j8vr61jLF_!B+AU+{g!R8)
zq(#RpTJ3PCY=dpya+E~-ESf&$ZRk$V{sm`>PkEhcsvQm<cxuY?$Xckn>%aJ<xjrrW
znTBPu-teqmY67*b<cs@iP*HjW+&$DLG|8^%TT@BbQ5yT`)}tl1J4=xrv-Big<AOF0
z+G{8UE$%w1?TW7-*P5Tx`VSOomLV<C@U9kjrL=hQ5UQ~4_#QY<$`+Zs*SWySp3rdF
z7r=!#F%|hBoj!@Io=ka8%#|!2LK9BZ2FVfKik{uoXZuNC6kVmZUjWbGHjvb#ocb2V
zIq5nsjB(t$Ey9h%Z|$R7CrY<n!3}eq3^PH7vEV=1<pXY)=zvo*Dx4@)6;42PcrfmQ
z7+BMi^~MbAajRlIPOOQipX38}%c0$vMOre}b1a>vej>XY*$T{6WFJPB8j5UhhGCDS
zax0^wJE_x9YTMUi*naNuG+M#c(m2N6ftG!wDrKXRSYPDKeZ$~Rl@h88#$;?4R8!It
zu@PR7Ol_Hi`V+BVqGT`R*%Nfp^rRT$SKbG6GS)VcPJaM($ygV1^~8~k?Ll^$gNP3!
zN6{u3yAe5B$C9xY<faf~f)k-J^&L`{NQ`j6se5Ui()3?Z={GZELhlwRF+X}HYT3(`
z=}+w=k(3THOmhC%g?nu%d}0nR`_|$jn*Abr11F$}I5tgs!=!Fp^AWr82PiMxjeqB*
zMxTcS%DdsGZcvoeR5u1tO0IklVk?aab#~JvuKOfc$i%gM64xfd725#&z{k;D8mqZv
z;ACt&vdB^P_Dr^0WfQUO)J|PATa35#6B<#&9WDgd5nE}3xB;g$*%>=xyRQF;?UFtO
zKb^Y~pC<90<WZRk7EK{q_Bplqj$a7Ri*d`u1t1%&LWR`oY+q|aqlH^-=Q(n#smPh!
z>L1=iMM6=WMN??SwN!N?A%Ji+TKuG=Z8h;bi@89f5D;LJfSUv|ZoC@k=noOr)QH_d
zW0B>aZ=jVlEuR(h{LeoS_t2=s6T-W8_VDJ*Da|L-9xT3S9xsSDlxuOPUDKb{D*82j
zkd`Sv)e$B%n>LW-qek8#2Ca5rTNwpOK7zFawz~#wKY1>mpz)0MTXdd@Jr{mi>R0}t
z8TGuNRU|ciBDWq``iSk~zDfQvY0T+f_#|Wg;Jeg+-aqAO`?dH^if@`_KUOzBtPNsV
z1(-CfkrV4!J|uj@EtCi_Nl7Is$@oT9MkfW~xgt98h4W5$iHJ_0e#dA$MY_)r`sZIF
z-g!Gy3z||XmWOeoW|oJ;gicx>Mu*U6Q(*mp(ezu0KX;D)wV01QuIsTrxMngoh$|27
zSnw#zhm<BS<)DEUk7uA(EFKgT<>JwhHMhS)^(7K*d<-TT|9Me*WB$@dL@95U7$Ng=
za}h7)DrpePfyQH0507J%iN{DWM`aB{)y@&BPk*Y{PF>Mo(DeQz+IJ^eWjmFMm<|h{
zx>bH-ScPI%UaMSxlv|~X+97*JOP!2wt9hx>vo!)G=0|@A-FpS=Q~L;}oG7J8b&gmk
zvV-rfvJ1Swr_u#EYn@qR_=6)SYVEg0X^W{ZrdWMgl-`iP^m$%t^t1(NJVu)Mpiw3s
zBT<eD9gho;5cTa81N(^dFIt)E5xC$FOJ`tn@ifimTyMW!8inppPH9~88fDj8+$emJ
zltXCh_Ayafz;*q+)aZ7HK#BPYaX*zzeGU6hJ?7^YpgOn(G-R~I<3z=r5?Emiyo~+X
zXwnp_a^l(V;Y%W(`42;(ycvb*ItVqzv&_Bb<uqQ#U2E8;@(`-Y783W**I>6Zr0J1C
zO<&)q>8pFSxT`PDVtqH;MJ_r~vh5sXdpU8s$bopXE$KRlal*dh;OIRtEJ_CB&Qjy{
zeK5Yfr$l!h67<<RZHY*=);uJXfU|$Zv}FRBZ<)fEoC;&yIeUpK6`s~htLoSkZYJGz
z5Uq*Q-X&Z@?XsX<(XEH3+G4xG7Tub%MrQNMOL0YOY5A!g2!A1mX008F%upN?)52Fk
z(vmCLN0MZu-ngNyk0d{4NLnI!nuoTX3ywZ1#UPQNtA=x(++Jc^B>FyT!zSTW<#t42
zI&PF|h?u%TMu~{=7hPlevladNpgz!lY+lt+#ZYv@B8{>nTat_txrjGFNj_ikq&{qx
z%-7w~&m&Y~q%4t0mN2h2I+4C<O%|E!L?gCco>jeQC9%)TrW^cuEIs-Xca1~Ew%9$e
zM^-(#y|zX^kw>w)bK$xZDzHRwqi8a<o@*UzUhC9~CQb=Yg^jF{E6sIO4Cq7s6Z5JD
zDh9af5?sl(^=G)@`}^OUS2b8MNOzgE%Y~mnM^U(xYr4XiFO_DU@a(g>GUeI%ozyhb
z?iQvSj58faBC-XpajujtaUG4w$g#vV9^PnBw-!e`j#>=#=He*MU4SCkfRReaGbojg
zTM8bB45{!D&jhBiBJ>YOLF%}v4bg57qTOypyIoq+)rVHIr0X$?A#vAZ2y3=GcVL@=
zd-J4=M;5e&Q?C|OErAG`SpS$7hmN=lx{|3!5bSApbv9U_bEpEY3^+ncwfO2?TKsAZ
zdYxU<pVum$)b!y=ckMXS+NDu|OuB}J)X63I_5#&v16uRA7JEmGE`rN69ty`6XuY((
zMB1k516u#FrP{k6;<nWGEqT_FJr%H<cuUiNYY5HLYM-**osZR$)Z$-}9Xg!Z?mSAS
z6x*GCEQMJWQPJ2mO&_9wuOEv&XWK~|9_(<;2QGWwprs3|5Xxh>Kx8ks1?`}g50Ihn
zCWg$7^)5nnS0Ai4Nd3fkz}6Hsce&#lO#`4B!r1ygHyl#nU1&LN)Q)6^LLA5NjoMT0
z=3#f@>a<u?=I(tD3$Qr&_|RC2Ul~oO-L=Ep=B`T2V5<_<rEbfww0QNqnqIx1Mt1Cg
zsELe$-N^-)s$;#6BPUk#Z$X7(LchMP&?Fg(A`pDjS<3xL<n7!NiPe24^(C>o!kcJE
z%Js}SC6D^w>`ouSmu^Urg)ztDv$#8bEsr~C#FKHSdO|T%$Z9&pJsN}(;aFSYL95|G
zt4BDUFWqo5XNi`8|Hc0_r{W&LPt!hac*NIVKLw}4%pi~APRaMXUohm|kVn&S2bWAW
zP+rD1(OhANxF&u7nT+q7XRX$Z9-`OOElWSbp<av)KM_8fe6PNIf3b|8eCdg=?~M*v
z^!2?M&>cTU)RZAt7Cy!cAEUyX>He9zgLp<aV!U77ubKK4{dt>=>o~G^(vdyF`Ut}M
zFm7Up+&Z7{L+Wl5%Tn&$X399APhf(ej*~Luj#GC{WDdSdZFkaRd^*Q*P0(TY@yuDA
z`LH`a8%vW=PX;!%Wl&3K>S4j4CRgYop=~v^J*`>rpSa}FdA}2_9)wlIiS;LjV4wLX
zuH86lKW-eg)A_k=#|jZLPugwabeX3U-G<Y>aFCDE$u+<!e|9RovaQNmWHytv@Cboh
zYebFeaMq}HNlUKB$j-)EHk*uHfY<bhCcb_sK8w%yQ{f#1Z$t4(70ZsuM-=+j2{`9C
zoD)vEdIZin3=QL|8>y^r@TN_0=Zvo(q3S3Wogy<iU}6<TzF|l<-d-YZeKJqACTKCh
zLz<Fp*YSHC<0;p+%QJp_l+@%r%`)5w55!ClgTl{{GDYFfa2}M;$<XNNgw=MZ2Rjm8
z7k^+RsF5@9fQ=r0(xZc;bV`zR8BMd@IVh&pzBz!Y`wzg&GGY1wpyIhwd^H;SwATL$
z_K^G0ZHzw|xOl&u5c#@6JIq96{Lx)-;=T9bLIE>^7NT9bQ&{^TpCajIQJRVwSBv6t
zSgs{(JFdVKGj$lx7DR_>5VAUam$}0azmnDA9|JvUhyNQI-^m+~$D0~9$y#FeFVIGc
zlOk{$M%*opScy^O_vU<4pJ;e*GV6CF>y#YUW0P6;NY)o&Dzn!2vsfPj*Iv5NDE=si
z^>`L5AMl4I>y8{&5nZ!<Lp9*K9M%sfYgOHH7_7JplvYsD-Q;!3V028&y^bDtn)=u!
z`j}XCquIfP8;OaA=goYn9H%h;k2p}v@}=(zUot(x-nQ+;b6Xy}tjy=`nMesA)Jsps
zaum@q_knRZI(cS%5zduAI>Nr={Qhb}Z=kc9ltM~?j3|U|3MO!mOg@<%<MhZul6v%C
z$v4D#pM0R%`!em*A~WO)K6(_goVAx&v3Y|VN!CP$m4egg(~9-+Nm`pStOz4)^jnIx
zpIG^GG^O=&!HU>-oEkQ^iPxT-#AnO!QLD!2>?8H)zfG$8^*`_qkv^(t>{FcYS>mJE
zYV>BG;G?IsM90HJY5M4)Qhn=jzBa+9=%J$iTg;?Cg8zvTsM$vmD>V)@)iaV#^UcfC
zPuk|ug!7jTyY-f`5iPM`-}C#@?!^3F0-&eddbn)dt>09JW$%VEy!~;g#$EAho&G_+
z{*KoFK~cT_LaO;C3UY6TFR1!G>2vGH-1<Aq^*`37XTPLHpTs*KW05zs_zh(kc7Iu^
zJKj<@$Bmrb9S@h4yW=;NRpK>|8Z>4*+Q^R3+aCGeFToonHJ^Yja3~a>`!jmYSH4Fw
zR)Y6Z;&@^@k&YZzZ;bGFS5h8yn7^_@nnj}b$4-=*WMN%6?Ca<X+rt6-a#x+(y>?k$
zqst!Y<Sz?)!@d^#Me{=!vAVDw@5}n^)eA4T2R7I@wEKN_Z>z5}?ATCSNvi6_3widy
zCSP!aKd{-pxy{#UZ}$3|BYtlfZ~NK9Z4l`Q;EhJo(BbO{1h-JNswUB(I(kVF0)bBZ
z=0L>XV)u17<84I6?{DvD53@|o<#iRC+whKH2kH%x2H788VMaG9q1P9;7?riyH+h5Y
z-X?S-tAC3Z=jq<n>+2isO@43lMxNspUgL7RmNnL|U9)uc+RwR`D*IGb<+D$wv?h=G
z^7@6B;J>}DqP%Wl#eyph?&{0(a5o3Kwiv^)sIoc_ONXgEUw>2uiz-jl*hQ7Kd2}n;
zg_q~k%oxpAn%fjwC}vPRz%s+VaU(|MD-oZsGZ+YL+}PRP+7@nV548oly1bh^Bb^&N
z1DiX+%F}XO`P&H+CqQ~A3D{LfdG+p`<*VzMrMuK}{)}lQJz${s@9FQQ7t`q<lR(|f
z(%Y=d&YD{EkOeHf?9(83U|Kurtu&*2$#g0&1L+3*C9pSrgF2$hua6cL?Jp)4o``P;
z{?;B!r-!Mtiq8+e?@uxKs4WlSFO6p!_tVr=d`0(JReOF3@^(CXyA{wVw{GP+Nd6H1
z4xs!#b9;*J=8d898R+Mi=)DBwGxEy}`AblK8_E}D*~4Mj!wvd9*vKw1%Wo20pnm#M
z-ivab%CG+Vl-s6yW;&zO?zDcRC{b*^b|#sG#^WyV+41Db9DzvwA<%1HNT(|S+04=v
zGv}<bP2XIyoh?0Y$;FGxE(Db)%lSo1%0En}&jL0Z{J+N9TmHLrdO2vn!+5p;&c)t(
z2Vl`yI{gsf@5jLhcoQBc9R>Ula5m)b#WUq<zypAdfajq7VL*DV<1WC1fR6#ns!xN{
z7C3Ez(-t^wfzuW^ZGqDkIBkK`7C3Ez|3enQtvpYv$+@_q)BcoFYORw)wO4tV_9jT@
z3c$*zIeAX)GiiTINx@QCF1Le>o&ZofLjVJ(-wc`)?U5<%vN{Pc+JaJ2^0bwt)Kl!_
zQ2i$EHQBzmKTHRxpnIw)mt^Dj)e4`-rLi}ZaJWS9)82|w34Xyr3EL;G?=GniTPTkA
zNgQ_MxUv%$`X9Kc->c_VHT4W9C;f$lpOSE~gexTcoP--B+$7;`5`I&{?@9O*37?Yi
zw-UZ4;X4veJyX^%VQ%}_%4N&0u$QlI!g*KZQg?f&HyE&2I~F?@EvSlc;$;;AKM`l8
zV6Bp@_Jx&I3oC1@YV74*L0{14_jyCU3VzN){#J}X`dxZ!0Ow{^jw<<6{7FqC0{MrP
zoyFWa?WZ5m6|=*W_QQ0(V8Ji9)prMg@^mq-7W`_Je%WSDHJm=1(XZ9a$pwV!?aHb5
zdeALwF54}C7peUB%aXoF(o3YWZmDM^N6!w>^R@pQlD~Mm6FJ8CnGoRp_@nkbGQ)`+
zWBe=#a1Z{7{^EQma*Xja7r<Wp5&b_da3aSTKl1_nCH{#1(+i!*L9d)B|A{=&pSajb
zWX8{401xAj=+{d9w^AX}ndmst-#*vLaenrM+<B6|N$SyfDPtFdZecb?r{9$9{K{CN
zalC@_&tmqRaaqafrEIv$DK!YNp3^6fqZf2)=Ma8QX-=Do-#UlwlH;Yy=n0m^`Y}d7
znlz`s;q-Hun&-QLQ@WR+b+RA+paA^|uIF4Mp40eI`ZegY&`$dGCnXiX4obTEUI;J5
zWlYlPXQGt&Sr_2@l1{%HrNqz3C<BFdMD3oO{!Rz|Y>bOt##fq~l+FWvmdIvZF9E$Y
zkDgktKZ}(k8rL(Osd%n9)^PevBd#kteb2+L5EG<d2<K~0v;dvHH<FKkcLDnM3()Bo
z2l@0oUx5B<0lF0nc|JXJ3(yx9psy@I|3U%!Ul*YNT><(J3()%u&|d((6meL^Lp5YC
z7ofi(=?^zJ6{~=F1mib-a)LDn!=Z2lPoD582+y*{wd*|Y`fD0J_!5O@c^0;6nW?BH
z;A!;-n!J8bOE?e=dAyNsMqhLA`|ya!vG}q@Rg4Ne?JeDe(WfZ9_-;i@q@!bt>2Xa{
zz#DAwwD|A=h`<&{)n$vT*y_6aHK<*bw0E|L9aW1fYgktx6l%xg84rK51J;^a$rI^n
z!E-522f4PILD|CamM$Lzt1i!G3So(C<{GP*-`9%flRB!nnsv4NntdKwBi2g!jR!|n
z4gN2xRn~E>S<a2KVqM*8mq%e_9F@=5rrEHK$I}uDc-rt)3qQVJAuKETmtVK0Zgu@K
zP^oTwZ6fI1B0dL_P4ac(a~mt&Yp<$vd)BU4agD3d(^z+v+eIVAKQ+=Eig-3a2Q#D%
zGHJ#KKkyL}*vhNQ>(?UJ(%$KbgnZCF>4PO`w29l~G-Lp-Qr7pUeY52M>sLuKpK-zG
zQ22*R{(K)I@%U({FosQ`kQ!cc80HB3y2H%T8o&h;v;&W5Ip*l{BZFH;ugLM?bU>Op
z_>2ZOIWMp+otRL};cN4VIo#F)?90u#w01@uc)T0J!&whd`UXp|ODcs}76Ws12Eslr
zLbsy}q@2*drGq)R=koG4Z>UYO*IiY=Ana|;)NWGK6lsT^_7<+f+tJ?49HBNeHSBFd
zPQfi591jM#eH{Fn9S}bnwh>~u1u*U(YOGFRneTwn{joU_uQ}0stF&jtGR9M*)hQtd
zlh$T+zaUB(dlnh9eAw#bMPaG1jANNguKfKdnvOqJ|1PT&80|kfVEkn^WNF_?Z7&gI
zV?SC497~KLulA)qvLdxFm110n$`kw%{_wl8fT~~ZTf5~(SlLgtTh*_0Y(<9lph{lt
zQ}2@Uv=5=A<Q1QSH=vC6v<mN=>Lhm7C*|=IQ=X{*#G~{GDr59=0nwDa+V_{zpdif=
zz>rhzSM-mgoaC>PeCk}GT*|9+2jZE5zg+op&}dv_bB+7HVacfK0SiyL?f)dGX8Cb>
z4lpj|`7>E5OMt(qWP&7XmRI-9_A`ka=O`BnsIE$0;SVBXmRIKvB?|<{OvNZ+Zu_S}
znB<lH)qS;H${$n(Qr<410!d`d@+Fl{UR1*0UJ?5Q#Y<4xU(xE3G0Us(+Ntl|g%zWO
zx$VC~%F`U8r1sJ3`*peY%B_D9WT<{6ulC#JSCY2OcnNHB`#+BYv%K1u*GT!?`f~Au
zkSE_$^{f4w`o7?9QjVm~t(3g#7rD8)e)YYok)>R0lD(C@D9wCxOVzK=?NU;Hk7ATC
zSKfxo&GoDOT8~o*sCFtfx$+Ja5KYyu?#p*Og~Z9^X--r9m4e;4DtW&_5gFp8q~IOM
z%TU4T>N2BF<W&4r^j!a=1D%{H!dc6uyb3IT3921`s{bmkybGG@JF-S9Un#PG%qdju
YR*Y{Vlf%M`&i$<5px>ICQx3}h3j)!XlK=n!
literal 0
HcmV?d00001
diff --git a/agents/fortran/agent.f90 b/agents/fortran/agent.f90
new file mode 100644
index 0000000..3f4c1ae
--- /dev/null
+++ b/agents/fortran/agent.f90
@@ -0,0 +1,446 @@
+! From the darkness of the 1970s came forth a language so foul and terrible that none can speak its name without shuddering in fear.
+! And woe unto all who seek to use it, for decades of development have not dulled it's magnificent horror.
+
+module qchess
+ implicit none
+
+ ! Fortran90 doesn't have enums...
+ integer, parameter :: KING=1, QUEEN=2, ROOK=3, KNIGHT=4, BISHOP=5, PAWN=6, UNKNOWN=7
+ ! Also it's case insensitive, but I thought I would make an effort to be consistent even if Fortran90 won't
+ integer, parameter :: NONE=0, WHITE=2, BLACK=1
+
+ integer, parameter :: BUFSIZ = 256 ! Need this for strings...
+
+ integer, parameter :: STDERR = 0
+
+ ! But it has types!
+ type piece
+ integer :: x
+ integer :: y
+ integer :: types(2)
+ integer :: type_index
+ integer :: colour
+ end type piece
+
+ ! And... really... confusing... pointer... stuff
+ ! (You can't have an array of pointers... but you can have an array of piece_ptr)
+ type piece_ptr
+ type(piece), pointer :: p
+ end type piece_ptr
+
+ type board
+ type(piece_ptr) :: grid(8,8)
+ ! If I wrote this:
+ ! type(piece), pointer :: grid(:,:)
+ ! It would be a pointer to an array of pieces... not an array of pointers to pieces
+ type(piece_ptr) :: pieces(2,16)
+ type(piece_ptr) :: kings(2)
+ end type board
+
+ type square
+ integer :: x
+ integer :: y
+ end type square
+
+
+end module qchess
+
+
+program agent
+
+ use qchess
+ implicit none
+
+ type(board) :: b
+
+ type(square), allocatable :: moves(:)
+ character(len = BUFSIZ) :: buffer
+ character(len = BUFSIZ) :: buffer2
+ character(len = 2) :: s
+ integer :: x, y, x2, y2, i, t, colour
+ real :: rand(1)
+
+
+ type(piece_ptr) :: choice
+
+ allocate(moves(0))
+
+ call board_init(b)
+
+ call random_seed(i) ! Probably want to fix this...
+
+
+ read(*, '(A)') buffer
+ if (buffer .eq. "white") then
+ colour = WHITE
+ else
+ colour = BLACK
+ endif
+
+
+
+ do while (.true.)
+ read(*, '(A)') buffer
+ !write(STDERR,*) "Got: ", buffer
+ if (buffer .eq. "QUIT black" .or. buffer .eq. "QUIT white") then
+ exit
+ else if (buffer .eq. "SELECTION?") then
+
+ do while(.true.)
+ call random_number(rand)
+ i = int(rand(1) * (size(b%pieces(colour,:)) - 1)) + 1
+ choice = b%pieces(colour, i)
+ if (associated(choice%p)) then
+ exit
+ endif
+ enddo
+ !write(STDERR,*) "Selected:", choice%p%x-1, choice%p%y-1
+ write(*,*) choice%p%x-1, choice%p%y-1
+
+ else if (buffer .eq. "MOVE?") then
+
+ call random_number(rand)
+ call possible_moves(b, choice%p, moves)
+
+ if (size(moves) == 0) then
+ !write(STDERR,*) "No moves!"
+ endif
+
+ do i=1,size(moves)
+ !write(STDERR,*) "Possible move:", i, "->", moves(i)%x-1, moves(i)%y-1
+ enddo
+
+ i = int(rand(1) * (size(moves) - 1)) + 1
+
+ !write(STDERR,*) "Move",i,":", choice%p%x-1, choice%p%y-1, "->", moves(i)%x-1, moves(i)%y-1
+ write(*,*) moves(i)%x-1, moves(i)%y-1
+ deallocate(moves)
+ allocate(moves(0))
+
+ else
+
+
+ read(buffer, '(I2,I2, A)') x, y, buffer
+ x = x + 1
+ y = y + 1
+
+ buffer2 = buffer
+ read(buffer, '(A2)') s
+ if (s .eq. "->") then
+ read(buffer2, *) s, x2, y2
+ x2 = x2 + 1
+ y2 = y2 + 1
+ !write(STDERR,*) "Update:", x-1, y-1, "->" , x2-1, y2-1
+ call board_update_move(b, x, y, x2, y2)
+ else
+ read(buffer, *), i, buffer
+ t = str2type(buffer)
+ !write(STDERR,*) "Update:", x-1, y-1, "selected:" , i, "type:", t
+ call board_update_select(b, x, y, i+1, t)
+ endif
+ endif
+
+ enddo
+
+ deallocate(moves)
+
+ call board_destroy(b)
+
+contains
+
+integer function str2type(s)
+
+ character(len=BUFSIZ), intent(in) :: s
+ !write(STDERR,*) "Determine type of piece:", s, ":"
+ if (s .eq. "king") then
+ str2type = KING
+ else if (s .eq. "queen") then
+ str2type = QUEEN
+ else if (s .eq. "rook") then
+ str2type = ROOK
+ else if (s .eq. "knight") then
+ str2type = KNIGHT
+ else if (s .eq. "bishop") then
+ str2type = BISHOP
+ else if (s .eq. "pawn") then
+ str2type = PAWN
+ else if (s.eq. "unknown") then
+ str2type = UNKNOWN
+ endif
+
+end function str2type
+
+subroutine piece_init(p, colour, type1, type2)
+
+ type(piece), intent(inout) :: p
+ integer, intent(in) :: colour, type1, type2
+ p%colour = colour
+ p%types(1) = type1
+ p%types(2) = type2
+ p%type_index = 0
+
+
+end subroutine piece_init
+
+subroutine board_init(b)
+ type(board), intent(inout) :: b
+ integer :: x, y, j
+ integer :: colour
+
+ do x=1,8
+ do y=1,8
+ nullify(b%grid(x,y)%p)
+ enddo
+ enddo
+
+ ! Add the pieces
+
+
+
+ do colour=1,2
+ j = 1
+ if (colour .eq. WHITE) then
+ y = 7
+ else
+ y = 2
+ endif
+
+ ! Add pawns
+ do x=1,8
+ allocate(b%grid(x,y)%p)
+ call piece_init(b%grid(x,y)%p, colour, PAWN, UNKNOWN)
+ b%pieces(colour, j) = b%grid(x,y)
+ j = j + 1
+ enddo
+
+ ! Add other pieces
+ if (colour .eq. WHITE) then
+ y = 8
+ else
+ y = 1
+ endif
+
+ do x=1, 8
+ allocate(b%grid(x, y)%p)
+ b%pieces(colour, j) = b%grid(x,y)
+ j = j + 1
+ enddo
+ call piece_init(b%grid(1,y)%p, colour, ROOK, UNKNOWN)
+ call piece_init(b%grid(2,y)%p, colour, KNIGHT, UNKNOWN)
+ call piece_init(b%grid(3,y)%p, colour, BISHOP, UNKNOWN)
+ call piece_init(b%grid(4,y)%p, colour, KING, KING)
+ call piece_init(b%grid(5,y)%p, colour, QUEEN, UNKNOWN)
+ call piece_init(b%grid(6,y)%p, colour, BISHOP, UNKNOWN)
+ call piece_init(b%grid(7,y)%p, colour, KNIGHT, UNKNOWN)
+ call piece_init(b%grid(8,y)%p, colour, ROOK, UNKNOWN)
+
+ b%kings(colour) = b%grid(4, y)
+ enddo
+
+ do x=1,8
+ do y=1,8
+ if (associated(b%grid(x,y)%p)) then
+ b%grid(x,y)%p%x = x
+ b%grid(x,y)%p%y = y
+ !write(STDERR,*) "Piece", b%grid(x,y)%p%types(1), "at", x, y
+ endif
+ enddo
+ enddo
+
+end subroutine board_init
+
+subroutine board_update_select(b, x, y, type_index, t)
+
+ integer, intent(in) :: x, y, type_index, t
+ type(board), intent(inout) :: b
+ b%grid(x, y)%p%type_index = type_index
+ b%grid(x, y)%p%types(type_index) = t
+
+end subroutine board_update_select
+
+subroutine board_update_move(b, x, y, x2, y2)
+
+ type(board), intent(inout) :: b
+ integer, intent(in) :: x, y, x2, y2
+ integer :: colour, i
+
+
+
+ if (associated(b%grid(x2, y2)%p) .eqv. .true.) then
+ colour = b%grid(x2,y2)%p%colour
+ do i=1,16
+ if (associated(b%pieces(colour, i)%p, b%grid(x2, y2)%p)) then
+ b%pieces(colour, i)%p => NULL()
+ endif
+ enddo
+ deallocate(b%grid(x2,y2)%p)
+ endif
+
+ b%grid(x2,y2) = b%grid(x,y)
+ b%grid(x,y)%p%x = x2
+ b%grid(x,y)%p%y = y2
+ b%grid(x,y)%p => NULL()
+
+
+
+end subroutine board_update_move
+
+subroutine possible_moves(b, p, m)
+
+ type(board), intent(in) :: b
+ type(piece), intent(in) :: p
+ type(square), intent(inout), allocatable :: m(:)
+ type(square), allocatable :: copy(:)
+
+ integer :: i
+ integer :: x, y
+
+
+
+
+ do x=1,8
+ do y=1,8
+ if (legal_move(b, p, x, y) .eqv. .true.) then
+ allocate(copy(size(m) + 1))
+ copy(1:size(m)) = m
+ deallocate(m)
+ allocate(m(size(copy)))
+ m(1:size(copy)) = copy
+ deallocate(copy)
+
+ m(size(m))%x = x
+ m(size(m))%y = y
+ else
+ !write(STDERR,*) "Piece of type", p%types(p%type_index), "can't move from", p%x, p%y, "to", x, y
+ endif
+
+ enddo
+ enddo
+
+end subroutine possible_moves
+
+logical function legal_move(b, p, x, y)
+
+ type(board), intent(in) :: b
+ type(piece), intent(in) :: p
+ integer, intent(in) :: x, y
+
+
+ integer :: t, c, xx, yy
+
+ if (x .le. 0 .or. x .gt. 8 .or. y .le. 0 .or. y .gt. 8) then
+ legal_move = .false.
+ return
+ endif
+
+ t = p%types(p%type_index)
+ c = p%colour
+
+ !write(STDERR,*) "Test legal move for piece", p%types(p%type_index), "at", p%x-1, p%y-1, "->", x-1, y-1
+
+ ! Establish move is into empty square or takes a piece
+ legal_move = .not. (associated(b%grid(x,y)%p) .and. b%grid(x,y)%p%colour .eq. c)
+ if (legal_move .eqv. .false.) then
+ return ! Move into allied square; not allowed
+ endif
+
+
+ if (t == PAWN) then
+ ! Check y coord
+ legal_move = (c == WHITE .and. y == p%y - 1 .or. (y == p%y-2 .and. p%y == 7)) &
+ .or. (c == BLACK .and. y == p%y+1 .or. (y == p%y+2 .and. p%y == 1))
+ ! Check x coord
+ legal_move = legal_move .and. (x == p%x)
+ if (legal_move .eqv. .true.) then
+ ! Can't move pawn forward into any occupied square
+ legal_move = .not. associated(b%grid(x,y)%p)
+ return
+ endif
+
+ if (associated(b%grid(x,y)%p) .eqv. .true.) then
+ ! Can take diagonally
+ legal_move = (c == WHITE .and. y == p%y - 1 .and. abs(x - p%x) == 1) &
+ .or. (c == BLACK .and. y == p%y+1 .and. abs(x - p%x) == 1)
+ endif
+
+ return
+ endif
+
+ if (t == KING) then
+ legal_move = (abs(x - p%x) .le. 1 .and. abs(y - p%y) .le. 1)
+ return
+ endif
+
+ if (t == KNIGHT) then
+
+ legal_move = ((abs(x - p%x) == 2 .and. abs(y - p%y) == 1) &
+ .or. (abs(x - p%x) == 1 .and. abs(y - p%y) == 2))
+ return
+ endif
+
+ if (t == BISHOP .or. t == QUEEN) then
+ legal_move = (abs(x - p%x) .eq. abs(y - p%y))
+ endif
+
+ if (t == ROOK .or. (t == QUEEN .and. .not. legal_move)) then
+ legal_move = (abs(x - p%x) == 0 .or. abs(y - p%y) == 0)
+ endif
+
+ if (legal_move .eqv. .false.) then
+ return
+ endif
+
+ xx = p%x
+ yy = p%y
+ do while (xx .ne. x .or. yy .ne. y)
+ if (xx .gt. x) then
+ xx = xx - 1
+ endif
+ if (xx .lt. x) then
+ xx = xx + 1
+ endif
+ if (yy .gt. y) then
+ yy = yy - 1
+ endif
+ if (yy .lt. y) then
+ yy = yy + 1
+ endif
+
+ if (associated(b%grid(xx,yy)%p)) then
+ legal_move = .false.
+ return
+ endif
+ enddo
+
+
+
+end function legal_move
+
+subroutine board_destroy(b)
+ type(board), intent(inout) :: b
+
+ integer :: x, y, c, i
+
+ do x=1, 8
+ do y=1,8
+ if (associated(b%grid(x,y)%p)) then
+ deallocate(b%grid(x,y)%p)
+ b%grid(x,y)%p => NULL()
+
+ endif
+ enddo
+ enddo
+
+ do c=1,2
+ do i=1,16
+ b%pieces(c, i)%p =>NULL()
+ enddo
+
+ b%kings(c)%p => NULL()
+ enddo
+
+end subroutine board_destroy
+
+
+
+end program agent
--
GitLab