tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

version apéro 20230103

Browse Source
This commit is contained in:
tTh 2024-01-04 02:22:39 +01:00
parent bd581ee2bd
commit 0fb6b03698
1 changed files with 43 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
GrafAnim/soundscope.f90
View File

@ -9,8 +9,8 @@ program soundscope
implicit none
integer :: width = 800
integer :: height = 600
integer :: width = 720
integer :: height = 576
integer :: marge = 20
integer :: samplerate = 44100
integer :: framerate = 30
@ -32,7 +32,7 @@ program soundscope
write(0, *) "----- iteration", iter, " -----"
iter = iter + 1
do foo=0, 45
do foo=0, 500
tx = (marge/2) + fair_random_gauss(width-marge)
ty = (marge/2) + fair_random_gauss(height-marge)
if (is_pixel_inside(tx, ty)) then
@ -45,9 +45,9 @@ program soundscope
endif
enddo
call dim_pix_rgb_sub(pix, 3300)
call dim_pix_rgb_sub(pix, 2200)
call make_a_frame(pix, smppf, flagdone)
call dessine_cadre(pix, 65000, 65000, 65000)
write (filename, "(a,i5.5,a)") "./F/np/", iter, ".pnm"
call rgbpix_spit_as_pnm_16(pix, filename)
@ -76,13 +76,20 @@ subroutine make_a_frame(image, nbdata, jobdone)
do idx=0, nbdata
! get a sample
read(5, *, iostat=errcode) vl, vr
if (0 .NE. errcode) then
write(0, *) "iostat", errcode
jobdone = .TRUE.
exit
endif
if ( (idx .LT. 160) .AND. &
((abs(vl).GT.21000).OR.(abs(vr).GT.21000)) ) then
!-
! add flash !
write(0,*) "overshoot!"
call preparation(image, 65000)
endif
! scale it to the window
ix = (2 * int(vl / 111.111)) + 400
iy = (2 * int(vr / 166.666)) + 300
@ -98,12 +105,41 @@ end subroutine
!-- ------------------------------------------------------------------
subroutine dessine_cadre(image, R, G, B)
type(t_pixrgb), intent(inout) :: image(:,:)
integer,intent(in) :: R, G, B
integer :: ix, iy, foo
foo = ubound(image, 2) - marge
do ix=1+marge, ubound(image, 1) - marge
image(ix, marge)%r = R
image(ix, marge)%g = G
image(ix, marge)%b = B
image(ix, foo)%r = R
image(ix, foo)%g = G
image(ix, foo)%b = B
enddo
foo = ubound(image, 1) - marge
do iy=1+marge, ubound(image, 2)-marge
image(marge, iy)%r = R
image(marge, iy)%g = G
image(marge, iy)%b = B
image(foo, iy)%r = R
image(foo, iy)%g = G
image(foo, iy)%b = B
enddo
end subroutine
!-- ------------------------------------------------------------------
function is_pixel_inside(ix, iy)
integer,intent(in) :: ix, iy
logical :: is_pixel_inside
is_pixel_inside = .TRUE.
if ( (ix .LT. marge) .OR. (ix .GT. width-marge) ) then
is_pixel_inside = .FALSE.
return
@ -115,7 +151,6 @@ function is_pixel_inside(ix, iy)
end function
!-- ------------------------------------------------------------------
!-- ------------------------------------------------------------------
subroutine preparation(image, mval)