program f90_COL_HTML
implicit none
integer,parameter::nmax=1000
character(len=50)::imgfile(1:nmax)
character(len=50)::str_col(1:nmax),swork(1:nmax),dummy
character(len=50)::str_hex(1:nmax)
integer::rr(1:nmax),gg(1:nmax),bb(1:nmax)
character(len=1)::yn
integer::i,j,nn,io,k,mm,work,flag
character(len=50)::fnameR,fnameW,fnameT
character(len=500)::linebuf
character(len=500)::comment
call getarg(1,yn) !Flag for execution of ImageMagick
call getarg(2,fnameR) !Input file name
call getarg(3,fnameW) !Output file name
call DATAINP(fnameR,nn,str_col,str_hex,imgfile,rr,gg,bb,nmax,comment)
if(yn=='y'.or.yn=='Y')then
open(12,file='bat_im.bat',status='replace')
do i=1,nn
linebuf='convert -size 86x29 xc:"'//trim(adjustl(str_hex(i)))//'" _test.gif'
write(12,'(a)') trim(adjustl(linebuf))
linebuf='convert _test.gif -bordercolor "#000000" -border 1x1 '//trim(adjustl(imgfile(i)))
write(12,'(a)') trim(adjustl(linebuf))
end do
close(12)
call system('bat_im')
end if
open(12,file='_temp.txt',status='replace')
open(13,file='_gray.txt',status='replace')
open(14,file='_grey.txt',status='replace')
write(12,'(a)') trim(adjustl(comment))
write(13,'(a)') trim(adjustl(comment))
write(14,'(a)') trim(adjustl(comment))
do i=1,nn
flag=0
dummy=""
dummy=str_col(i)
if(dummy(1:4)=='gray'.and.5<=len_trim(dummy))then
flag=1
write(13,*) trim(adjustl(str_col(i))),' ',trim(adjustl(str_col(i))),' ',trim(adjustl(str_hex(i))),' ',&
rr(i),' ',gg(i),' ',bb(i)
end if
if(dummy(1:4)=='grey'.and.5<=len_trim(dummy))then
flag=2
write(14,*) trim(adjustl(str_col(i))),' ',trim(adjustl(str_col(i))),' ',trim(adjustl(str_hex(i))),' ',&
rr(i),' ',gg(i),' ',bb(i)
end if
if(flag==0)then
write(12,*) trim(adjustl(str_col(i))),' ',trim(adjustl(str_col(i))),' ',trim(adjustl(str_hex(i))),' ',&
rr(i),' ',gg(i),' ',bb(i)
end if
end do
close(12)
close(13)
close(14)
fnameT='_temp.txt'
call DATAINP(fnameT,nn,str_col,str_hex,imgfile,rr,gg,bb,nmax,comment)
open(12,file=fnameW,status='replace')
write(12,'(a)') ''
write(12,'(a)') '
'
write(12,'()')
write(12,'()')
write(12,'(a)') 'Outline
'
write(12,'(a)') ''
write(12,'(a)') trim(adjustl(comment))
write(12,'(a)') '- Gif images in this page are created using ImageMagick.
'
write(12,'(a)') '- Sample commands of ImageMagick are shown below.
'
write(12,'(a)') '
'
write(12,'(a)') ''
write(12,'(a)') 'convert -size 86x29 xc:"#F0F8FF" _test.gif'
write(12,'(a)') 'convert _test.gif -bordercolor "#000000" -border 1x1 imgF0F8FF.gif'
write(12,'(a)') ' |
'
write(12,'()')
write(12,'(a)') 'Color image and color name
'
write(12,'(a)') ''
write(12,'(a)') ''
write(12,'(a)') ''
write(12,'(a)') 'gif image'
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') 'Color name'
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') 'Hexadecimal digits'
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') '(r, g, b)'
write(12,'(a)') ' | '
write(12,'(a)') '
'
call DATAWRITE(nn,imgfile,str_col,str_hex,rr,gg,bb,nmax)
write(12,'(a)') '
'
write(12,'()')
write(12,'()')
write(12,'(a)') 'Gray* and grey*
'
write(12,'(a)') ''
write(12,'(a)') ''
write(12,'(a)') ''
write(12,'(a)') 'gif image'
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') 'Color name'
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') 'Hexadecimal digits'
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') '(r, g, b)'
write(12,'(a)') ' | '
write(12,'(a)') '
'
fnameT='_gray.txt'
call DATAINP(fnameT,nn,str_col,str_hex,imgfile,rr,gg,bb,nmax,comment)
call SORT(nn,imgfile,str_col,str_hex,rr,gg,bb,nmax)
do i=1,nn
swork(i)=str_col(i)
end do
fnameT='_grey.txt'
call DATAINP(fnameT,nn,str_col,str_hex,imgfile,rr,gg,bb,nmax,comment)
call SORT(nn,imgfile,str_col,str_hex,rr,gg,bb,nmax)
do i=1,nn
str_col(i)=trim(adjustl(swork(i)))//', '//trim(adjustl(str_col(i)))
end do
call DATAWRITE(nn,imgfile,str_col,str_hex,rr,gg,bb,nmax)
write(12,'(a)') '
'
write(12,'()')
write(12,'()')
write(12,'(a)') ''
write(12,'(a)') ''
close(12)
contains
subroutine DATAINP(fnameT,nn,str_col,str_hex,imgfile,rr,gg,bb,nmax,comment)
character(len=50),intent(in)::fnameT
integer,intent(in)::nmax
integer,intent(out)::nn
character(len=50),intent(out)::str_col(1:nmax),str_hex(1:nmax),imgfile(1:nmax)
integer,intent(out)::rr(1:nmax),gg(1:nmax),bb(1:nmax)
character(len=500),intent(out)::comment
integer::i,io
character(len=50)::dummy
i=0
open(11,file=fnameT,status='old')
read(11,'(a)') comment
do
i=i+1
read(11,*,iostat=io) dummy,str_col(i),str_hex(i),rr(i),gg(i),bb(i)
dummy=""
dummy=trim(adjustl(str_hex(i)))//'.gif'
imgfile(i)='img'//dummy(2:7)//'.gif'
if(io<0)exit
end do
close(11)
nn=i-1
end subroutine DATAINP
subroutine DATAWRITE(nn,imgfile,str_col,str_hex,rr,gg,bb,nmax)
integer,intent(in)::nmax
integer,intent(in)::nn
character(len=50),intent(in)::str_col(1:nmax),str_hex(1:nmax),imgfile(1:nmax)
integer,intent(in)::rr(1:nmax),gg(1:nmax),bb(1:nmax)
integer::i
character(len=500)::linebuf
do i=1,nn
write(12,'(a)') ''
write(12,'(a)') ''
write(12,'(a)') ''
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') trim(adjustl(str_col(i)))
write(12,'(a)') ' | '
write(12,'(a)') ''
write(12,'(a)') trim(adjustl(str_hex(i)))
write(12,'(a)') ' | '
write(12,'(a)') ''
write(linebuf,*) '(',rr(i),',',gg(i),',',bb(i),')'
call del_spaces(linebuf)
write(12,'(a)') trim(adjustl(linebuf))
write(12,'(a)') ' | '
write(12,'(a)') '
'
end do
end subroutine DATAWRITE
subroutine SORT(nn,imgfile,str_col,str_hex,rr,gg,bb,nmax)
integer,intent(in)::nmax
integer,intent(in)::nn
character(len=50),intent(out)::str_col(1:nmax),str_hex(1:nmax),imgfile(1:nmax)
integer,intent(out)::rr(1:nmax),gg(1:nmax),bb(1:nmax)
integer::i,j,work
character(len=50)::dummy
do i=1,nn
do j=i+1,nn
if(bb(i)>bb(j))then
work=bb(i)
bb(i)=bb(j)
bb(j)=work
work=gg(i)
gg(i)=gg(j)
gg(j)=work
work=rr(i)
rr(i)=rr(j)
rr(j)=work
dummy=''
dummy=str_hex(i)
str_hex(i)=str_hex(j)
str_hex(j)=dummy
dummy=''
dummy=str_col(i)
str_col(i)=str_col(j)
str_col(j)=dummy
dummy=''
dummy=imgfile(i)
imgfile(i)=imgfile(j)
imgfile(j)=dummy
end if
end do
end do
end subroutine SORT
subroutine del_spaces(s)
character (*), intent (inout) :: s
character (len=len(s)) tmp
integer i, j
j = 1
do i = 1, len(s)
if (s(i:i)==' ') cycle
tmp(j:j) = s(i:i)
j = j + 1
end do
s = tmp(1:j-1)
end subroutine del_spaces
end program f90_COL_HTML