10 REM +----------------------------------+ 12 REM ! LIST CALC3.80K ! 14 REM ! Huvudmodul i CALC-kalkylprogram ! 16 REM ! Utg}va 1.0 ! 18 REM ! av (c) S-] Abrahamsson <105> ! 20 REM ! Minne 32 Kbytes f|r flexskiva ! 22 REM ! och 80 teckens sk{rm. ! 24 REM ! Ins{nt av <2260> ! 26 REM ! Samh|rande programfiler ! 28 REM ! CALC.80K, CALC1.80K ! 30 REM ! CALC3.80K, CALCOM.DAT ! 32 REM ! CALC.TXT, CALCEX.CA3 ! 34 REM ! Rev 1984-01-07 Tom Sj|berg <2401>! 36 REM ! Rev 1985-04-29 B Sandgren <2776> ! 38 REM +----------------------------------+ 45 DIM P$=13% : P$='PR:CSA36D72.4' : REM Printerkod med DIM=13 tkn 50 OPEN 'CALCOM.DAT' ASFILE 1% 60 INPUT #1%,]9$,X9%,Y9%,Z9% 65 CLOSE 1% 66 IF ]9$='$$' THEN ]9$=' ' : GOTO 100 67 IF ]9$='$' THEN CHAIN 'CALC.80K' 68 OPEN ]9$+'.CA3' ASFILE 1% : INPUT #1%,X9%,Y9%,Z9% : CLOSE 1% 100 Z8%=8% 105 Z7%=(77%/(Z9%+1%))-1% : Z6%=Z9%/2%-1% : Z5%=Z9%-Z6%-2% 110 [9$=CHR$(8%,9%,13%)+'^$' 120 \9$='ACDGLNPRSX+-*/HUK' 200 DIM C$(X9%,Y9%)=Z9%,D$(X9%,Y9%)=Z8% 500 ONERRORGOTO 30000 600 IF ]9$<>'$' AND ]9$<>' ' THEN \$='L' : GOTO 3800 1000 FOR I%=0% TO X9% : FOR J%=0% TO Y9% 1010 C$(I%,J%)=SPACE$(Z9%) : D$(I%,J%)=SPACE$(Z8%) 1020 NEXT J% : NEXT I% 1050 X%=0% : Y%=0% : X1%=0% : Y1%=0% 1990 ; CHR$(12%) 2000 GOSUB 20000 : ; CUR(4%,3%); 2002 FOR I%=Y1% TO Y1%+Z7% : IF I%>Y9% THEN ; SPACE$(Z9%+1%); : GOTO 2008 2004 ; ' 'STRING$(Z6%,45%); : IF I%<10% THEN ; '0'; 2006 ; RIGHT$(NUM$(I%),2%)STRING$(Z5%,45%); 2008 NEXT I% 2010 FOR I%=X1% TO X1%+13% 2012 ; CUR(5%+I%-X1%,0%); 2013 IF I%>X9% THEN ; SPACE$(3%); : GOTO 2020 2014 ; CHR$(I%/10%+65%,I%-(I%/10%)*10%+65%); 2020 NEXT I% 2100 FOR I%=X1% TO X1%+13% : FOR J%=Y1% TO Y1%+Z7% 2110 ; CUR(I%-X1%+5%,(J%-Y1%)*(Z9%+1%)+4%); 2115 IF I%>X9% OR J%>Y9% THEN ; SPACE$(Z9%); : GOTO 2130 2120 ; C$(I%,J%); 2130 NEXT J% : NEXT I% 2140 ; CUR(21%,0%)'INL[ST DATAFIL : ']9$; 2150 ; CUR(22%,0%)'UTSKR. P] FIL : ']8$' '; 3000 GOSUB 20000 : ; CUR(0%,0%)'-> <- ^ RETURN = FLYTTA TILL ANNAN RUTA $ = \VERG]NG TILL FUNKTION' 3006 R%=X%-X1%+5% : K%=(Y%-Y1%)*(Z9%+1%)+4% 3010 ; CUR(R%,K%-1%)CHR$(127%); 3015 ; CUR(2%,0%)CHR$(X%/10%+65%,X%-(X%/10%)*10%+65%); 3016 ; CHR$(Y%/10%+48%,Y%-(Y%/10%)*10%+48%)' = '; 3017 IF D$(X%,Y%)<>SPACE$(Z8%) THEN GOSUB 24000 : ; E$; ELSE ; C$(X%,Y%)SPACE$(20%); 3018 ; CUR(R%,K%+Z9%-1%); : GET [$ 3019 [%=INSTR(1%,[9$,[$)+1% 3020 ON [% GOTO 3030,3100,3100,3100,3100,3200 3030 IF [$<' ' OR [$>'_' THEN 3015 3040 C$(X%,Y%)=RIGHT$(C$(X%,Y%)+[$,2%) 3050 ; CUR(R%,K%)C$(X%,Y%); 3060 GOTO 3015 3100 ; CUR(R%,K%-1%)' '; 3110 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 2000 3150 GOTO 3006 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 \%=INSTR(1%,\9$,\$) 3250 IF \%=0% THEN 3200 3260 ; \$; 3270 IF \%>10% THEN 3290 3280 ON \% GOTO 3500,3700,3300,3400,3800,3350,3200,3500,3800,3000 3290 ON \%-10% GOTO 3500,3500,3500,3500,3200,5000,40000 3300 C$(X%,Y%)=SPACE$(Z9%) : D$(X%,Y%)=SPACE$(Z8%) 3310 ; CUR(R%,K%)SPACE$(Z9%); 3320 GOTO 3000 3350 ; CUR(2%,0%)'RADERA ALLT ? (J/N) '; : GET \$ 3360 IF \$='N' OR \$='n' THEN 3000 3370 IF \$='J' OR \$='j' THEN 1000 ELSE 3350 3400 GOSUB 20000 3410 ; CUR(2%,0%)'HOPPA TILL : '; : K1%=13% : GOSUB 21000 3420 X%=(ASC([1$)-65%)*10%+ASC(RIGHT$([1$,2%))-65% 3425 Y%=(ASC(RIGHT$([1$,3%))-48%)*10%+ASC(RIGHT$([1$,4%))-48% 3430 ; CUR(R%,K%-1%)' '; 3440 X2%=(X%/10%)*10% 3450 Y2%=(Y%/Z7%)*Z7% 3460 IF X2%<>X1% OR Y2%<>Y1% THEN X1%=X2% : Y1%=Y2% : GOTO 2000 3470 GOTO 3000 3500 GOSUB 20000 3510 ; CUR(2%,0%)\$' : '; 3520 IF \$='R' K1%=4% : GOTO 3530 3522 ; CHR$(X%/10%+65%,X%-(X%/10%)*10%+65%); 3524 ; CHR$(Y%/10%+48%,Y%-(Y%/10%)*10%+48%)' = '; 3526 K1%=11% 3530 GOSUB 21000 3540 IF [4$='X' THEN 3640 3545 E$=[1$+' '+\$+' ' 3550 ; CUR(2%,K1%)E$; : K1%=K1%+7% 3560 GOSUB 21000 3570 IF [4$='X' THEN 3640 3575 E$=E$+[1$+'...' 3580 ; CUR(2%,K1%-7%)E$; : K1%=K1%+7% 3590 GOSUB 21000 3600 IF [4$='X' THEN 3640 3605 E$=E$+[1$+' D ' 3610 ; CUR(2%,K1%-14%)E$; : K1%=K1%+7% 3611 IF \$='R' THEN E$=E$+'0' : GOTO 3618 ELSE GOSUB 20010 : ; CUR(0%,0%)'ANTAL DECIMALER 0 - 5' 3612 ; CUR(2%,K1%); : GET [4$ : IF [4$='X' THEN 3640 3614 IF [4$<'0' OR [4$>'5' THEN 3612 ELSE ; [4$; 3616 E$=E$+[4$ 3618 GOSUB 25000 3620 GOSUB 22000 3630 GOSUB 23000 3640 ; CUR(R%,K%-1%)' '; : GOTO 2000 3700 GOSUB 20000 : ; CUR(0%,0%)'KALKYLERING P]G]R' 3710 FOR X%=0% TO X9% : FOR Y%=0% TO Y9% 3720 IF D$(X%,Y%)<>SPACE$(Z8%) THEN GOSUB 22000 : GOSUB 23000 3730 NEXT Y% : NEXT X% 3740 X%=0% : Y%=0% 3745 ; CUR(R%,K%-1%)' '; : X1%=0% : Y1%=0% 3750 GOTO 2000 3800 GOSUB 20000 3810 ; CUR(2%,0%)'NAMN P] '; 3820 IF \$='L' THEN ; 'IN'; ELSE ; 'UT'; 3830 ; 'DATAFIL : ' 3840 ; CUR(2%,20%); : IF \$='L' THEN ; ]9$; : GOTO 3910 ELSE INPUT ]$ 3850 IF ]$='' THEN 2000 3860 IF LEN(]$)>8% OR ASC(]$)<65% OR ASC(]$)>93% THEN 3810 3870 FOR I%=2% TO LEN(]$) 3880 ]1$=MID$(]$,I%,1%) 3890 IF ]1$<'0' OR ]1$>']' OR (]1$>'9' AND ]1$<'A') THEN 3810 3900 NEXT I% : ]8$=]$ 3910 ONERRORGOTO 4000 3920 IF \$='L' THEN OPEN ]9$+'.CA3' ASFILE 1% ELSE PREPARE ]8$+'.CA3' ASFILE 1% 3921 IF \$='L' THEN 3927 3922 ; #1%,X9% : ; #1%,Y9% : ; #1%,Z9% 3923 GOTO 3930 3927 INPUT #1%,X9%,Y9%,Z9% 3930 FOR X%=0% TO X9% : FOR Y%=0% TO Y9% 3940 IF \$='L' THEN 3950 3942 ; #1%,C$(X%,Y%) : ; #1%,D$(X%,Y%) 3944 GOTO 3970 3950 INPUTLINE #1%,E$ : C$(X%,Y%)=LEFT$(E$,LEN(E$)-2%) 3960 INPUTLINE #1%,E$ : D$(X%,Y%)=LEFT$(E$,LEN(E$)-2%) 3970 NEXT Y% : NEXT X% 3980 CLOSE 1% 3985 X%=0% : Y%=0% : X1%=0% : Y1%=0% 3986 ; CUR(R%,K%-1%)' '; 3990 ONERRORGOTO 30000 : IF \$='L' THEN 1990 ELSE 2000 4000 GOSUB 20010 : ; CUR(0%,0%)'FEL VID SKIVHANTERINGEN - TRYCK RETURN'; 4010 GET \$ 4020 GOTO 3980 5000 GOSUB 20000 5005 ; CUR(2%,0%)'U : '; : K1%=4% 5010 GOSUB 21000 5020 IF [4$='X' THEN 5990 5030 N%=(ASC([1$)-65%)*10%+ASC(RIGHT$([1$,2%))-65% 5040 N1%=(ASC(RIGHT$([1$,3%))-48%)*10%+ASC(RIGHT$([1$,4%))-48% 5045 ; '...'; : K1%=11% 5050 GOSUB 21000 5060 IF [4$='X' THEN 5990 5070 M%=(ASC([1$)-65%)*10%+ASC(RIGHT$([1$,2%))-65% 5080 M1%=(ASC(RIGHT$([1$,3%))-48%)*10%+ASC(RIGHT$([1$,4%))-48% 5090 GOSUB 20010 : ; CUR(0%,0%)'UTSKRIFT AV TEXT (T) ELLER FUNKTION (F)' 5100 ; CUR(1%,0%); 5110 GET [4$ : IF [4$='X' THEN 5990 5120 IF [4$<>'T' AND [4$<>'F' THEN 5110 ELSE ; [4$; 5122 IF M1%-N1%SPACE$(Z8%) THEN GOSUB 24000 : ; #1%,E$ ELSE ; #1% 5190 NEXT Y% : ; #1% 5195 NEXT X% : ; #1% 5200 CLOSE 1% 5990 X%=0% : Y%=0% : X1%=0% : Y1%=0% 5995 ; CUR(R%,K%-1%)' '; : GOTO 2000 20000 ; CUR(2%,0%)STRING$(80%,32%); 20010 ; CUR(0%,0%)STRING$(160%,32%); 20020 RETURN 21000 GOSUB 20010 : ; CUR(0%,0%)'FUNKTION : '\$, 21005 ; 'ANGE BOKSTAV AA - 'CHR$(X9%/10%+65%,X9%-(X9%/10%)*10%+65%); 21006 ; ' OCH SIFFRA 00 - 'CHR$(Y9%/10%+48%,Y9%-(Y9%/10%)*10%+48%); 21008 ; ' X = EXIT' 21010 ; CUR(2%,K1%); : GET [4$ 21015 IF [4$='X' THEN 21110 21020 IF [4$<'A' OR [4$>CHR$(X9%/10%+65%) THEN 21010 ELSE ; [4$; : [1$=[4$ 21030 ; CUR(2%,K1%+1%); : GET [4$ 21035 IF [4$='X' THEN 21110 21040 IF [4$<'A' OR [4$>'J' THEN 21030 21050 IF (ASC([1$)-65%)*10%+ASC([4$)-65%>X9% THEN 21030 ELSE ; [4$; : [1$=[1$+[4$ 21060 ; CUR(2%,K1%+2%); : GET [4$ 21065 IF [4$='X' THEN 21110 21070 IF [4$<'0' OR [4$>CHR$(Y9%/10%+48%) THEN 21060 ELSE ; [4$; : [1$=[1$+[4$ 21080 ; CUR(2%,K1%+3%); : GET [4$ 21085 IF [4$='X' THEN 21110 21090 IF [4$<'0' OR [4$>'9' THEN 21080 21100 IF (ASC(RIGHT$([1$,3%))-48%)*10%+ASC([4$)-48%>Y9% THEN 21080 ELSE ; [4$; : [1$=[1$+[4$ 21110 RETURN 22000 P1%=ASC(RIGHT$(D$(X%,Y%),2%))-32% 22010 Q1%=ASC(RIGHT$(D$(X%,Y%),1%))-32% 22015 R$=C$(Q1%,P1%) 22020 N%=ASC(RIGHT$(D$(X%,Y%),4%))-32% 22030 N1%=ASC(RIGHT$(D$(X%,Y%),5%))-32% 22040 M%=ASC(RIGHT$(D$(X%,Y%),7%))-32% 22050 M1%=ASC(RIGHT$(D$(X%,Y%),8%))-32% 22060 M$=MID$(D$(X%,Y%),3%,1%) 22065 D%=VAL(MID$(D$(X%,Y%),6%,1%)) 22070 RETURN 23000 FOR A%=N% TO M% : FOR B%=N1% TO M1% 23006 IF M$<>'R' THEN IF C$(A%,B%)=SPACE$(Z9%) F$='0' ELSE \=VAL(C$(A%,B%)) : F$=C$(A%,B%) 23010 ON INSTR(1%,'R+-*/A',M$) GOTO 23020,23040,23060,23080,23100,23040 23020 C$(A%,B%)=C$(Q1%,P1%) 23030 GOTO 23150 23040 R$=ADD$(R$,F$,D%) 23050 GOTO 23150 23060 R$=SUB$(R$,F$,D%) 23070 GOTO 23150 23080 R$=MUL$(R$,F$,D%) 23090 GOTO 23150 23100 IF VAL(F$)=0 THEN 30000 23105 R$=DIV$(R$,F$,D%) 23110 GOTO 23150 23150 NEXT B% : NEXT A% 23170 IF M$<>'A' THEN 23180 23172 R=((M%-N%)+(M1%-N1%)+2%) : IF R=0 THEN 30000 23174 R$=DIV$(R$,NUM$(R),D%) 23180 IF M$='R' THEN 23210 23190 IF LEN(R$)>Z9% THEN R$='E '+LEFT$(R$,Z9%-2%) 23195 C$(X%,Y%)=R$ 23200 IF LEN(C$(X%,Y%))'N' THEN 40000 40040 ; CHR$(12%)CUR(22%,0%)CHR$(7%)'== Laddar menyprogrammet CALC.80K =='; 40050 CHAIN 'CALC.80K'