program histogram
            
implicit none

integer :: i, j, nchars, nchars2, p, nsubs=0
logical :: bin_flag
character (len=1) :: c
character (len=15) :: Y, wherestr, dummy, color, start, finish, width
character (len=30) :: Ystr, colorstr, startstr, finishstr, widthstr, cp
character (len=100) :: datastr
character (len=200) :: line, line2, fname
character (len=400) :: cm

! ------------------ Read and Parse CGI Data ------------------

read(*,'(a)') line
!write(*,'(a)') line

! see if file is local or on the net
p = index(line,"=")
cp = line(p+1:p+1)
if (cp == "l") then
  wherestr = "local"
else
	wherestr = "net"
end if

! prepare line for fortran csv read that parses line
! also replace the browser add + for a space with a .
nchars = len(trim(line))
do i = 1, nchars
  if (line(i:i) == '&') line(i:i) = ','
  if (line(i:i) == '+') line(i:i) = '.'
end do

! must precede all other write statements to stdout
write(*,'(a,//)') "Content-type:text/html"
!write(*,'(a)') line
!do i = 1, nchars
!  write(*,'(i3,1x,a)') i, line(i:i)
!end do

! browser escape character processing
do i = 1, nchars
	c = line(i:i)
  if (c == "%") then
    if(line(i+1:i+2) == "3A") line(i:i) = ':'
    if(line(i+1:i+2) == "2F") line(i:i) = '@'  ! add / later
    if(line(i+1:i+2) == "7E") line(i:i) = '~'
  end if
  if (c .ne. line(i:i)) then  ! substitution made
		nsubs = nsubs + 1
		line(i+1:i+2) = "  "
	end if
end do

! remove blanks and then remove any extra chars at end of line
j = 0
do i=1,nchars
  c=line(i:i)
	if (c /= ' ') then
		j=j+1
		line2(j:j) = c
  end if
end do
nchars2 = nchars - nsubs*2
do i=nchars2+1, len(line2)
  line2(i:i) = ' '
end do

! ----------------------------------------------------------
! line2 is the parsed, processed character string

! check for checked checkboxes
if (index(line2,"start") == 0) then
	bin_flag = .false.
else
	bin_flag = .true.
end if

!write(*,'(a)') line2
!do i = 1, nchars2
!	write(*,'(i3,1x,a)') i, line2(i:i)
!end do

if (wherestr == "local") then
	if (bin_flag) then
		read(unit=line2, fmt=*) dummy, Ystr, colorstr, startstr, finishstr, widthstr
	else
		read(unit=line2, fmt=*) dummy, Ystr, colorstr
	end if
	datastr = ""
else
	if (bin_flag) then
		read(unit=line2, fmt=*) dummy, datastr, Ystr, colorstr, startstr, finishstr, widthstr
	else
		read(unit=line2, fmt=*) dummy, datastr, Ystr, colorstr
	end if
	do i = 1, len(trim(datastr))
		if (datastr(i:i) == '@') datastr(i:i) = '/'
	end do
end if
! write(*,'(a)') line2

! write(*,*) '*** ', datastr, Ystr
! parse each name-value pair into just the value
if (wherestr == "local") then
	fname = ""
else
	fname = datastr(index(datastr,"=")+1:len(trim(datastr)))
end if
Y = Ystr(index(Ystr,"=")+1:len(trim(Ystr)))
color = colorstr(index(colorstr,"=")+1:len(trim(colorstr)))
if (bin_flag) then
	start = startstr(index(startstr,"=")+1:len(trim(startstr)))
	finish = finishstr(index(finishstr,"=")+1:len(trim(finishstr)))
	width = widthstr(index(widthstr,"=")+1:len(trim(widthstr)))
end if


write(*,'(a)') '<html>'
write(*,'(a)') '<body>'

write(*,'(a)') '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
write(*,'(a)') '       "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
write(*,'(a)') '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"><head>'
write(*,'(a)') '<title>R Regression</title>'
write(*,'(a)') '<meta http-equiv="Content-type" content="text/html; charset=iso-8859-1" />'
write(*,'(a)') '<link rel="stylesheet" href="../r.css" type="text/css" />'
write(*,'(a)') '</head>'
write(*,'(a)') '<body>'

write(*,'(a)') 
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '# *---------------------*<br />'
write(*,'(a)') '# R program for histogram<br />'
write(*,'(a)') '# *---------------------*<br />'
write(*,'(a)') '# option - encourage R to avoid scientific notation<br />'
write(*,'(a)') '<span class="g">options</span>(<span class="g">scipen</span>=10)<br />'
write(*,'(a)') '<br />'
write(*,'(a)') '# ------------------------<br />'
write(*,'(a)') '# Read and attach the data<br />'
write(*,'(a)') '# ------------------------<br />'
write(*,'(a)') '# data needs to be a '
write(*,'(a)') '<a href=http://web.pdx.edu/~hkdg/R/Movies/DataFiles/DataFiles.html>.csv<a> text file.<br />'
write(*,'(a)') '</div>'

if(fname .ne. '') then
	write(*,'(a)') 'rfile = "<span class="r">'//trim(fname)//'</span>"<br />'
	write(*,'(a)') 'mydata &lt;- <span class="b">read.csv</span>(<span class="b">file</span>=rfile)<br />'
else
	write(*,'(a)') 'mydata &lt;- <span class="b">read.csv</span>(<span class="b">file.choose()</span>)<br />'
endif

write(*,'(a)') '<span class="b">attach</span>(mydata)<br />'
write(*,'(a)') '<br />'
	write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '# ----------------------------------------------<br />'
write(*,'(a)') '# List Variable Names and first six rows of data<br />'
write(*,'(a)') '# ----------------------------------------------<br />'
write(*,'(a)') '# these names are what R read from first row of data file<br />'
write(*,'(a)') '# R replaces each blank in a name with a period<br />'
write(*,'(a)') '</div>'
write(*,'(a)') '<span class="b">head</span>(mydata)<br />'
write(*,'(a)') '<br />'

write(*,'(a)') 
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '#----------<br />'
write(*,'(a)') '# histogram<br />'
write(*,'(a)') '#----------<br />'
write(*,'(a)') '</div>'
write(*,'(a)') '<br />'
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '# breaks - to specify sequence of bins from Start to End by Width<br />'
write(*,'(a)') '# &nbsp; for which the range must be<br />'
write(*,'(a)') '# &nbsp; wide enough to include all data values as well as the full widths<br />'
write(*,'(a)') '# &nbsp; of the first bin and the last bin<br />'
write(*,'(a)') '# col - bars filled with this color<br />'
write(*,'(a)') '# xlab - label on the X axis<br />'
write(*,'(a)') '</div>'
write(*,'(a)') 

write(*,'(a)') '<span class="b">hist</span>(<span class="r">' //trim(Y)// '</span>, '
if (bin_flag) then
	cm = ' <span class="g">breaks=seq(from=</span><span class="r">'//trim(start)//'</span>'
	cm = trim(cm) // '<span class="g">,to=</span><span class="r">'//trim(finish)//'</span>'
	cm = trim(cm) // '<span class="g">,by=</span><span class="r">'//trim(width)//'</span>'
	cm = trim(cm) // '<span class="g">)</span>, '
	write(*,'(a)') trim(cm)
end if
if (color /= "novalue") then
	write(*,'(a)') ' <span class="g">col=</span>"'//trim(color)//'", '
end if
write(*,'(a)') ' <span class="g">xlab=</span>"' //trim(Y)// '")<br />'

write(*,'(a)') 
write(*,'(a)') '<br />'
write(*,'(a)') '<br />'
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '#-----------------------------<br />'
write(*,'(a)') '# histogram with density curve<br />'
write(*,'(a)') '#-----------------------------<br />'
write(*,'(a)') '</div>'
write(*,'(a)') '<br />'
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '# density histogram with estimated density (smooth) curve<br />'
write(*,'(a)') '# freq=F - put densities instead of frequencies on the vertical axis<br />'
write(*,'(a)') '</div>'
write(*,'(a)') '<span class="b">hist</span>(<span class="r">' //trim(Y)// '</span>, <span class="b">freq=F</span>, '

if (bin_flag) then
	cm = ' <span class="g">breaks=seq(from=</span><span class="r">'//trim(start)//'</span>'
	cm = trim(cm) // '<span class="g">,to=</span><span class="r">'//trim(finish)//'</span>'
	cm = trim(cm) // '<span class="g">,by=</span><span class="r">'//trim(width)//'</span>'
	cm = trim(cm) // '<span class="g">)</span>, '
	write(*,'(a)') trim(cm)
end if
if (color /= "novalue") then
	write(*,'(a)') ' <span class="g">col=</span>"'//trim(color)//'", '
end if
write(*,'(a)') ' <span class="g">xlab=</span>"' //trim(Y)// '",'
write(*,'(a)') ' <span class="g">main=</span>"Densities of ' //trim(Y)// '</span>", '
write(*,'(a)') ' <span class="g">cex=.5</span>)<br />'

write(*,'(a)') '<br />'
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '# abline - optional gridlines from 0 to 8<br />'
write(*,'(a)') '# abline(h=seq(from=0,to=8,by=1), col="gray95")<br />'
write(*,'(a)') '# lines - plot smoothed density curve over existing plot<br />'
write(*,'(a)') '# lwd=2 - double the line width of density curve<br />'
write(*,'(a)') '</div>'
write(*,'(a)') '<span class="b">lines</span>(<span class="b">density</span>(<span class="r">' //trim(Y)// '</span>),  '
write(*,'(a)') '<span class="g">lwd=</span>2)<br />'
write(*,'(a)') '<br />'
write(*,'(a)') '<br />'
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '#-------------------------------------------<br />'
write(*,'(a)') '# filled density curve without the histogram<br />'
write(*,'(a)') '#-------------------------------------------<br />'
write(*,'(a)') '<br />'
write(*,'(a)') '# store density coordinates in the object of class density, named here d<br />'
write(*,'(a)') '</div>'
write(*,'(a)') 'd = <span class="b">density</span>(<span class="r">' //trim(Y)// '</span>)<br />'
write(*,'(a)') '<br />'
write(*,'(a)') '<div class="ltgr">'
write(*,'(a)') '# plotting an object of class density yields density curve<br />'
write(*,'(a)') '</div>'
write(*,'(a)') '<span class="b">plot</span>(d, <span class="g">main=</span>"Density Curve of ' //trim(Y)// '")<br />'
write(*,'(a)') '<br />'
if (color /= "novalue") then
	write(*,'(a)') '<div class="ltgr">'
	write(*,'(a)') '# polygon -  fills area with series of polygons under the density coordinates<br />'
	write(*,'(a)') '</div>'
	write(*,'(a)') '<span class="b">polygon</span>(d, '
	write(*,'(a)') ' <span class="g">col=</span>"'//trim(color)//'")<br />'
end if
write(*,'(a)') ''
write(*,'(a)') '</body>'
write(*,'(a)') '</html>'

end program histogram
