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 Lnr126 THEN PRINT CHR$(7); : GOTO 1730 1800 IF Lnr>LEN(In$) THEN PRINT CHR$(7); : GOTO 1730 1810 IF Caps AND Lch$>CHR$(95) THEN Lch$=CHR$(ASCII(Lch$) AND NOT 32) 1820 PRINT Lch$; : MID$(Ltxt$,Lnr,1)=Lch$ 1830 Lnr=Lnr+1 : GOTO 1730 1840 FNEND 1850 ! 1860 DEF FNReadtal(Inprompt$,In) LOCAL Ltxt$=5 1870 ! inl{sning av ett heltal 1880 ON ERROR GOTO 1920 1890 Ltxt$=FNReadtxt$(Inprompt$,NUM$(In)+SPACE$(5-LEN(NUM$(In))), NOT True) 1900 IF Ltxt$=SPACE$(5) THEN RETURN 0 ELSE RETURN VAL(Ltxt$) 1910 ! ------- felhantering fnreadtal -------- 1920 IF ERRCODE=210 THEN PRINT CHR$(7) : RESUME 1890 1930 PRINT " ** FNReadtal Errcode: " ERRCODE : STOP 1940 FNEND 1950 ! 1960 DEF FNInittang 1970 DIM Rad25$=0 : POKE VAROOT(Rad25$),0,80,32640,SWAP%(32640),0,80 1980 DIM Esc$=1,Ret$=1,Del$=1,Linedel$=1,Fram$=1,Back$=1 1990 DIM Pf$(1:14)=1 2000 Pf$(1)=CHR$(192) : Pf$(2)=CHR$(193) : Pf$(3)=CHR$(194) : Pf$(4)=CHR$(195) 2010 Pf$(5)=CHR$(196) : Pf$(6)=CHR$(197) : Pf$(7)=CHR$(198) : Pf$(8)=CHR$(199) 2020 IF PEEK(39)<>3 AND PEEK(39)<>4 AND PEEK(39)<>10 THEN GOTO 2100 2030 ! ----- tangentkoder ABC 80x ---------------- 2040 OUT 56,6,57,25 2050 Rad25$="PF1:Position PF2:S|k PF3:Fil PF5:Text/Hex PF6:Avsluta ->:Fram}t <-: Bak}t" 2060 Esc$=CHR$(197) : Ret$=CHR$(13) 2070 Del$=CHR$(199) : Linedel$=CHR$(24) 2080 Fram$=CHR$(9) : Back$=CHR$(8) 2090 RETURN 0 2100 IF PEEK(39)<>6 THEN GOTO 2170 2110 ! ----- tangentkoder Facit DTC 2 ------------ 2120 Rad25$="PF1:Position PF2:S|k PF3:Fil PF5:Text/Hex Esc:Avsluta" 2130 Esc$=CHR$(27) : Ret$=CHR$(13) 2140 Del$=CHR$(8) : Linedel$=CHR$(24) 2150 Fram$=CHR$(163) : Back$=CHR$(162) 2160 RETURN 0 2170 PRINT CHR$(12)+"Programmet ej anpassat f|r denna dator"+CHR$(7) 2180 RETURN 0 ! CHAIN "NUL:" 2190 FNEND 2200 DEF FNStrip$(In$) LOCAL Pos 2210 Pos=LEN(In$) 2220 WHILE Pos>0 AND MID$(In$,Pos,1)=" " 2230 Pos=Pos-1 2240 WEND 2250 RETURN LEFT$(In$,Pos) 2260 FNEND 2270 ! ------------------------------------------------ 2280 DEF FNNoblank$(In$) LOCAL Pos 2290 Pos=INSTR(1,In$," ") 2300 IF Pos=0 RETURN In$ 2310 RETURN LEFT$(In$,Pos-1)+FNNoblank$(RIGHT$(In$,Pos+1)) 2320 FNEND 2330 ! ------------------------------------------------