program f90_HSVrgbHEX
implicit none
integer::H,S,V
integer::R,G,B
character(len=7)::HEX
character(len=13)::RGB
integer::i,j
character(len=50)::fnameW
character(len=50)::fnameF
character(len=3)::dum1,dum2,dum3
fnameW='bat_imk_ctl.bat'
open(12, file=fnameW, status='replace')
do i=1,12
H=(i-1)*30
do j=1,6
select case (j)
case(1)
S=255;V=255
case(2)
S=128;V=255
case(3)
S= 64;V=255
case(4)
S= 64;V=192
case(5)
S= 32;V=192
case(6)
S= 16;V=192
end select
call HSVtoRGB(H,S,V,R,G,B)
HEX='#'//C10to16(R)//C10to16(G)//C10to16(B)
write(dum1,'(i3)') R
write(dum2,'(i3)') G
write(dum3,'(i3)') B
RGB='('//trim(adjustl(dum1))//','//trim(adjustl(dum2))//','//trim(adjustl(dum3))//')'
write(fnameF,'("fig_gmt_",i2.2,i2.2,".png")') i,j
write(12,'("set col1=",a7)') HEX
write(12,'("set col2=",a13)') RGB
write(12,'(a)') 'set fig='//trim(adjustl(fnameF))
write(12,'(a)') 'call bat_imk_exe'
write(12,'()')
end do
end do
close(12)
! Execute a batch file for ImagiMagick
call system("bat_imK_ctl.bat")
fnameW='col.html'
open(12, file=fnameW, status='replace')
write(12,'(a)') ''
write(12,'(a)') '
'
write(12,'()')
write(12,'(a)') ''
write(12,'(a)') 'H | S=255 | S=128 | S= 64 | S= 64 | S= 32 | S= 16 |
'
write(12,'(a)') '(deg) | V=255 | V=255 | V=255 | V=192 | V=192 | V=192 |
'
do i=1,12
write(dum1,'(i3)') (i-1)*30
write(12,'(a)') ''
write(12,'(a)') ''//trim(adjustl(dum1))//' | '
do j=1,6
write(fnameF,'("fig_gmt_",i2.2,i2.2,".png")') i,j
write(12,'(a)') ' | '
end do
write(12,'(a)') '
'
end do
write(12,'(a)') '
'
write(12,'()')
write(12,'(a)') ''
write(12,'(a)') ''
close(12)
stop
contains
!-------------------------------------------------
subroutine HSVtoRGB(hh,ss,vv,R,G,B)
!-------------------------------------------------
integer,intent(in)::hh,ss,vv
integer,intent(out)::R,G,B
real(4)::ff
integer::ii,pp,qq,tt
ii = mod(real(hh)/60.0,6.0)
ff = real(hh)/60.0-real(int(real(hh)/60.0))
pp = nint(vv*(1.0-(ss/255.0)))
qq = nint(vv*(1.0-(ss/255.0)*ff))
tt = nint(vv*(1.0-(ss/255.0)*(1.0-ff)))
R=0; G=0; B=0
select case (ii)
case(0)
R=vv; G=tt; B=pp
case(1)
R=qq; G=vv; B=pp
case(2)
R=pp; G=vv; B=tt
case(3)
R=pp; G=qq; B=vv
case(4)
R=tt; G=pp; B=vv
case(5)
R=vv; G=pp; B=qq
end select
end subroutine HSVtoRGB
!-------------------------------------------------
character(len=2) function C10to16(num)
!-------------------------------------------------
integer,intent(in)::num
integer,parameter::n=10
integer::r(1:n)
integer::i,m
integer::numd=16
character(len=1)::snum(1:n)
character(len=200)::ans
integer::num0,qq
num0=num
do i=1,n
qq=num0/numd
r(i)=num0-numd*qq
if(qq==0)exit
num0=qq
end do
m=i
do i=m,1,-1
if(r(i)==10)snum(i)='A'
if(r(i)==11)snum(i)='B'
if(r(i)==12)snum(i)='C'
if(r(i)==13)snum(i)='D'
if(r(i)==14)snum(i)='E'
if(r(i)==15)snum(i)='F'
if(r(i)<=9)then
write(snum(i),'(i1.1)') r(i)
end if
end do
ans=''
do i=m,1,-1
ans=trim(adjustl(ans))//snum(i)
end do
if(len_trim(ans)==1)ans='0'//trim(ans)
C10to16=ans
end function C10to16
!-------------------------------------------------
end program f90_HSVrgbHEX