!-------------------------------------------------------------------------------------

!		******************************************************
!				CS 101  PROJECT WORK
!				     BILLIARDS
!			
!				Amol Deshmukh
!				roll No.  03d10028
!				E-mail : deshmukhamol@iitb.ac.in
!		******************************************************

!---------------------------------------------------------------------------------------
module data
implicit none
save

! information about balls,defines their position,velocity etc
real,dimension(3,2) :: coord,velo		! coordinates,velocity
integer,dimension(3,3) :: status		! colour,existance,hit by
integer,dimension(2,2) :: points		! points,last points scored
integer :: player,mode

end module

!-----------------/////////////////////////////////-------------------------------------------
! initial values of all variables+data
program BILLIARDS_MAIN
use data
implicit none

integer :: i,j,k

player=1
mode=1

do i=1,2
points(i,1)=0					! actual points
points(i,2)=0					! increase
end do

do i=1,3					   ! initial velocities zero		
	velo(i,1)=0.0
	velo(i,2)=0.0
	status(i,3)=0				! hit by
end do

status(1,1)=1                                       ! colours
status(2,1)=7
status(3,1)=2

status(1,2)=1					   ! initial existance 	on table
status(2,2)=0
status(3,2)=1

coord(1,1)=32.0					   ! initial locations	
coord(1,2)=30.0
coord(2,1)=32.0
coord(2,2)=30.0
coord(3,1)=32.0
coord(3,2)=80.0

call display()

end program

!-----------------------///////////////////////////////////////-----------------------------
subroutine display()
use data
implicit none

integer :: PGBEG,PGCURS,i,j,k,tmp,speed=200,round=0
real :: x,y,ang=0.0,angle,d
character :: ch
character(20) :: char
real,dimension(2) :: xl,yl

i=PGBEG(0,"/XWIN",1,1)
if(i/=1) stop
call PGWNAD(0.0,100.0,0.0,100.0)
!--------------------------------------------------------------------------------------------
call PGSCH(2.0)						! animation
call PGSCF(4)
call PGSFS(1)
do i=1,720
	call PGSCI(26)
	call PGRECT(0.0,100.0,0.0,100.0)
	call PGSCI(12)
	call PGPTXT(50.0,50.0,i+0.0,0.5,"B I L L I A R D S")
	j=0
	do k=1,600000
		j=j+1
	end do
end do
call system("sleep 5")
!----------------------------------------------------------------------------------------------
do while(round<10)					! 10/2 rounds

call table()						! table & menu display

do i=0,20						! speed display
call PGRECT(58.0+i*2.0,58.0+i*2.0,17.5,21.5)
end do
call PGSCI(7)
call PGRECT(58.0,58.0+speed/10,19.0,20.0)

do i=1,3					    ! displaying balls
	if(status(i,2)==1.0) then
		call PGSCI(status(i,1))
		call PGCIRC(coord(i,1),coord(i,2),2.0)
	end if
end do

call PGSCI(12)
call PGTEXT(63.0,75.0,"SCORE -  BOARD")
call PGTEXT(60.0,70.0," PLAYER 1--> ")
call PGTEXT(60.0,66.0," PLAYER 2--> ")
call PGTEXT(60.0,80.0," ROUND --> ")
call PGSCI(7)
call PGNUMB(points(1,1),0,1,char,i)
call PGTEXT(90.0,70.0,char(1:i))
call PGNUMB(points(2,1),0,1,char,i)
call PGTEXT(90.0,66.0,char(1:i))
call PGNUMB(int(round/2)+1,0,1,char,i)
call PGTEXT(87.0,80.0,char(1:i))

if(mode/=0) then
	call PGSLW(7)
	call PGSCI(25)
	xl(1)=coord(player,1)				     ! cue display
	yl(1)=coord(player,2)
	xl(2)=xl(1)+25*cos(ang)
	yl(2)=yl(1)+25*sin(ang)
	call PGLINE(2,xl,yl)
	xl(2)=xl(1)+25*cos(ang)+0.2
	yl(2)=yl(1)+25*sin(ang)+0.2
	call PGLINE(2,xl,yl)
	xl(2)=xl(1)+25*cos(ang)-0.2
	yl(2)=yl(1)+25*sin(ang)-0.2
	call PGLINE(2,xl,yl)

	if(player==1) k=2					! close view
	if(player==2) k=1
	call PGSCI(status(player,1))				! player ball
	call PGCIRC(78.0,10.0,2.0)
								! other balls
	d=(coord(player,2)-coord(k,2))*cos(ang)-(coord(player,1)-coord(k,1))*sin(ang)
	call PGSCI(status(k,1))
	if(abs(d)<15 .and. status(k,2)==1) call PGCIRC(78.0-d,10.0,2.0)
	d=(coord(player,2)-coord(3,2))*cos(ang)-(coord(player,1)-coord(3,1))*sin(ang)
	call PGSCI(status(3,1))
	if(abs(d)<15) call PGCIRC(78.0-d,10.0,2.0)

	ch=" "
	tmp=PGCURS(x,y,ch)				! -------------input command
	call play(speed,ang,ch)
	if(ch=="q") round=25
	if(ch=="r") call rules()
else
	call positions()
	call collision()
	if(velo(1,1)==0.0 .and. velo(2,1)==0.0 .and. velo(3,1)==0.0) then
		k=player
		call whoplays()
		if(k/=player) round=round+1
		do i=1,3
			velo(i,2)=0.0
		end do
	end if
end if
end do

call PGSCH(2.0)					!--------final results & scores
call PGSCI(2)
call PGSCF(4)
call PGSFS(1)
call PGTEXT(20.0,70.0," PLAYER 1--> ")
call PGTEXT(20.0,60.0," PLAYER 2--> ")
call PGNUMB(points(1,1),0,1,char,i)
call PGTEXT(85.0,70.0,char(1:i))
call PGNUMB(points(2,1),0,1,char,i)
call PGTEXT(85.0,60.0,char(1:i))
if(ch=="q") then
	call PGTEXT(25.0,50.0,"GAME TERMINATED")
else
	if(points(1,1)>points(2,1)) char="PLAYER 1 WINS"
	if(points(1,1)<points(2,1)) char="PLAYER 2 WINS"
	if(points(1,1)==points(2,1)) char="GAME ENDS IN A DRAW"
	call PGTEXT(20.0,50.0,char)
	call PGTEXT(30.0,35.0,"GAME ENDS")
end if
call PGEND()
end subroutine

!------------------------------------------///////////////////////////---------------------
subroutine table()

call PGSCH(1.0)
call PGSFS(1)
call PGSCI(25)
call PGSLW(1)
call PGRECT(0.0,100.0,0.0,100.0)		    ! base rect
call PGSFS(2)
call PGSCI(2)
call PGRECT(1.0,99.0,1.0,99.0)			! red rect
call PGSCH(2.0)		         
call PGSCF(4)
call PGTEXT(62.0,90.0,"BILLIARDS")
call PGSCF(1)
call PGSCH(1.0)		         
call PGSFS(1)
call PGSCI(4)                                       
call PGRECT(7.0,57.0,5.0,95.0)                      ! outer rect blue
call PGSCI(25)
call PGCIRC(12.0,10.0,3.0)                          ! pockets
call PGCIRC(52.0,10.0,3.0)                          !
call PGCIRC(12.0,90.0,3.0)                          !
call PGCIRC(52.0,90.0,3.0)			    !	
call PGCIRC(12.0,50.0,3.0)			    !	
call PGCIRC(52.0,50.0,3.0)                          ! end 
call PGSCI(3)
call PGRECT(12.0,52.0,10.0,90.0)                    ! inner rect green
call PGSCI(5)
call PGCIRC(32.0,30.0,8.0)			    ! half circle ,full circle 	
call PGSCI(3)					    ! deleted by the
call PGRECT(12.0,52.0,30.0,39.0)                    ! deleting rect
call PGSCI(4)
call PGRECT(12.0,52.0,30.0,30.0)                    ! line  
call PGSCI(11)
call PGTEXT(65.0,25.0,"SPEED")

!				-------------------------menu
call PGTEXT(99.5,95.0,"q _____________ QUIT")
call PGTEXT(99.5,54.0,"r ____________ RULES")
call PGTEXT(99.5,91.0,"4 _____________ LEFT")
call PGTEXT(99.5,88.0,"6 ____________ RIGHT")
call PGTEXT(99.5,85.0,"8 ______________ UP")
call PGTEXT(99.5,82.0,"2 ____________ DOWN")
call PGTEXT(99.5,77.0,"k/n _ INCREASE ANGLE")
call PGTEXT(99.5,74.0,"l/m _ DECREASE ANGLE")
call PGTEXT(99.5,70.0,"(+) _______ SPEED UP")
call PGTEXT(99.5,67.0,"(-) _____ SPEED DOWN")
call PGTEXT(99.5,60.0,"g ___________ LAUNCH")

end subroutine

!------------------------------------------///////////////////////////---------------------
subroutine rules()
implicit none
integer :: k,PGCURS
character(50) :: c
real :: x,y

call PGSFS(1)
call PGSCI(26)
call PGRECT(1.0,99.0,1.0,99.0)
call PGSFS(2)
call PGSCI(13)
call PGRECT(1.0,99.0,1.0,99.0)
open(unit=1,file="rules.txt",status="old",iostat=k)		! rules.txt opened
do k=1,32
	read (1,"(a50)") c					! reading rules
	call PGTEXT(8.0,98.5-3*k,c)				! output
end do
k=PGCURS(x,y,c)
close (unit=1)
end subroutine

!------------------------------------------///////////////////////////---------------------
subroutine play(speed,ang,ch)
use data
implicit none

real,intent(inout) :: ang
character,intent(in) :: ch
integer,intent(inout) :: speed
integer :: k

if(player==1) k=2
if(player==2) k=1

select case(ch)
	case("4")
if(mode==1 .and. ((coord(player,1)-32.5)**2+(coord(player,2)-30.0)**2<64.0)) then
if(((coord(k,1)-(coord(player,1)-0.5))**2+(coord(k,2)-coord(player,2))**2<16 .and. &
status(k,2)==1) .or. ((coord(3,1)-(coord(player,1)-0.5))**2+(coord(3,2)-coord(player,2))**2<16)) then
else
			coord(player,1)=coord(player,1)-0.5
end if
end if 
	case("6")
if(mode==1 .and. ((coord(player,1)-32.0+0.5)**2+(coord(player,2)-30.0)**2<64.0)) then
if(((coord(k,1)-(coord(player,1)+0.5))**2+(coord(k,2)-coord(player,2))**2<16 .and. &
status(k,2)==1) .or. ((coord(3,1)-(coord(player,1)+0.5))**2+(coord(3,2)-coord(player,2))**2<16)) then
else
		coord(player,1)=coord(player,1)+0.5
end if
end if
	case("8")
if(mode==1 .and. ((coord(player,1)-32.0)**2+(coord(player,2)-29.5)**2<64.0) .and. coord(player,2)<30.0) then
if(((coord(k,1)-coord(player,1))**2+(coord(k,2)-(coord(player,2)+0.5))**2<16 .and. &
status(k,2)==1) .or. ((coord(3,1)-coord(player,1))**2+(coord(3,2)-(coord(player,2)+0.5))**2<16)) then
else
			coord(player,2)=coord(player,2)+0.5
end if
end if
	case("2")
if(mode==1 .and. ((coord(player,1)-32.0)**2+(coord(player,2)-30.0-0.5)**2<64.0)) then
if(((coord(k,1)-coord(player,1))**2+(coord(k,2)-(coord(player,2)-0.5))**2<16 .and. &
status(k,2)==1) .or. ((coord(3,1)-coord(player,1))**2+(coord(3,2)-(coord(player,2)-0.5))**2<16)) then
else
		coord(player,2)=coord(player,2)-0.5
end if
end if
	case("n")
		ang=ang+0.1*3.141592654/180
	case("m")
		ang=ang-0.1*3.141592654/180
	case("k")
		ang=ang+3.0*3.141592654/180
	case("l")
		ang=ang-3.0*3.141592654/180
	case("+")
		if(speed<391) speed=speed+20.0
	case("-")
		if(speed>49) speed=speed-20.0
	case("g")
		velo(player,1)=speed+0.0
		velo(player,2)=ang+3.141592654
		mode=0
		speed=200
end select

end subroutine

!-----------------------------///////////////////////////------------------------------------
subroutine positions()
use data
implicit none

integer :: i,j,k,in=0
if(player==1) k=2
if(player==2) k=1

do i=1,3					!-------------- giving new positions
	coord(i,1)=coord(i,1)+velo(i,1)*cos(velo(i,2))/250
	coord(i,2)=coord(i,2)+velo(i,1)*sin(velo(i,2))/250
	velo(i,1)=velo(i,1)-2.0
	if(velo(i,1)<0.0) then
		velo(i,1)=0.0
		velo(i,2)=0.0
	end if
end do

do i=1,3					!------- checking for ball in pocket	
	if(coord(i,1)<14.0 .or. coord(i,1)>50.0) then
		select case(int(coord(i,2)))
			case(10:13)
				in=1
			case(47:53)
				in=1
			case(87:90)
				in=1
		end select
	end if
	if(coord(i,2)<12.0 .or. coord(i,2)>88.0) then
		select case(int(coord(i,1)))
			case(12:15)
				in=1
			case(47:50)
				in=1
		end select
	end if
	if(in==1) then				! ball in pocket=TRUE ,points calculations
			velo(i,1)=0.0
			velo(i,2)=0.0
			coord(i,1)=32
			coord(i,2)=30
			status(i,2)=0
		if(i==player) then				! player ball in
			if(status(player,3)==3) then
				points(player,2)=3
				points(player,1)=points(player,1)+3
			else if(status(player,3)==k) then
				points(player,2)=2
				points(player,1)=points(player,1)+2
			else
				points(player,2)=-4
				points(player,1)=points(player,1)-4
			end if
		else if(i==3) then				! red ball in
			coord(i,1)=32
			coord(i,2)=80
			points(player,2)=+3
			points(player,1)=points(player,1)+3
		else						! second player's ball in
			points(player,2)=+2
			points(player,1)=points(player,1)+2
		end if
	end if
	in=0
end do

end subroutine

!------------------------------------------///////////////////////////---------------------
subroutine collision()
use data
implicit none

real :: t,angle,compi,compj,vi,vj
integer :: i,j,k

do i=1,3				! ---------------------colliding on walls
	if(coord(i,1)<14.0 .or. coord(i,1)>50.0) then
		velo(i,2)=3.141592654-velo(i,2)
		coord(i,1)=coord(i,1)+(velo(i,1)+10.0)*cos(velo(i,2))/500
	end if
	if(coord(i,2)<12.0 .or. coord(i,2)>88.0) then
		velo(i,2)=2*3.141592654-velo(i,2)
		coord(i,2)=coord(i,2)+(velo(i,1)+10.0)*sin(velo(i,2))/500
	end if
end do

do i=1,2				! ---------------------collision among balls
	do j=i+1,3
if((coord(i,1)-coord(j,1))**2+(coord(i,2)-coord(j,2))**2<16 .and. status(i,2)==1 .and. &
status(j,2)==1) then

if((i==player .and. status(i,3)/=j .and. status(i,3)/=0) .or. (j==player .and. status(j,3)/=i) &
.and. status(j,3)/=0) then
	points(player,2)=+2
	points(player,1)=points(player,1)+2
end if

status(i,3)=j
status(j,3)=i
vi=velo(i,1)				! initial velo. stored
vj=velo(j,1)
t=angle(coord(i,1)-coord(j,1),coord(i,2)-coord(j,2))
compi=velo(i,1)*cos(t-velo(i,2))					! components of mumentum along axis of balls
compj=velo(j,1)*cos(t-velo(j,2))

velo(j,1)=((velo(j,1)*cos(velo(j,2))+(compi-compj)*cos(t))**2+ &	! -----CONSERVATION OF MOMENTUM
(velo(j,1)*sin(velo(j,2))+(compi-compj)*sin(t))**2)**0.5
velo(i,1)=((velo(i,1)*cos(velo(i,2))+(compj-compi)*cos(t))**2+ &
(velo(i,1)*sin(velo(i,2))+(compj-compi)*sin(t))**2)**0.5
velo(j,2)=angle(vj*cos(velo(j,2))+(compi-compj)*cos(t),vj*sin(velo(j,2))+(compi-compj)*sin(t))
velo(i,2)=angle(vi*cos(velo(i,2))+(compj-compi)*cos(t),vi*sin(velo(i,2))+(compj-compi)*sin(t))
	coord(i,1)=coord(i,1)+(velo(i,1)+10.0)*cos(velo(i,2))/500
	coord(i,2)=coord(i,2)+(velo(i,1)+10.0)*sin(velo(i,2))/500
end if
	end do
end do
end subroutine

!----------------------///////////////////////////////////////////--------------
real function angle(x,y)
implicit none

real,intent(in) :: x,y
real :: t

if(x==0.0 .and. y==0.0) then
t=0.0
else if(x==0.0 .and. y>0.0) then
t=3.141592654/2
else if(x==0.0 .and. y<0.0) then
t=3*3.141592654/2
else if(y==0.0 .and. x>0.0) then
t=0.0
else if(y==0.0 .and. x<0.0) then
t=3.141592654
else

t=atan(abs(y/x))
if(x<0.0 .and. y<0.0) then
	t=t+3.141592654
else if(x<0.0 .and. y>0.0) then
	t=3.141592654-t
else if(y<0.0 .and. x>0.0) then
	t=2*3.141592654-t
end if
end if
angle=t
end function

!------------------////////////////////////////////////////////////////---------------
subroutine whoplays()
use data
implicit none

integer :: k
if(player==1) k=2
if(player==2) k=1

if(status(3,2)/=1) then
	if(((coord(k,1)-32)**2+(coord(k,2)-80)**2<16 .and. status(k,2)==1) .or. &
((coord(player,1)-32)**2+(coord(player,2)-80)**2<16)) then
		if(((coord(k,1)-32)**2+(coord(k,2)-50)**2<16 .and. status(k,2)==1) .or. &
((coord(player,1)-32)**2+(coord(player,2)-50)**2<16)) then
			coord(3,2)=30
		else
			coord(3,2)=50
		end if
	end if
end if                          

status(3,2)=1
mode=2
if(status(player,3)==0) then
points(player,1)=points(player,1)-4
points(player,2)=-4
end if

if(points(player,2)>0) then			! if points scored then player continues
	if(status(player,2)/=1) then
	mode=1
	end if
	status(player,2)=1
else 	
	if(player==1) then
		player=2
	else 
		player=1
	end if
	if(status(player,2)/=1) then
	mode=1
	status(player,2)=1
if(player==1) k=2
if(player==2) k=1
if(((coord(k,1)-32)**2+(coord(k,2)-30)**2<16 .and. status(k,2)==1) .or. &
((coord(3,1)-32)**2+(coord(3,2)-30)**2<16)) then
		coord(player,2)=26
end if
end if 
end if
points(1,2)=0
points(2,2)=0
status(1,3)=0
status(2,3)=0
status(3,3)=0
end subroutine

!-------------<<<<<<<<<<<<<<<<<<<<---END--------->>>>>>>>>>>>>>>>>>>>>>>>>>>>--------------------