From 17d3a7edd766918e7e2a938125e3f72efc829222 Mon Sep 17 00:00:00 2001 From: Sam Moore 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*1C~Jof!NY1T`W$`#bl~n>Ujg zpnl!`cE9C9-nr-8bI!f@+;h);_r5o8o6EhzYOyettn5lgnEgyACy6U#m2QqoS`9mc zIoUk+aW)l{V*ELI2|m=&w=gYqUCn z5$+_wmh)={5-+8OSHmrof2oS2fKHxKFf7PSK_z!J*y9bh zn#X`hfv#|Spfd!Y#_+RqBm~GwB4`#dD`EuwW&bNSaMEMJI>dOmwgX1aYd?cQ=3`Q$ z1$l~-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%aJvej>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=xyRQF;?UFtO zKb^Y~pC<90L1=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#zhmJwhHMhS)^(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 zBT6Zr0J1C zO<&)q>8pFSxT`PDVtqH;MJ_r~vh5sXdpU8s$bopXE$KRlal*dh;OIRtEJ_CB&Qjy{ zeK5Yfr$l!h67<FyT!zSTW<#t42 zI&PF|h?u%TMu~{=7hPlevladNpgz!lY+lt+#ZYv@B8{>nTat_txrjGFNj_ikq&{qx z%-7w~&m&Y~q%4t0mN2h2I+4CjeQC9%)TrW^cuEIs-Xca1~Ew%9$e zM^-(#y|zX^kw>w)bK$xZDzHRwqi8aGUeI%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 zdYxUKx8ks1?`}g50Ihn zCWg$7^)5nnS0Ai4Nd3fkz}6Hsce&#lO#`4B!r1ygHyl#nU1&LN)Q)6^LLA5NjoMT0 z=3#f@>ao!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-`OOElWSbpcTU)RZAt7Cy!cAEUyX>He9zgLp=>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-GaFCDE$u+y^r@TN_0=Zvo(q3S3Wogy^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!Nr={Qhb}Z=kc9ltM~?j3|U|3MO!mOg@<%-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|8Z>4*+Q^R3+aCGeFToonHJ^Yja3~a>`!jmYSH4Fw zR)Y6Z;&@^@k&YZzZ;bGFS5h8yn7^_@nnj}b$4-=*WMN%6?Ca?k$ zqst!Yz5}?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+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`qUla5m)b#WUqo&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*Xja7rbOt##fq~l+FWvmdIvZF9E$Y zkDgktKZ}(k8rL(Osd%n9)^PevBd#kteb2+L5EG<(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(?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=ALhm7C*|=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} znBR0lD(C@D9wCxOVzK=?NU;Hk7ATC zSKfxo&GoDOT8~o*sCFtfx$+Ja5KYyu?#p*Og~Z9^X--r9m4e;4DtW&_5gFp8q~IOM z%TU4T>N2BFICQx3}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