diff --git a/Modules/Makefile b/Modules/Makefile index d01a345..a0eeee0 100644 --- a/Modules/Makefile +++ b/Modules/Makefile @@ -4,15 +4,21 @@ # Makefile for the general purpose moduls # -GFOPT = -Wall -Wextra -time -g -O +GFOPT = -Wall -Wextra -time -g + +all: chkpixels + spitpgm.o: spitpgm.f90 Makefile gfortran $(GFOPT) -c $< -o $@ +trials.o: trials.f90 Makefile + gfortran $(GFOPT) -c $< -o $@ + # # programmes de testouille # -chkpixels: chkpixels.f90 Makefile spitpgm.o - gfortran $(GFOPT) $< spitpgm.o -o $@ +chkpixels: chkpixels.f90 Makefile trials.o spitpgm.o + gfortran $(GFOPT) $< spitpgm.o trials.o -o $@ diff --git a/Modules/README.md b/Modules/README.md index 0833a74..1d4424c 100644 --- a/Modules/README.md +++ b/Modules/README.md @@ -1,4 +1,10 @@ # General purpose modules -* spitpgm +## spitpgm + +Write gray level 2d buffer (aka picture) to disk in the NetPNM format. + +## trials + +Experimental WIPs from hell. diff --git a/Modules/chkpixels.f90 b/Modules/chkpixels.f90 index 8e87e39..7013523 100644 --- a/Modules/chkpixels.f90 +++ b/Modules/chkpixels.f90 @@ -1,20 +1,25 @@ +!------------------------------------------------------------------- +!- + program chkpixels - use spitpgm + use spitpgm ! main module + use trials ! experiments, ymmv. + implicit none - write(0, *) "------ CHKPIXELS ------" - call test_alpha() + call test_alpha(3) STOP 'BECAUSE NO CPU AVAILABLE' contains !------------------------------------------------------------------- !- - subroutine test_alpha() + subroutine test_alpha(increment) + integer, intent(in) :: increment - integer, parameter :: SZ = 32 + integer, parameter :: SZ = 40 integer, dimension(SZ, SZ) :: greymap integer :: ix, iy, value @@ -22,12 +27,14 @@ contains do iy=1, SZ do ix=1, SZ greymap(ix, iy) = value - value = value + 1 + value = value + increment enddo enddo + call spit_as_pgm_16 (greymap, 'a.pgm') call spit_as_pgm_eq (greymap, 'b.pgm') call spit_as_pgm_8 (greymap, 'c.pgm') + call new_spit_a (greymap, 'x.pgm') end subroutine diff --git a/Modules/spitpgm.f90 b/Modules/spitpgm.f90 index 439f540..cd3606b 100644 --- a/Modules/spitpgm.f90 +++ b/Modules/spitpgm.f90 @@ -8,8 +8,9 @@ module spitpgm !------------------------------------------------------------------- !- -! This subroutine try to scale the values to fit the 16 bit range -! +! This subroutine try to scale the values to fit the 16 bit range. +! XXX may be add a third parameter : the max value required ? +!- subroutine spit_as_pgm_eq(pic, fname) integer, intent(in), dimension (:,:) :: pic @@ -19,7 +20,7 @@ subroutine spit_as_pgm_eq(pic, fname) integer :: ix, iy real :: fk, fpix - write(0, '(1X, A)') "> spit_as_pgm_eq to " // trim(fname) + ! write(0, '(1X, A)') " spit_as_pgm_eq to " // trim(fname) open(newunit=io, file=fname) write (io, '(a2)') "P2" @@ -34,7 +35,7 @@ subroutine spit_as_pgm_eq(pic, fname) enddo else fk = float(foo) / 65535.01 - write (0, *) " max pix value", foo, " fk ", fk + ! write (0, *) " max pix value", foo, " fk ", fk do iy = 1, ubound(pic, 2) do ix = 1, ubound(pic, 1) fpix = float(pic(ix, iy)) / fk @@ -48,6 +49,7 @@ end subroutine !------------------------------------------------------------------- !- ! 16 bits - 65535 levels portable grey map file +! no data conversion except upper clippin. !- subroutine spit_as_pgm_16(pic, fname) integer, intent(in), dimension (:,:) :: pic diff --git a/Modules/trials.f90 b/Modules/trials.f90 new file mode 100644 index 0000000..44a6fdf --- /dev/null +++ b/Modules/trials.f90 @@ -0,0 +1,49 @@ +!- +! This module try to write PNM complient files - ymmv +!- +module trials + + implicit none + contains + +!------------------------------------------------------------------- +subroutine new_spit_a(pic, fname) + + integer, intent(in), dimension (:,:) :: pic + character (len=*), intent(in) :: fname + + integer :: foo, io, ix, iy + integer :: buffer(8), ptr + + ! print *, "newspit a, largeur ", size(pic, 1), ubound(pic, 1) + ! print *, "newspit a, hauteur ", size(pic, 2), ubound(pic, 2) + ! print *, "newspit a, buffer ", size(buffer, 1) + + open(newunit=io, file=fname) + write (io, '(a2)') "P2" + write (io, '("# new_spit_a")') + write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2) + write (io, '(i0)') 65535 + + buffer = 0 + ptr = 1 + + do iy=1, ubound(pic, 2) + do ix=1, ubound(pic, 1) + foo = pic(ix, iy) + if (foo .GT. 65535) foo = 65535 + buffer(ptr) = foo + ptr = ptr + 1 + if (ptr .EQ. size(buffer, 1)+1) then + write(io, "(8(' ',i0))") buffer + ptr = 1 + endif + enddo + enddo + + close(io) + +end subroutine +!------------------------------------------------------------------- + +end module \ No newline at end of file