1 REM Ins{nd av Johan Olofsson <5809> 1987-08-01 16.14.25 (DUMP)
10 ! --------------------------------------------------
20 ! CROSSREF Ver 2.00 - Skapar en korsreferens lista
30 ! F|r ABC800-BASIC, med diskett-station
40 ! F}r kopieras fritt endast i icke-komersiella syften.
50 !
70 ! --------------------------------------------------
99 !
100 INTEGER : EXTEND
101 !
102 COMMON Sep$=18,E$=160,G$=30,Text$(0:6)=20,L$=1,W$=1,R$=1
103 COMMON Rub$=80,Fil$=16,Tmpfil$=16,Pr$=16,Order$=7
104 COMMON Typstring,Typvar,Typlocal,Typfn,Typbas,Typtal,Typrad
106 COMMON Infil,Tmp,Utfil,Bas,Order,Flaglist,Flagkill,K9,T0,Utfilpos.
108 !
109 IF Sep$='' THEN CHAIN 'Crossref' ! Initiering m}ste ske!
110 !
200 OPEN Tmpfil$ AS FILE Tmp
210 !
214 ! - \ppna Ut-filen
215 WHILE Flaglist
217 OPEN Pr$ AS FILE Utfil
219 POSIT #Utfil,Utfilpos.
220 IF 0 WEND : PREPARE Pr$ AS FILE Utfil
222 WHILE INSTR(1,Pr$,'PR:')<>1
224 ! Avsett f|r disk-filer !!!
226 WIDTH #Utfil,78
228 IF 0 WEND : PREPARE Pr$ AS FILE Utfil ! ==> FormFeed vid END
230 !
255 Utrymme=SYS(4)-1000
260 WHILE UtrymmeUtrymme ! den st|rsta str{ngen f}r INTE plats
276 Max=0
278 IF T0+20 AND Max>=K9*4
2021 ! - L{s in notater i N$
2025 POSIT #Tmp,0 : GET #Tmp,N$ COUNT K9*4
2030 Flagn=-1 : Flagt=0 : T$=''
2035 IF 0 WEND
2036 !
2037 ! - Skriv ut referenser f|r variabler - str{ngkonstanter
2040 FOR Uppgift=1 TO Typstring
2045 IF Uppgift<=Order THEN Z=FNRef(Uppgift)
2050 NEXT Uppgift
2054 !
2055 IF Max>0 THEN Flagn=0 ! ]terst{ll Flagn f|r s{kerhets skull
2056 !
2060 RETURN 0
2061 !
2065 FNEND
2070 !
2095 !
2100 DEF FNGo LOCAL R1$=4,Oldr$=4,Svar$=4,K,N{sta
2105 !
2110 ! - Beh|ver / kan T$ fyllas med ord ?
2115 WHILE Max>0 AND Max>=T0
2120 ! - l{s in T$
2125 POSIT #Tmp,K9*4+6 : GET #Tmp,T$ COUNT T0+2
2130 Flagt=-1
2135 IF 0 WEND
2136 !
2140 Svar$=STRING$(4,0) ! Initiering
2141 !
2145 ! - hitta referenser f|r GOTO och GOSUB
2150 FOR X=1 TO K9
2155 !
2160 R1$=RIGHT$(FNGetnotat$(X),3)
2165 WHILE R1$<>Oldr$
2170 Oldr$=R1$
2175 K=FNInt(1,W$+NUM$(FNUs.(CVT$%(R1$)))+R$+W$)
2180 WHILE K
2185 ; #Utfil,'Ref till ' Text$(0)+' '+NUM$(FNUs.(CVT$%(R1$)))
2190 N{sta=1
2195 WHILE -1
2200 N{sta=FNNextrad(N{sta,CVT%$(K),Svar$)
2205 WHILE N{sta>0
2210 N{sta=N{sta+1
2215 ; #Utfil USING '#######' FNUs.(CVT$%(RIGHT$(Svar$,3)));
2220 IF 0 WEND ELSE WEND
2225 ; #Utfil : ; #Utfil
2230 IF 0 WEND
2235 IF 0 WEND
2240 NEXT X
2245 RETURN 0
2250 FNEND
2255 !
2380 DEF FNRef(Flag) LOCAL Ord$=160,R1$=4,Kmax,Svar$=4,N{sta
2390 Svar$=STRING$(4,0)
2400 ; Text$(Flag)
2410 ; #Utfil : ; #Utfil 'Referenser till ' Text$(Flag)
2420 ; #Utfil STRING$(16+LEN(Text$(Flag)),ASCII('='))
2430 ; #Utfil
2440 Kmax=0
2450 FOR X=1 TO K9
2460 R1$=FNGetnotat$(X)
2470 WHILE CVT$%(R1$)>Kmax
2480 Kmax=CVT$%(R1$)
2490 Ord$=FNOrd$(Kmax)
2500 WHILE Flag=FNTyp(Ord$)
2510 IF Flag=Typlocal THEN ; #Utfil,LEFT$(Ord$,LEN(Ord$)-1)
2520 IF Flag<>Typlocal THEN ; #Utfil,Ord$
2530 N{sta=X
2540 WHILE -1
2550 N{sta=FNNextrad(N{sta,CVT%$(Kmax),Svar$)
2560 WHILE N{sta>0
2570 N{sta=N{sta+1
2580 ; #Utfil USING '#######' FNUs.(CVT$%(RIGHT$(Svar$,3)));
2590 IF 0 WEND ELSE WEND
2600 ; #Utfil : ; #Utfil
2610 IF 0 WEND
2620 IF 0 WEND
2630 NEXT X
2640 RETURN 0
2650 FNEND
2660 !
3000 DEF FNTyp(Ord$)
3005 IF LEN(Ord$)=0 THEN RETURN -1
3006 WHILE ASCII(Ord$)<=ASCII('9')
3007 WHILE ASCII(Ord$)>=ASCII('1')
3008 IF RIGHT$(Ord$,LEN(Ord$))=R$ RETURN Typrad
3009 IF 0 WEND
3010 IF ASCII(Ord$)>=ASCII('0') RETURN Typtal
3012 IF 0 WEND
3020 IF ASCII(Ord$)=ASCII('"') THEN RETURN Typstring
3030 IF ASCII(Ord$)=ASCII("'") THEN RETURN Typstring
3040 IF LEN(Ord$)=1 THEN RETURN Typvar
3047 IF RIGHT$(Ord$,LEN(Ord$))=L$ THEN RETURN Typlocal
3050 IF MID$(Ord$,2,1)>='a' THEN RETURN Typvar
3060 IF MID$(Ord$,2,1)<='9' THEN RETURN Typvar
3080 IF LEN(Ord$)>4 IF LEFT$(Ord$,5)='FNEND' THEN RETURN Typbas
3090 IF LEN(Ord$)>2 IF LEFT$(Ord$,2)='FN' THEN RETURN Typfn
3100 RETURN Typbas
3110 FNEND
3120 !
3290 DEF FNUs.(A)
3300 IF A<0 THEN RETURN 65536.+A ELSE RETURN A
3310 FNEND
3690 !
3700 DEF FNGetnotat$(Nr) LOCAL Retur$=4
3701 WHILE Flagn
3702 RETURN MID$(N$,(Nr-1)*4+1,4)
3703 IF 0 WEND
3710 POSIT #Tmp,(Nr-1)*4
3720 GET #Tmp,Retur$ COUNT 4
3730 RETURN Retur$
3740 FNEND
3750 !
3800 DEF FNOrd$(Kmax) LOCAL Retur$=160
3810 IF Flagt THEN RETURN MID$(T$,Kmax+1,INSTR(Kmax+1,T$,W$)-Kmax-1)
3811 POSIT #Tmp,K9*4+6+Kmax
3812 WHILE -1
3813 GET #Tmp,Z$
3814 IF Z$<>W$ THEN Retur$=Retur$+Z$ : WEND
3816 RETURN Retur$
3820 FNEND
3830 !
3840 DEF FNNextrad(Start,S|k$,Resultat$) LOCAL H$=4,H
3841 WHILE Flagn
3842 H=(Start-1)*4
3843 WHILE -1
3844 H=INSTR(H+1,N$,S|k$)
3845 WHILE MOD(H,4)=1
3846 MID$(Resultat$,1,4)=MID$(N$,H,4)
3847 RETURN 1+H/4
3848 IF 0 WEND
3849 IF H=0 THEN RETURN -1
3850 H=H+1
3851 WEND
3852 IF 0 WEND
3855 !
3858 FOR X2=Start TO K9
3860 H$=FNGetnotat$(X2)
3870 IF LEFT$(H$,LEN(S|k$))=S|k$ THEN MID$(Resultat$,1,4)=H$ : RETURN X2
3880 NEXT X2
3890 RETURN -1
3900 FNEND
3910 !
3930 DEF FNInt(Start,S|k$) LOCAL L$=1 ! Letar efter ord i T$
3940 IF Flagt THEN RETURN INSTR(Start,T$,S|k$)
4000 POSIT #Tmp,K9*4+6+Start-1
4010 FOR X3=1 TO T0
4020 GET #Tmp,L$
4030 WHILE ASCII(L$)=ASCII(S|k$)
4040 FOR X4=2 TO LEN(S|k$)
4050 GET #Tmp,L$
4060 IF L$=MID$(S|k$,X4,1) THEN NEXT X4 : RETURN X3
4070 POSIT #Tmp,K9*4+6+X3
4080 IF 0 WEND
4090 NEXT X3
4100 RETURN 0
4110 FNEND