program amazons

	integer*4 board(152),icol,ok,nummvs(4),value,style(4,2)
	integer*4 plaopt,whois1,whois2,sum1,sum2,gmove,whosmv
	integer*4 iboard(152)
	character*8 s1,s2
	character*24 string
	character*40 comment
	data iboard/13*-1,0,0,0,2,0,0,2,0,0,0,-1,-1,10*0,-1,-1,
     1   10*0,-1,-1,2,8*0,2,-1,-1,10*0,-1,-1,10*0,-1,-1,1,8*0,
     2   1,-1,-1,10*0,-1,-1,10*0,-1,-1,0,0,0,1,0,0,1,0,0,0,
     3   13*-1,86,95,125,128,17,20,50,59/
	common/pstyle/style,whosmv,gmove,s1,s2

 1	continue
	do ib=1,152
	  board(ib)=iboard(ib)
	end do
	type 9000
	accept 9001,plaopt
	whosmv=1
	gmove=1
	do io=1,4
	  style(io,1)=5-io
	  style(io,2)=5-io
	end do
	irestor=0
	if(plaopt.lt.0) then  ! restore
	  plaopt=-plaopt
	  type 9002
	  accept 9001,nmoves
	  read(94,9007) comment
	  write(95,9007) comment
	  read(94,9007) comment
	  write(95,9007) comment
	  read(94,9007) comment
	  write(95,9007) comment
	  do io=1,nmoves
	    read(94,9007) string
	    call getmov(board,1,ok,string(6:13),2)
	    if(io.lt.nmoves.or.string(16:16).ne.' ') then
	      call getmov(board,2,ok,string(16:23),2)
	      write(95,9007) string
	    else
	      s1=string(6:13)
	      whosmv=2
	      gmove=nmoves
	    end if
	  end do
	  if(gmove.eq.1) gmove=nmoves+1
	  irestor=1
	  close(94)
	end if
	if(plaopt.eq.0) then
	  stop
	else if(plaopt.eq.1) then
	  whois1=1   ! human
	  whois2=0   ! computer
	  type 9004
	  accept 9005,(style(is,2),is=1,4)
	  if(irestor.eq.0) write(95,9202)
	else if(plaopt.eq.2) then
	  whois1=0
	  type 9003
	  accept 9005,(style(is,1),is=1,4)
	  whois2=1
	  if(irestor.eq.0) write(95,9203)
	else if(plaopt.eq.3) then
	  whois1=1
	  whois2=1
	  if(irestor.eq.0) write(95,9200)
	else if(plaopt.eq.4) then
	  whois1=0
	  type 9003
	  accept 9005,(style(is,1),is=1,4)
	  whois2=0
	  type 9004
	  accept 9005,(style(is,2),is=1,4)
	  if(irestor.eq.0) write(95,9204)
	end if
	if(irestor.eq.0) then
	  type 9006
	  accept 9008,comment
	  write(95,9007) comment
	end if
	call draw(board,0)
	if(whosmv.eq.2) go to 20
 10	continue
	call getmov(board,1,ok,s1,whois1)
	if(ok.eq.-1) go to 200
	if(ok.eq.0) go to 10
	call draw(board,0)
	call count(board,1,nummvs,sum1,value,0)
		type *,(nummvs(kl),kl=1,4),value
	call count(board,2,nummvs,sum2,value,0)
		type *,(nummvs(kl),kl=1,4),value
	whosmv=2
	if(sum1.eq.0.or.sum2.eq.0) then
	  s2='        '
	  write(95,9201) gmove,s1,s2
	  go to 100
	end if
 20	continue
	call getmov(board,2,ok,s2,whois2)
	if(ok.eq.-1) go to 200
	if(ok.eq.0) go to 20
	call draw(board,0)
	call count(board,1,nummvs,sum1,value,0)
		type *,(nummvs(kl),kl=1,4),value
	call count(board,2,nummvs,sum2,value,0)
		type *,(nummvs(kl),kl=1,4),value
	whosmv=1
	write(95,9201) gmove,s1,s2
	if(sum1.eq.0.or.sum2.eq.0) go to 100
	gmove=gmove+1
	go to 10
 100	continue  ! game over
	if(sum1.eq.0.and.(sum2.gt.0.or.whosmv.eq.1)) then  ! Black wins
	  if(plaopt.eq.3.or.plaopt.eq.4) then
	    type 9206
	    write(95,9206)
	  else if(plaopt.eq.1) then
	    type 9208
	    write(95,9208)
	  else if(plaopt.eq.2) then
	    type 9210
	    write(95,9210)
	  end if
	else if((sum1.gt.0.or.whosmv.eq.2).and.sum2.eq.0) then ! White wins
	  if(plaopt.eq.3.or.plaopt.eq.4) then
	    type 9205
	    write(95,9205)
	  else if(plaopt.eq.1) then
	    type 9209
	    write(95,9209)
	  else if(plaopt.eq.2) then
	    type 9207
	    write(95,9207)
	  end if
	end if
	call draw(board,1)
	go to 1
 200	continue
	close(95)

 9000	format(' Player options : ',/,' 0 = exit ',/,
     1   ' 1 = player plays White ',/,' 2 = player plays Black ',/,
     2   ' 3 = players play both ',/,' 4 = computer plays both :   ',$)
 9001	format(i6)
 9002	format(' How many moves to restore ? ',$)
 9003	format(' Enter White playing style : ',$)
 9004	format(' Enter Black playing style : ',$)
 9005	format(4i7)
 9006	format(' Enter game comment : ',$)
 9007	format(' ',a)
 9008	format(a)
 9200	format(' The Game of the Amazons ',/,'      White     Black ')
 9201	format(' ',i3,'  ',a,'  ',a)
 9202	format(' The Game of the Amazons ',/,'      Human    Computer ')
 9203	format(' The Game of the Amazons ',/,'     Computer   Human  ')
 9204	format(' The Game of the Amazons ',/,'      WhiteC    BlackC ')
 9205	format('    White wins ')
 9206	format('              Black wins ')
 9207	format('       I win ')
 9208	format('                 I win ')
 9209	format('      you win ')
 9210	format('                you win ')
	end
c	
	subroutine draw(board,output)
	integer*4 board(152),output
	character*1 pictur(7)
	data pictur/' ','-','O','X',' ',' ','@'/
	type *,' '
	if(output.eq.1) write(95,9002)
	if(output.eq.2) write(95,9003)
	do io=10,1,-1
	  if(output.eq.0) then
	    type 9000,(io,(pictur(2+board(jo+12*(11-io))),jo=2,11))
	  else
	    write(95,9000) io,(pictur(2+board(jo+12*(11-io))),jo=2,11)
	  end if
	end do	  
	if(output.eq.0) then
	  type 9001
	else
	  write(95,9001)
	end if
	return
 9000	format(i4,' ',10(a1,' '))
 9001	format('     a b c d e f g h i j',/,' ')
 9002	format(' ',/,'  Final Position ',/,' ')
 9003	format(' ',/,'        Position ',/,' ')
	end
C
	subroutine getmov(board,kolor,ok,movout,which)
	integer*4 board(152),legal(120),dum1(4),value1,value2,nvalue
	integer*4 moves(9,8),bnumbr,bvalue,bhere,bthere,byon,bpiece
	integer*4 here,there,yon,ok,diff,adiff,step,which,dum2
	integer*4 style(4,2),whosmv,gmove
	character*40 comment
	character*8 move,movout,s1,s2
	data legal/9*1,0,11,12,13,8*0,11,0,12,0,13,6*0,11,0,0,12,0,0,
     1   13,4*0,11,3*0,12,3*0,13,0,0,11,4*0,12,4*0,13,11,5*0,12,4*0,11,
     2   13,5*0,12,3*0,11,2*0,13,4*0,12,2*0,11,4*0,13,3*0,12,8*0,13,3*0/
	data moves/1,2,3,4,5,6,7,8,9,-1,-2,-3,-4,-5,-6,-7,-8,-9,
     1   11,22,33,44,55,66,77,88,99,-11,-22,-33,-44,-55,-66,-77,-88,
     2   -99,12,24,36,48,60,72,84,96,108,-12,-24,-36,-48,-60,-72,-84,
     3   -96,-108,13,26,39,52,65,78,91,104,117,-13,-26,-39,-52,-65,
     4   -78,-91,-104,-117/
	common/pstyle/style,whosmv,gmove,s1,s2

	if(which.eq.0) then
	  movout(1:8)='        '
	  go to 1000
	else if(which.eq.2) then
	  move=movout
	else
	  movout(1:8)='        '
 2	  continue
	  if(kolor.eq.1) then
	    type 9100,gmove
	  else if(kolor.eq.2) then
	    type 9101,gmove
	  end if
	  accept 9002,move
	  if(move(1:2).eq.'--'.or.move(1:2).eq.'**') then
	    if(kolor.eq.2) then
C	      dump White's move
	      write(95,9204) gmove,s1
	      s1='        '
	    end if
	    if(move(1:2).eq.'**') then
	      ok=-1
	      call draw(board,2)
	      return
	    else
	      call draw(board,2)
	      go to 2
	    end if
	  else if(move(1:2).eq.'""') then
	    if(kolor.eq.2) then
C	      dump White's move
	      write(95,9204) gmove,s1
	      s1='        '
	    end if
	    type 9003
	    accept 9002,comment
	    write(95,9004) comment
	    go to 2
	  end if
	end if
	call whatsq(here,move(1:2))
	call whatsq(there,move(3:4))
	call whatsq(yon,move(6:7))
	ok=0
	if(board(here).eq.kolor) then
	  go to 15  ! starting square has own amazon
	else if(board(here).eq.-1) then
	  type *,' illegal move -- nonexistent starting square '
	else if(board(here).eq.0) then
	  type *,' illegal move -- starting square empty '
	else if(board(here).eq.3-kolor) then
	  type *,' illegal move -- moving wrong color piece '
	else if(board(here).eq.5) then
	  type *,' illegal move -- starting square filled '
	end if
	return
 15	continue
	if(board(there).eq.0) then
	  go to 20  ! landing square vacant
	else if(board(there).eq.-1) then
	  type *,' illegal move -- nonexistent landing square '
	else if(board(there).eq.3-kolor) then
	  type *,' illegal move -- cannot capture opposing amazons '
	else if(board(there).eq.kolor) then
	  type *,' illegal move -- cannot capture own amazons '
	else if(board(there).eq.5) then
	  type *,' illegal move -- landing square filled '
	end if
	return
 20	continue
	diff=there-here
	adiff=abs(diff)
	if(legal(adiff).eq.0) then
          type *,' illegal -- not a diagonal or orthogonal move '
	  return
	end if
	step=legal(adiff)
	if(diff.lt.0) step=-step
	do io=here+step,here+diff,step
	  if(board(io).eq.-1) then
C	    path looks straight but must be wraparound move
	    type *,' illegal -- not a diagonal or orthogonal move '
	    return
	  else if(board(io).ne.0) then
	    type *,' illegal -- movement path is obstructed '
	    return
	  end if
	end do
C	transfer part of move is legal
C	make it so we can fire into/through starting square
	board(here)=0
	board(there)=kolor
C	check for legality of firing part of move
	if(board(yon).ne.0) then
	  if(board(yon).eq.-1) then
	    type *,' illegal -- cannot fire off board '
	  else if(board(yon).eq.5) then
	    type *,' illegal -- firing square already filled '
	  else
	    type *,' illegal -- firing square contains an amazon '
	  end if
	  go to 200
	end if
	diff=yon-there
	adiff=abs(diff)
	if(legal(adiff).eq.0) then
          type *,' illegal -- not a diagonal or orthogonal firing path '
	  go to 200
	end if
	step=legal(adiff)
	if(diff.lt.0) step=-step
	do io=there+step,there+diff,step
	  if(board(io).eq.-1) then
	    type *,' illegal -- cannot fire off board '
	    go to 200
	  else if(board(io).ne.0) then
	    type *,' illegal -- firing path is obstructed '
	    go to 200
	  end if
	end do
C	all tests for legal move passed
	board(yon)=5
	ok=1
	movout(1:8)=move
C	insert parentheses for consistent format
	movout(5:5)='('
	movout(8:8)=')'
C	reset amazon location
	do io=140+(4*kolor)+1,140+(4*kolor)+4
	  if(board(io).eq.here) board(io)=there
	end do
	return
C	illegal firing move -- return amazon to previous location
 200	continue
	board(here)=kolor
	board(there)=0
	ok=0
	return

C	**********************************************************
 1000	continue    ! find computer move
	bnumbr = 0
	bvalue = -999
	bhere = 0
	bthere = 0
	byon = 0
	bpiece = 0
	do io=1,4
	  iwhich=140+(4*kolor)+io
	  mstart=board(iwhich)
	  do jo=1,8
	    do ko=1,9
	      mend=mstart+moves(ko,jo)
	      if(mend.lt.14.or.mend.gt.131) go to 1006
	      if(board(mend).ne.0) go to 1006
C	      legal -- make tentative move -- count possible shots
	      board(mstart)=0
	      board(mend)=kolor
	      board(140+(4*kolor)+io)=mend
	      do lo=1,8
	        do mo=1,9
	          mstop=mend+moves(mo,lo)
	          if(mstop.lt.14.or.mstop.gt.131) go to 1005
	          if(board(mstop).ne.0) go to 1005
	          bnumbr=bnumbr+1
	          board(mstop)=5
	          call count(board,3-kolor,dum1,dum2,value1,1)
	          call count(board,kolor,dum1,dum2,value2,1)
	          nvalue=value2-value1  ! want this large and positive
	          if(nvalue.gt.bvalue) then
	            bpiece=io
	            bvalue=nvalue
	            bhere=mstart
	            bthere=mend
	            byon=mstop
	          end if
	          board(mstop)=0
	        end do
 1005	        continue
	      end do
	      board(mstart)=kolor
	      board(mend)=0
	      board(140+(4*kolor)+io)=mstart
	    end do
 1006	    continue
	  end do
	end do
C	make selected best move
	type *,' total number of moves/shots = ',bnumbr
	type *,' best move found has value = ',bvalue
	board(bhere)=0
	board(bthere)=kolor
	board(byon)=5
	board(140+(4*kolor)+bpiece)=bthere
	movout(1:8)='    (  )'
	call namesq(bhere,movout(1:2))
	call namesq(bthere,movout(3:4))
	call namesq(byon,movout(6:7))
	if(kolor.eq.1) then
	  type 9102,gmove,movout
	else
	  type 9103,gmove,movout
	end if
	ok=1
	return

 9002	format(a)
 9003	format(' Enter annotation comment : ',$)
 9004	format(' ',/,'    ',a,/,' ')
 9100	format(' Enter White''s move ',i3,' : ',$)
 9101	format(' Enter Black''s move ',i3,' : ',$)
 9102	format(' My White move ',i3,' is ',a)
 9103	format(' My Black move ',i3,' is ',a)
 9204	format(' ',i3,'  ',a,'  ')
	end
C	
	subroutine whatsq(locat,alg)
	integer*4 locat
	character*2 alg
	character*10 rows
	character*20 cols
	data rows/'0987654321'/
	data cols/'abcdefghijABCDEFGHIJ'/
	i1=index(rows,alg(2:2))
	i2=index(cols,alg(1:1))
	if(i2.gt.10) i2=i2-10
	if(i1.ge.1.and.i1.le.10.and.i2.ge.1.and.i2.le.10) then
	  locat=(12*i1)+1+i2
	else
	  locat=1
	end if
	return
	end
C
	subroutine namesq(locat,alg)
	integer*4 locat
	character*2 alg
	character*10 nrows,ncols
	data nrows/'0987654321'/
	data ncols/'abcdefghij'/

	i1=locat/12
	i2=locat-(1+(12*i1))
	alg(1:1)=ncols(i2:i2)
	alg(2:2)=nrows(i1:i1)
	return
	end
C
	subroutine count(board,kolor,howmany,raw,sum,full)
	integer*4 board(152),howmany(4),vector(4),moves(9,8)
	integer*4 style(4,2)
	integer*4 kolor,raw,sum,whosmv,cnumbr,gmove,full
	character*8 s1,s2
	data moves/1,2,3,4,5,6,7,8,9,-1,-2,-3,-4,-5,-6,-7,-8,-9,
     1   11,22,33,44,55,66,77,88,99,-11,-22,-33,-44,-55,-66,-77,-88,
     2   -99,12,24,36,48,60,72,84,96,108,-12,-24,-36,-48,-60,-72,-84,
     3   -96,-108,13,26,39,52,65,78,91,104,117,-13,-26,-39,-52,-65,
     4   -78,-91,-104,-117/
	common/pstyle/style,whosmv,gmove,s1,s2

	do io=1,4
	  howmany(io)=0
	  iwhich=140+(4*kolor)+io
	  mstart=board(iwhich)
	  do jo=1,8
	    do ko=1,9
	      mend=mstart+moves(ko,jo)
	      if(mend.lt.14.or.mend.gt.131) go to 6
	      if(board(mend).ne.0) go to 6
	      if(full.eq.1.and.gmove.gt.7) then
	        board(mstart)=0
	        board(mend)=kolor
	        board(iwhich)=mend
	        cnumbr=0
	        do lo=1,8
	          do mo=1,9
	            mstop=mend+moves(mo,lo)
	            if(mstop.lt.14.or.mstop.gt.131) go to 5
	            if(board(mstop).ne.0) go to 5
	            cnumbr=cnumbr+1
	          end do
 5	          continue
	        end do
	        board(mstart)=kolor
	        board(mend)=0
	        board(iwhich)=mstart
	        howmany(io)=howmany(io)+cnumbr
	      else
	        howmany(io)=howmany(io)+1
	      end if
	    end do
 6	    continue
	  end do
	end do
	raw=howmany(1)+howmany(2)+howmany(3)+howmany(4)
	do io=1,4
	  vector(io)=howmany(io)
	end do
	call swap2(vector(1),vector(2))
	call swap2(vector(2),vector(3))
	call swap2(vector(3),vector(4))
	call swap2(vector(1),vector(2))
	call swap2(vector(2),vector(3))
	call swap2(vector(1),vector(2))
	sum=0
	do io=1,4
	  sum=sum+(style(io,whosmv)*vector(io))
	end do
	return
	end
C
	subroutine swap2(a,b)
	integer*4 a,b,c
	if(a.gt.b) then
	  c=a
	  a=b
	  b=c
	end if
	return
	end