Bitmap/Fortran: Difference between revisions
< Bitmap
Content added Content deleted
(rewrote everything. just one type using type-bound procedures) |
(overwrote dim. now uses variable name: n) |
||
Line 27:
!! k=1: red, k=2: green, k=3: blue
integer ::
!! image dimensions: [height, width]
Line 51:
integer, intent(in) :: height, width
this%
allocate (this%rgb(height,width,3), source=0)
end subroutine
Line 64:
! always check that dimensions match
rgbimage_valid = ( all(this%
& (size(this%rgb, dim=1) == this%
& (size(this%rgb, dim=2) == this%
& (size(this%rgb, dim=3) == 3)
! optionally: check if rgb values are in allowed range
Line 85:
integer, intent(in) :: x, y
rgbimage_inside = ((x > 0) .and. (x <= this%
end function
Line 162:
! write header
write (iounit, '(A)') 'P6'
write (iounit, '(I0, A, I0)') this%
write (iounit, '(A)') '255'
do i = 1, this%
do j = 1, this%
write (iounit, '(3A1)', advance='no') [(achar(this%rgb(i,j,k)), k=1,3)]
end do
|
Revision as of 20:55, 20 February 2020
Bitmap/Fortran is part of Basic bitmap storage. You may find other members of Basic bitmap storage at Category:Basic bitmap storage.
<lang fortran>module rgbimage_m
implicit none
private public :: rgbimage
type rgbimage !! usage !! 1) init !! 2a) fill_image !! or !! 2b) set_pixel !! 3) normalize !! 4) write
private
integer, dimension(:,:,:), allocatable :: rgb !! pixel arrays of rgb values !! indices (i,j,k) !! i: position x_i !! j: position y_j !! k=1: red, k=2: green, k=3: blue
integer :: n(2) = 0 !! image dimensions: [height, width]
contains procedure :: init => rgbimage_init ! inits image procedure :: fill_image => rgbimage_fill_image ! fill image with constant rgb value procedure :: get_pixel => rgbimage_get_pixel ! gets one pixel procedure :: normalize => rgbimage_normalize ! normalizes all pixels onto range [0, 255] procedure :: set_pixel => rgbimage_set_pixel ! sets one pixel procedure :: write => rgbimage_write ! outputs image to file
procedure, private :: inside => rgbimage_inside procedure, private :: valid => rgbimage_valid end type
contains
subroutine rgbimage_init(this, height, width) !! initialize image. !! sets dimensions, allocates pixels and sets colors to 0.
class(rgbimage), intent(out) :: this integer, intent(in) :: height, width
this%n = [height, width] allocate (this%rgb(height,width,3), source=0) end subroutine
logical function rgbimage_valid(this, check_rgb_vals) !! checks if the image has valid dimensions and optionally valid rgb values.
class(rgbimage), intent(in) :: this logical, intent(in), optional :: check_rgb_vals !! check if rgb values are in allowed range [0, 255]? !! default: dont check
! always check that dimensions match rgbimage_valid = ( all(this%n > 0) .and. & & (size(this%rgb, dim=1) == this%n(1)) .and. & & (size(this%rgb, dim=2) == this%n(2)) .and. & & (size(this%rgb, dim=3) == 3) )
! optionally: check if rgb values are in allowed range if (present(check_rgb_vals)) then if (check_rgb_vals) rgbimage_valid = ( rgbimage_valid .and. & & (all(this%rgb >= 0)) .and. & & (all(this%rgb <= 255)) ) end if
end function
logical function rgbimage_inside(this, x, y) !! checks if given coordinates are inside the image
class(rgbimage), intent(in) :: this integer, intent(in) :: x, y
rgbimage_inside = ((x > 0) .and. (x <= this%n(1)) .and. (y > 0) .and. (y <= this%n(2))) end function
subroutine rgbimage_set_pixel(this, x, y, rgb) class(rgbimage), intent(inout) :: this integer, intent(in) :: x, y !! coordinates integer, intent(in) :: rgb(3) !! red, green, blue values
if (this%inside(x, y)) then ! use given data at first this%rgb(x,y,:) = rgb
! check if given data was out of bounds where (this%rgb(x,y,:) > 255) this%rgb(x,y,:) = 255 elsewhere (this%rgb(x,y,:) < 0) this%rgb(x,y,:) = 0 end where end if end subroutine
function rgbimage_get_pixel(this, x, y) result(rgb) class(rgbimage), intent(in) :: this integer, intent(in) :: x, y !! coordinates integer :: rgb(3) !! red, green, blue values
if (this%inside(x, y)) then rgb = this%rgb(x,y,:) else rgb = 0 end if end function
subroutine rgbimage_normalize(this) !! normalize colors to be in range [0, 255]
class(rgbimage), intent(inout) :: this
where (this%rgb(:,:,:) > 255) this%rgb(:,:,:) = 255 elsewhere (this%rgb(:,:,:) < 0) this%rgb(:,:,:) = 0 end where end subroutine
subroutine rgbimage_fill_image(this, rgb) !! fill whole image with given rgb values.
class(rgbimage), intent(inout) :: this integer, intent(in) :: rgb(3) !! red, green, blue values
integer :: i
if (this%valid()) then do i = 1, 3 this%rgb(:,:,i) = rgb(i) end do end if end subroutine
subroutine rgbimage_write(this, fname) class(rgbimage), intent(in) :: this character(*), intent(in) :: fname !! file path, e.g. "tmp/out.ppm"
integer :: iounit, ios, i,j,k
open (newunit=iounit, file=fname, iostat=ios, action='WRITE') if (ios /= 0) error stop "Error opening file: " // fname
! write header write (iounit, '(A)') 'P6' write (iounit, '(I0, A, I0)') this%n(1), " ", this%n(2) write (iounit, '(A)') '255'
do i = 1, this%n(1) do j = 1, this%n(2) write (iounit, '(3A1)', advance='no') [(achar(this%rgb(i,j,k)), k=1,3)] end do end do
close (unit=iounit, iostat=ios) if (ios /= 0) error stop "Error closing file" end subroutine
end module</lang>