1 REM Ins{nd av Kristoffer Eriksson <5357>    1988-03-02 01.32.27 (KERMIT)
20 ! +------------------------------------------------+
30 ! ! VTK[RNA 1.00 - Grundstomme till VT100-emulator !
40 ! ! F|r ABC800M, 802, 806.                         !
50 ! ! Av Kristoffer Eriksson <5357>, 1988-03-02      !
60 ! ! Kan anv{ndas som det {r, eller byggas ut till  !
70 ! ! en m}ngsidig terminalemulator av den som vill. !
80 ! +------------------------------------------------+
90 !
100 ! De vanligaste VT100-funktionerna {r redan inlagda. N}gra som inte {r det,
110 ! men som skulle g} om man anstr{nger sig lite {r <ESC>#6 Dubbel tecken-
120 ! bredd, <ESC>#4 Dubbel h|jd (OBS dessa ska avslutas vid radbyte, s} radbyte
130 ! m}ste detekteras), <ESC>?7l/h Autowrap av/p}, <ESC>?9l/h Eko av/p},
140 ! <ESC>(0, <ESC>)0 Grafiskt teckenset (simulera), <SI>, <SO> v{xla mellan
150 ! t ex de tv} teckensetten i 806:ans teckengenerator, Blink och invertering
160 ! p} ABC802, <ESC><t>;<b>r Scroll region, <ESC>= Application keypad
170 ! (medelst up/down-mode p} tangentbordet), grafikkommandon, skrivardump.
180 !
190 ! D{rut|ver fattas allt vad interaktiv parameterst{llning, fil|verf|ring
200 ! hj{lprader, och andra finesser heter. Antagligen m}ste du justera V24par$
210 ! i FNConfig innan du f|rs|ker k|ra.
220 ! vara skriven n{stan helt i Basic.
230 !
240 ! Om programmet ska reagera p} mottaget XON/XOFF med annat {n paritet space
250 ! t ex vid fils{ndning, m}ste detta tas omhand i Basic, eftersom options-
260 ! prommet {r buggigt p} den punkten. Antingen POKE:ar man prommets flaggor
270 ! n{r tecknen tas emot, eller l}ter bli att skriva mer p} V24 tills XON
280 ! kommer. Ingendera l|sningen {r optimal, av sk{l som inte ryms h{r.
290 !
300 ! VTK[RNA {r mycket snabb p} r}mottagning f|r att vara skriven i Basic.
310 !
320 INTEGER : EXTEND
330 !
340 ! PF-tangenter: 192=PF1, 208=Shift-PF1, 224=Ctrl-PF1, 240=Shift-Ctrl-PF1
350 ! _versalbokstav = CTRL-bokstav
360 ! _a=stopp, _b=}teruppta s{ndning trots mottaget XOFF, _c=DTR-avbrott
370 ! _d=s{nd BREAK
380 DATA 200
390 DATA 192,_[, 193,_[OI, 194,_[[D, 195,_[[C
400 DATA 196,_[[A, 197,_[[4h, 198,_[[B, 199,_[[Z
410 DATA 208,_[[a, 209,_[[b, 210,_[[c, 211,_[[d
420 DATA 212,_[[V, 213,_[[e, 214,_[[U, 215,_[[f
430 DATA 224,_[OP, 225,_[OQ, 226,_[OR, 227,_[OS
440 DATA 228,_[Ow, 229,_[Ox, 230,_[Oy, 231,_[Om
450 DATA 240,_[Ot, 241,_[Ou, 242,_[Ov, 243,_[Ol
460 DATA 247,_a, 246,_b, 245,_c, 244,_d
470 DATA 0
480 !
490 ! PF enligt ovan (Facit Twist och ABC1600-inspirerad, f|r ABC77):
500 ! PF1=ESC, PF2=HELP, PF3= <-, PF4= ->, PF5=Upp, PF6=Ins char, PF7=Ned
510 ! PF8=Back tab, SPF5=Shift upp, SPF7=Shift ned, \vriga shift godtyckliga
520 ! koder, CPF1-CPF4=VT100 PF1-PF4, CPF5=App 7, CPF6=App 8, CPF7=App 9,
530 ! CPF8=App -, SCPF1=App 4, SCPF2=App 5, SCPF3=App 6, SCPF4="App ,",
540 ! SCPF5=BREAK, SCPF6=DTR-avbrott, SCPF7=Avbryt XOFF, SCPF8=Avsluta.
550 !
560 Z=FNConfig+FNInit+FNTerminal+FNStopp
570 !
580 DEF FNConfig
590   ! CRLF: 1:CR=CRLF,LF=-;  2:CR=-,LF=CRLF;  3:CR=CR,LF=LF
600   ! .     4:CR=CRLF,LF=LF; 5:CR=CR,LF=CRLF; 6:CR=CRLF,LF=CRLF
610   Crlfrec=3
620   Crlftran=3
630   Cursoron=1
640   Defattr=7
650   V24par$="V24:VDA30A24.77A" ! 9600 baud, XON/XOFF, paritet space
660   Enqsvar$=""
670   ! KEYMODE ,0
680   Buflen=80
690   V24buflen=5000
700   DIM Tabs$=80
710   Tabs$="T       "
720   Tabs$="        "+Tabs$+Tabs$+Tabs$+Tabs$+Tabs$+Tabs$+Tabs$+Tabs$+Tabs$
730   RETURN 0
740 FNEND
750 !
760 DEF FNReset LOCAL L
770   Savepos=0 : Saveattr=Defattr
780   ; CHR$(12); : IF Abc=806 THEN OUT 53,Defattr : POKE Aattr,Defattr
790   IF Abc<>800 L=8 : WHILE L>0 : Z=FNLed(L,0) : L=L-1 : WEND : OUT 34,133
800   RETURN FNPfinit
810 FNEND
820 !
830 DEF FNTerminal LOCAL P,K
840   Z=FNGetv24buf
850   P=CALL(Asm)
860   IF P=0 THEN ; Buf$; : GOTO 840
870   ; LEFT$(Buf$,P-1);
880   K=ASCII(RIGHT$(Buf$,P))+1
890   Buf$=RIGHT$(Buf$,P+1)
900   IF K=128 THEN ; ""; : GOTO 850 ! DEL (egentligen inte synligt tkn)
910   ON K GOTO 850,850,850,850,850,930,850,930,940,950,970,990,990,980,850,850,850,850,850,850,850,850,850,850,850,850,850,1020,850,850,850,850
920   Z=FNPutv24(Enqsvar$) : GOTO 850
930   ; CHR$(7); : GOTO 850
940   IF PEEK(Akol)>0 THEN ; CHR$(8); : GOTO 850 ELSE 850
950   Z=INSTR(PEEK(Akol)+2,Tabs$,"T") : IF Z=0 THEN Z=PEEK(Awid)
960   POKE Akol,Z-1 : GOTO 850 ! TAB
970   ; FNLf$(Crlfrec); : GOTO 850
980   ; FNCr$(Crlfrec); : GOTO 850
990   ; CHR$(10); : GOTO 850 ! VT,FF
1000   POKE V24xoff,PEEK(V24xoff) AND 253 : GOTO 850 ! XON
1010   POKE V24xoff,PEEK(V24xoff) OR 2 : GOTO 850 ! XOFF trots paritetsbug i PROM
1020   Z=FNEsc : GOTO 850
1030 FNEND
1040 !
1050 DEF FNCr$(Mode)
1060   ON Mode GOTO 1090,1070,1080,1090,1080,1090
1070   RETURN ""
1080   RETURN CHR$(13)
1090   RETURN CHR$(13,10)
1100 FNEND
1110 !
1120 DEF FNLf$(Mode)
1130   ON Mode GOTO 1140,1160,1150,1150,1160,1160
1140   RETURN ""
1150   RETURN CHR$(10)
1160   RETURN CHR$(13,10)
1170 FNEND
1180 !
1190 DEF FNEsc LOCAL Start$=2,Slut$=1,K,N,R
1200   K=FNGetv24
1210   ON INSTR(1,"DMEH78()c[#",CHR$(K))+1 GOTO 2120,1230,1240,1250,1260,1270,1280,1310,1310,1320,1350,2080
1220   !
1230   ; CHR$(10); : RETURN 0 ! D index
1240   IF PEEK(Arad)>0 THEN POKE Arad,PEEK(Arad)-1 : RETURN 0 ELSE RETURN FNRevscroll(0,23,1) ! M rev index
1250   ; : RETURN 0 ! E newline
1260   MID$(Tabs$,PEEK(Akol)+1,1)="T" ! H Set TAB
1270   Savepos=PEEK2(Akol) : Saveattr=INP(53) : RETURN 0 ! 7 save
1280   POKE Akol,Savepos,SWAP%(Savepos) ! 8 restore
1290   IF Abc=806 THEN OUT 53,Saveattr : POKE Aattr,Saveattr
1300   RETURN 0
1310   K=FNGetv24 : RETURN 0 ! (x, )x Char set
1320   RETURN FNConfig+FNReset ! c Reset
1330   !
1340   ! --[
1350   K=FNEscpar
1360   ON INSTR(1,"ABDCKJLMHfq?mncg",CHR$(K))+1 GOTO 2120,1370,1390,1410,1430,1460,1520,1580,1590,1610,1610,1630,1690,1790,1920,1980,2010
1370   N=FNPar(0,1) : IF PEEK(Arad)>=N THEN POKE Arad,PEEK(Arad)-N
1380   RETURN 0 ! [A upp
1390   N=FNPar(0,1) : IF PEEK(Arad)+N<=23 THEN POKE Arad,PEEK(Arad)+N
1400   RETURN 0 ! [B ned
1410   N=FNPar(0,1) : IF PEEK(Akol)>=N THEN POKE Akol,PEEK(Akol)-N
1420   RETURN 0 ! [D v{nster
1430   N=FNPar(0,1) : IF PEEK(Akol)+N<PEEK(Awid) THEN POKE Akol,PEEK(Akol)+N
1440   RETURN 0 ! [C h|ger
1450   !
1460   N=FNPar(0,0) : Z=FNCadr : K=PEEK(Akol)
1470   IF N=0 THEN POKE Z,32 : IF K<79 THEN Z=FNLdr(Ldir,Z,Z+1,79-K)
1480   IF N=1 THEN POKE Z,32 : IF K>0 THEN Z=FNLdr(Lddr,Z,Z-1,K)
1490   IF N=2 THEN Z=Z-K : POKE Z,32 : Z=FNLdr(Ldir,Z,Z+1,79)
1500   RETURN 0 ! [K radera rad
1510   !
1520   N=FNPar(0,0) : Z=FNCadr : K=PEEK(Akol) : R=PEEK(Arad)
1530   IF N=0 THEN POKE Z,32 : IF R<23 OR K<79 Z=FNLdr(Ldir,Z,Z+1,(24-R)*80-K-1)
1540   IF N=1 THEN POKE Z,32 : IF R>0 OR K>0 Z=FNLdr(Lddr,Z,Z-1,R*80+K)
1550   IF N=2 THEN ; CHR$(12); : POKE Akol,K : POKE Arad,R
1560   RETURN 0 ! [J radera sk{rm
1570   !
1580   N=FNPar(0,1) : RETURN FNRevscroll(PEEK(Arad),23,N) ! [L insert line
1590   N=FNPar(0,1) : RETURN FNScroll(PEEK(Arad),23,N) ! [M del line
1600   !
1610   POKE Arad,FNBound(FNPar(0,1),1,24)-1 : POKE Akol,FNBound(FNPar(1,1),1,PEEK(Awid))-1 : RETURN 0 ! [H, [f position
1620   !
1630   IF Abc=800 THEN RETURN 0 ! [q LEDS
1640   R=0 : WHILE R<Par OR R=0 : N=FNPar(R,0)
1650     IF N=0 THEN K=8 : WHILE K>0 : Z=FNLed(K,0) : K=K-1 : WEND ELSE Z=FNLed(FNBound(N,1,8),1)
1660   R=R+1 : WEND
1670   RETURN 0
1680   !
1690   IF Par<>0 THEN RETURN 0 ! [? pars
1700   K=FNEscpar
1710   IF K=104 THEN K=-1 ELSE IF K=108 THEN K=0 ELSE RETURN 0 ! h/l
1720   R=0 : WHILE R<Par : N=FNPar(R,0)
1730     IF N=5 AND Abc=806 THEN Defattr=(Defattr AND 192)+(K AND 56)+(7 AND NOT K) : OUT 53,Defattr : POKE Aattr,Defattr ! 5 bakgrund
1740     IF N=8 AND Abc<>800 THEN OUT 34,(K AND 128)+5 ! Repetering
1750     IF N=20 THEN Crlfrec=VAL(MID$("133434,625656",Crlfrec+(K AND 7),1))
1760   R=R+1 : WEND
1770   RETURN 0
1780   !
1790   IF Abc<>806 THEN RETURN 0 ! m attrib
1800   R=0 : K=INP(53) : WHILE R<Par OR R=0 : N=FNPar(R,0)
1810     IF N=0 THEN K=Defattr
1820     IF N=4 THEN K=K OR 64 ! ULN
1830     IF N=5 THEN K=K OR 128 ! FLSH
1840     IF N=7 THEN K=(K AND 192)+(Defattr AND 7)*8+(Defattr AND 56)/8 ! INV
1850     IF N=8 THEN K=(K AND 199)+(K AND 7)*8 ! HIDE
1860     IF N>=30 AND N<=37 THEN K=(K AND 248)+N-30 ! Bakgrund
1870     IF N>=40 AND N<=47 THEN K=(K AND 199)+(N-40)*8 ! Bakgrund
1880   R=R+1 : WEND
1890   OUT 53,K : POKE Aattr,K
1900   RETURN 0
1910   !
1920   R=0 : WHILE R<Par : N=FNPar(R,0)
1930     IF N=5 THEN Z=FNPutv24(CHR$(27)+"[0n") ! [5n Ge OK-svar
1940     IF N=6 THEN Z=FNPutv24(CHR$(27,91)+NUM$(PEEK(Arad)+1)+";"+NUM$(PEEK(Akol)+1)+"R") ! [6n Ge position
1950   R=R+1 : WEND
1960   RETURN 0
1970   !
1980   IF FNPar(0,0)=0 RETURN FNPutv24(CHR$(27)+"[?1;0c") ! [0c Ange ej skrivare
1990   RETURN 0
2000   !
2010   R=0 : WHILE R<Par OR R=0 : N=FNPar(R,0)
2020     IF N=0 THEN MID$(Tabs$,PEEK(Akol)+1,1)=" " ! [0g Unset TAB
2030     IF N=3 THEN Tabs$=SPACE$(LEN(Tabs$)) ! [3g Remove all TABs
2040   R=R+1 : WEND
2050   RETURN 0
2060   !
2070   ! --#
2080   K=FNGetv24
2090   IF K=56 THEN OUT 53,7 : POKE Aattr,7 : Defattr=7 : POKE 30720,69 : RETURN FNLdr(Ldir,30720,30721,1919) ! #8 Align
2100   RETURN 0
2110   !
2120   RETURN 0
2130 FNEND
2140 !
2150 DEF FNEscpar LOCAL K
2160   Par=0 : Par(0)=0
2170   K=FNGetv24
2180   IF K<>59 AND (K<48 OR K>57) THEN RETURN K
2190   WHILE 1
2200     IF K=59 THEN IF Par<9 THEN Par=Par+1 : Par(Par)=0 : GOTO 2230 ELSE 2230
2210     IF K<48 OR K>57 THEN Par=Par+1 : RETURN K
2220     IF Par(Par)<3276 THEN Par(Par)=Par(Par)*10+(K-48)
2230     K=FNGetv24
2240   WEND
2250 FNEND
2260 !
2270 DEF FNPar(N,Deflt)
2280   IF N<Par THEN RETURN Par(N) ELSE RETURN Deflt
2290 FNEND
2300 !
2310 DEF FNBound(N,Min,Max)
2320   IF N<Min THEN RETURN Min ELSE IF N>Max THEN RETURN Max ELSE RETURN N
2330 FNEND
2340 !
2350 DEF FNAdr(R,K)=30720+R*80+K
2360 DEF FNCadr=30720+PEEK(Arad)*80+PEEK(Akol)
2370 !
2380 DEF FNLdr(Dir,Src,Dest,Cnt) LOCAL K$=12
2390   K$=CHR$(33,Src,SWAP%(Src),17,Dest,SWAP%(Dest),1,Cnt,SWAP%(Cnt),237,Dir,201)
2400   RETURN CALL(VARPTR(K$))
2410 FNEND
2420 !
2430 DEF FNRevscroll(Top,Bot,Dif) LOCAL A
2440   IF Dif<1 THEN RETURN 0 ELSE IF Dif>Bot-Top+1 THEN Dif=Bot-Top+1
2450   IF Bot-Dif>=Top THEN Z=FNLdr(Lddr,30799+(Bot-Dif)*80,30799+Bot*80,(Bot-Dif-Top+1)*80)
2460   A=30719+(Top+Dif)*80
2470   POKE A,32 : RETURN FNLdr(Lddr,A,A-1,Dif*80-1)
2480 FNEND
2490 !
2500 DEF FNScroll(Top,Bot,Dif) LOCAL A
2510   IF Dif<1 THEN RETURN 0 ELSE IF Dif>Bot-Top+1 THEN Dif=Bot-Top+1
2520   IF Bot-Dif>=Top THEN Z=FNLdr(Ldir,30720+(Top+Dif)*80,30720+Top*80,(Bot-Dif-Top+1)*80)
2530   A=30800+(Bot-Dif)*80
2540   POKE A,32 : RETURN FNLdr(Ldir,A,A+1,Dif*80-1)
2550 FNEND
2560 !
2570 ! Lysdiod (eller annat) nr N (1-8) t{nds (M=1) / sl{cks (M=0)
2580 DEF FNLed(N,M) : OUT 34,N*16-16+(M=0 AND 128) : RETURN 0
2590 FNEND
2600 !
2610 DEF FNGetv24
2620   IF LEN(Buf$) THEN Z=ASCII(Buf$) : Buf$=RIGHT$(Buf$,2) : RETURN Z
2630   Z=FNWaitv24
2640   GET #V24 Z$ : RETURN ASCII(Z$) AND 127
2650 FNEND
2660 !
2670 DEF FNGetv24buf LOCAL C
2680   IF SYS(5) THEN Z=FNKey
2690   Z=FNWaitv24 : C=PEEK2(V24tkn) : IF C>Buflen THEN C=Buflen
2700   GET #V24 Buf$ COUNT C : RETURN 0
2710 FNEND
2720 !
2730 ! V{nta p} inkommande data p} V24. Kommer inget, s} kolla tangentbordet.
2740 ! Kommer inget d{r heller, s} placera (med GET) och t{nd mark|ren.
2750 DEF FNWaitv24 LOCAL G$=1,C
2760   WHILE PEEK2(V24tkn)=0
2770     IF SYS(5) THEN Z=FNKey : C=0 ELSE IF C=0 AND Cursoron THEN Z=SYS(6) : GET G$ : OUT 56,10,57,64+7 : C=1
2780   WEND
2790   RETURN 0
2800 FNEND
2810 !
2820 DEF FNKey LOCAL K$=2,K
2830   GET K$ : K=ASCII(K$)
2840   IF K>127 THEN RETURN FNPfkey(K)
2850   IF K=10 THEN K$=FNLf$(Crlftran)
2860   IF K=13 THEN K$=FNCr$(Crlftran)
2870   IF PEEK2(V24ut)>LEN(K$) THEN ; #V24 K$; ELSE ; CHR$(7);
2880   RETURN 0
2890 FNEND
2900 !
2910 DEF FNPfkey(K) LOCAL P,L
2920   P=INSTR(1,Pfdef$,CHR$(255,K))
2930   IF P=0 THEN RETURN 0
2940   WHILE ASCII(RIGHT$(Pfdef$,P+2))<>254
2950     L=INSTR(P+2,Pfdef$,CHR$(255))-P-2
2960     RETURN FNPutv24(MID$(Pfdef$,P+2,L))
2970   WEND
2980   L=ASCII(RIGHT$(Pfdef$,P+3))
2990   IF L=128 THEN RETURN FNStopp
3000   IF L=129 THEN POKE V24xoff,PEEK(V24xoff) AND 253 : RETURN 0 ! Bryt XOFF
3010   IF L=130 THEN OUT 65,5,65,96+16+8,65,5,65,128+96+8 : RETURN 0 ! Drop DTR
3020   IF L=131 THEN RETURN FNSendbreak
3030   RETURN 0
3040 FNEND
3050 !
3060 ! S{nder bara om det ryms i utbufferten, s} man inte f}r h{ngning vid
3070 ! paus pga XOFF.
3080 DEF FNPutv24(S$)
3090   IF PEEK2(V24ut)>LEN(S$) THEN ; #V24 S$; ELSE ; CHR$(7);
3100   RETURN 0
3110 FNEND
3120 !
3130 ! S{nder nolla i 0.2 sekunder
3140 DEF FNSendbreak LOCAL I
3150   I=230
3160   OUT 65,5,65,128+96+16+8 ! +4
3170   WHILE I : I=I-1 : WEND
3180   OUT 65,5,65,128+96+8
3190   RETURN 0
3200 FNEND
3210 !
3220 DEF FNPfinit LOCAL R$=200,P,K
3230   RESTORE : READ Z
3240   DIM Pfdef$=Z : Pfdef$=""
3250   READ Pf
3260   WHILE Pf<>0
3270     READ R$
3280     P=INSTR(1,R$,"_")
3290     WHILE P>0 AND P<LEN(R$)
3300       K=ASCII(RIGHT$(R$,P+1))
3310       IF K>=48 AND K<=57 THEN MID$(R$,P,2)=CHR$(254,K-48) : GOTO 3360
3320       IF K>=97 AND K<=122 THEN MID$(R$,P,2)=CHR$(254,K+31) : GOTO 3360
3330       IF K>=64 AND K<=95 THEN K=K-64
3340       R$=LEFT$(R$,P-1)+CHR$(K)+RIGHT$(R$,P+2)
3350       P=P-1
3360       P=INSTR(P+2,R$,"_")
3370     WEND
3380     Pfdef$=Pfdef$+CHR$(255,Pf)+R$
3390     READ Pf
3400   WEND
3410   Pfdef$=Pfdef$+CHR$(255)
3420   RETURN 0
3430 FNEND
3440 !
3450 DEF FNInit
3460   DIM Par(0:9)
3470   DIM Buf$=Buflen,V24buf$=V24buflen
3480   IF PEEK2(PEEK2(65500))<8 THEN ; "Tidig version av optionsprom. K|r p} egen risk!" : FOR Z=1 TO 2000 : NEXT Z
3490   POKE PEEK2(65500)+2,VAROOT(V24buf$),SWAP%(VAROOT(V24buf$))
3500   V24tkn=PEEK2(65500)+6
3510   V24ut=PEEK2(65500)+4
3520   V24xoff=PEEK2(65500)+37
3530   V24=1
3540   OPEN V24par$ AS FILE V24
3550   Ctrlc=PEEK2(65413) : POKE 65413,0,0
3560   IF PEEK(39)=4 THEN Abc=806 ELSE IF PEEK(39)=3 THEN Abc=802 ELSE Abc=800
3570   IF Abc=806 THEN POKE 65266,5 ! ATTRIBUTE 5
3580   Akol=65362
3590   Arad=65363
3600   Awid=65364
3610   Aattr=65369 AND Abc=806
3620   POKE VAROOT(Screen$),2000,SWAP%(2000),0,120,2000,SWAP%(2000)
3630   Ldir=176 : Lddr=184
3640   Z=FNAsminit(VAROOT(Buf$))+FNReset
3650   RETURN 0
3660 FNEND
3670 !
3680 DEF FNStopp
3690   ! KEYMODE ,1
3700   ; BLBG WHT CHR$(140,139,137) ! NRML NULN STDY
3710   POKE 65413,Ctrlc,SWAP%(Ctrlc)
3720   OUT 65,24,65,4,65,68 ! Rensa SIO
3730   POKE PEEK2(65500)+48,0,0,0,0 ! T|m utbuf
3740   CLOSE
3750   END
3760 FNEND
3770 !
3780 ! Avl{gsnar paritetsbittar p} str{ng, och s|ker upp f|rsta kontrolltkn.
3790 DEF FNAsminit(Bufptr)
3800   ! TERMHLP.ASM. 88-02-29 02.45
3810   DIM Asm$=55
3820   Asm$=CHR$(33,0,0,94,35,86,35,78,35,70,235,121,176,40,31,229,197,126,230,127,119,35,11,121,176,32,246,193,225,229,126,254,127,40,14,254,32,56)
3830   Asm$=Asm$+CHR$(10,35,11,121,176,32,241,225,111,103,201,209,167,237,82,35,201)
3840   MID$(Asm$,2,2)=CVT%$(Bufptr+2)
3850   Asm=VARPTR(Asm$)
3860   RETURN 0
3870 FNEND