Program HTML2HLP implicit integer (a-z) parameter (mbitmaps=20,mconfigs=100) character*(100) SourceFile character*127 DestFile character*20000 buffer character*100 lastag,tag,URL,tURL,title,upcase character*200 cline character*12 HelpFile /'WWHelp.HTM'/ character*12 HelpProj /'WWHelp.HPJ'/ character*12 HelpRTF /'WWHelp.RTF'/ character*100 bitmaps(mbitmaps) logical title_out,fexists external upcase,htmlp c SourceFile = 'c:n3000.cnv'//char(0) inquire(file=HelpRTF,exist=fexists) if(fexists) then open(2,file=HelpRTF,status='unknown',err=900) close(2,status='delete') endif inquire(file=HelpProj,exist=fexists) if(fexists) then open(2,file=HelpProj,status='unknown',err=900) close(2,status='delete') endif open(2,file=HelpRTF,status='unknown',err=900) open(3,file=HelpProj,status='unknown',err=920) call initRTF call initProj title = 'Automagically Generated from HTML2HLP' title_out = .false. lastag = '

'
      llast = 6
c
      nconfigs = 0
      nbitmaps = 0
      call = 0
    1 status = htmlp(SourceFile,lbuffer,buffer,ltag,tag,
     &               ltURL,tURL,call)
      if(status.lt.0) goto 910
      if(status.gt.0) goto 2
      call = call + 1
      if(ltURL.ne.0) then
         URL = tURL
         lURL = ltURL
      endif
c
c convert tags ...
c
      tag = upcase(tag,ltag)
      if(tag(:4).eq.'') then
         write(2,'(a)') '{\\strike '//buffer(:lbuffer)//'}'
         write(2,'(a)') '{\\v '//
     &   '!MakeDocument("'//URL(:lURL)//'",0);'//
     &   'GetCacheNameCopy(0," ");'//
     &   'EP("HTML2HLP.EXE",1);'//
     &   'EP("HC31.EXE WWHELP",1)}'
      else
         call putRTF(buffer,lbuffer,lastag,llast,title_out)
      endif
      if(tag(:3).ne.'') then
         write(3,'(a)') 'title = '//buffer(:lbuffer)
         title_out = .true.
         return      
      else if(tag(:4).eq.'

') then write(2,'(a)') '{$}{\\footnote {$} '// & buffer(:lbuffer)//'} \\pard' else if(tag(:4).eq.'

') then write(2,'(a)') '{\\fs32 '//buffer(:lbuffer)//'} \\par' else if(tag(:4).eq.'

') then write(2,'(a)') '{\\fs28 '//buffer(:lbuffer)//'} \\par' else if(tag(:4).eq.'

') then write(2,'(a)') '{\\fs24 '//buffer(:lbuffer)//'} \\par' else if(tag(:4).eq.'

') then write(2,'(a)') '{\\fs20 '//buffer(:lbuffer)//'} \\par' else if(tag(:4).eq.'
') then write(2,'(a)') '{\\fs16 '//buffer(:lbuffer)//'} \\par' else if(tag(:3).eq.'

') then write(2,'(a)') '\\pard\\plain' else if(tag(:3).eq.'') then write(2,'(a)') '\\b{' else if(tag(:4).eq.'') then write(2,'(a)') '}' else if(tag(:6).eq.''.or. & tag(:6).eq.'

') then
         write(2,'(a)') '\\line\\pard\\plain'
      else if(tag(:4).eq.'') then
         write(2,'(a)') '\\line'
         write(2,'(a)') '{\\f0\\''B7} \\tab'
      endif
      if(lbuffer.ne.0) write(2,'(a)') buffer(:lbuffer)
      end


  
      character*(*) function upcase(char,lc)
      character*(*) char
      character*26 up /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
      character*26 lo /'abcdefghijklmnopqrstuvwxyz'/
      upcase = char
      do i=1,lc
         ipos = index(lo,char(i:i))
         if (ipos.ne.0) upcase(i:i) = up(ipos:ipos)
      end do
      end
            

      Subroutine initProj
      write(3,'(a)') '; Automagically generated from HTML2HLP'
      write(3,'(a)') '[OPTIONS]'
      write(3,'(a)') 'copyright= (c) J.J.Bunn 1994             '
      write(3,'(a)') 'oldkeyphrase=off'
      write(3,'(a)') 'compress=high'
      write(3,'(a)') 'warning=3'
      end
 
      Subroutine endProj
      close(3)
      end


      integer function htmlp(SourceFile,lbuffer,buffer,
     &                       ltag,tag,lURL,URL,call)
      implicit integer (a-z)
      integer ipos
      character*(*) SourceFile
      character*20000 buffer
      character*100 context,tag,URL
      character*200 cline
      character*100 null
      save ipos,cline,lline,ilevel,ntags
c
      lbuffer = 0
      ltag = 0
      lURL = 0
      if(call.eq.0) then
         lsf = index(SourceFile,char(0))-1
         write(3,'(a)') '; Source file '//sourcefile(:lsf)
         if(lsf.le.0) goto 900
         open(1,file=SourceFile(:lsf),status='old',err=902)
         write(3,*) '; Source file opened'
         ntags = 0
         null = ' '
         context = null         
         goto 1
      else
         goto 3
      end if
    1 read(1,'(a)',end=2,err=2) cline
      lline = lenocc(cline)
      if(lline.le.0) goto 1
      cline = cline(:lline)//' '
      lline = lline + 1
c
      ipos = 0
      ilevel = 0
    3 ipos = ipos+1
      if(ipos.gt.lline) goto 1
      if(cline(ipos:ipos).eq.'<'.and.ilevel.eq.0) then ntags="ntags" + 1 iend="index(cline(ipos:lline),'">')
        if(iend.ne.0) then
           tag = cline(ipos:ipos+iend-1)
           ltag = iend
           ipos = ipos + iend - 1
           ihref=max(index(tag,'href='),index(tag,'HREF='))
           URL = ' '
           lURL = 0
           if(ihref.ne.0) then
              URL = tag(ihref+5:ltag-1)
              if(URL(1:1).eq.'"') then
                 URL = URL(2:)
              endif
              l1 = 999
              l2 = 999
              l3 = 999
              if(index(URL,'"').gt.0) then
                l1 = index(URL,'"')-1
              else if(index(URL,' ').gt.0) then
                l2 = index(URL,' ')-1 
              else
                l3 = index(URL,'>')-1
              endif
              lURL = min(l1,l2,l3)
           endif
           htmlp = 0
           goto 1000
        else
           goto 901
        endif
      else
        lbuffer = lbuffer + 1
        buffer(lbuffer:lbuffer) = cline(ipos:ipos)
      endif
      goto 3
    2 close(1)
      htmlp = ntags
      write(3,'(a,i6,a)') '; Source file : ',ntags,' tags'
      goto 1000
  900 htmlp = -5000
      goto 1000
  901 htmlp = -5001
      goto 1000
  902 htmlp = -5002
 1000 continue
      end
      integer function lenocc(c)
      character*(*) c
      lenocc = 0
      do lenocc=len(c),1,-1
         if(c(lenocc:lenocc).ne.' ') return
      end do
      end


      subroutine initRTF
      write(2,'(a)') '{\\rtf1\\ansi \\deff3\\deflang1024'
      write(2,'(a)') '{\\fonttbl'
      write(2,'(a)') '{\\f0\\froman Times New Roman;}'
      write(2,'(a)') '{\\f1\\froman Symbol;}'
      write(2,'(a)') '{\\f2\\fswiss Arial;}'
      write(2,'(a)') '{\\f3\\froman Tms Rmn;}'
      write(2,'(a)') '{\\f4\\fswiss Helv;}'
      write(2,'(a)') '{\\f5\\fdecor ZapfDingbats;}'
      write(2,'(a)') '{\\f6\\fmodern Courier;}}'
      write(2,'(a)') '{\\stylesheet'
      write(2,'(a)') '{\\fs10\\lang1033 \\snext0 Normal;}'
      write(2,'(a)') '}'
      end


      subroutine endRTF
      write(2,'(a)') '}'
      end