1 REM Ins{nd av Leopold Lundstr|m <2694>    1987-12-30 15.36.04 (DUMP)
10 REM +-------------------------------

11 REM ! Program ....   SQRROOT
12 REM ! Utg}va  1.1    1986-09-06
13 REM ! av (c) L Lundstr|m <2694>
14 REM ! F|r ABC 80
15 REM ! Minne 16/32 Kbytes
16 REM +-------------------------------
17 REM ! Programmet efterliknar den
18 REM ! algoritm, som f|rr anv{ndes
19 REM ! i skolan f|r att manuellt
20 REM ! ber{kna kvadratr|tter.
21 REM +-------------------------------
97 REM 
98 REM  DIM / INMATNING       
99 REM 
100 IF PEEK(65053%)<>128% THEN N%=700% ELSE N%=2800%
110 N2%=N%/2% : DIM P%(N%),S%(N2%),T%(N%),T$=N%,U$=N2%+1%,[$=1%,S$=1%,S$(1%)=3%,A$=5%
120 R%=1% : A8%=1% : S%=78% : A$='' : S$='J' : S$(0)='Ja' : S$(1)='Nej'
130 ; INP(4%);CHR$(12%);
140 ; TAB(PEEK(590%)/2%-16%)'<<< BER[KNING AV KVADRATROT >>>' : ;
150 ; 'Tryck p}  < mellanslag > och ber{kningen avbryts'
160 ; 'F|r att avsluta programmet ge "tal" S'
170 ; : ONERRORGOTO 170 : T$=''
180 ; 'Ge ett tal ';
190 GET [$ : E%=ASC([$)
200 IF E%=13% OR (E% AND 95%)=83% THEN GOTO 240
210 IF E%=8% AND N1%>0% THEN GOSUB 300
220 IF E%<46% OR E%>57% THEN GOTO 190
230 ; [$; : T$=T$+[$ : N1%=N1%+1% : GOTO 190
240 IF T$='' OR E%=83% THEN END
250 GOTO 1000
297 REM 
298 REM  KORRIGERA             
299 REM 
300 R9%=PEEK(65011%) : K9%=PEEK(65012%)-1%
310 IF K9%<0% THEN K9%=PEEK(590%) : R9%=R9%-1%
320 ; CUR(R9%,K9%);' ';CUR(R9%,K9%);
330 N1%=N1%-1% : T$=LEFT$(T$,N1%)
340 RETURN
997 REM 
998 REM  "NORMERING"           
999 REM 
1000 K%=INSTR(1%,T$,'.') : IF K% THEN IF K%=1% THEN T$='0'+T$ : GOTO 1000 ELSE GOTO 1030
1010 IF LEN(T$) AND 1% THEN T$='0'+T$
1020 K%=LEN(T$) : GOTO 1060
1030 IF LEN(LEFT$(T$,K%-1%)) AND 1% THEN T$='0'+T$ : K%=K%+1%
1040 IF LEN(RIGHT$(T$,K%+1%)) AND 1%=1% THEN T$=T$+'0'
1050 T$=LEFT$(T$,K%-1%)+RIGHT$(T$,K%+1%)
1060 K1%=INT(K%/2%)+1% : K2%=INT(LEN(T$)/2%) : K3%=LEN(T$)
1070 FOR I%=1% TO K3% : T%(I%)=VAL(MID$(T$,I%,1%)) : NEXT I%
1080 FOR I%=1% TO K3% : IF T%(I%)=0% AND T%(I%+1%)=0% THEN A9%=A9%+1% : NEXT I%
1090 ; : ; 'Roten=';
1100 ONERRORGOTO 0
1997 REM 
1998 REM   F\RSTA FAKTOR        
1999 REM 
2000 F%=INT(SQR(T%(1%)*10%+T%(2%))) : S%(1%)=F% : GOTO 4000
2997 REM 
2998 REM   FAKTOR               
2999 REM 
3000 R%=R%+1%
3010 A%=INT(SQR(R%)+.5) : S=0% : T=0%
3020 IF A9%>R% A%=R%
3030 IF A%<A8% THEN A%=A8% ELSE A8%=A%
3040 A1%=A%+1%
3050 FOR I%=0% TO A%
3060 S=S+S%(I%)*10^A%
3070 A%=A%-1%
3080 NEXT I%
3090 FOR I%=R%-1% TO R%+A1%
3100 T=T+T%(I%)*10^A1%
3110 A1%=A1%-1%
3120 NEXT I%
3130 IF S=0% THEN F%=SQR(10%*T) ELSE F%=INT(T/S)
3140 S%(R%)=F%
3997 REM 
3998 REM  MULTIPLICERA          
3999 REM 
4000 M%=0%
4010 FOR I%=2%*R% TO R% STEP -1%
4020 P%(I%)=S%(I%-R%)*F%+M%
4030 M%=INT(P%(I%)/10%)
4040 P%(I%)=P%(I%)-10%*M%
4050 NEXT I%
4060 P%(I%)=M%
4997 REM 
4998 REM  SUBTRAHERA            
4999 REM 
5000 B%=0%
5010 FOR I%=2%*R% TO R%-1% STEP -1%
5020 IF P%(I%)>T%(I%) THEN T%(I%)=T%(I%)+10% : T%(I%-1%)=T%(I%-1%)-1%
5030 T%(I%)=T%(I%)-P%(I%) : IF T%(I%)<>0% B%=-1%
5040 NEXT I%
5050 IF R%>1% IF T%(R%-1%)<0% OR T%(R%-2%)<0% GOSUB 8000 : F%=F%-1% : S%(R%)=F% : GOTO 4000
5997 REM 
5998 REM  ADDERA                
5999 REM 
6000 M%=F%
6010 FOR I%=R% TO 0% STEP -1%
6020 S%(I%)=S%(I%)+M%
6030 M%=INT(S%(I%)/10%)
6040 S%(I%)=S%(I%)-10%*M%
6050 NEXT I%
6997 REM 
6998 REM  UTSKRIFT SK[RM        
6999 REM 
7000 IF F%<0% OR F%>9% THEN ; 'FATALT FEL' : STOP
7010 IF R%=K1% THEN U$=U$+'.' : D%=0% : ; '.';
7020 U$=U$+RIGHT$(NUM$(F%),2%) : D%=D%+1%
7030 ; RIGHT$(NUM$(F%),2%); : C%=C%+1% : IF C%=N2% GOTO 7210
7040 IF (INP(56%) AND 127%)=32% THEN GOTO 7070
7050 IF (B%=0% AND R%>=K2%) OR (R%=N2%) THEN F9%=-1% : GOTO 7070
7060 GOTO 3000
7070 IF R%<K2% THEN R9%=PEEK(65011%) : K9%=PEEK(65012%) ELSE GOTO 7210
7080 ; CUR(21%,0%);'Ber{kningen avbruten i f|rtid!' : ; '[r detta riktigt? (N) '; : POKE 65013%,0% : GET [$
7090 E%=ASC([$) AND 95% : ; S$((E%=74%)+1%);
7100 IF E%<>74% THEN ; CUR(21%,0%)SPACE$(35%);CUR(22%,0%)SPACE$(35%);CUR(R9%,K9%); : GOTO 7060
7197 REM 
7198 REM  UTSKRIFT PRINTER      
7199 REM 
7200 A$=' [ND]' : S$='N' : S%=74% : S9%=-1%
7210 ; : ; 'Utskrift p} printer'A$'? ('S$') '; : POKE 65013%,0% : GET [$
7220 E%=ASC([$) AND 95% : IF E%=83% THEN END
7230 ON (S% AND 4%)/4%+1% GOTO 7240,7250
7240 ; S$((E%=S%)+1%); : IF E%=S% THEN GOTO 7260 ELSE GOTO 7480 : REM 'JA'
7250 ; S$((E%<>S%)+1%); : IF E%=S% THEN GOTO 7480 : REM 'NEJ'
7260 ; : P9%=1%
7270 IF INSTR(1%,U$,'.')=0% THEN D%=0%
7280 OPEN 'PR:' ASFILE P9%
7290 OUT 6%,211% : ; #P9%;CHR$(13%); : OUT 6%,0%
7300 ; #P9%;TAB(10%);'Roten ur '; : L%=59% : L1%=19%
7310 T$=LEFT$(T$,2%*K1%-2%)+'.'+RIGHT$(T$,2%*K1%-1%)
7320 IF ASC(T$)=48% AND ASC(RIGHT$(T$,2%))<>46% THEN T$=RIGHT$(T$,2%) : GOTO 7320
7330 IF ASC(RIGHT$(T$,LEN(T$)))=48% THEN T$=LEFT$(T$,LEN(T$)-1%)
7340 IF ASC(RIGHT$(T$,LEN(T$)))=46% THEN T$=LEFT$(T$,LEN(T$)-1%) : F9%=0%
7350 IF LEN(T$)>L% THEN W$=LEFT$(T$,L%) : T$=RIGHT$(T$,L%+1%) : L%=68% ELSE W$=T$ : T$=''
7360 ; #P9%;TAB(L1%);W$ : W$='' : L1%=10%
7370 IF LEN(T$)<>0% THEN GOTO 7350
7380 ; #P9% : ; #P9%;TAB(10%);'= '; : L%=66% : L1%=12%
7390 IF F9% IF ASC(RIGHT$(U$,LEN(U$)))=48% THEN U$=LEFT$(U$,LEN(U$)-1%) : D%=D%-1%
7400 IF ASC(U$)=48% AND ASC(RIGHT$(U$,2%))<>46% THEN U$=RIGHT$(U$,2%) : GOTO 7400
7410 IF LEN(U$)>L% THEN W$=LEFT$(U$,L%) : U$=RIGHT$(U$,L%+1%) : L%=68% ELSE W$=U$ : U$=''
7420 ; #P9%;TAB(L1%);W$ : W$='' : L1%=10%
7430 IF LEN(U$)<>0% THEN GOTO 7410
7440 IF D% THEN ; #P9% : ; #P9%;TAB(9%);D%;' decimaler ber{knade'
7450 IF S9% ; #P9%;TAB(10%);'Ber{kningen avbruten i f|rtid'
7460 ; #P9%;TAB(10%);STRING$(68%,95%) : ; #P9%
7470 CLOSE P9%
7480 Z%=CALL(3413%)
7997 REM 
7998 REM  ]TERST[LL             
7999 REM 
8000 FOR I%=2*R% TO R%-1% STEP -1%
8010 T%(I%)=T%(I%)+P%(I%) : IF T%(I%)>9% THEN T%(I%-1%)=T%(I%-1%)+1% : T%(I%)=T%(I%)-10%
8020 NEXT I%
8030 RETURN

>