tweaking...
This commit is contained in:
parent
2f4272909a
commit
8223cb8e77
@ -4,7 +4,7 @@
|
|||||||
# Makefile for the general purpose moduls
|
# Makefile for the general purpose moduls
|
||||||
#
|
#
|
||||||
|
|
||||||
GFOPT = -Wall -Wextra -time -g
|
GFOPT = -Wall -Wextra -time -g
|
||||||
|
|
||||||
all: chkpixels
|
all: chkpixels
|
||||||
|
|
||||||
|
@ -5,6 +5,10 @@
|
|||||||
|
|
||||||
Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
|
Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
|
||||||
|
|
||||||
|
## pixrgb
|
||||||
|
|
||||||
|
Write 8 bits RGB pictures to PNM format.
|
||||||
|
|
||||||
## trials
|
## trials
|
||||||
|
|
||||||
Experimental WIPs from hell.
|
Experimental WIPs from hell.
|
||||||
|
@ -11,8 +11,8 @@ program chkpixels
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
write(0, *) "------ CHKPIXELS ------"
|
write(0, *) "------ CHKPIXELS ------"
|
||||||
! call test_spit_as(3)
|
call test_spit_as(3)
|
||||||
call test_spit_rgb(256)
|
call test_spit_rgb(128, 222)
|
||||||
|
|
||||||
STOP 'BECAUSE NO CPU AVAILABLE'
|
STOP 'BECAUSE NO CPU AVAILABLE'
|
||||||
|
|
||||||
@ -21,8 +21,8 @@ contains
|
|||||||
!-
|
!-
|
||||||
! exerciser for the 'pixrgb' module
|
! exerciser for the 'pixrgb' module
|
||||||
!-
|
!-
|
||||||
subroutine test_spit_rgb(sz)
|
subroutine test_spit_rgb(sz, kg)
|
||||||
integer, intent(in) :: sz
|
integer, intent(in) :: sz, kg
|
||||||
|
|
||||||
type(t_pixrgb), allocatable :: pixrgb(:,:)
|
type(t_pixrgb), allocatable :: pixrgb(:,:)
|
||||||
integer :: ix, iy
|
integer :: ix, iy
|
||||||
@ -33,7 +33,7 @@ contains
|
|||||||
do ix=1, sz
|
do ix=1, sz
|
||||||
do iy=1, sz
|
do iy=1, sz
|
||||||
pixrgb(ix, iy)%r = ix
|
pixrgb(ix, iy)%r = ix
|
||||||
pixrgb(ix, iy)%g = 0
|
pixrgb(ix, iy)%g = mod(ix*iy, kg)
|
||||||
pixrgb(ix, iy)%b = iy
|
pixrgb(ix, iy)%b = iy
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
@ -50,6 +50,7 @@ contains
|
|||||||
integer, dimension(SZ, SZ) :: greymap
|
integer, dimension(SZ, SZ) :: greymap
|
||||||
integer :: ix, iy, value
|
integer :: ix, iy, value
|
||||||
|
|
||||||
|
print *, "test spit as", sz
|
||||||
value = 0
|
value = 0
|
||||||
do iy=1, SZ
|
do iy=1, SZ
|
||||||
do ix=1, SZ
|
do ix=1, SZ
|
||||||
@ -57,10 +58,10 @@ contains
|
|||||||
value = value + increment
|
value = value + increment
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
call spit_as_pgm_16 (greymap, 'a.pgm')
|
call spit_as_pgm_16 (greymap, 'a.pnm')
|
||||||
call spit_as_pgm_eq (greymap, 'b.pgm')
|
call spit_as_pgm_eq (greymap, 'b.pnm')
|
||||||
call spit_as_pgm_8 (greymap, 'c.pgm')
|
call spit_as_pgm_8 (greymap, 'c.pnm')
|
||||||
call new_spit_a (greymap, 'x.pgm')
|
call new_spit_a (greymap, 'x.pnm')
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
end program
|
end program
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
!-
|
!-
|
||||||
! This module try to write PGM complient gray level files
|
! This module try to write PNM complient RGB files
|
||||||
!-
|
!-
|
||||||
module pixrgb
|
module pixrgb
|
||||||
implicit none
|
implicit none
|
||||||
@ -28,6 +28,23 @@ subroutine rgbpix_set_to_zero(pic)
|
|||||||
end subroutine
|
end subroutine
|
||||||
!-------------------------------------------------------------------
|
!-------------------------------------------------------------------
|
||||||
!-
|
!-
|
||||||
|
! NOT TESTED !!!
|
||||||
|
!-
|
||||||
|
subroutine rgb_pix_clamp_at_8(pic)
|
||||||
|
type(t_pixrgb), intent(inout) :: pic(:,:)
|
||||||
|
integer :: ix, iy
|
||||||
|
do iy=1, ubound(pic, 2)
|
||||||
|
do ix=1, ubound(pic, 1)
|
||||||
|
pic(ix, iy)%r = max(0, min(pic(ix, iy)%r, 255))
|
||||||
|
pic(ix, iy)%g = max(0, min(pic(ix, iy)%g, 255))
|
||||||
|
pic(ix, iy)%b = max(0, min(pic(ix, iy)%b, 255))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end subroutine
|
||||||
|
!-------------------------------------------------------------------
|
||||||
|
!-
|
||||||
|
! CAUTION: there was NO out-of-bounds check !
|
||||||
|
!-
|
||||||
subroutine rgbpix_spit_as_pnm_8(pic, fname)
|
subroutine rgbpix_spit_as_pnm_8(pic, fname)
|
||||||
type(t_pixrgb), intent(in) :: pic(:,:)
|
type(t_pixrgb), intent(in) :: pic(:,:)
|
||||||
character (len=*), intent(in) :: fname
|
character (len=*), intent(in) :: fname
|
||||||
@ -42,7 +59,7 @@ subroutine rgbpix_spit_as_pnm_8(pic, fname)
|
|||||||
|
|
||||||
do iy=1, ubound(pic, 2)
|
do iy=1, ubound(pic, 2)
|
||||||
do ix=1, ubound(pic, 1)
|
do ix=1, ubound(pic, 1)
|
||||||
write(io, "(3I12)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
|
write(io, "(3I5)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
close(unit=io)
|
close(unit=io)
|
||||||
@ -50,6 +67,8 @@ subroutine rgbpix_spit_as_pnm_8(pic, fname)
|
|||||||
end subroutine
|
end subroutine
|
||||||
!-------------------------------------------------------------------
|
!-------------------------------------------------------------------
|
||||||
!-
|
!-
|
||||||
|
! CAUTION: there was NO out-of-bounds check !
|
||||||
|
!-
|
||||||
subroutine rgbpix_spit_as_pnm_16(pic, fname)
|
subroutine rgbpix_spit_as_pnm_16(pic, fname)
|
||||||
|
|
||||||
type(t_pixrgb), intent(in) :: pic(:,:)
|
type(t_pixrgb), intent(in) :: pic(:,:)
|
||||||
|
@ -60,7 +60,8 @@ subroutine spit_as_pgm_16(pic, fname)
|
|||||||
|
|
||||||
open(newunit=io, file=fname)
|
open(newunit=io, file=fname)
|
||||||
write (io, '(a2)') "P2"
|
write (io, '(a2)') "P2"
|
||||||
write (io, '("# size:", I9)') size(pic)
|
write (io, '(A)') "# spit_as_pgm_16"
|
||||||
|
! write (io, '("# size:", I9)') size(pic)
|
||||||
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
|
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
|
||||||
write (io, '(i0)') 65535
|
write (io, '(i0)') 65535
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user