*=*=*=*= ToMap.html =*=*=*=*
Integer Function ToMap

 

Integer Function ToMap


      Integer Function ToMap(hfile)
      parameter (mxhash=500)
      implicit integer(a-z)
      include 'whstruct.fi'

      common /HASH/ nhash,hashv,hasho

      record /TOMAPHEADER/    th
      record /FILEHEADER/     fh
      character*1 hfile(*)
      character*4 clong

      integer long

      integer hashv(mxhash),hasho(mxhash)
      equivalence (clong,long)
c
      ToMap = 0
      ipos = 1
      call overlay(fh.read,hfile(ipos),len(fh.read))
      ipos = ipos + len(fh.read)
      call overlay(th.read,hfile(ipos),len(th.read))
      ipos = ipos + len(th.read)
      topic = 0
      do i=ipos,fh.fileplusheader,4
         topic = topic+1
         call overlay(clong,hfile(i),4)
         hasho(topic) = long

         hashv(topic) = topic

         write(6,'(a,i3,a,z8)') ' Topic ',topic,' offset ',long

      enddo
      nhash = topic

      end




*=*=*=*= Context.html =*=*=*=*
Integer Function Context

 

Integer Function Context


      Integer Function Context(hfile)
      implicit integer(a-z)
      parameter (mxhash=500)
      include 'whstruct.fi'

      common /HASH/ nhash,hashv,hasho

      record /FILEHEADER/        fh
      record /BTREEHEADER/       bh
      record /BTREENODEHEADER/  bnh
      record /BTREEINDEXHEADER/ bih
      character*(1) hfile(*)
      character*4 clong

      character*2 cint

      integer hashv(mxhash),hasho(mxhash)
      integer*4 long

      integer*2 int

      equivalence (int,cint),(clong,long)
c
      Context = 0
      ipos = 1
      call overlay(fh.read,hfile(ipos),len(fh.read))
      ipos = ipos + len(fh.read)
      call overlay(bh.read,hfile(ipos),len(bh.read))
      ipos = ipos + len(bh.read)
      FirstPageLoc = ipos

      write(6,*) ' BTREE root page ',bh.rootpage
      write(6,*) ' Values in hash table ',bh.totalbtreeentries
      ipos = ipos + bh.rootpage*BTreePageSize

      write(6,*) ' Nlevels ',bh.nlevels
      Level = 1
      nextpage = 0
    1 if(level.lt.bh.nlevels) then
         call overlay(bih.read,hfile(ipos),len(bih.read))
         ipos = ipos+4
         call overlay(cint,hfile(ipos),2)
         nextpage = int

         level = level + 1
         goto 1
      endif
c
c found nextpage
c
      nhash = 0
    2 ipos = FirstPageLoc + nextpage*BTreePageSize

      call overlay(bnh.read,hfile(ipos),len(bnh.read))
      ipos = ipos + 8
      do i=1,bnh.nentries
         if(nhash.ge.mxhash) goto 900
         nhash = nhash + 1
         call overlay(clong,hfile(ipos),4)
         hashv(nhash) = long

         ipos = ipos + 4
         call overlay(clong,hfile(ipos),4)
         hasho(nhash) = long

         ipos = ipos + 4
      end do
      nextpage = bnh.nextpage
      if(nextpage.ne.-1) goto 2
      do i=1,nhash

         write(6,'(a,i3,a,z8,a,z8)') ' Hash ',i,' val ',
     &     hashv(i),' offset ',hasho(i)
      end do
      goto 1000
  900 write(6,*) ' Max hash values exceeded in CONTEXT'
      Context = -5090
 1000 continue
      end




*=*=*=*= Descriptors.html =*=*=*=*
Integer Function Descriptors

 

Integer Function Descriptors


      Integer Function Descriptors(ldata,cdata)
      implicit integer(a-z)
      parameter (mxtag=200)
      common /TAGS/ ntags,ltag,ctag


      character*50 ctag(mxtag)
      character*(*) cdata

      character*4 clong

      character*2 cint1,cint2

      character*1 c,c1,c2,c3

      integer ltag(mxtag)
      integer long,bi,bi1,bi2,bi3

      integer*2 int1,int2

      byte b,b1,b2,b3
      equivalence (b,c),(b1,c1),(b2,c2),(b3,c3)
      equivalence (clong,long),(cint1,int1),(cint2,int2)
c
      blocko(ii) = iand(ii,#3FFF)
c
      Descriptors = 0
      ntags = 0
      if(ldata.le.0) return
      write(6,*) ' descriptors ...'
      write(6,'(20(1x,z2))') (cdata(i:i),i=1,ldata)
      i = 0
    1 i = i+1
      if(i.lt.ldata) then
         write(6,*) ' -----------------------------'
         c = cdata(i:i)
         b1 = 0
         b2 = 0
         b3 = 0
         if(i+2.le.ldata) c1 = cdata(i+2:i+2)
         if(i+4.le.ldata) c2 = cdata(i+4:i+4)
         if(i+5.le.ldata) c3 = cdata(i+5:i+5)
         bi = iand(b,#FF)
         bi1 = iand(b1,#FF)
         bi2 = iand(b2,#FF)
         bi3 = iand(b3,#FF)
c
c Type 89x (link data) takes priority in search
c
         if (bi3.eq.#89) then
           if (bi.eq.#E3) then
            write(6,*) ' Topic link '
           else if(bi.eq.#E2) then
            write(6,*) ' Pop up Topic link'
           else
            write(6,'(a,z2)') ' Link type ',bi

           endif
           clong = cdata(i+1:i+4)
           write(6,'(a,z4,1x,z4)') ' value ',long,blocko(long)
           i = i+5
           Descriptors = Descriptors+2
           ntags = ntags + 1
           ctag(ntags) = ''
           ltag(ntags) = 16
           ntags = ntags + 1
           ctag(ntags) = ''
           ltag(ntags) = 4
         else if(bi.eq.#80) then
            write(6,*) ' byte #80 '
            Descriptors = Descriptors+1
            ntags = ntags + 1
            ltag(ntags) = 0
         else if(bi.eq.#82) then
            write(6,*) '\par'
            Descriptors = Descriptors+1
            ntags = ntags + 1
            ctag(ntags) = '

' ltag(ntags) = 3 else if(bi.eq.#81) then write(6,*) '\line' Descriptors = Descriptors+1 ntags = ntags + 1 ltag(ntags) = 0 else if(bi.eq.#83) then write(6,*) '\tab' Descriptors = Descriptors+1 ntags = ntags + 1 ctag = char(9) ltag = 1 else if(bi1.eq.#80) then cint1 = cdata(i:i+1) ntags = ntags + 1 if(int1.eq.5) then write(6,*) ' bold begin' ctag(ntags) = '' ltag(ntags) = 3 else if(int1.eq.4) then if(ltag(ntags-1).eq.0) then ctag(ntags-1) = '' ltag(ntags-1) = 3 endif ctag(ntags) = '' ltag(ntags) = 4 write(6,*) ' bold end' else if(int1.eq.8) then write(6,*) ' underline end' if(ltag(ntags-1).eq.0) then ctag(ntags-1) = '' ltag(ntags-1) = 4 endif ctag(ntags) = '' ltag(ntags) = 5 else write(6,'(a,z4)') ' format , value ',int1 ltag(ntags) = 0 endif i = i+2 Descriptors = Descriptors+1 else if(bi1.eq.#81) then cint1 = cdata(i:i+1) write(6,'(a,z4)') ' \line , value ',int1 i = i+2 Descriptors = Descriptors+1 ntags = ntags + 1 ltag(ntags) = 0 else if(bi1.eq.#82) then cint1 = cdata(i:i+1) write(6,'(a,z4)') ' \par , value ',int1 i = i+2 Descriptors = Descriptors+1 ntags = ntags + 1 ctag(ntags) = '

' ltag(ntags) = 3 else if(bi1.eq.#86) then cint1 = cdata(i:i+1) write(6,*) ' Unknown #86 value ',int1 i = i+2 Descriptors = Descriptors+1 ntags = ntags + 1 ltag(ntags) = 0 else if(bi2.eq.#80) then cint1 = cdata(i:i+1) cint2 = cdata(i+2:i+3) write(6,'(a,2z5)') ' Formatting values ',int1,int2 i = i+4 Descriptors = Descriptors+1 ntags = ntags + 1 ltag(ntags) = 0 else if (bi3.eq.#82) then write(6,'(a,z2)') ' Bitmap? data type ',bi cint1 = cdata(i+1:i+2) cint2 = cdata(i+3:i+4) write(6,'(a,2z5)') ' values ',int1,int2 i = i+5 Descriptors = Descriptors+2 ntags = ntags + 1 ctag(ntags) = '' ltag(ntags) = 14 ntags = ntags + 1 ctag(ntags) = '' ltag(ntags) = 4 else if(bi.ge.#80.and.bi.le.#90) then write(6,'(a,z2)') ' Unknown descriptor ',bi Descriptors = Descriptors+1 ntags = ntags + 1 ltag(ntags) = 0 else write(6,'(a,z2)') ' Unassigned byte ',bi endif goto 1 endif end *=*=*=*= TagTopic.html =*=*=*=*

Integer Function TagTopic

 

Integer Function TagTopic


      Integer Function TagTopic(length,TopicNum,cdata,itit)
      implicit integer (a-z)
      parameter (mxtag=200,lsp=80)
      common /TAGS/ ntags,ltag,ctag

      character*50 ctag(mxtag)
      character*(*) cdata

      character*1024 cbuff

      integer ltag(mxtag)
      TagTopic = 0
      if(itit.eq.1) then
         cbuff = cdata(:length)
         write(2,*) ' '
         write(2,*) '

cbuff(:length)//'">'// & cbuff(:length)//'' write(2,*) ' ' else itag = 0 ipos = 0 iout = 0 1 ipos = ipos + 1 if(ipos.gt.length) goto 2 if(cdata(ipos:ipos).eq.char(0)) then itag = itag + 1 if(itag.gt.ntags) goto 1 if(ltag(itag).eq.0) then write(2,*) cbuff(:iout) iout = 0 goto 1 endif if(iout.gt.lsp.and.cbuff(iout:iout).eq.' ') then write(2,*) cbuff(:iout) iout = 0 else if(ctag(itag).eq.'

') then write(2,*) cbuff(:iout) iout = 0 endif cbuff(iout+1:iout+ltag(itag)) = ctag(itag) iout = iout + ltag(itag) else cbuff(iout+1:iout+1) = cdata(ipos:ipos) iout = iout + 1 if(iout.gt.lsp.and.cdata(ipos:ipos).eq.' ') then write(2,*) cbuff(:iout) iout = 0 endif endif goto 1 endif 2 write(2,*) cbuff(:iout) end *=*=*=*= GetInt.html =*=*=*=*

Integer Function GetInt

 

Integer Function GetInt


      Integer Function GetInt(nchar,cin)
      character*(*) cin

      character*1 c1,c2,c3

      character*2 cint

      character*4 clong

      integer*2 int

      integer*4 long

c
      byte b1,b2,b3
      equivalence (b1,c1),(b2,c2),(b3,c3),(long,clong),(int,cint)
      GetInt = 0
      if(nchar.gt.4.or.nchar.le.0) return
      if(nchar.eq.1) then
         c1 = cin(1:1)
         GetInt = iand(b1,#FF)
      else if(nchar.eq.2) then
         cint = cin(:2)
         GetInt = int

      else if(nchar.eq.3) then
         c1 = cin(1:1)
         c2 = cin(2:2)
         c3 = cin(3:3)
         GetInt = iand(b1,#FF) + 256*iand(b2,#FF) +
     &            65536*iand(b3,#FF)
      else if(nchar.eq.4) then
         clong = cin(:4)
         GetInt = long

      endif
      end




*=*=*=*= Expand.html =*=*=*=*
Integer Function Expand

 

Integer Function Expand


      Integer Function Expand(needed,iposi,iposo,mx,nzero,cin,cout)
      implicit integer(a-z)
      include 'whstruct.fi'

      parameter (mxphrase=1000)
      common /PHRASES/ nphrase,is_p,if_p,cphrase

      character*15000 cphrase

      character*(*) cin,cout

      character*1 c1,c2

      integer is_p(mxphrase),if_p(mxphrase)
      byte b1,b2
      equivalence (b1,c1), (b2,c2)
c
      istarti = iposi

      istarto = iposo

      expand = 0
    1 if(expand.ge.needed) return
      c1 = cin(iposi:iposi)
      if(b1.le.9.and.b1.ge.1) then
         c2 = cin(iposi+1:iposi+1)
         phrase_n = 256*(iand(b1,#FF)-1) + iand(b2,#FF)
         phrasen = phrase_n/2 + 1
         if(phrasen.eq.0.or.phrasen.gt.nphrase) goto 900
         lp = if_p(phrasen)-is_p(phrasen)+1
         cout(iposo+1:iposo+lp) =
     &       cphrase(is_p(phrasen):if_p(phrasen))
         iposo = iposo + lp

         if(mod(phrase_n,2).eq.1) then
             cout(iposo+1:iposo+1)=' '
             iposo = iposo + 1
         endif
         iposi = iposi + 2
      else if(b1.ne.0) then
         cout(iposo+1:iposo+1) = c1

         iposo = iposo + 1
         iposi = iposi + 1
      else
         nzero = nzero + 1
         cout(iposo+1:iposo+1) = c1

         iposo = iposo + 1
         iposi = iposi + 1
      endif
      expand = iposo-istarto

      used = iposi-istarti

      if(expand.lt.needed.and.used.lt.mx) goto 1
      goto 1000
c
c error exits
c
  900 write(6,*) ' Phrase replacement error'
      expand = -5060
      goto 1000
 1000 end





*=*=*=*= WriteTopics.html =*=*=*=*
Integer Function WriteTopics

 

Integer Function WriteTopics


      Integer Function WriteTopics(compression,hfile)
      implicit integer(a-z)
      include 'whstruct.fi'

      parameter (fourb=4*TopicBlockSize)
      record /FILEHEADER/        fh
      record /TOPICBLOCKHEADER/ tbh
      record /TOPICLINK/         tl
      record /TOPICHEADER/       th
      integer*2 int

      integer*4 long

      character*(1) hfile(*)
      character*2 cint

      character*4 clong

      character*(fourb) cdec,cdeco

      character*(1) c1,c2,c3

      byte b1,b2,b3
      logical compression,pending

      equivalence (long,clong)
      equivalence (int,cint)
      equivalence (b1,c1)
      equivalence (b2,c2)
      equivalence (b3,c3)
      external expand,TagTopic

c
c statement function Block Offset
c
      blocko(ii) = iand(ii,#3FFF)
c
      WriteTopics = 0
      nlinks = 0
      iposh = 1
      nblocks = 0
      pending = .false.
c
      call overlay(fh.read,hfile(iposh),len(fh.read))
      iposh = iposh + len(fh.read)
      write(6,*) ' fileplushead ',fh.fileplusheader
      write(6,*) ' filesize ',fh.filesize
      TopicStart = iposh

c
 500  call overlay(tbh.read,hfile(iposh),len(tbh.read))
      iposh = iposh + len(tbh.read)
c
c tl_off is length of the topiclink header without the 2 offset bytes
c
      tl_off = len(tl.read)-2
      tbh_off = len(tbh.read)-4
c
      ToGet = min(TopicBlockSize-tbh_off,fh.filesize-iposh+1)
      if(compression) then
         ldec = Decompress(ToGet,hfile(iposh),cdec)
      else
         call overlay(cdec,hfile(iposh),ToGet)
         ldec = ToGet

      endif
      ipos = 1
      if(pending) then
         big =10000
         nout = expand(big,ipos,iout,needed,nhot,cdec,cdeco)
         write(6,*) nhot,' locators found'
         write(6,*) ' Text: ',cdeco(:iout)
         status = TagTopic(iout,TopicNum,cdeco,type)
         pending = .false.
      endif
c
    1 continue
      tl.read = cdec(ipos:)
      dlen1 = tl.datalen1 - tl_off

      dlen2 = tl.blocksize - tl.datalen1
      ipos = ipos + tl_off

      if(tl.recordtype.eq.tl_topichdr) then
         write(6,*) ' '
         write(6,*) ' TOPIC Header '
         write(6,'(a,z6)') ' offset ',ipos-tl_off

         th.read = cdec(ipos:)
         write(6,'(a,z6)') ' last one ',tl.prevblock
         TopicNum = th.topicnum
         write(6,*) ' this topic num ',topicnum

         ipos = ipos + dlen1

         iout = 0
         nhot = 0
c
         mx = ldec-ipos+1
         nout = expand(tl.datalen2,ipos,iout,mx,nhot,cdec,cdeco)
         if(nout.ne.tl.datalen2) then
            pending = .true.
            type = 1
            needed = blocko(tl.nextblock)-len(tbh.read)
         else
            pending = .false.
            write(6,*) ' TopicLink Title: ',cdeco(:iout)
            status = TagTopic(iout,TopicNum,cdeco,1)
         endif
c
      else if(tl.recordtype.eq.tl_display.or.
     &        tl.recordtype.eq.tl_text) then
         istart = ipos

         write(6,*) ' All descriptors ....'
         write(6,'(20(1x,z2))') (cdec(i:i),i=ipos,ipos+dlen1-2)
c Get linkdata1 length
         lrec = index(cdec(ipos:),char(#80)) - 1
         len_linkdata1 = GetInt(lrec,cdec(ipos:ipos+lrec-1))
         len_linkdata1 = len_linkdata1/2 - (lrec+1)
         ipos = ipos + lrec + 1
c Get linkdata2 length
         lrec = index(cdec(ipos:),char(#80)) - 1
         len_linkdata2 = GetInt(lrec,cdec(ipos:ipos+lrec-1))
         len_linkdata2 = len_linkdata2/2
         len_linkdata1 = len_linkdata1 - (lrec+1)
         write(6,*) ' dlen1,len_linkdata1 ',dlen1,len_linkdata1

         ipos = ipos + lrec + 1
         iend = istart + dlen1

         write(6,*) ' ipos,iend ',ipos,iend

c
c Decode the descriptors
c
         nihot = Descriptors(iend-ipos,cdec(ipos:iend-1))
         write(6,*) nihot,' descriptors found'
         ipos = iend

c
c Start of text (linkdata2)
c
         nhot = 0
         iout = 0
         mx = ldec-ipos+1
         nout = expand(tl.datalen2,ipos,iout,mx,nhot,cdec,cdeco)
         if(nout.ne.tl.datalen2) then
            pending = .true.
            type = 2
            needed = blocko(tl.nextblock)-len(tbh.read)
         else
            pending = .false.
            write(6,*) nhot,' locators found'
            write(6,*) ' Text: ',cdeco(:iout)
            status = TagTopic(iout,TopicNum,cdeco,2)
         endif
      else if(tl.recordtype.eq.tl_table) then
         write(6,*) ' Table data '
         write(6,'(20(1x,z2))') (cdec(i:i),i=ipos,ipos+39)
         ipos = ipos + tl.datalen2 + dlen1

      else
         write(6,*) ' *** Unknown data type *** '
         write(6,'(20(1x,z2))') (cdec(i:i),i=ipos,ipos+39)
         ipos = ipos + tl.datalen2 + dlen1

      endif
c
c Return to 1 for next TOPICLINK
c
      if(ipos.lt.ldec) goto 1
c
c Get next topic block
c
      nblocks = nblocks + 1
      iposh = TopicStart + nblocks*(TopicBlockSize+len(tbh.read))
      if(iposh.lt.fh.fileplusheader) goto 500
c
      end

*=*=*=*= PosFile.html =*=*=*=*
Integer Function PosFile

 

Integer Function PosFile


      Integer Function PosFile(ipos,iposnow)
      implicit integer(a-z)
      parameter (buffsize=1024)
      character*(buffsize) cbuff

      character*1 c

c
      PosFile = ipos


      if(iposnow.eq.ipos) then
         return
      else if(iposnow.lt.ipos) then
         diff = ipos - iposnow

      else
         diff = ipos

         rewind(1)
      endif
      write(6,*) ' ipos,iposnow,n,m ',ipos,iposnow,n,m

      n = diff/buffsize

      m = diff - (n*buffsize)
      if(n.ne.0) read(1,err=900,end=900) (cbuff,i=1,n)
      if(m.ne.0) read(1,end=900,err=900) (c,i=1,m)
      return
  900 PosFile = -1
      end

*=*=*=*= HLP2HTML
.html =*=*=*=*
Program HLP2HTML

 

Program HLP2HTML


      Program HLP2HTML

      implicit integer(a-z)
      parameter (mxfiles=30,mxbuff=1000)
      include 'whstruct.fi'

c
      record /HELPHEADER/       hh
      record /WHIFSBTREEHEADER/ wh
      record /FILEHEADER/       fh
c
      character*127 helpfile

      character*(mxbuff) cbuff

      character*1 c

      character*2 cint

      character*4 clong

      character hfile [allocatable, huge] (:)
c
      integer offset_file(mxfiles)
      integer*2 int

      integer*4 long

c
      byte b
c
      logical compression

c
      equivalence(c,b)
      equivalence(cint,int)
      equivalence(clong,long)
c
      call getarg(1,helpfile,status)
      if(status.le.0) stop
c
      open(2,file='user',title='HTML Output',recl=200)
      open(1,file=helpfile(:status),status='old',form='binary',
     &     access='direct',recl=1,err=900)
c
      nfiles = 0
c
      read(1,end=902,err=902) hh.read
      if(hh.MagicNumber.ne.hhMagic) goto 901
      ipos =  len(hh.read)
      write(6,*) ' WHIFS = ',hh.WHIFS
      write(6,*) ' Filesize = ',hh.filesize
c
c Goto  the WHIFS header and read the file positions
c
      ipos = PosFile(hh.WHIFS-1,ipos)
      if(ipos.lt.0) goto 904
      read(1,end=904,err=904) wh.read
      write(6,*) ' read WHIFSBtree '
      write(6,*) ' Nsplits = ',wh.nsplits
      write(6,*) ' Totalpages = ',wh.totalpages
      write(6,*) ' Nlevels = ',wh.nlevels
      write(6,*) ' -1 = ',wh.mustbenegone
      write(6,*) ' rootpage = ',wh.rootpage
      write(6,*) ' TotalEntries = ',wh.totalwhifsentries
      ipos = ipos + len(wh.read)
      FirstPageLoc = hh.WHIFS + len(wh.read)
      write(6,*) ' Firstpageloc = ',firstpageloc

c
c 8 is a fudge I do not understand ...
c
      firstpageloc=firstpageloc+8
c
      nfiles = min(wh.totalWHIFSentries,mxfiles)
      PhraseIndex = 0
      TopicIndex = 0
      TopicTitle = 0
      FontIndex = 0
      ToMapIndex = 0
      ContextIndex = 0
      compression = .false.
      ipos = PosFile(FirstPageLoc,ipos)
      do entry=1,nfiles

         write(6,*) ' Looking for WHIFS Entry ',entry

         lbuff = 0
    1    read(1,end=904,err=904) c

         ipos = ipos + 1
         if(b.ne.0) then
            lbuff = lbuff + 1
            cbuff(lbuff:lbuff) = c

            goto 1
         endif
         read(1,end=904,err=904) clong

         ipos = ipos + 4
         write(6,*) ' WHIFS entry name ',cbuff(:lbuff)
         offset_file(entry) = long + 1
         write(6,'(a,i8,1x,z7)') '  at offset ',offset_file(entry),
     &        offset_file(entry)
c
         if(cbuff(:lbuff).eq.'|SYSTEM') then
            SystemIndex = entry

         else if(cbuff(:lbuff).eq.'|Phrases') then
            PhraseIndex = entry

         else if(cbuff(:lbuff).eq.'|TOPIC') then
            TopicIndex = entry

         else if(cbuff(:lbuff).eq.'|TTLBTREE') then
            TopicTitle = entry

         else if(cbuff(:lbuff).eq.'|FONT') then
            FontIndex = entry

         else if(cbuff(:lbuff).eq.'|CONTEXT') then
            ContextIndex = entry

         else if(cbuff(:lbuff).eq.'|TOMAP') then
            ToMapIndex = entry

         else if(cbuff(:3).eq.'|bm') then
c            status = DecodeBMP(cbuff,lbuff,hfile(offset_file(entry)))
c            if(status.ne.0) goto 910
         endif
      end do
c
c Decode the SYSTEM file
c
      if(SystemIndex.ne.0) then
         ipos = PosFile(offset_file(SystemIndex)-1,ipos)
         if(ipos.lt.0) goto 904
         read(1,end=904,err=904) fh.read
         allocate(hfile(fh.fileplusheader),stat=status)
         if(status.ne.0) goto 905
         do i=1,len(fh.read)
            hfile(i) = fh.read(i:i)
         end do
         ipo = len(fh.read)+1
         read(1,end=904,err=904) (hfile(i),i=ipo,fh.fileplusheader)
         status = ReadSystem(compression,hfile(1))
         deallocate(hfile)
         ipos = ipos + fh.fileplusheader
         if(status.ne.0) goto 912
      endif

c
c Decode the Phrases file, if present
c
      if(PhraseIndex.ne.0) then
         ipos = PosFile(offset_file(PhraseIndex)-1,ipos)
         if(ipos.lt.0) goto 904
         read(1,end=904,err=904) fh.read
         allocate(hfile(fh.fileplusheader),stat=status)
         if(status.ne.0) goto 905
         do i=1,len(fh.read)
            hfile(i) = fh.read(i:i)
         end do
         ipo = len(fh.read)+1
         read(1,end=904,err=904) (hfile(i),i=ipo,fh.fileplusheader)
         status = DecodePhrases(compression,hfile(1))
         deallocate(hfile)
         ipos = ipos + fh.fileplusheader
         if (status.ne.0) goto 907
      endif
c
c Decode the Context file
c
      if(ContextIndex.ne.0) then
         ipos = PosFile(offset_file(ContextIndex)-1,ipos)
         if(ipos.lt.0) goto 904
         read(1,end=904,err=904) fh.read
         allocate(hfile(fh.fileplusheader),stat=status)
         if(status.ne.0) goto 905
         do i=1,len(fh.read)
            hfile(i) = fh.read(i:i)
         end do
         ipo = len(fh.read)+1
         read(1,end=904,err=904) (hfile(i),i=ipo,fh.fileplusheader)
         status = Context(hfile(1))
         deallocate(hfile)
         ipos = ipos + fh.fileplusheader
         if(status.ne.0) goto 915
      endif
c
c Decode the TOMAP file
c
      if(ToMapIndex.ne.0) then
         ipos = PosFile(offset_file(ToMapIndex)-1,ipos)
         if(ipos.lt.0) goto 904
         read(1,end=904,err=904) fh.read
         allocate(hfile(fh.fileplusheader),stat=status)
         if(status.ne.0) goto 905
         do i=1,len(fh.read)
            hfile(i) = fh.read(i:i)
         end do
         ipo = len(fh.read)+1
         read(1,end=904,err=904) (hfile(i),i=ipo,fh.fileplusheader)
         status = ToMap(hfile(1))
         deallocate(hfile)
         ipos = ipos + fh.fileplusheader
         if(status.ne.0) goto 916
      endif
c
c And the Topics Titles ..
c
      if(TopicTitle.ne.0) then
         ipos = PosFile(offset_file(TopicTitle)-1,ipos)
         if(ipos.lt.0) goto 904
         read(1,end=904,err=904) fh.read
         allocate(hfile(fh.fileplusheader),stat=status)
         if(status.ne.0) goto 905
         do i=1,len(fh.read)
            hfile(i) = fh.read(i:i)
         end do
         ipo = len(fh.read)+1
         read(1,end=904,err=904) (hfile(i),i=ipo,fh.fileplusheader)
         status = WriteTitles(hfile(1))
         deallocate(hfile)
         ipos = ipos + fh.fileplusheader
         if (status.ne.0) goto 909
      endif
c
c And the TOPICS files
c
      if(TopicIndex.ne.0) then
         ipos = PosFile(offset_file(TopicIndex)-1,ipos)
         if(ipos.lt.0) goto 904
         read(1,end=904,err=904) fh.read
         allocate(hfile(fh.fileplusheader),stat=status)
         if(status.ne.0) goto 905
         do i=1,len(fh.read)
            hfile(i) = fh.read(i:i)
         end do
         ipo = len(fh.read)+1
         read(1,end=904,err=904) (hfile(i),i=ipo,fh.fileplusheader)
         status = WriteTopics(compression,hfile(1))
         deallocate(hfile)
         ipos = ipos + fh.fileplusheader
         if(status.ne.0) goto 908
      endif
c
    2 iret = 0
      goto 1000
c
c
c
  900 write(6,*) ' Cannot open file'
      iret = -5000
      goto 1000
  901 write(6,*) ' Not a Windows help file'
      iret = -5001
      goto 1000
  902 write(6,*) ' Cannot read Help file header'
      iret = -5002
      goto 1000
  903 write(6,*) ' Error positioning internal file'
      iret = -5003
      goto 1000
  904 write(6,*) ' Error positioning Help file'
      iret = -5004
      goto 1000
  905 write(6,*) ' Cannot allocate enough memory'
      iret = -5005
      goto 1000
  906 write(6,*) ' Error writing output HTML file '
      iret = -5006
      goto 1000
  907 write(6,*) ' Error decoding Phrases file '
      iret = status

      goto 1000
  908 write(6,*) ' Error decoding Topics file'
      iret = status

      goto 1000
  909 write(6,*) ' Error fetching Topic titles '
      iret = status

      goto 1000
  910 write(6,*) ' Error in Bitmap decode'
      iret = status

      goto 1000
  912 write(6,*) ' Error decoding System file'
      iret = status

      goto 1000
  915 write(6,*) ' Error decoding CONTEXT file'
      iret = status

      goto 1000
  916 write(6,*) ' Error decoding TOMAP file'
      iret = status

      goto 1000
c
c all routes end here
 1000 continue
      read(5,*)
      close(1)
      close(2)
      end




*=*=*=*= DecodeBMP.html =*=*=*=*
Integer Function DecodeBMP

 

Integer Function DecodeBMP


      Integer Function DecodeBMP(name,lname,hfile)
      implicit integer(a-z)
      include 'whstruct.fi'

      record /FILEHEADER/        fh
      character*(*) name

      character*(1) hfile(*)
      character*13 filename

c
      DecodeBMP = 0
      ipos = 1
      filename = name(2:lname)//'.BMP '
      lf = index(filename,' ')-1
      call overlay(fh.read,hfile(ipos),len(fh.read))
      write(6,*) ' Bitmap ',name(:lname)
      write(6,*) ' fileplushead ',fh.fileplusheader
      write(6,*) ' filesize ',fh.filesize
      ipos = ipos + len(fh.read)
      open(80,file=filename(:lf),form='unformatted',
     &     status='new',err=900)
      write(80,err=901) (hfile(i),i=ipos,fh.fileplusheader)
      close(80)
      return
c
  900 write(6,*) ' Error opening bitmap file '//filename(:lf)
      DecodeBMP = -5060
      goto 1000
  901 write(6,*) ' Error writing bitmap file '//filename(:lf)
      DecodeBMP = -5061
      goto 1000
 1000 continue
      end


*=*=*=*= ReadSystem.html =*=*=*=*
Integer Function ReadSystem

 

Integer Function ReadSystem


      Integer Function ReadSystem(compression,hfile)
      implicit integer (a-z)
      include 'whstruct.fi'

      record /FILEHEADER/    fh
      record /SYSTEMHEADER/  sh
      record /SYSTEMRECORD/  sr
      logical compression

      character*1 hfile(*)
      character*127 title

c
      ReadSystem = 0
      ipos = 1
      call overlay(fh.read,hfile(ipos),len(fh.read))
      ipos = ipos + len(fh.read)
      call overlay(sh.read,hfile(ipos),len(sh.read))
      ipos = ipos + len(sh.read)
      if(sh.revision.eq.21) then
         compression = iand(sh.flags,comp_310) .ne. 0 .or.
     &                 iand(sh.flags,comp_unk) .ne. 0
      else
         compression = .false.
      endif
      write(6,*) ' compression ',compression

      if(sh.revision.eq.#0F) then
         call overlay(title,hfile(ipos),len(title))
         lt = index(title,char(0))-1
      else
         nmacro = 0
   30    if(ipos.lt.fh.fileplusheader) then
            call overlay(sr.read,hfile(ipos),len(sr.read))
            write(6,*) ' datasize = ',sr.datasize
            if (sr.recordtype.eq.1) then
                write(6,*) ' -Help file title'
                call overlay(title,hfile(ipos+4),len(title))
                lt = sr.datasize
                if(title(lt:lt).eq.char(0)) lt = lt-1
            else if(sr.recordtype.eq.2) then
                write(6,*) ' -Copyright notice'
            else if(sr.recordtype.eq.3) then
                write(6,*) ' -Contents ID'
            else if(sr.recordtype.eq.4) then
                write(6,*) ' -Macro Data'
            else if(sr.recordtype.eq.5) then
                write(6,*) ' -Icon'
            else if(sr.recordtype.eq.6) then
                write(6,*) ' -Secondary Window'
            else if(sr.recordtype.eq.8) then
                write(6,*) ' -Citation'
            else
                write(6,*) ' -Unknown ',sr.recordtype
            endif
            ipos = ipos + sr.datasize + len(sr.read)
            goto 30
         endif
      endif
      write(2,'(a)') ' '//<a HREF="dummy.html">title</a>(:<a HREF="dummy.html">lt</a>)//''
      write(2,'(a)') ' 

'//title(:lt)//'

' end *=*=*=*= WriteTitles.html =*=*=*=*
Integer Function WriteTitles

 

Integer Function WriteTitles


      Integer Function WriteTitles(hfile)
      implicit integer(a-z)
      include 'whstruct.fi'

      parameter (mxtitles=200)
      common /TOPICS/ ntitles,ttitle

      record /FILEHEADER/        fh
      record /BTREEHEADER/       bh
      record /BTREENODEHEADER/   bnh
      record /BTREEINDEXHEADER/  bih
      integer*4 long

      character*(1) hfile(*)
      character*4 clong

      character*128 title,ttitle(mxtitles)
      equivalence (long,clong)
c
      WriteTitles = 0
      ipos = 1
      call overlay(fh.read,hfile(ipos),len(fh.read))
      ipos = ipos + len(fh.read)
      call overlay(bh.read,hfile(ipos),len(bh.read))
      ipos = ipos + len(bh.read)
      FirstPageLoc = ipos

      Ntitles = bh.totalbtreeentries
      ipos = FirstPageLoc + bh.rootpage*btreepagesize

      level = 1
      ititle = 0
    1 if(level.lt.bh.nlevels) then
         call overlay(bih.read,hfile(ipos),len(bih.read))
         ipos = ipos+len(bih.read)
         call overlay(clong,hfile(ipos),4)
         nextpage = long

         ipos = FirstPageLoc + nextpage*btreepagesize

         level = level + 1
         goto 1
      endif
    2 continue
      call overlay(bnh.read,hfile(ipos),len(bnh.read))
      ipos = ipos+len(bnh.read)
      write(6,*) ' nentries = ',bnh.nentries
      do i=1,bnh.nentries
         call overlay(clong,hfile(ipos),4)
         ipos = ipos + 4
         TopicOffset = long

         call overlay(title,hfile(ipos),len(title))
         ltit = index(title,char(0))-1
         write(6,*) ' Summary Topic '//title(:ltit)
         write(6,'(a,z4)') ' at offset ',long

         ititle = ititle + 1
         ttitle(ititle) = title(:ltit)
         ipos = ipos + ltit + 1
      end do
      if (bnh.nextpage.ne.-1) then
         write(6,*) ' Going to page ',bnh.nextpage
         ipos = FirstPageLoc + bnh.nextpage*btreepagesize

         goto 2
      endif
      end

*=*=*=*= DecodePhrases.html =*=*=*=*
Integer Function DecodePhrases

 

Integer Function DecodePhrases


      Integer Function DecodePhrases(compression,hfile)
      implicit integer(a-z)
      include 'whstruct.fi'

      parameter (mxphrase=1000)
      common /PHRASES/ nphrase,is_p,if_p,cphrase

      record /PHRASEHEADER/    ph
      record /FILEHEADER/      fh
      character*1 hfile(*)
      character*2 cint

      character*15000 cphrase

      integer int

      integer is_p(mxphrase),if_p(mxphrase)
      logical compression

      equivalence(int,cint)
c
      DecodePhrases = 0
      ipos = 1
      write(6,'(20(1x,z2))') (hfile(i),i=1,20)
      write(6,*) ' Decoding Phrases ...'
      call overlay(fh.read,hfile(ipos),len(fh.read))
      ipos = ipos + len(fh.read)
      call overlay(ph.read,hfile(ipos),len(ph.read))
      ipos = ipos + len(ph.read)
      write(6,*) ' Phrases file size = ',fh.filesize
      write(6,*) ' numphrases = ',ph.numphrases
      nphrase = ph.numphrases
      if(compression) then
         write(6,*) ' phrasessize = ',ph.phrasessize
         call overlay(cint,hfile(ipos),2)
         istart = ipos+int

         before = fh.filesize - (len(ph.read)+2*(ph.numphrases+1))
         ldec = Decompress(before,hfile(istart),cphrase)
         if(ldec.le.0) goto 900
         write(6,*) ' Before/after decode ',before,ldec

      else
         write(6,*) ' 100x ',ph.onehundred
         ipos = ipos - 4
         call overlay(cint,hfile(ipos),2)
         istart = ipos + int

         psize = fh.fileplusheader - istart + 1
         call overlay(cphrase,hfile(istart),psize)
      endif
      call overlay(cint,hfile(ipos),2)
      ioff = int

      is_p(1) = 1
      ipos = ipos + 2
      do i = 2,nphrase

         call overlay(cint,hfile(ipos),2)
         is_p(i) = int - ioff + 1
         if_p(i-1) = int - ioff

         ipos = ipos + 2
      enddo
      call overlay(cint,hfile(ipos),2)
      if_p(nphrase) = int - ioff

c      do i=1,nphrase
c         write(6,*) ' phrase ',i,' ',cphrase(is_p(i):if_p(i))
c      end do
      DecodePhrases = 0
      return
  900 write(6,*) ' Decompressed Phrases error'
      DecodePhrases = -5050
      end


*=*=*=*= overlay.html =*=*=*=*
subroutine overlay

 

subroutine overlay


      subroutine overlay(char1,char2,N)
      integer N

      character*(*) char1

      character*(1) char2(*)
      do i=1,N

         char1(i:i) = char2(i)
      enddo
      end


*=*=*=*= Decompress.html =*=*=*=*
Integer Function Decompress

 

Integer Function Decompress


      Integer Function Decompress(lin,cin,cout)
      implicit integer (a-z)
      character*1 cin(*)
      character*(*) cout

      character*(1) c,c1

      byte control,b,b1
      equivalence (b,c)
      equivalence (b1,c1)
      equivalence (ib,b)
c
      Decompress = 0
      lout = 0
      ipos = 1
    1 continue
      if(ipos.gt.lin) goto 2
      c = cin(ipos)
      control = b

      ip2 = 1
      do count=0,7
         if(btest(control,count)) then
           c = cin(ipos+ip2)
           c1 = cin(ipos+ip2+1)
           len = ishft(iand(b1,#F0),-4) + 3
           dis = 256*iand(b1,#0F) + iand(b,#FF) + 1
           if(dis.le.lout) then
             do i=1,len

                ib = lout-dis+i

                c = cout(ib:ib)
                cout(lout+i:lout+i) = c

             enddo
           else
             cout(lout+1:lout+len) = '?'
           endif
           lout = lout + len

           ip2 = ip2 + 2
         else
           lout = lout+1
           cout(lout:lout) = cin(ipos+ip2)
           ip2 = ip2+1
         endif
      end do
      ipos = ipos+ip2

      goto 1
    2 Decompress = lout

      end