Skip to content

Instantly share code, notes, and snippets.

@DSCF-1224

DSCF-1224/main.f90

Created February 3, 2024 10:01
Show Gist options
  • Save DSCF-1224/a98285a3bc4dc6bc05db8233d54df6f7 to your computer and use it in GitHub Desktop.
Save DSCF-1224/a98285a3bc4dc6bc05db8233d54df6f7 to your computer and use it in GitHub Desktop.
Download ZIP
pong-wars (Fortran 2008 ver)
Raw
main.f90
! original: https://github.com/vnglst/pong-wars
! gfortran -O3 -Wall -std=f2008 main.f90 && time ./a.out && gnuplot ./score.plt
program pong_wars
use , intrinsic :: iso_fortran_env
implicit none
logical , parameter :: square_mode_day = .true.
logical , parameter :: square_mode_night = .false.
integer , parameter :: canvas_size_x = 800
integer , parameter :: canvas_size_y = 800
integer , parameter :: square_size = 25
integer , parameter :: num_iteration = 10 ** 5 * 2
integer , parameter :: num_squares_x = canvas_size_x / square_size
integer , parameter :: num_squares_y = canvas_size_y / square_size
real(real64) , parameter :: math_pi = acos(-1.0_real64)
real(real64) , parameter :: math_pi_4 = 0.25_real64 * math_pi
real(real64) , parameter :: square_size_half = 0.50_real64 * square_size
logical , dimension(num_squares_x, num_squares_y) :: square
integer :: score_day
integer :: score_night
integer :: write_unit
real(real64) :: dx1
real(real64) :: dy1
real(real64) :: x1
real(real64) :: y1
real(real64) :: dx2
real(real64) :: dy2
real(real64) :: x2
real(real64) :: y2
open( &!
newunit = write_unit , &!
file = 'score.dat' , &!
access = 'stream' , &!
form = 'unformatted' , &!
action = 'write' , &!
status = 'replace' &!
)
block
integer :: i
do i = 1, num_squares_x
if ( i .le. (num_squares_x / 2) ) then
square(i,:) = square_mode_day
else
square(i,:) = square_mode_night
end if
end do
score_day = update_score( square_mode_day )
score_night = update_score( square_mode_night )
end block
x1 = 0.25_real64 * canvas_size_x
y1 = 0.50_real64 * canvas_size_y
dx1 = 0.50_real64 * square_size_half
dy1 = - 0.50_real64 * square_size_half
x2 = 0.75_real64 * canvas_size_x
y2 = 0.50_real64 * canvas_size_y
dx2 = - 0.50_real64 * square_size_half
dy2 = 0.50_real64 * square_size_half
write( unit=write_unit ) score_day, score_night , x1 , x2
block
integer :: i
do i = 1, num_iteration
block
real(real64) :: bounce_x
real(real64) :: bounce_y
call update_square_and_bounce( &!
x = x1 , &!
y = y1 , &!
dx = dx1 , &!
dy = dy1 , &!
square_mode = square_mode_day , &!
bounce_x = bounce_x , &!
bounce_y = bounce_y &!
)
dx1 = bounce_x
dy1 = bounce_y
call update_square_and_bounce( &!
x = x2 , &!
y = y2 , &!
dx = dx2 , &!
dy = dy2 , &!
square_mode = square_mode_night , &!
bounce_x = bounce_x , &!
bounce_y = bounce_y &!
)
dx2 = bounce_x
dy2 = bounce_y
end block
call check_boundary_collision( x=x1, y=y1, dx=dx1, dy=dy1 )
call check_boundary_collision( x=x2, y=y2, dx=dx2, dy=dy2 )
x1 = x1 + dx1
y1 = y1 + dy1
x2 = x2 + dx2
y2 = y2 + dy2
score_day = update_score( square_mode_day )
score_night = update_score( square_mode_night )
write( unit=write_unit ) score_day, score_night , x1 , x2
end do
end block
contains
pure function update_score(square_mode) result(score)
logical , intent(in) :: square_mode
integer :: score
score = count( square(:,:) .eqv. square_mode )
end function update_score
subroutine check_boundary_collision(x, y, dx, dy)
real(real64) , intent(in ) :: x
real(real64) , intent(in ) :: y
real(real64) , intent(inout) :: dx
real(real64) , intent(inout) :: dy
associate( x_plus_dx => x + dx )
associate( &!
flag_x_min => (x_plus_dx .lt. square_size_half ) , &!
flag_x_max => (x_plus_dx .gt. ( canvas_size_x - square_size_half ) ) &!
)
if ( flag_x_min .or. flag_x_max ) dx = - dx
end associate
end associate
associate( y_plus_dy => y + dy )
associate( &!
flag_y_min => (y_plus_dy .lt. square_size_half ) , &!
flag_y_max => (y_plus_dy .gt. ( canvas_size_y - square_size_half ) ) &!
)
if ( flag_y_min .or. flag_y_max ) dy = - dy
end associate
end associate
end subroutine check_boundary_collision
subroutine update_square_and_bounce(x, y, dx, dy, square_mode, bounce_x, bounce_y)
real(real64) , intent(in ) :: x
real(real64) , intent(in ) :: y
real(real64) , intent(in ) :: dx
real(real64) , intent(in ) :: dy
logical , intent(in ) :: square_mode
real(real64) , intent( out) :: bounce_x
real(real64) , intent( out) :: bounce_y
integer :: location_x
integer :: location_y
real(real64) :: angle
real(real64) :: check_x
real(real64) :: check_y
real(real64) :: cos_angle
real(real64) :: sin_angle
integer :: iter_angle
bounce_x = dx
bounce_y = dy
do iter_angle = 0, 7
angle = iter_angle * math_pi_4
cos_angle = cos(angle)
sin_angle = sin(angle)
check_x = x + cos_angle * square_size_half
check_y = y + sin_angle * square_size_half
location_x = floor( check_x / square_size )
location_y = floor( check_y / square_size )
if ( (1 .le. location_x) .and. (location_x .le. num_squares_x) ) then
if ( (1 .le. location_y) .and. (location_y .le. num_squares_y) ) then
associate( target_square => square(location_x, location_y) )
if ( target_square .neqv. square_mode ) then
target_square = square_mode
if ( abs(sin_angle) .lt. abs(cos_angle) ) then
bounce_x = - bounce_x
else
bounce_y = - bounce_y
end if
end if
end associate
end if
end if
end do
end subroutine update_square_and_bounce
end program pong_wars
Raw
score.plt
reset session
set terminal pdfcairo
set output 'score.pdf'
set xlabel 'iteration'
set ylabel 'score'
set key outside right center Left reverse
plot 'score.dat' using 0:1 binary format='%2int%2double' with lines title 'day' , \
'score.dat' using 0:2 binary format='%2int%2double' with lines title 'night'
# EOF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment