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