1 REM Ins{nd av Leopold Lundstr|m <2694> 1985-04-25 23.24.33
1 REM +++++++++++++++++++++++++++++++++
2 REM ! Program .... LISTAREN
3 REM ! Utg}va 1.1 1985-03-16
4 REM ! av (c) <2694> L Lundstr|m
7 REM ! Minne 32 Kb f|r flexskiva
9 REM +++++++++++++++++++++++++++++++++
10 REM Listar BAC/BAS-filer samt
11 REM ing}ende variabler p} printer.
12 REM Bygger p} program MJ.. FILOMV
13 REM och PROCENT.BAS (\. K{rrsg}rd)
14 REM ++++++++++++++++++++++++++++++++
20 REM DIM/DEF
30 DIM O$=253%,O1$=0%,U1$=253%
40 DIM Q0$=253%,C$=516%,U2$=253%
50 DIM U$=20%,I$=20%,A$=253%,T$=253%,S$=7%,N1$=25%
60 O$=SPACE$(253%) : S%=1% : T%=15% : M%=145%
70 DIM D$=145%,D1$=140%,K$(M%)=62%,B$=20%,B$(40%)=8%,B%(40%),[$=1%,N$=120%,R$=3%,G$=250% : G$=' 0 '
80 DEFFNP1%(P%)=SWAP%(PEEK(P%+3%))
90 DEFFNP%(P%)=PEEK(P%+2%)+FNP1%(P%)
100 DEFFNM%(X%,Y%)=-X%*(X%>Y%)-Y%*(Y%>=X%)
110 DEFFNN%(X%,Y%)=-X%*(X%78% THEN P9%=2% ELSE 290
250 ; 'Variabellista? (J)'; : GET [$ : ; : IF (ASC([$) AND 95%)=78% THEN H%=-1%
260 ; 'Antal sidor '; : INPUT S1$
270 ; 'K{lla? ';TAB(29%)'!';STRING$(23%,8%); : INPUTLINE N1$ : ; : N1$=LEFT$(N1$,LEN(N1$)-2%)
280 ; 'Datum + ev.tid ';TAB(35)'!';STRING$(21%,8%); : INPUT U$
290 ONERRORGOTO 290
300 ; 'Infil inkl. extension '; : INPUT I$ : IF S1$='' THEN S1$=' '
310 OPEN I$ ASFILE 1%
320 FOR I%=1% TO LEN(I$)
330 A$=A$+CHR$(FNA%(I%)-(32% AND FNA%(I%)>95%)) : NEXT I%
340 K%=INSTR(1%,A$,':')
350 I$=MID$(A$,K%+1%,LEN(A$)-K%)
360 K%=INSTR(1%,I$,'.') : I$=LEFT$(I$,K%-1%)+SPACE$(9%-K%)+RIGHT$(I$,K%)
370 GOSUB 3050 : REM *lbl*
380 OPEN 'PR:' ASFILE P9% : GOSUB 1230 : REM *check PR*
390 ONERRORGOTO 1090
400 GOSUB 920 : A%=ASC(A$) : REM *read*
410 IF (A% OR 1%)=131% GOTO 680
420 IF A%>0% AND A%<128% GOTO 450
430 Z1%=59% : GOTO 1090
440 REM IN-BAS LOOP
450 B%=1% : R$='BAS' : ; R$
460 GOSUB 1130 : REM *sidhuvud*
470 GOTO 510
480 IF ASC(RIGHT$(C$,LEN(C$)))<>3% 1090
490 C$=LEFT$(C$,LEN(C$)-1%)
500 GOSUB 920 : B%=1% : REM INBLOCK F%
510 IF LEFT$(A$,7%)=S$ THEN 870 : REM * end *
520 K%=LEN(C$) : C$=C$+RIGHT$(A$,B%)
530 IF ASC(C$)=3% C$='' : GOTO 500
540 P%=INSTR(1%,C$,CHR$(13%))
550 IF P%=0% GOTO 480
560 IF P%>1% IF ASC(MID$(C$,P%-1%,1%))=9% THEN P%=INSTR(P%+1%,C$,CHR$(13%)) : IF P%=0% THEN 480
570 C$=LEFT$(C$,P%) : B%=B%+P%-K%
580 P%=INSTR(1%,C$,CHR$(9%))
590 IF P%<>0% GOSUB 640 : GOTO 580
600 IF LEN(C$)>119% THEN F$='>'+RIGHT$(NUM$(LEN(C$)),2%)+'!->' : ; CHR$(7%)
610 GOSUB 950 : REM *write*
620 C$='' : GOTO 520
630 REM SPACE IN C$
640 T$=SPACE$(ASC(MID$(C$,P%+1%,1%)))
650 T$=LEFT$(C$,P%-1%)+T$
660 C$=T$+RIGHT$(C$,P%+2%) : T$='' : RETURN
670 REM IN-BAC LOOP
680 GOSUB 1130 : REM *sidhuvud*
690 R$='BAC' : ; R$
700 B%=2% : GOTO 720
710 GOSUB 920 : B%=1%
720 C$=RIGHT$(A$,B%) : L%=ASC(C$)
730 IF L%=1% THEN GOTO 870 : REM *end*
740 IF L%=0% 710
750 C$=LEFT$(C$,L%)
760 IF ASC(RIGHT$(C$,L%))<>13% 1090
770 B%=B%+L% : IF B%>253% 1090
780 O$=C$ : Z1%=CALL(65408%)
790 IF Z1%<>0% GOTO 1090
800 P%=INSTR(1%,O1$,CHR$(13%))
810 IF P%=0% GOTO 1090
820 IF P%<120% GOTO 840
830 F$='!obs!->' : REM *f|r l}ng rad*
840 C$=LEFT$(O1$,P%)
850 GOSUB 950 : GOTO 720
860 REM END
870 GOSUB 2360 : GOSUB 2640 : REM * Qsort * print var *
880 ; S%; : IF S%=1% THEN ; ' sida' ELSE ; ' sidor'
890 IF P9% ; #P9%TAB(73%)R$ : R1%=R1%+1% : GOSUB 1240
900 END
910 REM READ FROM FILE
920 Z%=CALL(28666%,1%)+CALL(28668%,F%)
930 F%=F%+1% : A$=Q0$ : RETURN
940 REM WRITE
950 R2%=R2%+1% : R3%=R3%+LEN(C$)
960 IF P9%=0% AND (INP(56%) AND 95%)=0% GET [$
970 K%=INSTR(1%,C$,' ') : D1$=LEFT$(C$,K%) : L%=LEN(F$+D1$) : U1$=RIGHT$(C$,K%+1%) : GOSUB 1280 : REM *s|k var*
980 ; #P9%;TAB(T%-L%);F$;D1$; : F$=''
990 IF LEN(U1$)<=60% THEN 1030
1000 FOR P%=60% TO 40% STEP -1%
1010 A%=ASC(RIGHT$(U1$,P%)) : IF A%=32 OR A%=44 OR A%=59 THEN U2$=RIGHT$(U1$,P%+1%) : U1$=LEFT$(U1$,P%) : GOTO 1030
1020 NEXT P% : U2$=RIGHT$(U1$,61%) : U1$=LEFT$(U1$,60%)
1030 ; #P9%;TAB(T%+1%)U1$ : U1$='' : R1%=R1%+1%
1040 IF R1%>=62% AND U2$='' AND G%=0% THEN ; #P9% : GOSUB 1210 : R1%=R1%+2% ELSE 1060
1050 IF G%=0% ; #P9%TAB(71)'forts' : R1%=R1%+1% : GOSUB 1240 : S%=S%+1% : GOSUB 1130
1060 IF LEN(U2$)>0% AND ASC(U2$)<>13% THEN U1$=U2$ : U2$='' : GOTO 990
1070 RETURN
1080 REM ERROR
1090 ; 'ERROR'CHR$(7%); : CLOSE 1%
1100 CLOSE P9% : IF Z1% ; Z1% AND 127%
1110 STOP
1120 REM SIDHUVUD
1130 ; #P9%;TAB(6%);STRING$(70%,45%)
1140 ; #P9%;TAB(11%);'"';CHR$(14%);I$;CHR$(15%);'"';TAB(65%-LEN(I$));'Sid';S%;' ('S1$')' : R1%=4%
1150 IF LEN(U$) THEN ; #P9%;TAB(11%);'Utskriven ';U$ : R1%=R1%+1%
1160 IF S%>1% THEN 1190
1170 IF LEN(N$) THEN ; #P9%;TAB(11%);'Volume: ';N$ : R1%=R1%+1%
1180 ; #P9%TAB(11%)'K{lla: ';N1$ : R1%=R1%+1%
1190 GOSUB 1210 : ; #P9%
1200 RETURN
1210 ; #P9%;TAB(6%);STRING$(9%,45%);'0'; : FOR I%=1% TO 6% : ; #P9%'----+----';RIGHT$(NUM$(I%),2%); : NEXT I%
1220 ; #P9% : RETURN
1230 ; 'Printer ej klar!'; : OUT 6%,211% : ; #P9%CHR$(13%); : ; CHR$(13%);TAB(39%);CHR$(13%); : OUT 6%,0% : RETURN
1240 FOR R1%=R1%+1% TO 72% : ; #P9% : NEXT R1%
1260 RETURN
1270 REM S\K VARIABLER
1280 IF F%=1% AND K%=0% THEN ; 'Radnummer saknas' : GOTO 1090
1290 D$=U1$
1300 D%=ASC(D$) : D$=RIGHT$(D$,2%) : GOSUB 1530 : REM *l{s symbol*
1310 REM VARIABELTYP
1320 IF C%=13% OR B$='REM' OR B$='DATA' THEN RETURN
1330 IF B$<>'GOSUB' THEN 1410
1340 D%=ASC(D$) : D$=RIGHT$(D$,2%) : IF D%>47% AND D%<58% THEN T$=T$+CHR$(D%) : GOTO 1340
1350 K%=INSTR(1%,G$,T$) : IF K%<>0% THEN 1400 ELSE P%=1%
1360 P1%=INSTR(P%+1%,G$,' ') : IF P1% IF VAL(T$)>VAL(MID$(G$,P%,P1%-P%)) THEN 1390
1370 IF P1% THEN G$=LEFT$(G$,P%)+T$+' '+RIGHT$(G$,P%+1%) ELSE G$=G$+T$+' '
1380 R4%=R4%+1% : GOTO 1400
1390 P%=P1% : GOTO 1360
1400 T$='' : GOTO 1530
1410 IF LEN(B$)>1% THEN 1450
1420 IF D%=40% GOSUB 1750 : REM *var i var*
1430 GOSUB 2260 : REM *radnr*
1440 GOTO 1530
1450 IF LEFT$(B$,2%)='DE' THEN B$=RIGHT$(B$,4%) : GOTO 1470
1460 IF LEFT$(B$,2%)<>'FN' THEN 1490
1470 IF (D%=36% OR D%=37%) AND ASC(D$)=40% THEN D%=ASC(D$) : D$=RIGHT$(D$,2%)
1480 GOTO 1500
1490 IF ASC(RIGHT$(B$,2%))>57% AND E1%=0% THEN T$=B$ : GOSUB 2120 : GOTO 1530
1500 IF D%=40% GOSUB 1750 : REM *var i var*
1510 GOSUB 2260 : REM *radnr*
1520 REM L[S SYMBOL
1530 IF D%=13% THEN 1620
1540 IF (D%>47% AND D%<58%) AND ASC(D$)=69% THEN D%=69% : D$=RIGHT$(D$,2%) : GOTO 1600
1550 IF D%>64% AND D%<94% THEN 1620
1560 IF D%=35% E1%=1%
1570 IF D%<>34% AND D%<>39% THEN 1600
1580 K%=INSTR(1%,D$,CHR$(D%)) : REM CITATION
1590 D$=RIGHT$(D$,K%+1%)
1600 E%=D% : D%=ASC(D$) : D$=RIGHT$(D$,2%) : IF D%<63% THEN E1%=0%
1610 GOTO 1530
1620 B$='' : REM *symb end*
1630 IF D%=13% THEN B$=CHR$(13%) : GOTO 1720
1640 IF D%>57% AND D%<65% THEN 1720
1650 IF D%=94% THEN 1720
1660 IF D%<48% AND (D%<36% OR D%>37%) THEN 1720
1670 B$=B$+CHR$(D%)
1680 E%=D% : D%=ASC(D$) : D$=RIGHT$(D$,2%)
1690 IF (E%=36% OR E%=37%) AND D%>64% THEN 1720
1700 IF E1%=1% AND D%>64% 1720
1710 GOTO 1640
1720 C%=ASC(B$) : E1%=0%
1730 GOTO 1310
1740 REM VARIABEL I VARIABEL
1750 B$(V%)=B$+CHR$(D%) : B%(V%)=3% : F5%=1% : F6%=0% : B$=''
1760 V1%=V1%+1% : A%=0% : E%=D% : D%=ASC(D$) : D$=RIGHT$(D$,2%)
1770 IF D%=34% OR D%=39% THEN K%=INSTR(1%,D$,CHR$(D%)) : D$=RIGHT$(D$,K%+1%) : GOTO 1760
1780 IF D%=94% THEN 1760
1790 IF D%=69% AND (E%>47% AND E%<58%) THEN 1760
1800 IF D%=70% AND ASC(D$)=78% THEN V%=V%+1% : V1%=0% : B%(V%)=0% : B$(V%)='F' : GOSUB 2200 : GOTO 1760
1810 IF D%>63% AND (ASC(D$)>63% AND ASC(D$)<94%) THEN GOSUB 2100 : GOTO 1760
1820 IF D%>63% AND D%<94% THEN V%=V%+1% : V1%=0% : B%(V%)=0% : B$(V%)=CHR$(D%) : GOTO 1760
1830 IF D%=42% OR D%=43% OR (D%>44% AND D%<48%) OR D%=94% V1%=4% : GOSUB 2070 : GOTO 1760
1840 IF (E%=40 OR E%=44) AND ((D%>47 AND D%<58) OR D%=37%) THEN D%=ASC(D$) : D$=RIGHT$(D$,2%) : GOTO 1840
1850 IF (D%>47% AND D%<58%) AND V1%=1% THEN B$(V%)=B$(V%)+CHR$(D%) : B%(V%)=1% : GOTO 1760
1860 IF (D%=36% OR D%=37%) AND B%(V%)<=1% THEN B$(V%)=B$(V%)+CHR$(D%) : B%(V%)=2% : GOTO 1760
1870 IF D%=40% AND V1%<4% AND B%(V%)<=2% THEN B$(V%)=B$(V%)+CHR$(D%) : B%(V%)=3% : F5%=F5%+1% : F6%=0% : GOTO 1760
1880 IF D%<>44% THEN 1920
1890 IF B%(V%)<3% THEN B%(V%)=5%
1900 IF F3%>0% AND F6% THEN F3%=F3%-1% : GOTO 1760
1910 IF B%(V%-A%)=3% THEN B$(V%-A%)=B$(V%-A%)+',' : B%(V%-A%)=4% : GOTO 1760 ELSE IF A%41% 2010
1930 IF B%(V%)<2% THEN B%(V%)=2%
1940 IF V%>0% IF B%(V%-1%)=3% THEN B%(V%-1%)=4%
1950 IF B%(V%-A%)=4% THEN B$(V%-A%)=B$(V%-A%)+CHR$(D%) : B%(V%-A%)=5% : F5%=F5%-1% : F6%=1% : GOTO 1760
1960 IF A%0% AND F5%=0% THEN F4%=F4%-1% : GOTO 1760
1980 A%=0%
1990 IF B%(V%-A%)=3% THEN B$(V%-A%)=B$(V%-A%)+CHR$(D%) : B%(V%-A%)=5% : F5%=F5%-1% : F6%=1% : GOTO 1760
2000 IF A%57% AND D%<63%) OR D%=13% THEN 2020 ELSE 1760
2020 FOR I%=0% TO V% : REM *var i var-end*
2030 B$=B$(I%) : B$(I%)='' : GOSUB 2260 : REM *radnr*
2040 NEXT I%
2050 V%=0% : V1%=0% : RETURN
2060 REM l{s f|rbi siffror och %
2070 IF (ASC(D$)>47% AND ASC(D$)<58%) OR ASC(D$)=37% THEN D%=ASC(D$) : D$=RIGHT$(D$,2%) : GOTO 2070
2080 RETURN
2090 REM l{s f|rbi bokst{ver och $
2100 T$=T$+CHR$(D%) : IF ASC(D$)>63% OR ASC(D$)=36% THEN E%=D% : D%=ASC(D$) : D$=RIGHT$(D$,2%) : GOTO 2100
2110 IF ASC(D$)=40% THEN E%=D% : D%=ASC(D$) : D$=RIGHT$(D$,2%)
2120 IF LEN(T$)>2% THEN T$=LEFT$(T$,3%) : K%=INSTR(1%,'@LEFCURIGSTRCOMDOTMIDINSUBMULADDIV',T$) ELSE 2150
2130 IF K%>18% THEN F3%=F3%+2% ELSE IF K%>0% F3%=F3%+1% ELSE 2150
2140 GOTO 2160
2150 IF INSTR(1%,'GETLETONEXORNDIMINPIFORELSETHEQVANDNOTCLRPOKGOTGOS',T$)<>0% THEN 2170
2160 F4%=F4%+1%
2170 T$='' : F6%=1%
2180 RETURN
2190 REM *fn...*
2200 IF ASC(D$)>63% THEN D%=ASC(D$) : D$=RIGHT$(D$,2%) ELSE 2220
2210 B$(V%)=B$(V%)+CHR$(D%) : GOTO 2200
2220 IF ASC(D$)<>36% AND ASC(D$)<>37% THEN 2240
2230 D%=ASC(D$) : D$=RIGHT$(D$,2%) : B$(V%)=B$(V%)+CHR$(D%) : V1%=2%
2240 RETURN
2250 REM LAGRA RADNUMMER
2260 IF B$='' THEN 2340
2270 FOR J%=1% TO J1%
2280 IF B$<>LEFT$(K$(J%),INSTR(1%,K$(J%),' ')-1%) THEN 2320
2290 IF INSTR(1%,K$(J%),D1$)<>0% THEN 2340
2300 IF LEN(K$(J%))+LEN(D1$)>62% THEN 2320
2310 K$(J%)=K$(J%)+D1$ : GOTO 2340
2320 NEXT J%
2330 J1%=J1%+1% : K$(J1%)=B$+' '+D1$
2340 B$='' : F3%=0% : F4%=0% : F5%=0% : F6%=1% : RETURN
2350 REM QUICKSORT
2360 IF J1%<=9% THEN 2560
2370 V%=0% : L%=1% : R%=J1%
2380 D$=K$((L%+R%)/2%) : K$((L%+R%)/2%)=K$(L%+1%) : K$(L%+1%)=D$
2390 IF LEFT$(K$(R%),INSTR(1%,K$(R%),' '))>LEFT$(K$(L%+1%),INSTR(1%,K$(L%+1%),' ')) THEN 2410
2400 D$=K$(L%+1%) : K$(L%+1%)=K$(R%) : K$(R%)=D$
2410 IF LEFT$(K$(R%),INSTR(1%,K$(R%),' '))>LEFT$(K$(L%),INSTR(1%,K$(L%),' ')) THEN 2430
2420 D$=K$(L%) : K$(L%)=K$(R%) : K$(R%)=D$
2430 IF LEFT$(K$(L%),INSTR(1%,K$(L%),' '))>LEFT$(K$(L%+1%),INSTR(1%,K$(L%+1%),' ')) THEN 2450
2440 D$=K$(L%+1%) : K$(L%+1%)=K$(L%) : K$(L%)=D$
2450 I%=L%+1% : J%=R% : D1$=LEFT$(K$(L%),INSTR(1%,K$(L%),' '))
2460 I%=I%+1% : IF LEFT$(K$(I%),INSTR(1%,K$(I%),' '))D1$ THEN 2470
2480 IF J%=R%-I%+1% THEN S3%=L% : S4%=J%-1% : S5%=I% : S6%=R% ELSE S3%=I% : S4%=R% : S5%=L% : S6%=J%-1%
2540 IF FNN%(J%-L%,R%-I%+1%)<=9% THEN L%=S3% : R%=S4% ELSE V%=V%+1% : S1%(V%)=S3% : S2%(V%)=S4% : L%=S5% : R%=S6%
2550 GOTO 2380
2560 FOR I%=J1%-1% TO 1% STEP -1%
2570 IF LEFT$(K$(I%),INSTR(1%,K$(I%),' '))61% THEN GOSUB 1040
2650 D1$=STRING$(T%-5%,45%) : U1$=' VARIABLER '+STRING$(63%-T%,45%) : L%=T%-5% : IF H%=0% GOSUB 980 : REM *write*
2660 ; #P9% : R1%=R1%+2% : K$(J1%+1%)=STRING$(10%,48%)
2670 FOR J%=1% TO J1%
2680 L%=INSTR(1%,K$(J%),' ')
2690 IF X%=0 GOSUB 2840 : REM *delsort*
2700 D1$=LEFT$(K$(J%),L%-1%) : U1$=RIGHT$(K$(J%),L%)
2710 IF H%=0% GOSUB 980 : REM *write*
2720 IF X%>0% THEN X%=X%-1%
2730 NEXT J%
2740 ; #P9% : ; #P9%TAB(T%);' Programmet inneh}ller'R2%' rader';
2750 ; #P9%' med totalt'R3%' tecken'
2760 ; #P9%TAB(T%);' Antalet variabler {r'J1%-V2% : R1%=R1%+4%
2770 ; #P9%TAB(T%);' Lagrat p}'F%+1%' sektorer'
2780 IF R1%>=62% AND R4% THEN GOSUB 1210 : R1%=R1%+1% : GOSUB 1050
2790 IF R4% THEN ; #P9% : D1$=NUM$(R4%)+' GOSUB' : L%=7%+LEN(NUM$(R4%)) : U1$=RIGHT$(G$,3%) : G%=-1% : GOSUB 980
2800 IF P9% THEN FOR R1%=R1% TO 63% : ; #P9% : NEXT R1% : IF R4%=0% THEN ; #P9%
2810 ; #P9% : GOSUB 1210 : R1%=R1%+2%
2820 RETURN
2830 REM DELSORTERING
2840 FOR X%=0% TO 10% : REM *Tag ut K$() med samma var*
2850 IF LEN(K$(J%+X%+1%))'LBL' THEN N$='' : GOTO 3120
3100 N$='' : FOR I%=4% TO 11%
3110 N$=N$+CHR$(PEEK(B%+I%)) : NEXT I% : GOTO 3190
3120 Z%=CALL(24678%,0%)
3130 FOR I%=62855% TO 62975%
3140 IF PEEK(I%)=13% AND LEN(N$)>1% THEN 3190
3150 IF PEEK(I%)<32% OR PEEK(I%)>127% THEN N$='' : GOTO 3170
3160 N$=N$+CHR$(PEEK(I%))
3170 NEXT I%
3180 IF LEN(N$)>1% IF ASC(RIGHT$(N$,LEN(N$)))=32% THEN N$=LEFT$(N$,LEN(N$)-1%) : GOTO 3180
3190 RETURN