2 ! +++++++++++++++++++++++++++++++++++
3 ! Program ....     TVMAIN.800
4 ! Utg}va  1.0      1983-03-07
5 ! av (c) Niklas Notteman
6 ! Konverterad fr}n ABC80-orginalet av Niklas Notteman
8 ! Ins{nt av Niklas Notteman, 995.
9 ! +++++++++++++++++++++++++++++++++++
20 ! Version med Q-reg, neg argument, M-komando, discutrymme (ABC830),
30 ! och radl{ngdskontroll.
50 ! 
60 EXTEND : FLOAT 
70 Pr$='PR:VSA36C72.5'
100 ! Funktion som ger m|jlighet att f}
110 ! infilens namn genom tryck p} '->'.
120 ! 
130 DEF FNInput$ LOCAL Slask$=20,Key$=1,Cr$=1,Bs$=1,Ht$=1
140   POKE 65506%,0% ! Tangentflagga
150   Cr$=CHR$(13%) : Bs$=CHR$(8%) : Ht$=CHR$(9%)
160   GET Key$
170   WHILE Key$<>Cr$
180     WHILE Key$=Bs$ AND Slask$<>''
190       Slask$=LEFT$(Slask$,LEN(Slask$)-1%)
200       ; CHR$(8%,32%,8%);
210       Key$=''
220     WEND 
230     WHILE Key$=Ht$ AND Slask$=''
240       Slask$=Slask$+F$ : ; Slask$;
250       Key$=''
260     WEND 
270     WHILE ASCII(Key$)>31% AND ASCII(Key$)<128% AND LEN(Slask$)<20%
280       Slask$=Slask$+Key$ : ; Key$;
290       Key$=''
300     WEND 
310     GET Key$
320   WEND 
330   RETURN Slask$
340 FNEND 
350 ! 
360 ! Ber{kna maximal radl{ngd.
370 ; CUR(0%,40%); ! Ger bara kolumn 40 p} en 80-tkns maskin
380 IF PEEK(65362%)=40% THEN Bredd%=80% ELSE Bredd%=40%
390 POKE 65364%,Bredd%
400 ! 
1000 DIM C$=1%,C1$=500%,Q$=2000%,F$=20%,X$=20%,S$=20%,M4$=60%,Pr$=15%,Xx$=20%,Fl$=5%
1010 M9%=SYS(4%)-500% : DIM M$=M9%
1020 S$=' ' : M$=''
1030 M8%=VAROOT(M$)-4% : L8%=VAROOT(C1$)-4% : Q8%=VAROOT(Q$)-4%
1040 M7%=FNA%(M8%+6%) : L7%=FNA%(L8%+6%)
1050 Q7%=FNA%(Q8%+6%)
1060 N9%=FNA%(65290%)
1070 POKE 65290%,N9%+12%,SWAP%(N9%+12%)
1080 DEF FNA%(A%)=PEEK2(A%) 
1090 DEF FNR%(A%)=A%-(32% AND (A%>95%))*(-(A%<128%)) 
1100 GOTO 1190 ! Skip break+reenter
1110 STOP 
1190 ! ** REENTER **
1200 ON ERROR GOTO 3300
1210 P%=0% : X%=65363% : Y%=65362%
1220 L%=0% : S%=0%
1230 GOSUB 1310 ! Print screen
1240 GOSUB 1610 ! Inputline
1250 IF E% THEN 1230
1260 GOSUB 1690 ! Execcom
1270 IF P%>L% OR P%<S% THEN GOSUB 3790
1280 GOTO 1230
1290 ! ***********************
1300 ! * Print screen
1310 POKE 63488%,S%,SWAP%(S%),P%,SWAP%(P%),M7%,SWAP%(M7%),LEN(M$),SWAP%(LEN(M$))
1320 L%=CALL(63504%) : RETURN 
1330 ! ********************
1340 ! * Test if imm. com.
1350 E%=-1%
1360 IF C%<>8% AND C%<>194% THEN 1420
1370 P%=P%-1%
1380 IF PEEK(M7%+P%-1%)<>13% THEN 1410
1390 IF PEEK(M7%+P%)<>10% THEN 1410
1400 P%=P%-1%
1410 GOTO 1540
1420 IF C%<>9% AND C%<>195% THEN 1480
1430 P%=P%+1%
1440 IF PEEK(M7%+P%-1%)<>13% THEN 1470
1450 IF PEEK(M7%+P%)<>10% THEN 1470
1460 P%=P%+1%
1470 GOTO 1540
1480 IF C%=13% OR C%=196% THEN P1%=P% : GOSUB 3690 : P%=P1% : GOTO 1540
1490 IF C%=94% OR C%=192% THEN P1%=P% : GOSUB 3740 : P%=P1% : GOTO 1540
1500 IF C%=2% OR C%=193% THEN P1%=(L%+S%)/2% : GOSUB 3740 : P%=P1% : GOTO 1540
1510 IF C%=12% OR C%=24% THEN GOSUB 3790 : GOTO 1540
1520 IF C%=32% AND L%<LEN(M$) THEN S%=L% : RETURN 
1530 E%=0% : RETURN 
1540 IF P%<0% THEN P%=0%
1550 IF P%>LEN(M$) THEN P%=LEN(M$)
1560 IF P%>L% OR P%<S% OR (P%=L% AND P%<LEN(M$)) THEN GOSUB 3790
1570 RETURN 
1580 ! **************************
1590 ! * Inputline
1600 ! *
1610 C1%=CALL(63507%)
1620 C%=FNR%(C1%) : GOSUB 1350 : IF E% THEN RETURN 
1630 C%=CALL(63510%,L7%)+1%
1640 POKE L8%+8%,C%,SWAP%(C%)
1650 RETURN 
1660 ! *********************
1670 ! * Executecommand
1680 ! *
1690 E%=0% : Z1%=2% : Z2%=LEN(C1$)-1%
1700 N%=1% : A9%=0%
1710 IF Z1%>Z2% THEN RETURN 
1720 C$=CHR$(FNR%(ASCII(MID$(C1$,Z1%,1%))))
1730 Z1%=Z1%+1%
1740 IF C$<' ' THEN 1700
1750 IF C$=' ' THEN 1710
1760 IF NOT (C$='-' OR C$>='0' AND C$<='9') THEN 1840
1770 ! *** number ***
1780 Z3%=Z1%-1% : N%=-1%
1790 C$=MID$(C1$,Z1%,1%) : Z1%=Z1%+1%
1800 IF C$>='0' AND C$<='9' THEN 1790
1810 Z1%=Z1%-1%
1815 ON ERROR GOTO 1825
1820 N%=VAL(MID$(C1$,Z3%,Z1%-Z3%))
1825 ON ERROR GOTO 3300
1830 A9%=1% : GOTO 1710
1840 IF C$<>'I' THEN 1960
1850 ! *** Insert ***
1860 IF A9%=0% THEN 1910
1870 M5%=1%
1880 GOSUB 3350 : IF E% THEN RETURN 
1890 POKE M7%+P%,(N% AND 127%) : P%=P%+1%
1900 GOTO 1700
1910 Z3%=INSTR(Z1%,C1$,CHR$(9%))
1920 M5%=Z3%-Z1%
1930 GOSUB 3350 : IF E% THEN RETURN 
1940 GOSUB 3560
1950 Z1%=Z3%+1% : GOTO 1700
1960 IF C$<>'G' THEN 1969
1961 ! *** G Insert from Q-reg ***
1962 M5%=LEN(Q$) : GOSUB 3340 : IF E% THEN RETURN 
1963 N1%=M5%
1964 N2%=M7%+P%
1965 N3%=Q7%
1966 N4%=176%
1967 GOSUB 3630
1968 P%=P%+M5% : GOTO 1700
1969 IF C$<>'D' THEN 2035
1970 ! *** Delete ***
1980 Z3%=P%+N%
1990 IF Z3%<0% THEN Z3%=0% ELSE IF Z3%>LEN(M$) THEN Z3%=LEN(M$)
2000 M5%=-ABS(P%-Z3%)
2010 IF Z3%<P% THEN P%=Z3%
2020 GOSUB 3350 : IF E% THEN RETURN 
2030 GOTO 1700
2035 IF C$<>'M' THEN 2044
2036 ! *** Put i M-reg ***
2037 M4$=RIGHT$(C1$,3%)
2040 Z1%=Z2%+1%
2043 GOTO 1700
2044 IF C$<>'W' THEN 2049
2045 ! *** S{tt ny radl{ngd ***
2046 IF N%>=5% AND N%<=Bredd% THEN POKE 65364%,N% : ; CHR$(12%); ELSE ; CHR$(7%);
2047 GOTO 1700
2049 IF C$<>'L' THEN 2170
2050 ! *** move n% lines ***
2060 P1%=P% : IF N%<0% THEN 2120
2070 FOR I%=1% TO N%
2080   GOSUB 3690
2090   IF P1%=LEN(M$) THEN 2160
2100 NEXT I% 
2110 GOTO 2160
2120 FOR I%=1% TO -N%
2130   GOSUB 3740
2140   IF P1%=0% THEN 2160
2150 NEXT I% 
2160 P%=P1% : GOTO 1700
2170 IF C$<>'C' THEN 2270
2180 ! *** move n% characters ***
2190 P%=P%+N% : N%=1%
2200 IF P%<0% THEN P%=0%
2210 IF P%>LEN(M$) THEN P%=LEN(M$)
2220 GOTO 1700
2270 IF C$<>'Z' THEN 2310
2280 ! *** Z number of chars ***
2290 N%=LEN(M$) : A9%=1%
2300 GOTO 1710
2310 IF C$<>'.' THEN 2350
2320 ! *** . position ***
2330 N%=P% : A9%=1%
2340 GOTO 1710
2350 IF C$<>'=' THEN 2390
2360 ! *** = print value ***
2370 ; CUR(23%,0%);N%;
2380 GOTO 1710
2390 IF C$<>'S' THEN 2490
2400 ! *** search ***
2410 P1%=P%
2420 Z3%=INSTR(Z1%,C1$,CHR$(9%))
2430 IF Z3%>Z1% THEN S$=MID$(C1$,Z1%,Z3%-Z1%)
2440 Z1%=Z3%+1%
2450 P1%=INSTR(P1%+1%,M$,S$)-1%
2460 IF P1%<0% THEN 3320
2465 P1%=P1%+1%
2470 IF N%>1% THEN N%=N%-1% : GOTO 2450
2480 P%=P1%+LEN(S$)-1% : GOTO 1700
2490 IF C$<>'R' THEN 2660
2500 ! *** replace ***
2510 Z3%=INSTR(Z1%,C1$,CHR$(9%))
2520 IF Z3%>Z1% THEN S$=MID$(C1$,Z1%,Z3%-Z1%)
2530 Z1%=Z3%+1%
2540 Z3%=INSTR(Z1%,C1$,CHR$(9%))
2550 IF Z3%=0% THEN Z3%=Z1%
2560 P1%=INSTR(P%+1%,M$,S$)-1%
2570 IF P1%<0% THEN 3320
2580 P%=P1%
2590 M5%=Z3%-Z1%-LEN(S$)
2600 GOSUB 3350 : IF E% THEN RETURN 
2610 GOSUB 3560
2620 N%=N%-1%
2630 IF N%>0% THEN 2560
2640 Z1%=Z3%+1%
2650 GOTO 1700
2660 IF C$<>'J' THEN 2681
2670 ! *** jump ***
2680 P%=0% : GOTO 1700
2681 IF C$<>'Q' THEN 2707
2682 ! *** Put i Q-register ***
2683 P1%=P%
2684 IF N%<0% THEN 2691
2685 FOR I%=1% TO N%
2686   GOSUB 3680
2687   IF P1%=LEN(M$) THEN 2689
2688 NEXT I% 
2689 M5%=P1%-P%
2690 GOTO 2696
2691 FOR I%=1% TO -N%
2692   GOSUB 3740
2693   IF P1%=0% THEN 2695
2694 NEXT I% 
2695 M5%=P%-P1% : P%=P1%
2696 N1%=M5% : IF N1%>2000% THEN ; CUR(23%,0%);"Fel! Fler tecken {n 2000"; : RETURN 
2697 N2%=Q7%
2698 N3%=M7%+P%
2699 N4%=176%
2700 GOSUB 3630
2701 POKE Q8%+8%,M5%,SWAP%(M5%)
2705 GOTO 1700
2707 IF C$<>'K' THEN 2860
2708 ! *** kill ***
2710 P1%=P%
2720 IF N%<0% THEN 2790
2730 FOR I%=1% TO N%
2740   GOSUB 3690
2750   IF P1%=LEN(M$) THEN 2770
2760 NEXT I% 
2770 M5%=P%-P1%
2780 GOTO 2840
2790 FOR I%=1% TO -N%
2800   GOSUB 3740
2810   IF P1%=0% THEN 2830
2820 NEXT I% 
2830 M5%=P1%-P% : P%=P1%
2840 GOSUB 3350 : IF E% THEN RETURN 
2850 GOTO 1700
2860 IF C$<>';' THEN 3280
2870 ! *** ; commands
2880 C$=CHR$(FNR%(ASCII(MID$(C1$,Z1%,1%)))) : Z1%=Z1%+1%
2890 IF C$<>'Y' THEN 3101
2900 ; CUR(23%,0%);'Input file: ';
2910 INPUT LINE F$ : F$=LEFT$(F$,LEN(F$)-2%) : IF F$='' THEN 3070
2915 IF INSTR(1%,F$,'.')=0% THEN F$=F$+'.TXT' : ; '.TXT';
2920 ON ERROR GOTO 3080
2930 OPEN F$ AS FILE 1%
2940 ON ERROR GOTO 3050
2950 INPUT LINE #1%,C1$
2960 M6%=LEN(M$)+LEN(C1$)
2970 IF M6%>M9% THEN ; CUR(23%,0%);"?Minnet fullt"; : GOTO 3060
2980 N1%=LEN(C1$)
2990 N2%=M7%+LEN(M$)
3000 N3%=FNA%(L8%+6%)
3010 N4%=176%
3020 GOSUB 3640
3030 POKE M8%+8%,M6%,SWAP%(M6%)
3040 GOTO 2950
3050 CLOSE 1% : IF ERRCODE<>34% THEN 3315
3060 CLOSE 1% : ON ERROR GOTO 3300
3070 P%=0% : RETURN 
3080 CLOSE 1% : IF ERRCODE<>21% THEN 3315
3090 ; CUR(23%,0%);"?File not found: ";F$;
3100 GOTO 3070
3101 IF C$<>'M' THEN 3116
3102 ! *** Exec M-reg ***
3103 IF P%>LEN(M$) THEN RETURN 
3105 C1$=M4$ : Z2%=LEN(C1$)
3110 Z1%=1%
3113 GOTO 1710
3116 IF C$='P' THEN X$=Pr$ : GOTO 3230
3119 IF C$<>'S' AND C$<>'T' THEN 3251
3122 IF C$='T' THEN 3140
3125 ! *** save file ***
3126 Fl$=''
3128 P%=1% : P1%=P%
3131 IF P1%<LEN(M$) THEN GOSUB 3690 ELSE 3140
3134 IF P1%-P%<158% THEN P%=P1% : GOTO 3131
3137 ; CUR(23%,0%) 'Raden {r f|r l}ng!'; : Fl$='FL]NG' : RETURN 
3140 ; CUR(23%,0%) SPACE$(PEEK(65364%));
3143 ; CHR$(13%);'Output file: ';
3146 X$=FNInput$
3160 IF X$='' THEN 3250
3170 IF INSTR(1%,X$,'.')=0% AND LEN(X$)<17% THEN X$=X$+'.TXT' : ; '.TXT';
3230 ON ERROR GOTO 3315
3240 PREPARE X$ AS FILE 1% : ; #1%;M$; : CLOSE 1%
3245 P%=0% : ON ERROR GOTO 3300
3250 RETURN 
3251 IF C$<>'0' THEN 3254
3252 REM Drive 0 
3253 POKE -767%,0% : GOTO 3257
3254 IF C$<>'1' THEN 3270
3255 REM Drive 1 
3256 POKE -767%,1%
3257 IF PEEK(24660%)<>195% THEN 1700
3258 G8%=0%
3259 Z%=CALL(24678%,224%)
3260 IF PEEK(-747%) AND 128% ; CUR(23%,0%) "Diskfel!"; : GOTO 1700
3261 G%=0% : FOR P2%=-2816% TO P2%+160%
3262   IF PEEK(P2%)=255% THEN 3266 ELSE IF PEEK(P2%)=0% THEN G%=G%+8% : GOTO 3266
3263   Q%=1%
3264   G%=G%-((PEEK(P2%) AND Q%)=0%)
3265   Q%=Q%+Q% : IF Q%<256% THEN 3264
3266 NEXT P2% 
3267 IF G8%=0% THEN G8%=G% : Z%=CALL(24678%,192%) : GOTO 3261
3268 ; CUR(23%,0%);'Drive ' C$ ':   ' NUM$(G%) ' av' G8% ' sektorer lediga';
3269 GOTO 1700
3270 IF C$='H' THEN 1110
3275 IF C$='X' THEN GOSUB 3125 : IF Fl$<>'FL]NG' THEN 1110 ELSE RETURN 
3280 ; CUR(23%,0%);'Illegal com: ';
3290 ; RIGHT$(C1$,Z1%-1%); : RETURN 
3300 ; CUR(23%,0%);SPACE$(39%);CHR$(13%);"?Error ";ERRCODE;
3310 GOTO 1200
3315 ; CUR(23%,0%);SPACE$(39%);CHR$(13%);"?Error ";ERRCODE;
3316 RETURN 
3320 ; CUR(23%,0%);'Search failed: ';
3330 ; S$; : RETURN 
3340 ! ** ROOM(M5%) **
3350 IF M5%<0% THEN 3440
3360 M6%=LEN(M$)+M5%
3370 IF M6%>M9% THEN 3530
3380 N1%=LEN(M$)-P% ! Byte Count
3390 N2%=M7%+M6%-1% ! DEstination
3400 N3%=M7%+LEN(M$)-1% ! HL
3410 N4%=184% ! LDDR second byte
3420 GOSUB 3640 ! COMPILE, LOAD and GO
3430 GOTO 3510
3440 IF LEN(M$)+M5%<P% THEN M5%=P%-LEN(M$)
3450 N1%=LEN(M$)-P%+M5%
3460 N2%=M7%+P%
3470 N3%=N2%-M5%
3480 N4%=176%
3490 GOSUB 3640
3500 M6%=LEN(M$)+M5%
3510 POKE M8%+8%,M6%,SWAP%(M6%)
3520 RETURN 
3530 ; CUR(23%,0%);"?Minnet fullt";
3540 E%=-1% : RETURN 
3550 ! ** INSERT(Z1%,Z3%) **
3560 N1%=Z3%-Z1%
3570 N2%=M7%+P%
3580 N3%=L7%+Z1%-1%
3590 N4%=176%
3600 GOSUB 3640
3610 P%=P%+Z3%-Z1%
3620 RETURN 
3630 ! ** LOAD-AND-GO COMPILER
3640 IF N1%=0% THEN RETURN 
3650 POKE N9%,1%,N1%,SWAP%(N1%),33%,N3%,SWAP%(N3%),237%,N4%,201%
3660 I%=CALL(N9%,N2%) : RETURN 
3670 ! *************************
3680 ! move P1% to next line
3690 P1%=INSTR(P1%+1%,M$,CHR$(13%,10%))+1%
3700 IF P1%=1% THEN P1%=LEN(M$)
3710 RETURN 
3720 ! *************************
3730 ! move P1% to previous line
3740 FOR P1%=P1%-2% TO 1% STEP -1%
3750   IF MID$(M$,P1%,2%)=CHR$(13%,10%) THEN P1%=P1%+1% : RETURN 
3760 NEXT P1% : P1%=0% : RETURN 
3770 ! ************************
3780 ! center page on cursor
3790 P1%=P%
3800 FOR I%=1% TO 10% : GOSUB 3740 : NEXT I% 
3810 S%=P1% : RETURN