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