1 REM Ins{nd av: Kristoffer Eriksson <5357>    1987-07-10 03.18.39 (WRITE)
10 ! ========================================
12 ! VISAUTIL 2.23 - Visa textfil med backningsm|jlighet.
14 ! F|r hela ABC800-serien.
16 ! ========================================
18 ! 
20 ! Lista en fil p} sk{rmen.
22 ! Ger m|jlighet att scrolla lite bak}t i filen.
24 ! 
30 ! Ver--/-Datum----/-F|rfattare----------------/-Kommentar---
32 ! 1.00 / 86-08-08 / David Andersson <5201>    / F|r ABC80
34 ! 2.00 / 86-11-10 / Kristoffer Eriksson <5357>/ Konverterad till ABC800
36 ! 2.10 / 86-11-12 / Bo Kullmar <1789>         / RUN VISAUTIL,<filnamn>
38 ! 2.20 / 86-11-14 / Kristoffer Eriksson <5357>/ Tgbstatus->Tgbget, GOTO
40 ! .  fr}n 2.10 avl{gsnade, RUN VISAUTIL,<filnamn>;<chainfil>
42 ! 2.21 / 86-11-15 / Kristoffer Eriksson <5357>/ 1810: NOT
44 ! 2.22 / 86-11-19 / Bo Kullmar <1789>/ 350: DIM L$=160
46 ! 2.23 / 87-07-10 / Kristoffer Eriksson <5357>/ 140: Identifierar 802 r{tt
80 ! 
82 ! Denna version {r avsedd att fungera p} alla maskiner i ABC800-serien,
84 ! med alla olika inst{llningar, dvs 40 eller 80 tecken p} ABC802 eller
86 ! ABC806, 40 tecken p} ABC800C och 80 tecken p} ABC800M.
88 ! Ett litet 'men' bara: Programmet {r inte testat p} ABC800C...
90 ! 
92 ! (Notera att det inte finns n}gra GOTO utom ON ERROR GOTO, och att
94 ! alla GOSUB g}r till j{mna hundratal.)
96 ! 
100 ! ----Init----
110 INTEGER : EXTEND : ! NO RESUME
120 Wid=PEEK(65364) ! Radl{ngd
130 X=PEEK(39)
140 Abc=(800 AND (X=10 OR X=2))+(802 AND X=3)+(806 AND X=4)
150 Tgbget=(Abc<>802 AND Abc<>806)
160 Done=0
170 DEF FNV(V)=V+Buflen*((V>=Buflen)-(V<0)) 
180 ! 
190 ! ----Maskinkod bak}tscroll----
200 Bkscroll$=STRING$(138,0)
220 A=VARPTR(Bkscroll$)
230 ! BKSCROLL.ASM. 1986-11-10
240 POKE 0+A,58,39,0,254,2,40,41,254,10,32,7,58,84,255,254,41,56,30,219
250 POKE 19+A,53,8,33,47,127,17,127,127,1,48,7,237,184,17,0,120,1,79,0,175
260 POKE 39+A,211,53,205,A+82,SWAP%(A+82),8,211,53,201,221,33,A+138,SWAP%(A+138)
270 POKE 52+A,62,24,1,40,0,221,94,254,221,86,255,61,202,A+81,SWAP%(A+81)
280 POKE 67+A,221,110,252,221,102,253,237,176,221,43,221,43,24,229,11,98
290 POKE 83+A,107,54,32,19,237,176,201,0,124,128,124,0,125,128,125,0,126
300 POKE 100+A,128,126,0,127,128,127,40,124,168,124,40,125,168,125,40,126
310 POKE 116+A,168,126,40,127,168,127,80,124,208,124,80,125,208,125,80,126
320 POKE 132+A,208,126,80,127,208,127
330 ! 
340 ! Textrad fr}n fil
350 DIM L$=160
360 ! Filnamn F1$ & Chainfil$
370 DIM F1$=20
380 F1$=FNRunpar$
390 ! Tangentbordstecken
400 DIM G$=1
410 ! Stoptangenter
420 DIM Stt$=4 : Stt$=CHR$(0,28,192,193)
430 ! Dimensionera buffert
440 Buflen=(SYS(4)-700)/(Wid+6)
450 IF Buflen<48 ; 'F|r lite minne f|r textbufferten' : STOP 
460 DIM V$(Buflen-1)=Wid
470 ! 
1000 ! ----Huvudloop----
1010 IF F1$='' THEN ; 
1020 ; '***** VISAUTIL *****'
1030 ; 'Listar en fil,' Buflen '- raders buffert'
1040 ; ' PF5 och <---   =lista bak}t i filen'
1050 ; ' PF7 och --->   =lista fram}t i filen'
1060 ; ' MELLANSLAG     =   -"-'
1070 ; ' PF2 och CTRL-\ =lista fr}n b|rjan igen'
1080 ; ' PF1 och CTRL-@ =sluta'
1090 ; 
1100 ! 
1110 WHILE NOT Done
1120   WHILE F1$=''
1130     ON ERROR GOTO 1130 : INPUT 'Filnamn? ';F1$
1140   IF 0 WEND 
1150   ! 
1160   Done=-1 ! Anta det g}r v{gen
1170   WHILE F1$<>''
1180     F1=1
1190     F1$=FNCaps$(F1$)
1200     ON ERROR GOTO 1300 : OPEN F1$ AS FILE F1
1210     ; CHR$(12);
1220     L$=''
1230     GOSUB 1800 ! Sl{pp tangent
1240     GOSUB 2000 ! Visningsloop
1250     CLOSE F1
1260   IF I=28 OR I=193 WEND 
1270   WHILE SYS(5) : GET G$ : WEND ! T|m buffert
1280   ! 
1290   WHILE 0 ! Openfel
1300     ; CHR$(7)
1310     IF ERRCODE=21 THEN ; 'Hittar inte filen ' F1$ '!' ELSE ; 'Fel nr:' ERRCODE
1320     Done=0 ! Det h{r gick ju inte
1330     F1$=''
1340   WEND 
1350 WEND 
1360 ; CUR(23,0);
1370 IF LEN(Chainfil$) THEN ON ERROR GOTO 1380 : CHAIN Chainfil$
1380 END 
1390 ! 
1800 ! ----V{nta p} tangentsl{pp----
1810 IF NOT Tgbget THEN WHILE SYS(8) : WEND 
1830 RETURN 
1840 ! 
2000 ! ----Huvudrutin----
2001 ! Initiera buffert
2010 W1=0 : W2=0 : V1=0
2020 V$(0)='****** H[R B\RJAR FILEN '+F1$ : ; CUR(0,0) V$(0);
2030 FOR V=1 TO 23
2040   V$(V)=':' : ; CUR(V,0) V$(V);
2050 NEXT V 
2100 ! Huvudloop
2110 WHILE 1
2120   GOSUB 3390 ! Tangentkod
2130   IF INSTR(1,Stt$,CHR$(I)) RETURN ! CTRL-@, CTRL-\, PF1 or PF2
2140   IF I=8 OR I=196 GOSUB 2300 ! <- or PF5
2150   IF I=9 OR I=32 OR I=198 GOSUB 2400 ! -> or SPACE or PF7
2160   IF I=255 GOSUB 2200 ! Ingen tangent
2170 WEND 
2180 ! 
2200 ! ----Framf|rh}llning----
2210 ! L{s fr}n filen om n{ra slutet p} bufferten
2220 V=FNV(W2-V1)
2230 IF V<36 GOSUB 3000
2240 RETURN 
2250 ! 
2300 ! ----Scrolla bak}t----
2310 IF V1=W1 RETURN 
2320 V1=FNV(V1-1)
2330 V2=FNV(V1+23)
2340 Z=CALL(VARPTR(Bkscroll$))
2350 ; CUR(0,0) V$(V1);
2360 RETURN 
2370 ! 
2400 ! ----Scrolla fram}t----
2410 X=FNV(W2-V1)
2420 IF X<12 GOSUB 3000 : RETURN 
2430 V1=FNV(V1+1) : ; CUR(23,0)
2440 V2=FNV(V1+23)
2450 IF V2=W1 W1=FNV(W1+1)
2460 IF X<24 V$(V2)=':'
2470 ; CUR(23,0) V$(V2);
2480 RETURN 
2490 ! 
3000 ! ----L{s fr}n filen----
3010 IF F1=0 RETURN 
3020 W2=FNV(W2+1)
3030 IF W2=W1 W1=FNV(W1+1)
3040 ! Kolla om rest fr}n f|rra raden
3050 L=LEN(L$)-2 : IF L<=0 GOSUB 3200 : L=LEN(L$)-2
3060 IF L>Wid L=Wid
3070 V$(W2)=LEFT$(L$,L)
3080 L$=RIGHT$(L$,L+1)
3090 ! Visa raden p} sk{rmen om det g}r
3100 S1=FNV(W2-V1)
3110 IF S1<24 ; CUR(S1,0) CHR$(32,8) V$(W2);
3120 RETURN 
3130 ! 
3200 ! ----L{s en rad----
3210 ON ERROR GOTO 3250
3220 INPUT LINE #F1,L$
3230 ON ERROR GOTO 
3240 RETURN 
3250 ! Error
3260 L$='****** L[SFEL ERROR'+NUM$(ERRCODE)+'**'
3270 IF ERRCODE=34 L$='****** SLUT P] FILEN '+F1$+'**'
3280 CLOSE F1 : F1=0
3290 RETURN 
3300 ! 
3390 ! ----L{s tangentkod----
3400 IF Tgbget THEN IF SYS(5) THEN ; CUR(23,Wid); : GET G$ : I=ASCII(G$) : RETURN ELSE I=255 : RETURN 
3410 IF SYS(8) THEN IF I=255 THEN FOR R=1 TO 70 : NEXT R : I=INP(34) ELSE I=INP(34) ELSE I=255
3420 RETURN 
3430 ! 
3500 DEF FNCaps$(S$) LOCAL T$=160,P
3510   T$=S$
3520   WHILE P<LEN(T$) : P=P+1
3530     IF MID$(T$,P,1)>="`" THEN MID$(T$,P,1)=CHR$(ASCII(MID$(T$,P,1))-32)
3540   WEND 
3550   RETURN T$
3560 FNEND 
3570 ! 
3600 DEF FNRunpar$ LOCAL Adr,Par$=0,Komma,Cr,Semi
3610   Adr=CALL(81)
3620   POKE VAROOT(Par$),161,0,Adr,SWAP%(Adr),161,0
3630   Komma=INSTR(1,Par$,',')
3640   Cr=INSTR(1,Par$,CHR$(13))
3650   IF Komma=0 OR Cr<Komma OR Cr=0 THEN RETURN ''
3660   Semi=INSTR(1,Par$,";")
3670   IF Semi>Komma AND Semi<Cr THEN DIM Chainfil$=Cr-Semi-1 : Chainfil$=MID$(Par$,Semi+1,Cr-Semi-1) : Cr=Semi
3680   RETURN MID$(Par$,Komma+1,Cr-Komma-1)
3690 FNEND