Compare commits

..

4 Commits

Author SHA1 Message Date
tTh
0501f5f9b4 try, try, and try, and try again... 2022-12-12 00:58:58 +01:00
tTh
c08ff78ce9 cosmetic 2022-12-12 00:57:38 +01:00
tTh
61382ed12a shacking around code lines 2022-12-12 00:57:00 +01:00
tTh
9569e1b462 first plotation release 2022-12-12 00:52:19 +01:00
7 changed files with 152 additions and 56 deletions

View File

@ -13,6 +13,7 @@ WS/data/*
*.gif
*.log
*.mp4
*.dump
*.stderr

View File

@ -10,9 +10,9 @@ program animation
implicit none
! some configuration constants
integer, parameter :: S_WIDTH = 1024
integer, parameter :: S_HEIGHT = 1024
integer, parameter :: NB_BODY = 70
integer, parameter :: S_WIDTH = 1600
integer, parameter :: S_HEIGHT = 1600
integer, parameter :: NB_BODY = 60
!!! WARNING : global variable !!!
type(massbody) :: planets(NB_BODY)
@ -71,7 +71,7 @@ subroutine deplace_les_planetes(moons, clipit)
integer :: foo
real :: depx, depy
integer, parameter :: EE = 45
integer, parameter :: EE = 51
integer :: SW = S_WIDTH - EE
integer :: SH = S_HEIGHT - EE
@ -100,7 +100,7 @@ subroutine deplace_les_planetes(moons, clipit)
if (moons(foo)%posy .LT. EE) moons(foo)%posy = SH
endif
moons(foo)%heading = moons(foo)%heading + (0.71*(rand()-0.50))
moons(foo)%heading = moons(foo)%heading + (0.73*(rand()-0.50))
if (moons(foo)%heading .GT. 6.2831853) moons(foo)%heading = 0.0
if (moons(foo)%heading .LT. 0.0000001) moons(foo)%heading = 0.0

View File

@ -9,53 +9,71 @@ program essai
implicit none
! some configuration constants
integer, parameter :: S_WIDTH = 800
integer, parameter :: S_HEIGHT = 600
integer, parameter :: NB_BODY = 51
type(massbody) :: planets(NB_BODY)
integer :: foo
character(len=100) :: filename
call init_random()
call create_some_planets(planets, 45e5, S_WIDTH, S_HEIGHT)
do foo=0, 1999
write (filename, "(a, i5.5, a)") 'WS/field/', foo, '.pgm'
call build_and_write_a_field(S_WIDTH, S_HEIGHT, planets, filename)
! print *, trim(filename)
! OMG! two magic numbers, wtf?
planets(1)%posx = planets(1)%posx + 3 + (4.5*rand())
planets(1)%posy = planets(1)%posy + 3 + (2.1*rand())
if (planets(1)%posx .GT. S_WIDTH) planets(1)%posx = 0.0
if (planets(1)%posy .GT. S_HEIGHT) planets(1)%posy = 0.0
call boulegue_les_astres(planets, 2.21)
enddo
call essai_near_planet(9999, 4096)
STOP 'BECAUSE YOLO'
contains
!-----------------------------------------------------------------------
!-
! Et si on bougeait un peu tous ces corps planétaires ?
! computation of thr nearest planet
!-
subroutine boulegue_les_astres(astres, factor)
type(massbody), intent(inout) :: astres(:)
real, intent(in) :: factor
subroutine essai_near_planet(nbplanets, szfield)
integer, intent(in) :: nbplanets, szfield
integer :: foo
integer, dimension(:,:), allocatable :: map
integer :: ix, iy
real :: fx, fy, dx, dy
integer :: near, ipl, errcode
real :: curdist, smalldist
type(massbody) :: planets(nbplanets)
print *, "near planets test", nbplanets, szfield
allocate(map(szfield, szfield), stat=errcode)
map = -1
! create some random bodies
do ipl=1, nbplanets
planets(ipl)%posx = rand() * szfield
planets(ipl)%posy = rand() * szfield
planets(ipl)%serial = ipl
end do
! call save_bodies_to_txt_file(planets, "planets.txt")
! loop over all the location of the field
do ix=1, szfield
fx = real(ix)
do iy=1, szfield
fy = real(iy)
near = -1
smalldist = 1e37
! loop over all the planet's bodies
do ipl=1, nbplanets
! compute the "fake" distance
dx = fx - planets(ipl)%posx
dy = fy - planets(ipl)%posy
curdist = (dx*dx) + (dy*dy)
if (curdist .LT. smalldist) then
near = ipl
smalldist = curdist
endif
end do ! loop on ipl
map(ix, iy) = mod(near, 255)
enddo
write(0, *) "row", ix, " on", szfield
do foo = 2, ubound(astres, 1)
astres(foo)%posx = astres(foo)%posx + factor*(rand() - 0.5)
astres(foo)%posy = astres(foo)%posy + factor*(rand() - 0.5)
enddo
call spit_as_pgm_8(map, "nearest.pgm")
end subroutine
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
end program

View File

@ -14,7 +14,7 @@ NUMERO=$1
SRC=$(printf "WS/data/%05d.txt" $NUMERO)
DST=$(printf "WS/graph/%05d.png" $NUMERO)
TXT=$(printf "Mass bodies #%05d" $NUMERO)
TXT=$(printf "mb #%05d" $NUMERO)
echo " " $SRC $DST " " $TXT
@ -23,20 +23,20 @@ set term png size 512,512
set xrange [ 0.0 : 1024 ]
set yrange [ 0.0 : 1024 ]
set output "${DST}"
set ytics 256
set xtics 256
set ytics 128
set xtics 128
set grid front
set title "${TXT}"
plot "$SRC" using 1:2 title "location"
plot "$SRC" using 1:2 title "loc"
__EOC__
}
# ----------------------------------------------------------
for foo in $(seq 0 8 1999)
for foo in $(seq 0 5 1999)
do
plot_a_map $foo
done
convert -delay 10 WS/graph/0????.png foo.gif
convert -delay 10 WS/graph/0????.png displacement.gif
# ----------------------------------------------------------

View File

@ -24,14 +24,14 @@ outfile=$(printf "WS/troid/%05d.png" $clock)
echo $timestamp $texte $outfile
convert ${TMPF} \
-pointsize 24 \
-pointsize 22 \
-font Courier-Bold \
-fill Orange \
-annotate +15+16 "$timestamp" \
-annotate +15+38 "$texte" \
-annotate +15+22 "$timestamp" \
-annotate +15+48 "$texte" \
-pointsize 16 \
-gravity south-west \
-annotate +15+6 "tTh & Konrad" \
-annotate +15+9 "tTh & Konrad" \
${outfile}
}

View File

@ -72,7 +72,7 @@ subroutine create_some_planets(planets, coef, sx, sy)
!-
planets(1)%posx = sx / 2
planets(1)%posy = sy / 2
planets(1)%mass = 29e8
planets(1)%mass = 31e8
planets(1)%serial = 1337
planets(1)%speed = 6.666
else
@ -82,10 +82,11 @@ subroutine create_some_planets(planets, coef, sx, sy)
planets(foo)%posx = rand() * real(sx-1)
planets(foo)%posy = rand() * real(sy-1)
planets(foo)%mass = 7e6 + coef*foo
planets(foo)%heading = 3.14159 * rand()
if (rand() .LT. 0.08) planets(foo)%speed = 3.14159
planets(foo)%heading = 2 * 3.14159 * rand()
if (rand() .LT. 0.15) planets(foo)%speed = 3.14159
planets(foo)%serial = foo*2 + 120
endif
write (*, fmt) foo, planets(foo)
enddo
end subroutine
@ -110,11 +111,29 @@ function compute_gravity(fx, fy, body)
endif
end function
!-----------------------------------------------------------------------
!-
! Export a massbody area to a text file. no error check, wtf ?
!-
subroutine save_bodies_to_txt_file (astres, fname)
type(massbody), intent(in) :: astres(:)
character(len=*), intent(in) :: fname
character(50) :: fmt
integer :: io, idx
write(0, "('saving planets to ', A20)") fname
fmt = "( 2(F9.3, ' ') 2(F9.3, ' '), F14.3, I8)"
open(newunit=io, file=fname)
do idx = 1, ubound(astres, 1)
write(io, fmt) astres(idx)
enddo
close(io)
end subroutine
!-----------------------------------------------------------------------
!-
! Compute the gravity field in a pre-allocated array relative
! to the massbody 'moon'. Nobody know where the magic number
! to the massbody 'moon'. Nobody know where the magic numbers
! come from, sorry.
!-
subroutine compute_a_field(field, moon)
@ -158,7 +177,7 @@ subroutine build_and_write_a_field(szx, szy, moons, fname)
field = 0.0
do foo=1, ubound(moons, 1)
call compute_a_field(tmpf, moons(foo))
tmpf = tmpf * 0.019
tmpf = tmpf * 0.018
field = field + tmpf
enddo
@ -199,9 +218,67 @@ subroutine init_random()
! you MUST use it for initializing the initializer
do t3=1, 4
dummy = rand()
write(0, *) 'dummy ', t3, dummy
write(0, '(" dummy", I4, F9.6)') t3, dummy
enddo
end subroutine
!-----------------------------------------------------------------------
!-
! dump a field of reals numbers to disk - preliminary version
!-
subroutine dump_a_field_to_file(field, fname)
real, dimension(:,:), intent(in) :: field
character(len=*), intent(in) :: fname
integer :: header(8)
integer :: io
print *, "D) field size ", ubound(field, 1), "W", ubound(field, 2), "H"
print *, "D) filename ", fname
header = 0
header(1) = 574908040 ! magic number
header(2) = 1 ! this is a dump of real field
header(3) = ubound(field, 1)
header(4) = ubound(field, 2)
header(5) = 666
open(newunit=io, file=fname, form='unformatted')
write(io) header
write(io) field
close(io)
end subroutine
!-----------------------------------------------------------------------
!-
! load a real field from file - preliminary version
!-
subroutine load_a_field_from_file(field, fname)
real, dimension(:,:), intent(in) :: field
character(len=*), intent(in) :: fname
integer :: header(8)
integer :: io, foo
print *, "L) field size ", ubound(field, 1), "W", ubound(field, 2), "H"
!-
! how to check if the field array was valid ?
!-
open(newunit=io, file=fname, form='unformatted', status='old', &
action='read')
read(io) header
do foo=1, 8
print *, foo, header(foo)
enddo
STOP ' --- FUCKED UP BEYOND ALL REPAIR ---'
close(io)
end subroutine
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

View File

@ -31,8 +31,8 @@ height_field {
translate <-0.5, 0, -0.5>
}
texture {
pigment { color Gray80 }
finish { phong 0.50 }
pigment { color Gray70 }
finish { phong 0.55 }
}
}
@ -55,7 +55,7 @@ light_source { < -15, 2.3, 17> color Green*0.25 }
// ----------------------------------------------------------------------
camera {
location <-8, 4-NormClock, 1 + (5*NormClock)>
location <-8, 4-(1.5*NormClock), 1 + (5*NormClock)>
look_at <0, 0, 0>
right x*image_width/image_height
angle 33