1 REM Ins{nd av Bengt Erlandsson <5219>    1989-05-07 17.23.07 (DUMP)
10 REM *****************************************
20 REM *            ABC800 LIB                 *
30 REM *         Biblioteksprogram             *
40 REM *            f|r ABC800                 *
50 REM *             Ver 6.8                   *
60 REM *       Bengt Erlandsson <5219>         *
70 REM *****************************************
80 INTEGER : EXTEND : WIDTH 80 : ATTRIBUTE 0 : D=SWAP%(PEEK(64787)) : DIM L(16),B(14),B$(14),N$=255 : A$=SPACE$(40) : A=PEEK2(VAROOT(A$)+2)
90 S$(0)='--' : S$(1)='S-' : S$(2)='-R' : S$(3)='SR' : POKE A,33,D,SWAP%(D),6,239,17,0,0,14,1,126,161,32,1,19,203,121,32,4,203,33,24,243,35,16,238,235,201
100 DATA 30,UFD,12,MO0,13,MO1,8,MF0,9,MF1,10,MF2,16,SF0,17,SF1,18,SF2,4,HD0,5,HD1,6,HD2,7,HD3,29,RAM
110 G1$=WHT : RESTORE : FOR I=1 TO 14 : READ B(I),B$(I) : NEXT I : F$=G1$ : C$=CHR$(12)+CUR(0,24)+F$+'** ABC800 LIB **' : Q$='' : W$=''
120 ; C$ : ; : ; TAB(23) F$ 'P - Skrivare (Printer)' : ; TAB(23) F$ 'S - Storlek' : ; TAB(23) F$ 'F - Filstatus' : ; TAB(23) F$ 'D - Viss enhet'
130 ; TAB(23) F$ 'V - Viss fil' : ; TAB(23) F$ 'E - Editera' : ; TAB(22) F$ 'Optioner (P,S,F,D,V,E): ';
140 GET X$ : A=INT((INSTR(1,'PpSsFfDdVvEe'+CHR$(13),X$)+1)/2) : IF A=0 THEN 140 ELSE ; X$
150 F$=G1$ : Y=0 : P=0 : IF A=1 THEN OPEN 'PR:' AS FILE 1 : P=1 : F$=' '
160 IF A<>4 THEN 190 ELSE ; : ; F$ 'Enhet '; : INPUT Y$ : Y$=LEFT$(FNC$(Y$)+'   ',3) : FOR Z=1 TO 14 : IF Y$=B$(Z) THEN 180 ELSE NEXT Z : Z=FND(Y$)
170 IF Z=0 ; : ; F$ 'Felaktig enhet!' : GOTO 210
180 ; C$ : Z=FNUrra(Z) : IF Z=0 ; : ; F$ 'Enheten ej klar.' : GOTO 210 ELSE 210
190 IF A=5 THEN ; : ; F$ 'Filnamn :'; : INPUT LINE Q$ : Q$=FNC$(LEFT$(Q$,LEN(Q$)-2)) : GOTO 120
200 ; C$ : FOR R=1 TO 14 : Z=FNUrra(R) : NEXT R 
210 CLOSE 1 : Q$='' : W$='' : ; : ; G1$ 'Fler utskrifter (N/P/S/F/D/V/E) ';
220 GET X$ : A=INT((1+INSTR(1,'NnPpSsFfDdVvEe'+CHR$(13,13),X$))/2) : IF A>1 THEN A=A-1 : GOTO 150 ELSE IF A=1 ; X$ : ; ELSE 220
230 END 
240 DEF FNUrra(R)
250   D1=B(R) : POKE -767,D1 : Z=CALL(24678,0) : IF PEEK(-747) RETURN 0 ELSE IF INSTR(1,Q$,':')>3 THEN W$=LEFT$(Q$,3) : Q$=RIGHT$(Q$,5)
260   H=0 : L1=16 : M1=15 : C1=14 : C2=C1 : IF LEN(W$)=0 THEN 290 ELSE IF FND(W$) W$=B$(FND(W$))
270   IF INSTR(1,W$,'*')=3 IF LEFT$(W$,2)=LEFT$(B$(R),2) THEN 290 ELSE RETURN -1
280   IF W$<>B$(R) RETURN -1
290   U1=0 : IF D1=30 THEN U1=24685 : D1=PEEK(PEEK2(U1)+2) : POKE -767,D1 : L1=PEEK2(PEEK2(U1)) : C1=L1-1 : IF L1=0 THEN RETURN 0
300   IF (PEEK2(PEEK2(24683)+(D1 AND 28)) AND 192)=128 THEN M1=7 : C2=6 : IF U1=0 THEN C1=6
310   ; #P : ; #P;F$ 'Enhet ' B$(R) ':'; : IF U1 THEN ; #P '   <';B$(FNB(D1));':>' ELSE ; #P
320   Z=CALL(24678,0) : IF PEEK(-747) THEN 770 ELSE N$='' : FOR I=D+135 TO D+255 : IF PEEK(I)=13 AND PEEK(I+1)=10 THEN 340
330   IF PEEK(I)<32 OR PEEK(I)>127 N$='' : GOTO 340 ELSE N$=N$+CHR$(PEEK(I)) : NEXT I : N$=''
340   N2=LEN(N$) : IF N2>1 OR (A=6 AND U1=0 AND D1<>29) ; #P : ; #P;F$ 'Volym: ';N$ : X=PEEK(-173)-1+(N2>72)
350   IF A<>6 OR U1>0 OR D1=29 THEN 380 ELSE ; CUR(X,0);F$ 'Volym: '; : GET X$ : IF X$<' ' IF X$=CHR$(9) N=1 : GOTO 380 ELSE 380
360   Z=SYS(6) : INPUT LINE N1$ : N1=N2-LEN(N1$)+2 : IF N1>0 ; SPACE$(N1)
370   FOR I=1 TO LEN(N1$) : POKE D+134+I,ASCII(RIGHT$(N1$,I)) : NEXT I : Z=CALL(24675,0) : IF PEEK(-747) THEN 770
380   ; #P;STRING$(-(A=6) AND (U1=0) AND (D1<>29),10) : Z=CALL(24678,C1) : M2=L1 : FOR I=0 TO 15 : L(I)=PEEK(I+D+239) : IF L(I)>0 M2=I+L1
390   NEXT I : Z=CALL(24678,M1) : T1=0 : E1=0 : C1=4 : IF PEEK(D+255)<3 THEN C1=2^PEEK(D+255)
400   FOR B1=L1 TO M2 : Z=CALL(24678,B1) : IF L(B1-L1)=0 THEN 720 ELSE R1=D-12 : FOR A2=0 TO 15 : R1=R1+16 : IF PEEK(R1)=0 OR PEEK(R1)=255 THEN 710
410       F1$='' : F2$='' : FOR K=0 TO 7 : F1$=F1$+CHR$(PEEK(R1+K)) : NEXT K : FOR K=8 TO 10 : F2$=F2$+CHR$(PEEK(R1+K)) : NEXT K 
420       IF LEN(Q$)=0 THEN 480 ELSE I1=INSTR(1,Q$,'.') : IF I1>0 Q1$=LEFT$(Q$,I1-1) : Q2$=RIGHT$(Q$,I1+1) : GOTO 440
430       Q1$=Q$ : Q2$=''
440       IF LEN(Q1$)=0 THEN 460 ELSE I2=INSTR(1,Q1$,'*') : IF I2 IF LEFT$(Q1$,I2-1)=LEFT$(F1$,I2-1) THEN 460
450       IF Q1$<>FNSpac$(F1$) THEN 700
460       IF LEN(Q2$)=0 THEN 480 ELSE I2=INSTR(1,Q2$,'*') : IF I2 IF LEFT$(Q2$,I2-1)=LEFT$(F2$,I2-1) THEN 480
470       IF Q2$<>FNSpac$(F2$) THEN 700
480       F1$=F1$+'.'+F2$ : ; #P;F$;F1$;
490       IF A=1 OR A=3 OR A=6 ; #P;F$;S$(PEEK(R1-3) AND 3);
500       IF A<>6 IF A>2 THEN 680 ELSE 670
510       IF N THEN 630 ELSE ; CHR$(63,8); : GET X$ : G=1+INT((1+INSTR(1,'SsRrXxKkNn'+CHR$(9,9,13,13),X$))/2)
520       ON G GOTO 510,530,540,550,570,600,620,630
530       POKE R1-3,PEEK(R1-3) OR 1 : GOTO 560
540       POKE R1-3,PEEK(R1-3) OR 2 : GOTO 560
550       GOSUB 650
560       H=1 : ; STRING$(3,8); : GOTO 490
570       IF PEEK(R1-3) AND 3 THEN 590 ELSE KILL FNSpac$(B$(R)+':'+F1$) : ; STRING$(16,8);STRING$(20,32);STRING$(20,8);
580       POKE -767,D1 : Z=CALL(24678,B1) : H=0 : E1=E1-1 : T1=T1-1 : GOTO 640
590       GOSUB 650 : GOSUB 660 : ; STRING$(3,8); : IF PEEK(-747) THEN 770 ELSE 490
600       Q2=PEEK(-174)-16 : ; CUR(PEEK(-173),Q2);F$; : INPUT LINE N$ : N$=LEFT$(N$,LEN(N$)-2)
610       GOSUB 660 : NAME FNSpac$(B$(R)+':'+F1$) AS B$(R)+':'+N$ : ; CUR(PEEK(-173),Q2); : IF PEEK(-747) THEN 770 ELSE 410
620       N=1
630       IF H THEN GOSUB 660 : IF PEEK(-747) THEN 770
640       ; CHR$(32,8); : GOTO 680
650       POKE R1-3,PEEK(R1-3) AND 252 : RETURN 
660       POKE -767,D1 : Z=CALL(24675,B1) : H=0 : RETURN 
670       I=PEEK2(R1-2) : ; #P;F$;CHR$(8);SPACE$(3-LEN(NUM$(I)));I;
680       T1=T1+1 : IF T1=6+(A=3)+2*(A=2)+2*(A=6)+3*(A=1) THEN T1=0 : ; #P
690       IF P=0 AND A<>6 AND PEEK(-173)=23 AND PEEK(-174)=0 AND Y=0 GET X$ : IF X$=CHR$(9) THEN Y=1
700       E1=E1+1
710     NEXT A2 
720   NEXT B1 : IF E1=1 THEN E$='y' ELSE E$='ies'
730   IF T1 ; #P
740   ; #P : ; #P;F$;NUM$(E1);' entr';E$;',';FNScan(C2);'av';FNScan(M1);'sektorer lediga.' : IF P ; #P
750   IF P=0 AND A<>6 AND PEEK(-173)=23 AND PEEK(-174)=0 AND Y=0 GET X$ : IF X$=CHR$(9) THEN Y=1
760   N=0 : T1=0 : RETURN -1
770   ; : ; : ; F$ 'Diskfel nr:' PEEK(-747) : RETURN -1
780 FNEND 
790 DEF FNScan(S)
800   Z=CALL(24678,S) : RETURN C1*CALL(PEEK2(VAROOT(A$)+2))
810 FNEND 
820 DEF FNSpac$(L2$) LOCAL N3$=17
830   N3$='' : FOR I=1 TO LEN(L2$) : IF ASCII(RIGHT$(L2$,I))=32 THEN 840 ELSE N3$=N3$+MID$(L2$,I,1)
840   NEXT I : RETURN N3$
850 FNEND 
860 DEF FNB(X)
870   FOR I=1 TO 14 : IF B(I)<>X THEN NEXT I ELSE RETURN I
880 FNEND 
890 DEF FND(W4$) LOCAL W3$=20
900   W3$=W4$ : IF LEFT$(W3$+'   ',2)='DR' THEN W3$=RIGHT$(W3$,3)
910   IF ASCII(W3$)=48 OR ASCII(W3$)=49 THEN RETURN FNB(PEEK(PEEK2(24683))+ASCII(W3$)-48) ELSE RETURN 0
920 FNEND 
930 DEF FNC$(Z$)
940   Z2$='' : FOR I=1 TO LEN(Z$) : Z=ASCII(MID$(Z$,I,1)) : IF Z<127 AND Z>95 THEN Z=Z-32
950   Z2$=Z2$+CHR$(Z) : NEXT I : RETURN Z2$
960 FNEND