1 REM Ins{nd av Erik Wetterberg <5948> 1987-01-21 Diskett
2 !
10 ! LIST PF.BAS
20 ! ! Visa en fil p} sk{rmen i text eller hexformat. Har funktioner som
21 ! ! bl{ddring fram och bak samt enkel s|kning.
22 !
30 ! utvecklat p} Facit DTC 2
40 ! anpassat (efter b{sta f|rm}ga) ocks} till ABC806
50 ! anpassning till andra datorer kan g|ras i FNInittang
60 ! Erik Wetterberg <5948>
69 ! --------------
70 ! Rev 19870314.1914 <2776> B Sandgren
71 ! CHAIN "NUL:" har tagits bort p} rad 2130
72 ! P} rad 2050 har texten Fram}t resp Bak}t tillkommit.
73 ! Rev 19870627 <5357> Kristoffer Eriksson:
74 ! Rad 2020 {ndrad f|r tangentkoder till alla ABC80x
75 ! Rad 345 och 346 nya f|r att sl{cka rad 25 vid END
80 ! ------------------------------------------------------
90 EXTEND
100 INTEGER
110 ON ERROR GOTO 390
120 DIM Pos(1:24)
130 DIM Rad122$=0
140 POKE VAROOT(Rad122$),1760,SWAP%(1760),30800,SWAP%(30800),1760,SWAP%(1760)
150 DIM Rad223$=0
160 POKE VAROOT(Rad223$),1760,SWAP%(1760),30880,SWAP%(30880),1760,SWAP%(1760)
170 True=(1=1)
180 Nextprog$=FNInarg$
190 DIM Soek$=70 : Soek$=SPACE$(70)
200 PRINT CHR$(12)
210 Z=FNInittang
220 Dump=FNSetfil : Z=FNNysid(Dump)
230 GET Kom$
240 WHILE Kom$<>"Q" AND Kom$<>Esc$
250 IF Kom$=Pf$(1) THEN POSIT #1,FNReadtal("POSITION: ",Pos(22)) : Z=FNNysid(Dump)
260 IF Kom$=Pf$(2) THEN Z=FNSoek(Dump)+FNNysid(Dump)
270 IF Kom$=Pf$(3) THEN Dump=FNSetfil : Z=FNNysid(Dump)
280 IF Kom$=Pf$(5) THEN Dump=NOT Dump : POSIT #1,Pos(1) : Z=FNNysid(Dump)
290 IF Kom$=Ret$ THEN IF Pos(23)=0 THEN PRINT CHR$(7); ELSE POSIT #1,Pos(23) : Z=FNNysid(Dump)
300 IF Kom$=Fram$ THEN IF Pos(23)=0 THEN PRINT CHR$(7); ELSE Z=FNFram(Dump)
310 IF Kom$=Back$ THEN IF Pos(1)=0 PRINT CHR$(7); ELSE Z=FNBack(Dump)
320 GET Kom$
330 WEND
340 CLOSE 1
345 IF PEEK(39)=10 OR PEEK(39)=3 THEN OUT 56,6,57,25 ! ABC800,802
346 ; CHR$(12); : Rad25$=SPACE$(80)
350 ON ERROR GOTO 370
360 IF Nextprog$<>"" THEN CHAIN Nextprog$
370 END
380 ! ----- FELHANTERING huvudprogrammet
390 PRINT "ERRCODE: ";ERRCODE
400 STOP
410 ! ================== funktioner ==================
420 !
430 DEF FNSetfil LOCAL Fil$=16,Fsize
440 ON ERROR GOTO 570
450 Fil$=FNReadtxt$("FIL: ",SPACE$(16),True)
460 Fil$=FNNoblank$(Fil$)
470 PRINT CUR(0,0) SPACE$(80);
480 OPEN Fil$ AS FILE 1
490 Eof=NOT True
500 Fsize=PEEK2(64778)+1
510 PRINT CUR(0,0)+"FIL: "+Fil$+" STORLEK: "+NUM$(Fsize);
520 ! ----- kontroll om det {r en textfil ----------
530 INPUT LINE #1,Buff$
540 POSIT #1,0
550 RETURN NOT True
560 RETURN True
570 IF ERRCODE=21 THEN PRINT CUR(0,40) "*** hittar ej filen ***"; : RESUME 450
580 IF ERRCODE=58 OR ERRCODE=34 THEN RESUME 560 ! *** EJ TEXTFIL ****
590 PRINT "fnsetfil errcode:" ERRCODE : STOP
600 FNEND
610 ! ------------------------
620 DEF FNNysid(Inmode) LOCAL Rad,Radant,Buff$=160
630 Rad=1 : PRINT CUR(1,0);
640 Eof=NOT True
650 WHILE Rad<23 AND NOT Eof
660 Pos(Rad)=POSIT(1)
670 Buff$=FNFilrad$(Inmode)
680 IF LEN(Buff$)>80 THEN Radant=2 : Pos(Rad+1)=Pos(Rad)+80 ELSE Radant=1
690 PRINT Buff$+SPACE$(Radant*80-LEN(Buff$));
700 Rad=Rad+Radant
710 WEND
720 Pos(Rad)=POSIT(1)
730 WHILE Rad<23
740 PRINT SPACE$(80);
750 Rad=Rad+1
760 Pos(Rad)=0
770 WEND
780 PRINT CUR(23,0) SPACE$(80) CUR(23,0);
790 RETURN 0
800 FNEND
810 ! ------------------------
820 DEF FNFram(Inmode) LOCAL Rad,Pos22,Buff$=160
830 Rad122$=Rad223$
840 Pos22=Pos(23) : POSIT #1,Pos22
850 Eof=NOT True
860 Buff$=FNFilrad$(Inmode)
870 IF LEN(Buff$)>80 THEN Buff$=LEFT$(Buff$,80) : Pos22=Pos22+80-LEN(Buff$) : POSIT #1,Pos22+79
880 PRINT CUR(22,0) Buff$+SPACE$(80-LEN(Buff$));
890 PRINT CUR(23,0) SPACE$(80) CUR(23,0);
900 Rad=1
910 WHILE Rad<23
920 Pos(Rad)=Pos(Rad+1) : Rad=Rad+1
930 WEND
940 IF Eof THEN Pos(23)=0 ELSE Pos(23)=POSIT(1)
950 RETURN 0
960 FNEND
970 ! ----------------------------
980 DEF FNBack(Inmode) LOCAL Buff$=160,Rad,Pos1,T$=1
990 IF Inmode THEN Pos1=Pos(1)-18 : GOTO 1060
1000 Pos1=Pos(1)-1
1010 WHILE T$<>CHR$(13) AND Pos1>0
1020 Pos1=Pos1-1
1030 POSIT #1,Pos1 : GET #1,T$
1040 WEND
1050 IF T$=CHR$(13) THEN Pos1=Pos1+1
1060 POSIT #1,Pos1 : Buff$=FNFilrad$(Inmode)
1070 IF Pos(1)-Pos1>80 THEN Pos1=Pos1+80 : Buff$=RIGHT$(Buff$,81)
1080 IF LEN(Buff$)>80 THEN Buff$=LEFT$(Buff$,80)
1090 Temp$=Rad122$ : Rad223$=Temp$
1100 PRINT CUR(1,0) Buff$+SPACE$(80-LEN(Buff$));
1110 PRINT CUR(23,0) SPACE$(80) CUR(23,0);
1120 Rad=23
1130 WHILE Rad>1
1140 Pos(Rad)=Pos(Rad-1) : Rad=Rad-1
1150 WEND
1160 Pos(1)=Pos1
1170 RETURN 0
1180 FNEND
1190 ! ----------------------------
1200 DEF FNSoek(Inmode) LOCAL Buff$=160,Lsoek$=70
1210 Soek$=FNReadtxt$("S\K P]: ",Soek$, NOT True)
1220 Lsoek$=FNStrip$(Soek$)
1230 POSIT #1,Pos(1)
1240 WHILE INSTR(1,Buff$,Lsoek$)=0 AND NOT Eof
1250 Pos=POSIT(1)
1260 Buff$=FNFilrad$(Inmode)
1270 WEND
1280 IF NOT Eof THEN POSIT #1,Pos
1290 RETURN 0
1300 FNEND
1310 ! ----------------------------
1320 DEF FNFilrad$(Inmode) LOCAL Lbuff$=160,Ltkn$=1,Lpos
1330 ! inl{sning av en rad fr}n fil
1340 ON ERROR GOTO 1490
1350 IF Inmode=0 THEN INPUT LINE #1,Lbuff$ : RETURN LEFT$(Lbuff$,LEN(Lbuff$)-2)
1360 Ltkn$=" "
1370 Lbuff$=SPACE$(80)
1380 Lpos=0
1390 MID$(Lbuff$,1,6)=NUM$(POSIT(1))
1400 WHILE Lpos<18
1410 GET #1,Ltkn$
1420 Lpos=Lpos+1
1430 MID$(Lbuff$,(Lpos*3)+5,2)=HEX$(ASCII(Ltkn$))
1440 IF ASCII(Ltkn$)<32 OR ASCII(Ltkn$)>126 THEN Ltkn$="."
1450 MID$(Lbuff$,62+Lpos,1)=Ltkn$
1460 WEND
1470 RETURN Lbuff$
1480 ! ----------- felhantering ----------
1490 IF ERRCODE=34 OR ERRCODE=38 THEN Eof=(1=1) : RESUME 1470
1500 IF ERRCODE=58 THEN RESUME 1520
1510 PRINT "FNFilrad Errcode: " ERRCODE : STOP
1520 RETURN " ***** EJ TEXTFIL ***** "
1530 FNEND
1540 ! --------------------------------
1550 DEF FNInarg$ LOCAL Arg$=0,Pos
1560 Pos=CALL(81)
1570 POKE VAROOT(Arg$),160,0,Pos,SWAP%(Pos),160,0
1580 Pos=INSTR(1,Arg$,",")
1590 IF Pos=0 THEN RETURN ""
1600 Arg$=RIGHT$(Arg$,Pos+1)
1610 Pos=INSTR(1,Arg$,CHR$(13))
1620 IF Pos THEN RETURN LEFT$(Arg$,Pos-1) ELSE RETURN ""
1630 FNEND
1640 ! -------
1650 DEF FNReadtxt$(Inprompt$,In$,Caps) LOCAL Lch,Lnr,Ltxt$=80
1660 ! inl{sning av en textstr{ng
1670 Ltxt$=SPACE$(80)
1680 PRINT CUR(23,0) SPACE$(79);
1690 MID$(Ltxt$,1,LEN(In$))=In$
1700 Lnr=1
1710 PRINT CUR(23,0) Inprompt$+MID$(Ltxt$,1,LEN(In$));
1720 PRINT CUR(23,LEN(Inprompt$)+Lnr-1);
1730 GET Lch$
1740 IF Lch$=Ret$ THEN RETURN MID$(Ltxt$,1,LEN(In$))
1750 IF Lch$=Del$ AND Lnr>1 THEN MID$(Ltxt$,Lnr-1,81-Lnr)=RIGHT$(Ltxt$,Lnr) : Lnr=Lnr-1 : GOTO 1710
1760 IF Lch$=Linedel$ THEN MID$(Ltxt$,1,LEN(In$))=SPACE$(LEN(In$)) : Lnr=1 : GOTO 1710
1770 IF Lch$=Back$ AND Lnr>1 THEN Lnr=Lnr-1 : GOTO 1720
1780 IF Lch$=Fram$ AND Lnr