-
Notifications
You must be signed in to change notification settings - Fork 4
/
forcolormap_utils.f90
86 lines (74 loc) · 3.4 KB
/
forcolormap_utils.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
! The MIT License (MIT)
!
! Copyright (c) 2024 vmagnin, gha3mi
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all
! copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.
!-------------------------------------------------------------------------------
! Contributed by vmagnin & gha3mi: 2024-02-21
! Last modification: vmagnin 2024-02-22
!-------------------------------------------------------------------------------
!> This module contains miscellaneous procedures and functions.
module forcolormap_utils
use forcolormap, only: Colormap, wp
implicit none
private
public :: test_colormap
contains
!> This procedure computes a default z=f(x,y) function and plot it
!> in a .ppm file using the specified colormap. That function is defined
!> in the [0, 2] range.
subroutine test_colormap(self, filename, encoding)
use forimage, only: format_pnm
type(Colormap), intent(inout) :: self
character(*), intent(in) :: filename
integer :: k, j ! Pixbuffer coordinates
integer, parameter :: pixwidth = 600
integer, parameter :: pixheight = 600
integer, dimension(:,:), allocatable :: rgb_image
integer :: red, green, blue
real(wp) :: z
type(format_pnm) :: ppm
character(*), intent(in), optional :: encoding !> Default is binary
allocate(rgb_image(pixheight,pixwidth*3))
do k = 0, pixwidth-1
do j = 0, pixheight-1
! Computing a z=f(x,y) function:
z = 1.0_wp + sin(k*j/10000.0_wp) * cos(j/100.0_wp)
! The corresponding RGB values in our colormap:
call self%compute_RGB(z, red, green, blue)
rgb_image(pixheight-j, 3*(k+1)-2) = red
rgb_image(pixheight-j, 3*(k+1)-1) = green
rgb_image(pixheight-j, 3*(k+1)) = blue
end do
end do
if (present(encoding)) then
call ppm%set_format(encoding)
else
call ppm%set_format('binary')
end if
call ppm%set_pnm(encoding = ppm%get_format(),&
file_format = 'ppm',&
width = pixwidth,&
height = pixheight,&
max_color = 255,&
comment = 'Test generated by ForColormap',&
pixels = rgb_image)
call ppm%export_pnm(filename)
end subroutine test_colormap
end module forcolormap_utils