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