pong-wars (Fortran 2008 ver)

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

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