1 REM Ins{nt av 4230 10 REM ++++++++++++++++++++++++++++++++ 11 REM + Program .... CALC1.BER + 12 REM + Utg}va 1.0 1984-05-20 + 13 REM + av (c) Alf Wirdling + 14 REM + Minne 16 Kbytes + 15 REM + Ins{nt av 4230 + 16 REM ++++++++++++++++++++++++++++++++ 100 ; CHR$(12);TAB(14);"**********" 105 ; TAB(14);"* *" 110 ; TAB(14);"* CALC-1 *" 115 ; TAB(14);"* *" 120 ; TAB(14);"**********" : ; 125 ONERRORGOTO 125 130 ; : ; "Antal kolumner/rad (2-10) "; 135 INPUT C% : IF C%<2% OR C%>10% THEN 130 140 T%=(39%-C%+1%)/C% 145 ; : ; "Det blir";T%;" tecken/kolumn !!!" 150 ; : ; "[r det ok "; : GET R$ : ; R$ 155 IF R$<>"J" AND R$<>"j" THEN 130 160 R%=19% : C%=C%-1% 165 DIM M$(R%,C%)=T%,N$=30%,R2$=1% 170 DIM M%(R%,C%),S$(R%,C%)=20% 175 N$=" * CALC-1 *" 180 B%=1% : GOSUB 690 185 REM * MAIN LOOP * 190 ; CUR(R1%+2%,C1%*(T%+1%)); : R$="" 195 GET R2$ 200 IF ASC(R2$)=23% THEN 270 205 IF ASC(R2$)=26% THEN 280 210 IF ASC(R2$)=1% THEN 290 215 IF ASC(R2$)=19% THEN 300 220 IF ASC(R2$)=2% THEN 310 225 IF ASC(R2$)=14% THEN 320 230 IF ASC(R2$)=12% THEN 330 235 IF ASC(R2$)=11% THEN 370 240 IF ASC(R2$)=7% THEN 400 245 IF ASC(R2$)=30% THEN 480 250 IF ASC(R2$)=8% THEN 490 255 IF ASC(R2$)=13% THEN 610 260 IF ASC(R2$)=18% THEN 680 265 ; R2$; : R$=R$+R2$ : IF LEN(R$)=T% THEN 610 ELSE 195 270 REM * CTRL-W * 275 IF R1%=0% THEN 195 ELSE R1%=R1%-1% : GOTO 185 280 REM * CTRL-Z * 285 IF R1%=R% THEN 195 ELSE R1%=R1%+1% : GOTO 185 290 REM * CTRL-A * 295 IF C1%=0% THEN 195 ELSE C1%=C1%-1% : GOTO 185 300 REM * CTRL-S * 305 IF C1%=C% THEN 195 ELSE C1%=C1%+1% : GOTO 185 310 REM * CTRL-B * 315 B%=1% : GOSUB 690 : GOTO 185 320 REM * CTRL-N * 325 B%=0% : GOSUB 690 : GOTO 185 330 REM * CTRL-L * 335 ; CUR(22%,7%);STRING$(30%,95%); 340 ; CUR(23%,0%);SPACE$(39%); 345 ; CUR(23%,0%);"LABEL: "; : INPUTLINE R$ 350 IF LEN(R$)<3% OR LEN(R$)>32% THEN 340 355 N$=LEFT$(R$,LEN(R$)-2%) : N$=N$+SPACE$(30%-LEN(N$)) 360 ; CUR(0%,5%);N$; 365 ; CUR(22%,0%);SPACE$(39%) : ; SPACE$(39%); : GOTO 185 370 REM * CTRL-K * 375 GOSUB 440 : ONERRORGOTO 465 380 PREPARE R$ ASFILE 1 : ; #1,N$ 385 FOR I%=0% TO R% : FOR J%=0% TO C% 390 ; #1,M$(I%,J%) : ; #1,M%(I%,J%) : ; #1,S$(I%,J%) 395 NEXT J% : NEXT I% : CLOSE 1 : GOTO 185 400 REM * CTRL-G * 405 GOSUB 440 : ONERRORGOTO 465 410 OPEN R$ ASFILE 2 : INPUTLINE #2,R$ : N$=LEFT$(R$,LEN(R$)-2%) 415 FOR I%=0% TO R% : FOR J%=0% TO C% 420 INPUTLINE #2,R$ : M$(I%,J%)=LEFT$(R$,LEN(R$)-2%) 425 INPUT #2,M%(I%,J%) 430 INPUTLINE #2,R$ : S$(I%,J%)=LEFT$(R$,LEN(R$)-2%) 435 NEXT J% : NEXT I% : CLOSE 2 : GOSUB 690 : GOTO 185 440 ; CUR(23%,0%);SPACE$(39%); 445 ; CUR(23%,0%);"FILNAMN: "; : INPUTLINE R$ 450 IF LEN(R$)<3% OR LEN(R$)>18% THEN 440 455 R$=LEFT$(R$,LEN(R$)-2%) 460 ; CUR(23%,0%);SPACE$(39%); : RETURN 465 ; CUR(23%,0%);SPACE$(39%); 470 F$=CHR$(7)+"--- FELKOD"+NUM$(ERRCODE)+" ---" 475 GOSUB 690 : GOTO 185 480 REM * CTRL-^ * 485 ; CUR(23%,0%); : END 490 REM * <-- * 495 ; CUR(R1%+2%,C1%*(T%+1%));SPACE$(T%); : GOTO 185 500 REM * OPERATION ? * 505 ; SPACE$(T%-1%); : M$(R1%,C1%)="" 510 ; CUR(22%,11%);STRING$(20%,95%); 515 ; CUR(23%,0%);SPACE$(39%); 520 ; CUR(23%,0%);"Operation: ";S$(R1%,C1%); 525 ; CUR(23%,11%); : INPUTLINE R$ 530 IF LEN(R$)=2% AND LEN(S$(R1%,C1%))<>0% THEN 595 535 IF LEN(R$)<5% OR LEN(R$)>22% OR ASC(LEFT$(R$,1%))<48% THEN 515 540 S$(R1%,C1%)=LEFT$(R$,LEN(R$)-2%) 545 ; CUR(23%,0%);SPACE$(39%); 550 ; CUR(23%,0%);"Antal decimaler - max"; 555 IF T%>10% ; 9%; ELSE ; T%-1%; 560 ; " "; 565 GET R$ : IF ASC(R$)=13% THEN 580 570 ONERRORGOTO 580 575 D%=VAL(R$) : GOTO 585 580 D%=2% 585 IF D%<0% OR D%>9% OR D%>T%-1% THEN 545 590 M%(R1%,C1%)=30%+D% 595 ; CUR(22%,0%);SPACE$(39%) : ; SPACE$(39%); : GOTO 185 600 REM * NULL * 605 ; SPACE$(T%-1%); : M%(R1%,C1%)=0% : S$(R1%,C1%)="" : GOTO 185 610 REM * RET * 615 IF R$=SPACE$(LEN(R$)) THEN 665 620 IF R$="*" THEN 500 625 IF R$="'" THEN 600 630 R$=SPACE$(T%-LEN(R$))+R$ 635 ; CUR(R1%+2%,C1%*(T%+1%));R$; 640 ONERRORGOTO 650 645 R=VAL(R$) : M%(R1%,C1%)=2% : GOTO 655 650 M%(R1%,C1%)=1% 655 M$(R1%,C1%)=R$ : S$(R1%,C1%)="" 660 GOTO 185 665 IF C1%0% R$=M$(I%,J%) : GOTO 720 710 IF B%=0% R$=SPACE$(T%) : GOTO 725 715 R$=CHR$(65%+I%)+RIGHT$(NUM$(J%),2%) 720 R$=SPACE$(T%-LEN(R$))+R$ 725 ; R$; : IF J%=C% ; ELSE ; " "; 730 NEXT J% : NEXT I% 735 ; CUR(23%,11%);F$; : F$="" : RETURN 740 REM * CALC * 745 ; CUR(23%,0%);SPACE$(39%); 750 FOR I%=0% TO R% : FOR J%=0% TO C% 755 IF M%(I%,J%)<3% THEN 860 760 M$(I%,J%)=SPACE$(T%-1%)+"0" 765 D=M%(I%,J%)/10 : D%=(D-INT(D))*10 : P%=1% : P2%=1% 770 A%=ASC(MID$(S$(I%,J%),P%,1%)) 775 IF A%>47% OR A%=45% OR A%=46% THEN 850 780 T$=MID$(S$(I%,J%),P2%,P%-P2%) 785 ONERRORGOTO 790 : T=VAL(T$) : GOTO 810 790 IF LEN(T$)=4% THEN 815 795 R2%=ASC(LEFT$(T$,1%))-65% : C2%=ASC(RIGHT$(T$,2%))-48% 800 IF R2%<0% OR R2%>R% OR C2%<0% OR C2%>C% THEN 865 805 T$=M$(R2%,C2%) : ONERRORGOTO 865 : T=VAL(T$) 810 GOSUB 885 : P2%=P%+1% : GOTO 850 815 R2%=ASC(LEFT$(T$,1%))-65% : C2%=ASC(MID$(T$,2%,1%))-48% 820 R3%=ASC(MID$(T$,3%,1%))-65% : C3%=ASC(RIGHT$(T$,4%))-48% 825 IF R2%<0% OR R2%>R% OR C2%<0% OR C2%>C% THEN 865 830 IF R3%<0% OR R3%>R% OR C3%<0% OR C3%>C% THEN 865 835 FOR K%=R2% TO R3% : FOR L%=C2% TO C3% 840 T$=M$(K%,L%) : ONERRORGOTO 865 : T=VAL(T$) 845 GOSUB 885 : NEXT L% : NEXT K% : P2%=P%+1% 850 P%=P%+1% : IF P%<=LEN(S$(I%,J%)) THEN 770 855 ; CUR(I%+2%,J%*T%+J%);M$(I%,J%); 860 NEXT J% : NEXT I% : RETURN 865 ; CUR(23%,0%);SPACE$(39%); 870 ; CUR(23%,4%);CHR$(7);"--- FELAKTIG OPERATION ("; 875 ; CHR$(I%+65%)+RIGHT$(NUM$(J%),2%);") ---"; 880 FOR F=1 TO 2000 : NEXT F : GOTO 855 885 REM * OPERATION * 890 IF A%=43% R$=ADD$(M$(I%,J%),T$,D%) : GOTO 910 895 IF A%=42% R$=MUL$(M$(I%,J%),T$,D%) : GOTO 910 900 IF A%=47% R$=DIV$(M$(I%,J%),T$,D%) : GOTO 910 905 R$=SUB$(M$(I%,J%),T$,D%) 910 IF LEN(R$)>T% M$(I%,J%)=LEFT$(R$,T%) ELSE M$(I%,J%)=SPACE$(T%-LEN(R$))+R$ 915 RETURN