Lester,
Put the main content of your window (excluding the menu items) in a property sheet using %sh.
Then create a main window (with the menu items) to display the property sheet as a child window via %ch[vscrollbar,hscrollbar]. The size and position of this main window are set by %sz and %sp.
As the user resizes the main window, the scrollbars appear when they are necessary to view the child window.
I have modified your code to demonstrate the basic idea.
winapp
module schwarzschildmodule
use clrwin
implicit none
real(kind=2) :: mass = 1.0, real_time = 1.0, velocity = 0.25, distance = 3000
! NIST CODATA values (2022)
! constants set to double-precision real(kind=2) and real*8 are both dp
real(kind=2), parameter :: sol = 1.989e30 ! 1 solar mass kg
real(kind=2), parameter :: velocity_of_light = 2.99792458e8 ! m/s
real(kind=2), parameter :: gravitational_constant = 6.67430e-11 ! m^3 kg^1 s^2
real(kind=2), parameter :: Planck_constant = 6.62607015e-34 ! J·s (h)
real(kind=2), parameter :: reduced_Planck_constant = 1.054571817e-34 ! J·s (hbar)
real(kind=2), parameter :: Boltzmann_constant = 1.380649e-23 ! J -K
real(kind=2), parameter :: Stefan_Boltzmann_constant = 5.670374419e-8 ! W m-2 K-4
real(kind=2), parameter :: AU = 1.495978707e11 ! Astronomical unit (m)
real(kind=2), parameter :: LY = 9.460730472580800e15 ! Light year (m)
real(kind=2), parameter :: PC = 3.26156*LY ! Parsec (m)
real(kind=2), parameter :: Pi = 3.14159265359d0
integer, parameter :: days_in_year = 365
integer, parameter :: seconds_in_day = 86400
integer, parameter :: seconds_in_year = 31536000
character(200) :: str = ''
character(len=32*1024) :: buffer = ''
integer :: EMC2_control = 1, sr_control = 0, VELR_control = 0, &
GTIME_control = 0, PSPHERE_control = 0, PDEFL_control = 0, &
BHPOW_control = 0, HAWKR_control = 0
INTEGER iv
contains
! Mass - Energy equivalence: E=MC^2
function emc2(mass) result(E)
real(kind=2), intent(in) :: mass
real(kind=2) :: E
E = mass * velocity_of_light**2 ! Joules
end function emc2
! Time dilation as a function of velocity
function relativistic_time(velocity, real_time) result(rel_time)
real(kind=2), intent(in) :: velocity, real_time
real(kind=2) :: rel_time
!velocity = velocity_of_object / velocity_of_light
rel_time = real_time / sqrt(1.0 - velocity**2)
end function relativistic_time
! Schwarzschild radius of a mass
function Schwarzschild_radius(mass) result(Rs)
real(kind=2), intent(in) :: mass
real(kind=2) :: Rs
Rs = 2 * gravitational_constant * mass / velocity_of_light**2
end function Schwarzschild_radius
! Photon sphere for a given mass where a photon theoretically orbits a black hole (unstable)
function photon_sphere(mass) result(P_orbit)
! Strong gravitational field: distance closer to Rs_rad
! Photon capture in an unstable orbit
real(kind=2), intent(in) :: mass
real(kind=2) :: P_orbit
P_orbit = 3 * gravitational_constant * mass / velocity_of_light**2
end function photon_sphere
! Black hole surface area assuming a perfect sphere
function Surface_area_BH(mass) result(area)
real(kind=2), intent(in) :: mass
real(kind=2) :: Rs_rad, area
Rs_rad = Schwarzschild_radius(mass)
area = 4 * Pi * Rs_rad**2
end function Surface_area_BH
! Black hole power radiation
function Power_radiated_BH(mass) result(power_rad)
! smaller masses radiate faster
real(kind=2), intent(in) :: mass
real(kind=2) :: power_rad
power_rad = Stefan_Boltzmann_constant * Surface_area_BH(mass) * Hawking_radiation(mass)**4
end function Power_radiated_BH
! Gravitational time dilation for a given mass
function gravitational_time(mass, distance, real_time) result(grav_time)
real(kind=2), intent(in) :: mass, distance, real_time
real(kind=2) :: grav_time, Rs_rad
Rs_rad = Schwarzschild_radius(mass)
if (distance > Rs_rad) then
grav_time = real_time / sqrt(1.0 - (Rs_rad / distance))
else
grav_time = -1
end if
end function gravitational_time
! Photon deflection angle proximal to a black hole of given mass
function photon_deflection_phi(mass, distance) result(delta_phi)
! Weak gravitational field: distance >> Rs_rad
real(kind=2), intent(in) :: mass, distance
real(kind=2) :: Rs_rad, delta_phi
Rs_rad = Schwarzschild_radius(mass)
! (4GM/c^2b)*(1-Rs/b) approximation
! relativistic correction needed close to Rs
if (distance > Rs_rad) then
delta_phi = (2 * Rs_rad / distance) * (1 - Rs_rad / distance)
!delta_phi = (2 * Rs_rad / distance) * !(radians)
else
delta_phi = -1 ! error value if distance < Rs_rad
end if
end function photon_deflection_phi
! Hawking radiation for a black hole of a given mass
function Hawking_radiation(mass) result(HK)
real(kind=2), intent(in) :: mass
real(kind=2) :: HK
HK = (reduced_Planck_constant * velocity_of_light**3) / (8 * Pi * gravitational_constant * mass * Boltzmann_constant)
end function Hawking_radiation
integer function calculate_cb()
implicit none
real(kind=2) :: val
buffer = ''
! Mass-Energy equivalence (E=MC^2) result in Joules
if (EMC2_control == 1) then
val = mass * sol * velocity_of_light**2
write(str, '("Energy (E = mc^2): ", es15.5, " Joules")') val
call append2buffer
end if
! Schwarzschild radius in meters as a function of N*Solar masses
if (SR_control .eq. 1) then
if (mass <= 0) then
str = 'Mass must be positive!'
else
val = Schwarzschild_radius(mass*sol)
write(str, '("Schwarzschild radius: ", F15.5, " meters")') val
end if
call append2buffer
end if
! Time dilation as a function of relatavistic velocity
if (VELR_control == 1) then
val = relativistic_time(velocity, real_time)
write(str, '("Velocity time dilation: ", f15.5, " seconds")') val
call append2buffer
end if
! Time dilation as a function of gravitation
if (GTIME_control == 1) then
val = gravitational_time(mass*sol, distance, real_time)
write(str, '("Gravitational time dilation: ", f15.5, " seconds")') val
call append2buffer
end if
! Photon sphere for a given mass where a photon theoretically orbits a black hole (unstable)
if (PSPHERE_control == 1) then
val = photon_sphere(mass*sol)
write(str, '("Photon sphere radius: ", f15.5, " meters")') val
call append2buffer
end if
! Photon deflection in radians
if (PDEFL_control == 1) then
val = photon_deflection_phi(mass*sol, distance)
write(str, '("Photon deflection: ", f15.5, " Radians")') val
call append2buffer
end if
! Black hole power radiated
if (BHPOW_control == 1) then
val = Power_radiated_BH(mass*sol)
write(str, '("Power radiated from Black Hole: ", es15.5, " Watts")') val
call append2buffer
end if
! Hawking radiation from Black hole
if (HAWKR_control == 1) then
val = Hawking_radiation(mass*sol)
write(str, '("Hawking radiation of Black hole: ", es15.5, " kg/s")') val
call append2buffer
end if
call window_update@(buffer)
calculate_cb = 2
end function calculate_cb
subroutine append2buffer
if (len_trim(buffer) .eq. 0) then
buffer = str
else
buffer = trim(buffer)//achar(13)//achar(10)//str
end if
end subroutine append2buffer
end module schwarzschildmodule
program schwarzschild_calculator
use schwarzschildmodule
implicit none
integer :: iw
real(kind=2), parameter :: min_mass = 1, max_mass = 500
real(kind=2), parameter :: min_vel = 0.25, max_vel = 0.9999
real(kind=2), parameter :: min_dist = 3000, max_dist = 1e6
integer :: control_var1, screen_width, screen_depth
iw = winio@('%sh&',control_var1)
iw = winio@('%bg&', RGB@(230,245,250)) ! Add a pale blue background
iw = winio@('%il&', 0, 1000)
iw = winio@('%ob[named_c, thin_panelled][Mass (N*Sol)]&') ! Open a box and center a title inline
iw = winio@('%cn%30sl%nl&', mass, min_mass, max_mass) ! Slider control for mass (min, max)
iw = winio@('%cb%2nl&') ! close the box
iw = winio@('Mass in solar masses: %rf%2nl&', mass)
iw = winio@('%ob[named_c, thin_panelled][Velocity (% Vel_c)]&')
iw = winio@('%cn%30sl%2nl&', velocity, min_vel, max_vel)
iw = winio@('%cb%2nl&') ! close the box
iw = winio@(' object_velocity / velocity of light: %rf%2nl&', velocity)
iw = winio@('%ob[named_c, thin_panelled][Radial distance (m)]&')
iw = winio@('%cn%30sl%nl&', distance, min_dist, max_dist)
iw = winio@('%cb%2nl&') ! close the box
iw = winio@('Radial distance (m): %rf%2nl&', distance)
iw = winio@('Real time in seconds: %rf%2nl&', real_time)
! Update %rb list to add new options
iw = winio@('%rb[Mass-Energy ]&',EMC2_control) ! %nl = new line, %rb = radio button
iw = winio@('%ob%eq@%cb%4nl&','E=mc{sup 2}',0,0)
iw = winio@('%nl&')
iw = winio@('%rb[Schwarzschild Radius ]&',SR_control)
iw = winio@('%ob%eq@%cb%6nl&','Rs = {divide 2GM; c{sup 2}}',0,0)
iw = winio@('%nl&')
iw = winio@('%rb[Time dilation as a function of velocity (%C) ]&',VELR_control)
iw = winio@('%ob%eq@%cb%7nl&','t{sub v} = {divide t; {sqrt} 1 - ({divide v; c}){sup 2}}',0,0)
iw = winio@('%2nl&')
iw = winio@('%rb[Time dilation as a function of gravitation ]&',GTIME_control)
iw = winio@('%ob%eq@%cb%7nl&','t{sub g} = t {sqrt} 1 - {divide 2GM; R c{sup 2}}',0,0)
iw = winio@('%nl&')
iw = winio@('%rb[Photon sphere radius]%nl&',PSPHERE_control)
iw = winio@('%rb[Photon deflection]%nl&',PDEFL_control)
iw = winio@('%rb[Power radiated by black hole]%nl&',BHPOW_control)
iw = winio@('%rb[Hawking Radiation for black hole]%2nl&',HAWKR_control)
! Calculate the selected options
iw = winio@('%cn%`^tt[Calculate]%2nl&', calculate_cb)
iw = winio@('%pv%42.10re[VSCROLLBAR]&',buffer) ! %pv resize calculation window
iw = winio@('')
! Main window to show child
iw = winio@('%ca[Relatavistic function Calculator]&')
iw = winio@('%mn[&file[e&xit]]&', 'exit')
screen_width = clearwin_info@('SCREEN_WIDTH')
screen_depth = clearwin_info@('SCREEN_DEPTH')
iw = winio@('%sz&',screen_width/3, screen_depth/2)
iw = winio@('%sp&',screen_width/3, screen_depth/3)
iw = winio@('%pv%ch[vscrollbar,hscrollbar]&',control_var1)
iw = winio@('')
end program schwarzschild_calculator
