|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen RC3600/RC7000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen RC3600/RC7000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8704 (0x2200)
Types: COMAL_SAVE
Names: »KURV«
└─⟦d85593a46⟧ Bits:30000470 DOMUS disk image - User files
└─⟦this⟧
SAVE filename: "KURV"
0010 DIM A ( 22 , 22 )
0020 EXEC START
0030 EXEC POLYN
0040 PRINT
0050 EXEC IND
0060 EXEC TEGN
0070 EXEC CHOICE
0080 PROC TEGN
0090 PRINT "<27><12>"
0100 DELAY = 1
0110 LET A2 = XAKS * ( XAKS >= 45 ) * ( XAKS <= FELT - 45 ) + 5 * ( XAKS < 45 ) + 5 * ( XAKS > FELT - 45 )
0120 LET A1 = 145 A3 = FELT + 100 A4 = A2 C1 = - 5 C2 = 3 C3 = C1 C4 = - 3 C5 = 8 C6 = 0
0130 LET X0 = INT ( ( XAKS - 45 ) / S ) Y0 = INT ( ( YAKS - 145 ) / S )
0140 LET Y = A2 + 4 START = YAKS - Y0 * S SLUT = START + 11 * S
0150 EXEC KOORD
0160 LET A1 = YAKS * ( YAKS >= 145 ) * ( YAKS <= FELT + 100 ) + 105 * ( YAKS < 145 ) + 105 * ( YAKS > FELT + 100 )
0170 LET A2 = 45 A3 = A1 A4 = FELT C1 = 3 C2 = - 5 C3 = - 3 C4 = C2 C5 = 0 C6 = 8
0180 LET X = A1 + 4 START = XAKS - X0 * S SLUT = START + 11 * S
0190 EXEC KOORD
0200 FOR I = 1 TO N
0210 LET X = KO ( 1 , I ) * XSTEP + YAKS
0220 LET Y = KO ( 2 , I ) * YSTEP + XAKS
0230 CALL "GRAPH" , X - 2 , Y + 2
0240 CALL "OUTVECT" , X + 2 , Y - 2
0250 CALL "OUTVECT" , X - 2 , Y - 2
0260 CALL "OUTVECT" , X + 2 , Y + 2
0270 NEXT
0280 LET DX = ( X2 - X1 ) / 100 VEC = 0
0290 LET T = X1
0300 EXEC MODEL
0310 CALL "GRAPH" , X1 * XSTEP + YAKS , FUNK * YSTEP + XAKS
0320 FOR T = X1 TO X2 STEP DX
0330 EXEC MODEL
0340 LET X = T * XSTEP + YAKS Y = FUNK * YSTEP + XAKS
0350 IF ( X > FELT + 100 ) + ( Y < 45 ) + ( Y > FELT ) THEN
0360 LET VEC = 0
0370 ELSE
0380 CALL "VECTOR" , X , Y , VEC
0390 LET VEC = 1
0400 ENDIF
0410 NEXT
0420 CALL "GRAPH" , 0 , 780
0430 CALL "ALPHA"
0440 ENDPROC
0450 PROC CROSS
0460 ON ERR THEN EXEC OUTERR
0470 LET AFBRYD = 2
0480 PRINT "<29>" ;
0490 INPUT "<27><26>" , G$ ;
0500 IF LEN ( G$ ) = 0 THEN GOTO 0590
0510 PRINT "<31>" ;
0520 LET X = ( ORD ( G$ ( 2 ) ) - 33 ) * 32 + ORD ( G$ ( 3 ) )
0530 LET Y = ( ORD ( G$ ( 4 ) ) - 33 ) * 32 + ORD ( G$ ( 5 ) )
0540 LET XKOR = ( X - YAKS ) / XSTEP YKOR = ( Y - XAKS ) / YSTEP
0550 IF AFBRYD = 3 THEN GOTO 0470
0560 PAGE = 72
0570 PRINT "(" ; XKOR ; "," ; YKOR ; ")"
0580 GOTO 0470
0590 PRINT "<31>"
0600 LET AFBRYD = 1
0610 LET A = 1 / 0
0620 ENDPROC
0630 PROC KOORD
0640 CALL "GRAPH" , A1 , A2
0650 CALL "OUTVECT" , A3 , A4
0660 CALL "OUTVECT" , A3 + C1 , A4 + C2
0670 CALL "OUTVECT" , A3 + C3 , A4 + C4
0680 CALL "OUTVECT" , A3 , A4
0690 FOR T = START TO SLUT STEP S
0700 IF C5 THEN LET X = T
0710 IF C6 THEN LET Y = T
0720 CALL "GRAPH" , X , Y
0730 CALL "OUTVECT" , X - C6 , Y - C5
0740 NEXT
0750 DELAY = 1
0760 ENDPROC
0770 PROC IND
0780 PRINT " INDTAST MINDSTE OG ST0RSTE X-VAERDI: " ;
0790 INPUT "XMIN,XMAX ? " , X1 , X2
0800 IF X1 >= X2 THEN GOTO 0790
0810 PRINT
0820 PRINT " INDTAST MINDSTE OG ST0RSTE Y-VAERDI: " ;
0830 INPUT "YMIN,YMAX ? " , Y1 , Y2
0840 IF Y1 >= Y2 THEN GOTO 0830
0850 LET S = 50 FELT = 650
0860 LET E ( 1 ) = S * ( X2 - X1 ) / FELT E ( 2 ) = S * ( Y2 - Y1 ) / FELT
0870 FOR I = 1 TO 2
0880 LET ENH = 0
0890 IF E ( I ) > 1 THEN
0900 LET D1 = 2.5 D2 = 5 D3 = 7.5 D4 = 10
0910 REPEAT
0920 LET ENH = D1 * ( E ( I ) <= D1 ) + D2 * ( E ( I ) > D1 ) * ( E ( I ) <= D2 ) + D3 * ( E ( I ) > D2 ) * ( E ( I ) <= D3 ) + D4 * ( E ( I ) > D3 ) * ( E ( I ) <= D4 )
0930 LET D1 = 10 * D1 D2 = 10 * D2 D3 = 10 * D3 D4 = 10 * D4
0940 UNTIL ENH
0950 ELSE
0960 LET D1 = 0.1 D2 = 0.25 D3 = 0.5 D4 = 0.75
0970 REPEAT
0980 LET ENH = D2 * ( E ( I ) > D1 ) * ( E ( I ) <= D2 ) + D3 * ( E ( I ) > D2 ) * ( E ( I ) <= D3 ) + D4 * ( E ( I ) > D3 ) * ( E ( I ) <= D4 ) + 10 * D1 * ( E ( I ) > D4 )
0990 LET D1 = D1 / 10 D2 = D2 / 10 D3 = D3 / 10 D4 = D4 / 10
1000 UNTIL ENH
1010 ENDIF
1020 LET E ( I ) = ENH
1030 NEXT
1040 LET XSTEP = S / E ( 1 ) YSTEP = S / E ( 2 )
1050 LET XAKS = - YSTEP * Y1 + 45 YAKS = - XSTEP * X1 + 145
1060 PRINT
1070 PRINT
1080 PRINT " ET INTERVAL PAA X-AKSEN ER LIG " ; E ( 1 )
1090 PRINT " ET INTERVAL PAA Y-AKSEN ER LIG " ; E ( 2 )
1100 PRINT
1110 PRINT
1120 INPUT " NAAR DU ER PARAT, TAST RETURN" , G$
1130 ENDPROC
1140 PRINT "" ;
1150 PROC CHOICE
1160 PRINT "DU HAR F0LGENDE MULIGHEDER (INDTAST TALLET):"
1170 PRINT "1 = KOORDINATS0GNING (KOORDINATERNE TIL KORSET FAAS VED AT"
1180 PRINT " TRYKKE PAA ET BOGSTAV. DU VENDER TILBAGE TIL HOVED-"
1190 PRINT " PROGRAMMET VED AT TASTE RETURN)"
1200 PRINT "2 = DEN NUVAERENDE GRAF TEGNES PAA PLOTTEREN"
1210 PRINT "3 = SAMME FUNKTION I NYT INTERVAL"
1220 PRINT "4 = NYT POLYNOMIUM"
1230 PRINT "5 = STOP"
1240 INPUT Q
1250 LET Q = INT ( Q )
1260 IF ( Q < 1 ) + ( Q > 5 ) THEN GOTO 1240
1270 IF Q = 1 THEN EXEC CROSS
1280 IF Q = 2 THEN
1290 LET S = 60 FELT = 780
1300 LET XSTEP = S / E ( 1 ) YSTEP = S / E ( 2 )
1310 LET XAKS = - YSTEP * Y1 + 45 YAKS = - XSTEP * X1 + 145
1320 PRINT "<27>AE"
1330 EXEC TEGN
1340 PRINT "<27>AF"
1350 ENDIF
1360 IF Q = 3 THEN
1370 PRINT "<27><12>"
1380 DELAY = 1
1390 EXEC IND
1400 EXEC TEGN
1410 ENDIF
1420 IF Q = 4 THEN
1430 EXEC POLYN
1440 EXEC IND
1450 EXEC TEGN
1460 ENDIF
1470 IF Q = 1 THEN GOTO 1240
1480 IF ( Q = 2 ) + ( Q = 3 ) + ( Q = 4 ) THEN GOTO 1160
1490 ENDPROC
1500 PROC START
1510 PRINT "<27>AF"
1520 PRINT "<27><12>"
1530 DELAY = 1
1540 DIM G$ ( 5 )
1550 PRINT
1560 INPUT "ANTAL MAALEPUNKTER =" , N
1570 DIM KO ( 2 , N )
1580 FOR I = 1 TO N STEP 1
1590 PRINT "TALSAET NR " ; I ;
1600 INPUT " X=" , KO ( 1 , I ) , " Y=" , KO ( 2 , I )
1610 NEXT
1620 ENDPROC
1630 PROC POLYN
1640 INPUT "DET APPROXIMERENDE POLYNOMIUMS GRAD " , M
1650 FOR J = 1 TO M + 1
1660 FOR I = 1 TO J
1670 FOR L = 1 TO N
1680 IF KO ( 1 , L ) <> 0 THEN
1690 IF I = 1 THEN LET A ( J , M + 2 ) = A ( J , M + 2 ) * ( L > 1 ) + KO ( 1 , L ) ^ ( J - 1 ) * KO ( 2 , L )
1700 LET A ( J , I ) = A ( J , I ) * ( L > 1 ) + KO ( 1 , L ) ^ ( J + I - 2 )
1710 ENDIF
1750 NEXT
1760 NEXT
1770 NEXT
1780 FOR J = 1 TO M + 1
1790 FOR I = 1 TO J
1800 LET A ( I , J ) = A ( J , I )
1810 NEXT
1820 NEXT
1830 FOR J = 1 TO M + 1
1840 LET I = J
1850 IF A ( I , J ) <> 0 THEN GOTO 1900
1860 LET I = I + 1
1870 IF I <= M + 1 THEN GOTO 1850
1880 PRINT "INGEN ENTYDIG L0SNING."
1890 END «nul»
1900 FOR K = 1 TO M + 2
1910 LET X = A ( J , K ) A ( J , K ) = A ( I , K ) A ( I , K ) = X
1920 NEXT
1930 LET Y = 1 / A ( J , J )
1940 FOR K = 1 TO M + 2
1950 LET A ( J , K ) = Y * A ( J , K )
1960 NEXT
1970 FOR I = 1 TO M + 1
1980 IF I = J THEN GOTO 2030
1990 LET Y = - A ( I , J )
2000 FOR K = 1 TO M + 2
2010 LET A ( I , K ) = A ( I , K ) + Y * A ( J , K )
2020 NEXT
2030 NEXT
2040 NEXT
2050 LET AFBRYD = 1
2060 DIM E ( 2 )
2070 ENDPROC
2080 PROC OUTERR
2090 LET FUNK = 0
2100 IF AFBRYD = 1 THEN GOTO 2130
2110 ON ERR THEN EXEC OUTERR
2120 LET AFBRYD = 3
2130 ENDPROC
2140 PROC MODEL
2150 LET FUNK = 0
2160 FOR J = 1 TO M + 1
2170 IF T <> 0 THEN
2180 LET FUNK = FUNK + A ( J , M + 2 ) * T ^ ( J - 1 )
2190 ELSE
2200 LET FUNK = FUNK + A ( 1 , M + 2 )
2210 ENDIF
2220 NEXT
2230 ENDPROC
FNA definition = 0xffff
FNB definition = 0xffff
FNC definition = 0xffff
FND definition = 0xffff
FNE definition = 0xffff
FNF definition = 0xffff
FNG definition = 0xffff
FNH definition = 0xffff
FNI definition = 0xffff
FNJ definition = 0xffff
FNK definition = 0xffff
FNL definition = 0xffff
FNM definition = 0xffff
FNN definition = 0xffff
FNO definition = 0xffff
FNP definition = 0xffff
FNQ definition = 0xffff
FNR definition = 0xffff
FNS definition = 0xffff
FNT definition = 0xffff
FNU definition = 0xffff
FNV definition = 0xffff
FNW definition = 0xffff
FNX definition = 0xffff
FNY definition = 0xffff
FNZ definition = 0xffff
FN[ definition = 0xffff
FN\ definition = 0xffff
FN] definition = 0xffff
GOSUB-RETURN stack pointer = 0x0002
stack[0] = 0x005e
stack[1] = 0x0589
stack[2] = 0x01bc
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
FOR-NEXT stack pointer = 0x0000
Var# = 0x03aa
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 5.14756e-85 (0x00000001)
Step Val = 0 (0x00000000)
Var# = 0x0000
Loop Top = 0x0000
To Val = 0 (0x00000000)
Step Val = 0 (0x00000000)
Var# = 0x00a2
Loop Top = 0x01b3
To Val = 12 (0x41c00000)
Step Val = 0.12 (0x401eb852)
Var# = 0x00b6
Loop Top = 0x0865
To Val = 3 (0x41300000)
Step Val = 1 (0x41100000)
Var# = 0x00b8
Loop Top = 0x07e6
To Val = 4 (0x41400000)
Step Val = 1 (0x41100000)
REPEAT-UNTIL stack pointer = 0x0000
stack[0] = 0x0000
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
WHILE-ENDWHILE stack pointer = 0x0000
stack[0] = 0x0000
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
IF-ELSE stack pointer = 0x0000
stack[0] = 0x0000
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
Variables:
0x80 0xffff 0x00
0x81 0x0627 0x00 START
0x82 0xffff 0x00 IND
0x83 0xffff 0x00 TEGN
0x84 0xffff 0x00 CHOICE
0x85 0x060f 0x00 A2
0x86 0x060b 0x00 XAKS
0x87 0x05fb 0x00 FELT
0x88 0x0611 0x00 A1
0x89 0x0613 0x00 A3
0x8a 0x0615 0x00 A4
0x8b 0x0617 0x00 C1
0x8c 0x0619 0x00 C2
0x8d 0x061b 0x00 C3
0x8e 0x061d 0x00 C4
0x8f 0x061f 0x00 C5
0x90 0x0621 0x00 C6
0x91 0x0623 0x00 X0
0x92 0x05f9 0x00 S
0x93 0x0625 0x00 Y0
0x94 0x060d 0x00 YAKS
0x95 0x05e4 0x00 Y
0x96 0x0629 0x00 SLUT
0x97 0xffff 0x00 KOORD
0x98 0x05e2 0x00 X
0x99 0x05d8 0x00 I
0x9a 0x05b5 0x00 N
0x9b 0x05b7 0x01 KO
0x9c 0x0607 0x00 XSTEP
0x9d 0x0609 0x00 YSTEP
0x9e 0x062d 0x00 DX
0x9f 0x05f3 0x00 X2
0xa0 0x05f1 0x00 X1
0xa1 0x062f 0x00 VEC
0xa2 0x062b 0x00 T
0xa3 0xffff 0x00 MODEL
0xa4 0x0631 0x00 FUNK
0xa5 0xffff 0x00 CROSS
0xa6 0xffff 0x00 OUTERR
0xa7 0x05e6 0x00 AFBRYD
0xa8 0x05af 0x02 G$
0xa9 0x0635 0x00 XKOR
0xaa 0x0637 0x00 YKOR
0xab 0x0000 0x01 A
0xac 0x05f5 0x00 Y1
0xad 0x05f7 0x00 Y2
0xae 0x05e8 0x01 E
0xaf 0x05fd 0x00 ENH
0xb0 0x05ff 0x00 D1
0xb1 0x0601 0x00 D2
0xb2 0x0603 0x00 D3
0xb3 0x0605 0x00 D4
0xb4 0x0633 0x00 Q
0xb5 0x05da 0x00 M
0xb6 0x05dc 0x00 J
0xb7 0x05de 0x00 L
0xb8 0x05e0 0x00 K
0xb9 0xffff 0x00 OUTESC
0xba 0xffff 0x00 POLYN
.magic = 0x4e32 .u_pas = 0x087b // Length of UPAS in words .u_das = 0x07c8 // Length of UDAS in words .u_dvs = 0x018f // Start på savede variabel indhold (word adr) .u_nds = 0x0819 // Address på næste prog.sætning (word adr) .u_cps = 0x0000 // Address på curr prog.sætning (word adr) .u_tll = 0x0048 // Page størrelse .u_tts = 0x000e // TAP størrelse .u_ran = 0x0001 // Random tal .u_cdl = 0x0006 // Current DATA sætning ptr .u_cdb = 0x0000 // Current DATA byte ptr .u_esa = 0x0042 // ON ESE (word adr) .u_era = 0x0000 // ON ERR (word adr) .u_cas = 0xffff // CASE dybde .u_las = 0xffff // last (-1)