31 Jan 2026 1:08
#32764
Hello
Just playing around with formatting and testing, but cannot see how to apply a scrollable control to the whole main window, like a normal resizable windows pane. I applied it to the calculator output pane, but the whole thing extends top to bottom in the screen. I'm sure it is something obvious. Formatting equations is rather clumsy, but good to test.
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
iw = winio@('%ca[Relatavistic function Calculator]&')
iw = winio@('%mn[&file[e&xit]]&', 'exit')
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
end program schwarzschild_calculator
Lester
