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 Utrymme<T0+K9*4 
270   Max=T0+2 
272   IF Max<K9*4 THEN Max=K9*4 
274   WHILE Max>Utrymme ! den st|rsta str{ngen f}r INTE plats 
276     Max=0 
278     IF T0+2<Utrymme THEN Max=T0+2 
280     IF K9*4<Utrymme THEN Max=K9*4 
282   IF 0 WEND 
290   DIM T$=Max : DIM N$=0 
291   POKE 2+VAROOT(N$),VARPTR(T$),SWAP%(VARPTR(T$)) ! gemensam area 
292   POKE VAROOT(N$),Max,SWAP%(Max) ! samma dimensionering 
300 IF 0 WEND : Flagt=-1 : Flagn=-1 
310 IF Flagn THEN POSIT #Tmp,0 : GET #Tmp,N$ COUNT K9*4 
320 IF Flagt THEN POSIT #Tmp,K9*4+6 : GET #Tmp,T$ COUNT T0+2 
330 ! 
340 Z=FNUt 
370 ! 
380 IF Flagkill CLOSE Tmp : ON ERROR GOTO 390 : KILL Tmpfil$ 
385 ! 
390 END 
400 ! 
410 ! ------------------------------------------------------------------------ 
420 ! 
2000 DEF FNUt 
2005   IF Flaglist THEN ; #Utfil : ; #Utfil 
2010   ; #Utfil,Rub$ : ; #Utfil 
2013   ! 
2014   ! - Skriv ut referenser till radnummer 
2015   IF Bas=0 THEN Z=FNGo 
2016   ! 
2020   WHILE Max>0 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