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%0%)-([%=3% AND Y%X1%+13%)+10%*(X%Y1%+Z7%)+Z7%*(Y%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%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%))'N' THEN 30080
30120 ; CHR$(12%) CUR(10%,20%) ']TERG]NG TILL MENYN'
30130 CHAIN FNCh$('CALCMENY.bas')