Below is the text of the program that I been given to modify. This is a program that represent random collisions of two balls in an enclosed area. There are a few things that i need to do but i am stuck....lolz Many thanks if anyone could HELP! cheers
P.S This is a F90 text, There are no errors when i run it, but i just couldnt get the result i wanted
What I have to do is:
1) introduce the elasticity between the walls, and the ball. and(coefficent of restitution) that can be insert by the user. In which the ball WILL COLLIDE and SLOW DOWN.
Line 331 Couldnt work
2) introduce real time, time step variable
Line 286 - 300, (couldnt do it) please give suggestion is creation an output the print on the screen that has a real time counting....
3) Call a halt when any key pressed during the graphics shown
See subrountine* get_key_if_pressed
Thanks if any one could reply me a solution
CHEERS!!
!----------------------------------------------------------------------
! GRAPHICS DEMONSTRATION PROGRAM
! Ball Bouncing Within a Rectangular Enclosure
! Original Text Written by JGL Aston
!
!----------------------------------------------------------------------
MODULE system_data
IMPLICIT none
SAVE
INTEGER ,PARAMETER:: screen=6, keyboard=5, no_points = 18
REAL, PARAMETER :: pi = 3.14159
Type components
REAL:: x,z
End type components
!Regulation snooker balls are 52.5 mm (approximately 2-1?8 inches) in diameter,r = 26.25
!A standard tournament snooker table measures 3569mm by 1778mm (11ft 8.5in by 5ft 10in).
!The Dimensions divided by a factor of 3
TYPE(components):: ball_centre, ball_2centre, field_size= (357.0,178.0), fieldtwo_size= (357.0,178.0), velocity, velocitytwo
REAL, DIMENSION(0:no_points):: ball_circumf_x, ball_circumf_z, ball_2circumf_x, ball_2circumf_z
REAL :: ball_radius=2.625, start_angle=pi/6.0
Real :: VeloConstant1, VeloConstant2, VeloConstant3, VeloConstant4, vel, veltwo, e,ewall
TYPE (components):: acc, v1el, v2el, dist
REAL :: time, timestep, Vmax, MagVel, MagVeltwo
INTEGER :: step_count, step_interval
INTEGER:: ios, i, j, bounces
END MODULE system_data
!----------------------------------------------------------------------
MODULE non_standard_routines
!Written by JGL Aston
!Last Modified 12/2/05
!This module of routines contains non-standard Fortran of the
!Salford system which would not be portable to other compilers. If you
!wanted to transport your program to another system you would need to edit
!the compiler-specific Fortran in this module to use corresponding
!non_standard subroutines in the new system.
!Salford graphics routines draw in integer numbers of screen pixels.
!The subroutines here use similar names but allow the user to
!work in world X, Z coordinates, albeit with the origin corresponding
!to the top left hand corner of the screen and positive Z values down.
!This is just a very simple and rather unsophisticated version of a LIBRARY
!of routines that you might put together to help you visualise a problem.
!Drawing what you think you have modelled can be very useful for debugging
!as well as bringing a bit of life to your programming.
IMPLICIT NONE
INCLUDE <clearwin.ins>
integer ::ans
REAL :: screen_scale
INTEGER (kind=2), PARAMETER :: black=0, blue=1, green=2, red=4, &
brown=6, white=7, yellow=14, intense_white=15
SAVE
CONTAINS
!-------------------------------------------
SUBROUTINE clear_screen
!Calls Salford clear_screen routine
CALL clear_screen@
END SUBROUTINE clear_screen
!-------------------------------------------
SUBROUTINE open_graphics_screen
!Calls Salford routine to set up a standard VGA
!screen 640 x 480 pixels and 16 colours
CALL vga@
END SUBROUTINE open_graphics_screen
!----------------------------------------------------------------------------------
!Let User Select Starting Point
SUBROUTINE USER_Ball_Vel
USE system_data
Print*,"Please Enter the Velocity of the ball 1 in X,Y. And Bal 2 in X,Y"
Read*, VeloConstant1,VeloConstant2,VeloConstant3,VeloConstant4
END SUBROUTINE USER_Ball_Vel
!-------------------------------------------
! Let User Select Starting Point
SUBROUTINE USER_Ball_Pos
USE system_data
Read*,ball_centre%x, ball_centre%z, ball_2centre%x, ball_2centre%z
Print*,"Please enter the coefficent of restituition between ballsand walls (elastic 1>e>o in elastic)"
Read*,e,ewall
End SUBROUTINE USER_Ball_Pos
!-------------------------------------------------
SUBROUTINE set_screen_scale (min_x_coverage, min_z_coverage)
!Sets variable "screen_scale" for any subsequent drawing requests.
!The variables min_x_coverage, min_z_coverage are supplied by the user
!and this routine determines screen_scale to satisfy both.
!Screen_scale is then used in other drawing routines.
REAL, INTENT(IN):: min_x_coverage, min_z_coverage
screen_scale = MIN((640/min_x_coverage),(480/min_z_coverage))
END SUBROUTINE set_screen_scale
!-------------------------------------------
SUBROUTINE update_graphics
!The SALFORD system updates graphics in the background until
!this call is made to update the graphics screen
CALL PERFORM_GRAPHICS_UPDATE@
END SUBROUTINE update_graphics
!-------------------------------------------
SUBROUTINE draw_line (X1, Z1, X2, Z2, ICOL)
!Calls Salford draw_line_between@ routine
REAL, INTENT(IN):: X1, Z1, X2, Z2
INTEGER (kind=2) :: IX1, IZ1, IX2, IZ2, ICOL
!Convert coordinates to screen coordinates
IX1 = X1 * screen_scale ; IZ1 = Z1 * screen_scale
IX2 = X2 * screen_scale ; IZ2 = Z2 * screen_scale
CALL draw_line_between@ (IX1,IZ1, IX2, IZ2, ICOL)
END SUBROUTINE draw_line
!-------------------------------------------
SUBROUTINE polyline ( X, Z, N, ICOL )
!Calls Salford draw_line@ routine
INTEGER (kind=2), INTENT(IN):: N, ICOL
REAL, INTENT(IN):: X(N), Z(N)
INTEGER (kind=2) :: IX(N), IZ(N)
INTEGER :: i
!Convert coordinates to screen coordinates
DO i = 1, N
IX(i) = NINT(X(i)*screen_scale)
IZ(i) = NINT(Z(i)*screen_scale)
END DO
CALL POLYLINE@ (IX,IZ,N,ICOL)
END SUBROUTINE polyline
!-------------------------------------------
SUBROUTINE hit_any_key_to_continue
!Calls Salford GET_KEY@
!This "gets" the keycode of the key that is typed
!though doesn't need to do anything with it here!
INTEGER (KIND=2) :: key_code
PRINT*,"Hit any key to continue"
CALL get_key@ (key_code)
END SUBROUTINE hit_any_key_to_continue
!-------------------------------------------
!
SUBROUTINE get_key_if_pressed(key_code)
!Calls Salford get_key1@
!This "gets" the keycode if a key has been typed.
!It does not wait for a key to be typed, though. (For that, use GET_KEY@)
!The value of key_code is passed back to the calling program.
INTEGER (KIND=2) :: key_code
CALL get_key1@ (key_code)
END SUBROUTINE get_key_if_pressed
!-------------------------------------------
!--------------------------------------------
SUBROUTINE sleep (time_in_secs)
!Calls Salford sleep@
!This suspends the processing for a period of time in seconds
!specified by the user.
REAL :: time_in_secs
CALL sleep@(time_in_secs)
END SUBROUTINE sleep
!--------------------------------------------
SUBROUTINE get_computer_time (time_in_secs)
!Calls Salford clock@
REAL :: time_in_secs
CALL clock@(time_in_secs)
END SUBROUTINE get_computer_time
END MODULE non_standard_routines
!---------------------------------------------------------------
MODULE analysis_routines
USE system_data
USE non_standard_routines
IMPLICIT none
REAL :: key_code
CONTAINS
!---------------------------------------------------------------
SUBROUTINE set_up_graphics_screen
USE system_data
USE non_standard_routines
IMPLICIT none
CALL open_graphics_screen
CALL set_screen_scale (1.1 * field_size%x, 1.1* field_size%z)
! The 1.1 factor helps to show at least 2 boundaries of the field
END SUBROUTINE set_up_graphics_screen
!---------------------------------------------------------------
SUBROUTINE draw_system
USE system_data
USE non_standard_routines
IMPLICIT none
INTEGER (kind = 2):: N
! Calculate ball circumference points
DO i = 0, no_points
ball_circumf_x(i) = ball_centre%x + ball_radius * COS((2*pi*i)/no_points)
ball_circumf_z(i) = ball_centre%z + ball_radius * SIN((2*pi*i)/no_points)
END DO
! Calculate ball2 circumference points
DO i = 0, no_points
ball_2circumf_x(i) = ball_2centre%x + ball_radius * COS((2*pi*i)/no_points)
ball_2circumf_z(i) = ball_2centre%z + ball_radius * SIN((2*pi*i)/no_points)
END DO
! Draw the field
CALL draw_line ( 0.0, 0.0, field_size%x, 0.0, red )
CALL draw_line ( field_size%x, 0.0, field_size%x, field_size%z, red )
CALL draw_line ( field_size%x, field_size%z, 0.0, field_size%z, red )
CALL draw_line ( 0.0, field_size%z, 0.0, 0.0, red )
! Draw the field22222
CALL draw_line ( 0.0, 0.0, fieldtwo_size%x, 0.0, red )
CALL draw_line ( fieldtwo_size%x, 0.0, fieldtwo_size%x, fieldtwo_size%z, red )
CALL draw_line ( fieldtwo_size%x, fieldtwo_size%z, 0.0, fieldtwo_size%z, red )
CALL draw_line ( 0.0, fieldtwo_size %z, 0.0, 0.0, red )
! Draw Ball
N = no_points + 1
CALL polyline (ball_circumf_x, ball_circumf_z, N, white)
! Draw Ball2
N = no_points + 1
CALL polyline (ball_2circumf_x, ball_2circumf_z, N, white)
! Update Graphics
CALL update_graphics
END SUBROUTINE draw_system
SUBROUTINE move_ball
USE system_data
! This subroutine simply sets the ball off at the start_angle
! at a fixed "velocity" and allows it to bounce 30 times
USE non_standard_routines
INTEGER (KIND=2) :: key_code
! Set pseudo "velocity" to fraction of field_size%x in each step
velocity%x = VeloConstant1 * 0.01 * field_size%x * cos (start_angle)
velocity%z = VeloConstant2 * 0.01 * field_size%z * sin (start_angle)
velocitytwo%x = VeloConstant3 * 0.01 * field_size%x * cos (start_angle)
velocitytwo%z = VeloConstant4 * 0.01 * field_size%z * sin (start_angle)
! Initialise number of bounces
bounces = 0
!MagVel = (velocity%x**2 + velocity%z**2)**0.5
!MagVeltwo = (velocitytwo%x**2 + velocitytwo%z**2)**0.5
!IF (MagVel>MagVeltwo) Then
!MagVel= Vmax
! end if
!IF (MagVeltwo>MagVel) Then
!Vmax = MagVeltwo
! end if
!timestep = 0.1 * ball_radius / vmax
!Step_interval=NINT(1.0/timestep*40.0)
! Step_count=1
DO
CALL clear_screen
CALL draw_system
CALL sleep (0.05)
! Calculate new position based on "unit time"
ball_centre%x = ball_centre%x + velocity%x
Ball_centre%z = ball_centre%z + velocity%z
ball_2centre%x = ball_2centre%x + velocitytwo%x
Ball_2centre%z = ball_2centre%z + velocitytwo%z
! Check to see if any wall hit. If so alter velocity accordingly.
IF ( ((ball_centre%x + ball_radius) >= field_size%x) .OR. &
((ball_centre%x - ball_radius) <= 0.0 )) THEN
velocity%x = -1.0*ewall*velocity%x
bounces = bounces + 1
END IF
IF ( ((ball_centre%z + ball_radius) >= field_size%z) .OR. &
((ball_centre%z - ball_radius) <= 0.0 )) THEN
velocity%z = -1.0*ewall*velocity%z
bounces = bounces + 1
END IF
IF ( ABS(ball_centre%z + ball_radius) == ABS (ball_2centre%z + ball_radius).And.&
ABS(ball_centre%x + ball_radius) == ABS (ball_2centre%x + ball_radius))THEN
velocity%z = -1.0*e*velocity%z
velocity%x = -1.0*e*velocity%x
END IF
! BALL Two Check to see if any wall hit. If so alter velocity accordingly.
IF ( ((ball_2centre%x + ball_radius) >= field_size%x) .OR. &
((ball_2centre%x - ball_radius) <= 0.0 )) THEN
velocitytwo%x = -1.0*ewall*velocitytwo%x
bounces = bounces + 1
END IF
IF ( ((ball_2centre%z + ball_radius) >= field_size%z) .OR. &
((ball_2centre%z - ball_radius) <= 0.0 )) THEN
velocitytwo%z = -1.0*ewall*velocitytwo%z
bounces = bounces + 1
END IF
! Option to Abort Simulation by pressing any key
CALL get_key_if_pressed(key_code)
IF (key_code /= 0) EXIT
END DO
END SUBROUTINE move_ball
!---------------------------------------------------------------
END MODULE analysis_routines
!---------------------------------------------------------------
PROGRAM demo_graphics
USE system_data
USE analysis_routines
USE non_standard_routines
IMPLICIT none
CALL clear_screen
PRINT*,"Welcome to the Graphics Demonstration Program"
PRINT*
PRINT*,"Please Enter the Position of Ball one and two x1,y1, x2, y2"
Print*,"In a Range of x 1 - 357, and y 1 - 178"
Print*
CALL USER_Ball_Pos
Call USER_Ball_Vel
PRINT*,"Move/reduce text screen away from where graphics screen will appear!"
Print*,"Graphics will be shown shortly!"
CALL hit_any_key_to_continue
CALL clear_screen
CALL set_up_graphics_screen
CALL move_ball
END PROGRAM demo_graphics
P.S This is a F90 text, There are no errors when i run it, but i just couldnt get the result i wanted
What I have to do is:
1) introduce the elasticity between the walls, and the ball. and(coefficent of restitution) that can be insert by the user. In which the ball WILL COLLIDE and SLOW DOWN.
Line 331 Couldnt work
2) introduce real time, time step variable
Line 286 - 300, (couldnt do it) please give suggestion is creation an output the print on the screen that has a real time counting....
3) Call a halt when any key pressed during the graphics shown
See subrountine* get_key_if_pressed
Thanks if any one could reply me a solution
CHEERS!!
!----------------------------------------------------------------------
! GRAPHICS DEMONSTRATION PROGRAM
! Ball Bouncing Within a Rectangular Enclosure
! Original Text Written by JGL Aston
!
!----------------------------------------------------------------------
MODULE system_data
IMPLICIT none
SAVE
INTEGER ,PARAMETER:: screen=6, keyboard=5, no_points = 18
REAL, PARAMETER :: pi = 3.14159
Type components
REAL:: x,z
End type components
!Regulation snooker balls are 52.5 mm (approximately 2-1?8 inches) in diameter,r = 26.25
!A standard tournament snooker table measures 3569mm by 1778mm (11ft 8.5in by 5ft 10in).
!The Dimensions divided by a factor of 3
TYPE(components):: ball_centre, ball_2centre, field_size= (357.0,178.0), fieldtwo_size= (357.0,178.0), velocity, velocitytwo
REAL, DIMENSION(0:no_points):: ball_circumf_x, ball_circumf_z, ball_2circumf_x, ball_2circumf_z
REAL :: ball_radius=2.625, start_angle=pi/6.0
Real :: VeloConstant1, VeloConstant2, VeloConstant3, VeloConstant4, vel, veltwo, e,ewall
TYPE (components):: acc, v1el, v2el, dist
REAL :: time, timestep, Vmax, MagVel, MagVeltwo
INTEGER :: step_count, step_interval
INTEGER:: ios, i, j, bounces
END MODULE system_data
!----------------------------------------------------------------------
MODULE non_standard_routines
!Written by JGL Aston
!Last Modified 12/2/05
!This module of routines contains non-standard Fortran of the
!Salford system which would not be portable to other compilers. If you
!wanted to transport your program to another system you would need to edit
!the compiler-specific Fortran in this module to use corresponding
!non_standard subroutines in the new system.
!Salford graphics routines draw in integer numbers of screen pixels.
!The subroutines here use similar names but allow the user to
!work in world X, Z coordinates, albeit with the origin corresponding
!to the top left hand corner of the screen and positive Z values down.
!This is just a very simple and rather unsophisticated version of a LIBRARY
!of routines that you might put together to help you visualise a problem.
!Drawing what you think you have modelled can be very useful for debugging
!as well as bringing a bit of life to your programming.
IMPLICIT NONE
INCLUDE <clearwin.ins>
integer ::ans
REAL :: screen_scale
INTEGER (kind=2), PARAMETER :: black=0, blue=1, green=2, red=4, &
brown=6, white=7, yellow=14, intense_white=15
SAVE
CONTAINS
!-------------------------------------------
SUBROUTINE clear_screen
!Calls Salford clear_screen routine
CALL clear_screen@
END SUBROUTINE clear_screen
!-------------------------------------------
SUBROUTINE open_graphics_screen
!Calls Salford routine to set up a standard VGA
!screen 640 x 480 pixels and 16 colours
CALL vga@
END SUBROUTINE open_graphics_screen
!----------------------------------------------------------------------------------
!Let User Select Starting Point
SUBROUTINE USER_Ball_Vel
USE system_data
Print*,"Please Enter the Velocity of the ball 1 in X,Y. And Bal 2 in X,Y"
Read*, VeloConstant1,VeloConstant2,VeloConstant3,VeloConstant4
END SUBROUTINE USER_Ball_Vel
!-------------------------------------------
! Let User Select Starting Point
SUBROUTINE USER_Ball_Pos
USE system_data
Read*,ball_centre%x, ball_centre%z, ball_2centre%x, ball_2centre%z
Print*,"Please enter the coefficent of restituition between ballsand walls (elastic 1>e>o in elastic)"
Read*,e,ewall
End SUBROUTINE USER_Ball_Pos
!-------------------------------------------------
SUBROUTINE set_screen_scale (min_x_coverage, min_z_coverage)
!Sets variable "screen_scale" for any subsequent drawing requests.
!The variables min_x_coverage, min_z_coverage are supplied by the user
!and this routine determines screen_scale to satisfy both.
!Screen_scale is then used in other drawing routines.
REAL, INTENT(IN):: min_x_coverage, min_z_coverage
screen_scale = MIN((640/min_x_coverage),(480/min_z_coverage))
END SUBROUTINE set_screen_scale
!-------------------------------------------
SUBROUTINE update_graphics
!The SALFORD system updates graphics in the background until
!this call is made to update the graphics screen
CALL PERFORM_GRAPHICS_UPDATE@
END SUBROUTINE update_graphics
!-------------------------------------------
SUBROUTINE draw_line (X1, Z1, X2, Z2, ICOL)
!Calls Salford draw_line_between@ routine
REAL, INTENT(IN):: X1, Z1, X2, Z2
INTEGER (kind=2) :: IX1, IZ1, IX2, IZ2, ICOL
!Convert coordinates to screen coordinates
IX1 = X1 * screen_scale ; IZ1 = Z1 * screen_scale
IX2 = X2 * screen_scale ; IZ2 = Z2 * screen_scale
CALL draw_line_between@ (IX1,IZ1, IX2, IZ2, ICOL)
END SUBROUTINE draw_line
!-------------------------------------------
SUBROUTINE polyline ( X, Z, N, ICOL )
!Calls Salford draw_line@ routine
INTEGER (kind=2), INTENT(IN):: N, ICOL
REAL, INTENT(IN):: X(N), Z(N)
INTEGER (kind=2) :: IX(N), IZ(N)
INTEGER :: i
!Convert coordinates to screen coordinates
DO i = 1, N
IX(i) = NINT(X(i)*screen_scale)
IZ(i) = NINT(Z(i)*screen_scale)
END DO
CALL POLYLINE@ (IX,IZ,N,ICOL)
END SUBROUTINE polyline
!-------------------------------------------
SUBROUTINE hit_any_key_to_continue
!Calls Salford GET_KEY@
!This "gets" the keycode of the key that is typed
!though doesn't need to do anything with it here!
INTEGER (KIND=2) :: key_code
PRINT*,"Hit any key to continue"
CALL get_key@ (key_code)
END SUBROUTINE hit_any_key_to_continue
!-------------------------------------------
!
SUBROUTINE get_key_if_pressed(key_code)
!Calls Salford get_key1@
!This "gets" the keycode if a key has been typed.
!It does not wait for a key to be typed, though. (For that, use GET_KEY@)
!The value of key_code is passed back to the calling program.
INTEGER (KIND=2) :: key_code
CALL get_key1@ (key_code)
END SUBROUTINE get_key_if_pressed
!-------------------------------------------
!--------------------------------------------
SUBROUTINE sleep (time_in_secs)
!Calls Salford sleep@
!This suspends the processing for a period of time in seconds
!specified by the user.
REAL :: time_in_secs
CALL sleep@(time_in_secs)
END SUBROUTINE sleep
!--------------------------------------------
SUBROUTINE get_computer_time (time_in_secs)
!Calls Salford clock@
REAL :: time_in_secs
CALL clock@(time_in_secs)
END SUBROUTINE get_computer_time
END MODULE non_standard_routines
!---------------------------------------------------------------
MODULE analysis_routines
USE system_data
USE non_standard_routines
IMPLICIT none
REAL :: key_code
CONTAINS
!---------------------------------------------------------------
SUBROUTINE set_up_graphics_screen
USE system_data
USE non_standard_routines
IMPLICIT none
CALL open_graphics_screen
CALL set_screen_scale (1.1 * field_size%x, 1.1* field_size%z)
! The 1.1 factor helps to show at least 2 boundaries of the field
END SUBROUTINE set_up_graphics_screen
!---------------------------------------------------------------
SUBROUTINE draw_system
USE system_data
USE non_standard_routines
IMPLICIT none
INTEGER (kind = 2):: N
! Calculate ball circumference points
DO i = 0, no_points
ball_circumf_x(i) = ball_centre%x + ball_radius * COS((2*pi*i)/no_points)
ball_circumf_z(i) = ball_centre%z + ball_radius * SIN((2*pi*i)/no_points)
END DO
! Calculate ball2 circumference points
DO i = 0, no_points
ball_2circumf_x(i) = ball_2centre%x + ball_radius * COS((2*pi*i)/no_points)
ball_2circumf_z(i) = ball_2centre%z + ball_radius * SIN((2*pi*i)/no_points)
END DO
! Draw the field
CALL draw_line ( 0.0, 0.0, field_size%x, 0.0, red )
CALL draw_line ( field_size%x, 0.0, field_size%x, field_size%z, red )
CALL draw_line ( field_size%x, field_size%z, 0.0, field_size%z, red )
CALL draw_line ( 0.0, field_size%z, 0.0, 0.0, red )
! Draw the field22222
CALL draw_line ( 0.0, 0.0, fieldtwo_size%x, 0.0, red )
CALL draw_line ( fieldtwo_size%x, 0.0, fieldtwo_size%x, fieldtwo_size%z, red )
CALL draw_line ( fieldtwo_size%x, fieldtwo_size%z, 0.0, fieldtwo_size%z, red )
CALL draw_line ( 0.0, fieldtwo_size %z, 0.0, 0.0, red )
! Draw Ball
N = no_points + 1
CALL polyline (ball_circumf_x, ball_circumf_z, N, white)
! Draw Ball2
N = no_points + 1
CALL polyline (ball_2circumf_x, ball_2circumf_z, N, white)
! Update Graphics
CALL update_graphics
END SUBROUTINE draw_system
SUBROUTINE move_ball
USE system_data
! This subroutine simply sets the ball off at the start_angle
! at a fixed "velocity" and allows it to bounce 30 times
USE non_standard_routines
INTEGER (KIND=2) :: key_code
! Set pseudo "velocity" to fraction of field_size%x in each step
velocity%x = VeloConstant1 * 0.01 * field_size%x * cos (start_angle)
velocity%z = VeloConstant2 * 0.01 * field_size%z * sin (start_angle)
velocitytwo%x = VeloConstant3 * 0.01 * field_size%x * cos (start_angle)
velocitytwo%z = VeloConstant4 * 0.01 * field_size%z * sin (start_angle)
! Initialise number of bounces
bounces = 0
!MagVel = (velocity%x**2 + velocity%z**2)**0.5
!MagVeltwo = (velocitytwo%x**2 + velocitytwo%z**2)**0.5
!IF (MagVel>MagVeltwo) Then
!MagVel= Vmax
! end if
!IF (MagVeltwo>MagVel) Then
!Vmax = MagVeltwo
! end if
!timestep = 0.1 * ball_radius / vmax
!Step_interval=NINT(1.0/timestep*40.0)
! Step_count=1
DO
CALL clear_screen
CALL draw_system
CALL sleep (0.05)
! Calculate new position based on "unit time"
ball_centre%x = ball_centre%x + velocity%x
Ball_centre%z = ball_centre%z + velocity%z
ball_2centre%x = ball_2centre%x + velocitytwo%x
Ball_2centre%z = ball_2centre%z + velocitytwo%z
! Check to see if any wall hit. If so alter velocity accordingly.
IF ( ((ball_centre%x + ball_radius) >= field_size%x) .OR. &
((ball_centre%x - ball_radius) <= 0.0 )) THEN
velocity%x = -1.0*ewall*velocity%x
bounces = bounces + 1
END IF
IF ( ((ball_centre%z + ball_radius) >= field_size%z) .OR. &
((ball_centre%z - ball_radius) <= 0.0 )) THEN
velocity%z = -1.0*ewall*velocity%z
bounces = bounces + 1
END IF
IF ( ABS(ball_centre%z + ball_radius) == ABS (ball_2centre%z + ball_radius).And.&
ABS(ball_centre%x + ball_radius) == ABS (ball_2centre%x + ball_radius))THEN
velocity%z = -1.0*e*velocity%z
velocity%x = -1.0*e*velocity%x
END IF
! BALL Two Check to see if any wall hit. If so alter velocity accordingly.
IF ( ((ball_2centre%x + ball_radius) >= field_size%x) .OR. &
((ball_2centre%x - ball_radius) <= 0.0 )) THEN
velocitytwo%x = -1.0*ewall*velocitytwo%x
bounces = bounces + 1
END IF
IF ( ((ball_2centre%z + ball_radius) >= field_size%z) .OR. &
((ball_2centre%z - ball_radius) <= 0.0 )) THEN
velocitytwo%z = -1.0*ewall*velocitytwo%z
bounces = bounces + 1
END IF
! Option to Abort Simulation by pressing any key
CALL get_key_if_pressed(key_code)
IF (key_code /= 0) EXIT
END DO
END SUBROUTINE move_ball
!---------------------------------------------------------------
END MODULE analysis_routines
!---------------------------------------------------------------
PROGRAM demo_graphics
USE system_data
USE analysis_routines
USE non_standard_routines
IMPLICIT none
CALL clear_screen
PRINT*,"Welcome to the Graphics Demonstration Program"
PRINT*
PRINT*,"Please Enter the Position of Ball one and two x1,y1, x2, y2"
Print*,"In a Range of x 1 - 357, and y 1 - 178"
Print*
CALL USER_Ball_Pos
Call USER_Ball_Vel
PRINT*,"Move/reduce text screen away from where graphics screen will appear!"
Print*,"Graphics will be shown shortly!"
CALL hit_any_key_to_continue
CALL clear_screen
CALL set_up_graphics_screen
CALL move_ball
END PROGRAM demo_graphics