1 REM Ins{nd av John Amsberg <5786>    1985-10-03 09.37.24
100 ! +----------------------------------------+
110 ! !  CALC3.800 - HUVUDMODUL - Utg}va 3.0   !
120 ! ! av (c) S-] ABRAHAMSSON (105) 84-01-07  !
130 ! !       SAMH\RANDE PROGRAMFILER          !
140 ! ! CALCMENY.800, CALC1.800, CALC2.TXT     !
150 ! ! CALC3.800 - MODIFIERAT MED KOMPIL -    !
160 ! ! BEARBETAT F\R ABC800/806 OCH BASIC-II- !
170 ! ! KORTET 85-10-01 AV (5786) JOHN AMSBERG !
180 ! +----------------------------------------+
190 ! WIDTH 80 F\R ABC-806 och BASIC-II-KORTET
200 EXTEND : FLOAT : SINGLE : OPTION BASE 0 : DIGITS 6
210 DEF FNIp%(U%) LOCAL I%
220   IF U%=56% I%=PEEK(65122%) OR PEEK(65123%) : POKE 65122%,0% : RETURN I%
230   RETURN INP(U%)
240 FNEND 
250 DEF FNNm$(U)=SPACE$(-(U>=0))+NUM$(U) 
260 DEF FNIr%(U%,U$,U1$)
270   IF LEN(U1$)=0% RETURN 0% ELSE RETURN INSTR(U%,U$,U1$)
280 FNEND 
290 DEF FNEc%=ASCII(MID$(CHR$(ERRCODE+1%,0%,5%,8%,13%),INSTR(1%,CHR$(0%,130%,132%,210%),CHR$(ERRCODE)),1%))-1% 
300 DEF FNFi$(U$) LOCAL U1$=120
310   FOR Slask%=1% TO LEN(U$)
320     IF MID$(U$,Slask%,1%)<>' ' U1$=U1$+MID$(U$,Slask%,1%)
330   NEXT Slask% : RETURN U1$
340 FNEND 
350 DEF FNCh$(U$) LOCAL U1$=120
360   U1$=FNFi$(U$)
370   IF LEN(U1$)=0% RETURN "NUL:" ELSE RETURN U1$
380 FNEND 
390 DIM In$=120%,Ut$=120%
400 DEF FNIn$(U%)
410   IF LEN(In$)>0% RETURN FNId$
420   INPUT LINE #U%,In$ : IF U%=0% ; #U%
430   In$=LEFT$(In$,LEN(In$)-2%)
440   RETURN FNId$
450 FNEND 
460 DEF FNId$ LOCAL Ut$=120,Kp%,De%
470   Kp%=ASCII(In$) : IF Kp%=34% OR Kp%=39% De%=Kp% ELSE De%=44%
480   Kp%=INSTR(2%+(De%=44%),In$,CHR$(De%))
490   IF Kp%=0% Ut$=In$ : In$='' : RETURN FNFi$(Ut$)
500   Ut$=MID$(In$,1%-(De%<>44%),Kp%+(De%<>44%)-1%) : IF De%<>44% AND LEN(In$)>Kp%+1% In$=RIGHT$(In$,Kp%+2%) ELSE In$=RIGHT$(In$,Kp%+1%)
510   RETURN Ut$
520 FNEND 
530 ; CHR$(12%)
540 OPEN FNFi$('CALCOM.DAT') AS FILE 1%
550 ]9$=FNIn$(1%) : X9%=VAL(FNIn$(1%)) : Y9%=VAL(FNIn$(1%)) : Z9%=VAL(FNIn$(1%)) : In$=""
560 CLOSE 1%
570 IF ]9$='$$' THEN ]9$='        ' : GOTO 600
580 IF ]9$='$' THEN CHAIN FNCh$('CALCMENY.800')
590 OPEN FNFi$(]9$+'.CA3') AS FILE 1% : X9%=VAL(FNIn$(1%)) : Y9%=VAL(FNIn$(1%)) : Z9%=VAL(FNIn$(1%)) : In$="" : CLOSE 1%
600 Z8%=8%
610 Z7%=(77%/(Z9%+1%))-1% : Z6%=Z9%/2%-1% : Z5%=Z9%-Z6%-2%
620 [9$=CHR$(8%,9%,13%)+'^$'
630 \9$='ACDGLNPRSX+-*/HUK'
640 DIM C$(X9%,Y9%)=Z9%,D$(X9%,Y9%)=Z8%
650 ON ERROR GOTO 30000
660 IF ]9$<>'$' AND ]9$<>'        ' THEN \$='L' : GOTO 3780
670 FOR I%=0% TO X9% : FOR J%=0% TO Y9%
680     C$(I%,J%)=SPACE$(Z9%) : D$(I%,J%)=SPACE$(Z8%)
690 NEXT J% : NEXT I% 
700 X%=0% : Y%=0% : X1%=0% : Y1%=0%
2000 ; CHR$(12%)
2010 GOSUB 20000 : ; CUR(4%,3%);
2020 FOR I%=Y1% TO Y1%+Z7% : IF I%>Y9% THEN ; SPACE$(Z9%+1%); : GOTO 2050
2030   ; ' ' STRING$(Z6%,45%); : IF I%<10% THEN ; '0';
2040   ; RIGHT$(FNNm$(I%),2%) STRING$(Z5%,45%);
2050 NEXT I% 
2060 FOR I%=X1% TO X1%+13%
2070   ; CUR(5%+I%-X1%,0%);
2080   IF I%>X9% THEN ; SPACE$(3%); : GOTO 2100
2090   ; CHR$(I%/10%+65%,I%-(I%/10%)*10%+65%);
2100 NEXT I% 
2110 FOR I%=X1% TO X1%+13% : FOR J%=Y1% TO Y1%+Z7%
2120     ; CUR(I%-X1%+5%,(J%-Y1%)*(Z9%+1%)+4%);
2130     IF I%>X9% OR J%>Y9% THEN ; SPACE$(Z9%); : GOTO 2150
2140     ; C$(I%,J%);
2150 NEXT J% : NEXT I% 
2160 ; CUR(21%,0%) 'INL[ST DATAFIL : ' ]9$;
2170 ; CUR(22%,0%) 'UTSKR. P]  FIL : ' ]8$ '        ';
3000 GOSUB 20000 : ; CUR(0%,0%) '->  <-  ^  RETURN = FLYTTA TILL ANNAN RUTA     $ = \VERG]NG TILL FUNKTION'
3010 R%=X%-X1%+5% : K%=(Y%-Y1%)*(Z9%+1%)+4%
3020 ; CUR(R%,K%-1%) CHR$(127%);
3030 ; CUR(2%,0%) CHR$(X%/10%+65%,X%-(X%/10%)*10%+65%);
3040 ; CHR$(Y%/10%+48%,Y%-(Y%/10%)*10%+48%) ' = ';
3050 IF D$(X%,Y%)<>SPACE$(Z8%) THEN GOSUB 23240 : ; E$; ELSE ; C$(X%,Y%) SPACE$(20%);
3060 ; CUR(R%,K%+Z9%-1%); : GET [$
3070 [%=FNIr%(1%,[9$,[$)+1%
3080 ON [% GOTO 3090,3130,3130,3130,3130,3200
3090 IF [$<' ' OR [$>'_' THEN 3030
3100 C$(X%,Y%)=RIGHT$(C$(X%,Y%)+[$,2%)
3110 ; CUR(R%,K%) C$(X%,Y%);
3120 GOTO 3030
3130 ; CUR(R%,K%-1%) ' ';
3140 X%=X%+([%=5% AND X%>0%)-([%=4% AND X%<X9%)
3150 Y%=Y%+([%=2% AND Y%>0%)-([%=3% AND Y%<Y9%)
3160 X2%=X1%-10%*(X%>X1%+13%)+10%*(X%<X1%)
3170 Y2%=Y1%-Z7%*(Y%>Y1%+Z7%)+Z7%*(Y%<Y1%)
3180 IF X2%<>X1% OR Y2%<>Y1% THEN X1%=X2% : Y1%=Y2% : GOTO 2010
3190 GOTO 3010
3200 GOSUB 20000
3210 ; CUR(0%,0%) 'A C D G L N R S X + - * / H U K'
3220 ; CUR(2%,O%);
3230 GET \$
3240 \%=FNIr%(1%,\9$,\$)
3250 IF \%=0% THEN 3200
3260 ; \$;
3270 IF \%>10% THEN 3290
3280 ON \% GOTO 3450,3710,3300,3360,3780,3330,3200,3450,3780,3000
3290 ON \%-10% GOTO 3450,3450,3450,3450,3200,4090,30080
3300 C$(X%,Y%)=SPACE$(Z9%) : D$(X%,Y%)=SPACE$(Z8%)
3310 ; CUR(R%,K%) SPACE$(Z9%);
3320 GOTO 3000
3330 ; CUR(2%,0%) 'RADERA ALLT ? (J/N) '; : GET \$
3340 IF \$='N' OR \$='n' THEN 3000
3350 IF \$='J' OR \$='j' THEN 670 ELSE 3330
3360 GOSUB 20000
3370 ; CUR(2%,0%) 'HOPPA TILL : '; : K1%=13% : GOSUB 21000
3380 X%=(ASCII([1$)-65%)*10%+ASCII(RIGHT$([1$,2%))-65%
3390 Y%=(ASCII(RIGHT$([1$,3%))-48%)*10%+ASCII(RIGHT$([1$,4%))-48%
3400 ; CUR(R%,K%-1%) ' ';
3410 X2%=(X%/10%)*10%
3420 Y2%=(Y%/Z7%)*Z7%
3430 IF X2%<>X1% OR Y2%<>Y1% THEN X1%=X2% : Y1%=Y2% : GOTO 2010
3440 GOTO 3000
3450 GOSUB 20000
3460 ; CUR(2%,0%) \$ ' : ';
3470 IF \$='R' K1%=4% : GOTO 3510
3480 ; CHR$(X%/10%+65%,X%-(X%/10%)*10%+65%);
3490 ; CHR$(Y%/10%+48%,Y%-(Y%/10%)*10%+48%) ' = ';
3500 K1%=11%
3510 GOSUB 21000
3520 IF [4$='X' THEN 3700
3530 E$=[1$+' '+\$+' '
3540 ; CUR(2%,K1%) E$; : K1%=K1%+7%
3550 GOSUB 21000
3560 IF [4$='X' THEN 3700
3570 E$=E$+[1$+'...'
3580 ; CUR(2%,K1%-7%) E$; : K1%=K1%+7%
3590 GOSUB 21000
3600 IF [4$='X' THEN 3700
3610 E$=E$+[1$+' D '
3620 ; CUR(2%,K1%-14%) E$; : K1%=K1%+7%
3630 IF \$='R' THEN E$=E$+'0' : GOTO 3670 ELSE GOSUB 20010 : ; CUR(0%,0%) 'ANTAL DECIMALER 0 - 5'
3640 ; CUR(2%,K1%); : GET [4$ : IF [4$='X' THEN 3700
3650 IF [4$<'0' OR [4$>'5' THEN 3640 ELSE ; [4$;
3660 E$=E$+[4$
3670 GOSUB 23340
3680 GOSUB 22000
3690 GOSUB 23000
3700 ; CUR(R%,K%-1%) ' '; : GOTO 2010
3710 GOSUB 20000 : ; CUR(0%,0%) 'KALKYLERING P]G]R'
3720 FOR X%=0% TO X9% : FOR Y%=0% TO Y9%
3730     IF D$(X%,Y%)<>SPACE$(Z8%) THEN GOSUB 22000 : GOSUB 23000
3740 NEXT Y% : NEXT X% 
3750 X%=0% : Y%=0%
3760 ; CUR(R%,K%-1%) ' '; : X1%=0% : Y1%=0%
3770 GOTO 2010
3780 GOSUB 20000
3790 ; CUR(2%,0%) 'NAMN P] ';
3800 IF \$='L' THEN ; 'IN'; ELSE ; 'UT';
3810 ; 'DATAFIL :              '
3820 ; CUR(2%,20%); : IF \$='L' THEN ; ]9$; : GOTO 3890 ELSE ]$=FNIn$(0%) : In$=""
3830 IF ]$='' THEN 2010
3840 IF LEN(]$)>8% OR ASCII(]$)<65% OR ASCII(]$)>93% THEN 3790
3850 FOR I%=2% TO LEN(]$)
3860   ]1$=MID$(]$,I%,1%)
3870   IF ]1$<'0' OR ]1$>']' OR (]1$>'9' AND ]1$<'A') THEN 3790
3880 NEXT I% : ]8$=]$
3890 ON ERROR GOTO 4060
3900 IF \$='L' THEN OPEN FNFi$(]9$+'.CA3') AS FILE 1% ELSE PREPARE FNFi$(]8$+'.CA3') AS FILE 1%
3910 IF \$='L' THEN 3940
3920 ; #1%,X9% : ; #1%,Y9% : ; #1%,Z9%
3930 GOTO 3950
3940 X9%=VAL(FNIn$(1%)) : Y9%=VAL(FNIn$(1%)) : Z9%=VAL(FNIn$(1%)) : In$=""
3950 FOR X%=0% TO X9% : FOR Y%=0% TO Y9%
3960     IF \$='L' THEN 3990
3970     ; #1%,C$(X%,Y%) : ; #1%,D$(X%,Y%)
3980     GOTO 4010
3990     INPUT LINE #1%,E$ : C$(X%,Y%)=LEFT$(E$,LEN(E$)-2%)
4000     INPUT LINE #1%,E$ : D$(X%,Y%)=LEFT$(E$,LEN(E$)-2%)
4010 NEXT Y% : NEXT X% 
4020 CLOSE 1%
4030 X%=0% : Y%=0% : X1%=0% : Y1%=0%
4040 ; CUR(R%,K%-1%) ' ';
4050 ON ERROR GOTO 30000 : IF \$='L' THEN 2000 ELSE 2010
4060 GOSUB 20010 : ; CUR(0%,0%) 'FEL VID SKIVHANTERINGEN - TRYCK RETURN';
4070 GET \$
4080 GOTO 4020
4090 GOSUB 20000
4100 ; CUR(2%,0%) 'U : '; : K1%=4%
4110 GOSUB 21000
4120 IF [4$='X' THEN 4430
4130 N%=(ASCII([1$)-65%)*10%+ASCII(RIGHT$([1$,2%))-65%
4140 N1%=(ASCII(RIGHT$([1$,3%))-48%)*10%+ASCII(RIGHT$([1$,4%))-48%
4150 ; '...'; : K1%=11%
4160 GOSUB 21000
4170 IF [4$='X' THEN 4430
4180 M%=(ASCII([1$)-65%)*10%+ASCII(RIGHT$([1$,2%))-65%
4190 M1%=(ASCII(RIGHT$([1$,3%))-48%)*10%+ASCII(RIGHT$([1$,4%))-48%
4200 GOSUB 20010 : ; CUR(0%,0%) 'UTSKRIFT AV TEXT (T) ELLER FUNKTION (F)'
4210 ; CUR(1%,0%);
4220 GET [4$ : IF [4$='X' THEN 4430
4230 IF [4$<>'T' AND [4$<>'F' THEN 4220 ELSE ; [4$;
4240 IF M1%-N1%<Z7% OR [4$='F' THEN 4270
4250 GOSUB 20010 : ; CUR(0%,0%) 'F\R M]NGA KOLUMNER - ANGE NYTT - TRYCK RETURN'
4260 GET [4$ : GOTO 4090
4270 OPEN FNFi$('PR:') AS FILE 1%
4280 ; #1%,TAB(1+(10%));
4290 ; #1%,'MATRIS : ' CHR$(N%/10%+65%,N%-(N%/10%)*10%+65%);
4300 ; #1%,CHR$(N1%/10%+48%,N1%-(N1%/10%)*10%+48%) ' ... ';
4310 ; #1%,CHR$(M%/10%+65%,M%-(M%/10%)*10%+65%);
4320 ; #1%,CHR$(M1%/10%+48%,M1%-(M1%/10%)*10%+48%),
4330 ; #1%,'NAMN : ' ]9$ : ; #1% : ; #1%
4340 FOR X%=N% TO M% : ; #1%,TAB(1+(10%)); : FOR Y%=N1% TO M1%
4350     IF [4$='T' THEN ; #1%,' ' C$(X%,Y%); : GOTO 4400
4360     ; #1%,TAB(1+(10%));
4370     ; #1%,CHR$(X%/10%+65%,X%-(X%/10%)*10%+65%);
4380     ; #1%,CHR$(Y%/10%+48%,Y%-(Y%/10%)*10%+48%) ' = ' C$(X%,Y%) TAB(1+(30%)) 'FUNKTION : ';
4390     IF D$(X%,Y%)<>SPACE$(Z8%) THEN GOSUB 23240 : ; #1%,E$ ELSE ; #1%
4400   NEXT Y% : ; #1%
4410 NEXT X% : ; #1%
4420 CLOSE 1%
4430 X%=0% : Y%=0% : X1%=0% : Y1%=0%
4440 ; CUR(R%,K%-1%) ' '; : GOTO 2010
20000 ; CUR(2%,0%) STRING$(80%,32%);
20010 ; CUR(0%,0%) STRING$(160%,32%);
20020 RETURN 
21000 GOSUB 20010 : ; CUR(0%,0%) 'FUNKTION : ' \$,
21010 ; 'ANGE BOKSTAV AA - ' CHR$(X9%/10%+65%,X9%-(X9%/10%)*10%+65%);
21020 ; ' OCH SIFFRA 00 - ' CHR$(Y9%/10%+48%,Y9%-(Y9%/10%)*10%+48%);
21030 ; '    X = EXIT'
21040 ; CUR(2%,K1%); : GET [4$
21050 IF [4$='X' THEN 21180
21060 IF [4$<'A' OR [4$>CHR$(X9%/10%+65%) THEN 21040 ELSE ; [4$; : [1$=[4$
21070 ; CUR(2%,K1%+1%); : GET [4$
21080 IF [4$='X' THEN 21180
21090 IF [4$<'A' OR [4$>'J' THEN 21070
21100 IF (ASCII([1$)-65%)*10%+ASCII([4$)-65%>X9% THEN 21070 ELSE ; [4$; : [1$=[1$+[4$
21110 ; CUR(2%,K1%+2%); : GET [4$
21120 IF [4$='X' THEN 21180
21130 IF [4$<'0' OR [4$>CHR$(Y9%/10%+48%) THEN 21110 ELSE ; [4$; : [1$=[1$+[4$
21140 ; CUR(2%,K1%+3%); : GET [4$
21150 IF [4$='X' THEN 21180
21160 IF [4$<'0' OR [4$>'9' THEN 21140
21170 IF (ASCII(RIGHT$([1$,3%))-48%)*10%+ASCII([4$)-48%>Y9% THEN 21140 ELSE ; [4$; : [1$=[1$+[4$
21180 RETURN 
22000 P1%=ASCII(RIGHT$(D$(X%,Y%),2%))-32%
22010 Q1%=ASCII(RIGHT$(D$(X%,Y%),1%))-32%
22020 R$=C$(Q1%,P1%)
22030 N%=ASCII(RIGHT$(D$(X%,Y%),4%))-32%
22040 N1%=ASCII(RIGHT$(D$(X%,Y%),5%))-32%
22050 M%=ASCII(RIGHT$(D$(X%,Y%),7%))-32%
22060 M1%=ASCII(RIGHT$(D$(X%,Y%),8%))-32%
22070 M$=MID$(D$(X%,Y%),3%,1%)
22080 D%=VAL(MID$(D$(X%,Y%),6%,1%))
22090 RETURN 
23000 FOR A%=N% TO M% : FOR B%=N1% TO M1%
23010     ! IF M$<>'R' THEN F$=NUM$(VAL(C$(A%,B%)))
23020     IF M$<>'R' THEN IF C$(A%,B%)=SPACE$(Z9%) F$='0' ELSE \=VAL(C$(A%,B%)) : F$=C$(A%,B%)
23030     ON FNIr%(1%,'R+-*/A',M$) GOTO 23040,23060,23080,23100,23120,23060
23040     C$(A%,B%)=C$(Q1%,P1%)
23050     GOTO 23150
23060     R$=ADD$(R$,F$,D%)
23070     GOTO 23150
23080     R$=SUB$(R$,F$,D%)
23090     GOTO 23150
23100     R$=MUL$(R$,F$,D%)
23110     GOTO 23150
23120     IF VAL(F$)=0 THEN 30000
23130     R$=DIV$(R$,F$,D%)
23140     GOTO 23150
23150 NEXT B% : NEXT A% 
23160 IF M$<>'A' THEN 23190
23170 R=((M%-N%)+(M1%-N1%)+2%) : IF R=0 THEN 30000
23180 R$=DIV$(R$,FNNm$(R),D%)
23190 IF M$='R' THEN 23230
23200 IF LEN(R$)>Z9% THEN R$='E '+LEFT$(R$,Z9%-2%)
23210 C$(X%,Y%)=R$
23220 IF LEN(C$(X%,Y%))<Z9% THEN C$(X%,Y%)=' '+C$(X%,Y%) : GOTO 23220
23230 RETURN 
23240 E$='' : FOR J%=0% TO 6% STEP 3% : FOR I%=1% TO 2%
23250     E%=ASCII(RIGHT$(D$(X%,Y%),J%+I%))-32%
23260     IF I%=1% THEN E$=E$+CHR$(E%/10%+65%,E%-(E%/10%)*10%+65%) : GOTO 23280
23270     E$=E$+CHR$(E%/10%+48%,E%-(E%/10%)*10%+48%)
23280   NEXT I% 
23290   IF J%=0% THEN E$=E$+' '+MID$(D$(X%,Y%),3%,1%)+' ' : GOTO 23320
23300   IF J%=3% THEN E$=E$+'...' : GOTO 23320
23310   E$=E$+' D '+MID$(D$(X%,Y%),6%,1%)
23320 NEXT J% 
23330 RETURN 
23340 D$(X%,Y%)=''
23350 FOR I%=1% TO 15% STEP 7%
23360   D$(X%,Y%)=D$(X%,Y%)+CHR$((ASCII(RIGHT$(E$,I%))-65%)*10%+ASCII(RIGHT$(E$,I%+1%))-33%)
23370   D$(X%,Y%)=D$(X%,Y%)+CHR$((ASCII(RIGHT$(E$,I%+2%))-48%)*10%+ASCII(RIGHT$(E$,I%+3%))-16%)
23380   IF I%=1% THEN D$(X%,Y%)=D$(X%,Y%)+MID$(E$,6%,1%)
23390   IF I%=15% THEN D$(X%,Y%)=LEFT$(D$(X%,Y%),5%)+MID$(E$,22%,1%)+RIGHT$(D$(X%,Y%),6%)
23400 NEXT I% 
23410 RETURN 
30000 GOSUB 20010 : ; CUR(0%,2%) 'FEL VID KALKYLERING (ERR';FNEc% ') ';CHR$(7%);
30010 ; 'I RUTA ';CHR$(X%/10%+65%,X%-(X%/10%)*10%+65%);CHR$(Y%/10%+48%,Y%-(Y%/10%)*10%+48%);
30020 ; 'f|r RUTA ';CHR$(A%/10%+65%,A%-(A%/10%)*10%+65%);CHR$(B%/10%+48%,B%-(B%/10%)*10%+48%);
30030 ; CUR(1%,2%) 'TRYCK RETURN';
30040 GET [$
30050 ON ERROR GOTO 30000
30060 X%=0% : Y%=0% : ; CUR(R%,K%-1%) ' '; : X1%=0% : Y1%=0%
30070 GOTO 2010
30080 GOSUB 20000 : ; CUR(0%,0%) 'SKA DU SPARA MATRISEN (J/N) ? ';
30090 GET [4$ : ; [4$;
30100 IF [4$='J' THEN [$='$' : \$='S' : GOTO 3240
30110 IF [4$<>'N' THEN 30080
30120 ; CHR$(12%) CUR(10%,20%) ']TERG]NG TILL MENYN'
30130 CHAIN FNCh$('CALCMENY.bas')