10 ! Program to extract table of contents from intro documentation
11 ! insert via rnp and make document file
20 dim a$[83]v,pg$[4]v,dd$[60],ou$[57],b$[11]v,ck$[1]
30 dd$=". . . . . . . . . . . . . . . . . . . . . . . . . . . . . . "
32 nf=0
40 b=0 : call "SPAWNB"("RNO INTRO.TMP=INTRO.RNO",b)
45 print "Temporary output file done"
50 open #3, "INTRO.TMP/LN:83/RO"
60 if end #3 then 200
70 open #4, "INTRO.TOC/WR"
71 print #4, ".page"
72 print #4, ".center"
73 print #4, "^^TABLE OF CONTENTS"
74 print #4, ".fg 1;.nofill"
80 input line #3, a$
85 if pos(a$,".") = 12 then  gosub 4000
90 if pos(a$,"PAGE ")>64 then  gosub 1000
100 if pos(a$,"CHAPTER")>1 then  gosub 2000
110 if pos(a$,"APPENDIX")>1 then  gosub 3000
130 goto 80
200 print #4, "\\" : print #4, ".fill"
205 close 
210 print "Table of contents extracted"
215 call "SPAWNB"("RNP INTRO.OUT=INTRO.RNO",b)
220 print "Table of contents inserted"
221 set upper on
222 input "Output in diablo format ";ck$
225 if ck$="Y" then call "SPAWNB"("RNO INTRO.DIA/SC=INTRO.OUT",b)
226 if ck$="N" then call "SPAWNB"("RNO INTRO.DOC=INTRO.OUT",b)
230 print "Document file ready"
232 if ck$="Y" then call "SPAWNB"("PIP INTRO.DIA,INTRO.OUT/PU",b)
234 if ck$="N" then call "SPAWNB"("PIP INTRO.DOC,INTRO.OUT/PU",b)
236 call "SPAWNB"("PIP INTRO.OUT;*,INTRO.TMP;*,INTRO.TOC;*/DE",b)
240 exit
1000 pg$=sbs$(a$,pos(a$,"PAGE ")+5)
1010 return 
2000 ck$=sbs$(a$,pos(a$,"CHAPTER")+8,1)
2001 if asc(ck$)<48 or asc(ck$)>57 then  return 
2002 a$=sbs$(a$,pos(a$,"CH"),9)
2005 pg$=sbs$(a$,9,1)+"-1"
2010 b$=a$+" "
2015 input line #3, a$ : input line #3, a$
2016 if pos(a$,chr$(13))>1 then  let a$=sbs$(a$,1,len(a$)-1)
2017 if pos(a$,chr$(13))=1 then  let a$=sbs$(a$,2)
2018 a$=sbs$(a$,2,len(a$)-1)
2019 if pos(a$," ")=1 then 2018
2020 gosub 5000
2021 print #4, " "
2022 print #4, ou$;pg$
2025 print ou$;pg$
2030 return 
3000 ck$=sbs$(a$,pos(a$,"APPENDIX")+9,1)
3001 if asc(ck$)<65 or asc(ck$)>75 then  return 
3002 a$=sbs$(a$,pos(a$,"APPENDIX"),10)
3005 pg$=sbs$(a$,10,1)+"-1"
3010 b$=a$+" "
3015 input line #3, a$ : input line #3, a$
3016 if pos(a$,chr$(13))>1 then  let a$=sbs$(a$,1,len(a$)-1)
3017 if pos(a$,chr$(13))=1 then  let a$=sbs$(a$,2)
3018 a$=sbs$(a$,2,len(a$)-1)
3019 if pos(a$," ")=1 then 3018
3020 gosub 5000
3022 print #4, " "
3023 print #4, ou$;pg$
3025 print ou$;pg$
3026 nf=1
3030 return 
4000 if pos(a$,chr$(13))>1 then  let a$=sbs$(a$,1,len(a$)-1)
4002 if nf>0 then  return 
4005 a$=sbs$(a$,2,len(a$)-1)
4010 if pos(a$," ")=1 then 4005
4015 if asc(sbs$(a$,1,1)) > 53 then  return 
4016 if asc(sbs$(a$,3,1)) > 57 then  return 
4020 b$="        "
4025 gosub 5000
4030 print #4, ou$;pg$
4035 print ou$;pg$
4040 return 
5000 ! fix <, > and &
5005 jj=pos(a$,"<") : if jj<1 then 5015
5010 a$=seg$(a$,1,jj-1)+"("+seg$(a$,jj+1,len(a$)) : goto 5005
5015 jj=pos(a$,">") : if jj<1 then 5025
5020 a$=seg$(a$,1,jj-1)+")"+seg$(a$,jj+1,len(a$)) : goto 5015
5022 jj=pos(a$,"&") : if jj<1 then 5025
5023 a$=seg$(a$,1,jj-1)+"+"+seg$(a$,jj+1,len(a$)) : goto 5015
5025 k=len(a$)+len(b$)
5030 j=k-2*int(k/2)
5035 if j=1 then  let a$=a$+" "
5040 ou$=b$+a$+dd$
5045 return