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)') '
'
    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)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' call DATAWRITE(nn,imgfile,str_col,str_hex,rr,gg,bb,nmax) write(12,'(a)') '
' write(12,'(a)') 'gif image' write(12,'(a)') '' write(12,'(a)') 'Color name' write(12,'(a)') '' write(12,'(a)') 'Hexadecimal digits' write(12,'(a)') '' write(12,'(a)') '(r, g, b)' 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)') '' write(12,'(a)') '' 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,'(a)') 'gif image' write(12,'(a)') '' write(12,'(a)') 'Color name' write(12,'(a)') '' write(12,'(a)') 'Hexadecimal digits' write(12,'(a)') '' write(12,'(a)') '(r, g, b)' 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)') ''//trim(adjustl(imgfile(i)))//'' 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