|
|
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 - metrics - download
Length: 4608 (0x1200)
Types: COMAL_SAVE
Names: »KURV0«
└─⟦d85593a46⟧ Bits:30000470 DOMUS disk image - User files
└─⟦this⟧ »/KURV0«
SAVE filename: "KURV0"
0010 EXEC START
0020 PRINT
0030 EXEC IND
0040 EXEC TEGN
0050 EXEC CHOICE
0060 PROC TEGN
0070 PRINT "<27><12>"
0080 DELAY = 1
0090 LET A2 = XAKS * ( XAKS >= 45 ) * ( XAKS <= FELT - 45 ) + 5 * ( XAKS < 45 ) + 5 * ( XAKS > FELT - 45 )
0100 LET A1 = 145 A3 = FELT + 100 A4 = A2 C1 = - 5 C2 = 3 C3 = C1 C4 = - 3 C5 = 8 C6 = 0
0110 LET X0 = INT ( ( XAKS - 45 ) / S ) Y0 = INT ( ( YAKS - 145 ) / S )
0120 LET Y = A2 + 4 START = YAKS - Y0 * S SLUT = START + 11 * S
0130 EXEC KOORD
0140 LET A1 = YAKS * ( YAKS >= 145 ) * ( YAKS <= FELT + 100 ) + 105 * ( YAKS < 145 ) + 105 * ( YAKS > FELT + 100 )
0150 LET A2 = 45 A3 = A1 A4 = FELT C1 = 3 C2 = - 5 C3 = - 3 C4 = C2 C5 = 0 C6 = 8
0160 LET X = A1 + 4 START = XAKS - X0 * S SLUT = START + 11 * S
0170 EXEC KOORD
0172 LET VEC = 0
0174 CALL "GRAPH" , KO ( 1 , 1 ) * XSTEP + YAKS , KO ( 2 , 1 ) * YSTEP + XAKS
0180 FOR I = 1 TO N
0190 LET X = KO ( 1 , I ) * XSTEP + YAKS
0200 LET Y = KO ( 2 , I ) * YSTEP + XAKS
0330 IF ( X > FELT + 100 ) + ( Y < 45 ) + ( Y > FELT ) THEN
0340 LET VEC = 0
0350 ELSE
0360 CALL "VECTOR" , X , Y , VEC
0370 LET VEC = 1
0380 ENDIF
0390 NEXT
0400 CALL "GRAPH" , 0 , 780
0410 CALL "ALPHA"
0420 ENDPROC
0430 PROC CROSS
0440 ON ERR THEN EXEC OUTERR
0450 LET AFBRYD = 2
0460 PRINT "<29>" ;
0470 INPUT "<27><26>" , G$ ;
0480 IF LEN ( G$ ) = 0 THEN GOTO 0570
0490 PRINT "<31>" ;
0500 LET X = ( ORD ( G$ ( 2 ) ) - 33 ) * 32 + ORD ( G$ ( 3 ) )
0510 LET Y = ( ORD ( G$ ( 4 ) ) - 33 ) * 32 + ORD ( G$ ( 5 ) )
0520 LET XKOR = ( X - YAKS ) / XSTEP YKOR = ( Y - XAKS ) / YSTEP
0530 IF AFBRYD = 3 THEN GOTO 0450
0540 PAGE = 72
0550 PRINT "(" ; XKOR ; "," ; YKOR ; ")"
0560 GOTO 0450
0570 PRINT "<31>"
0580 LET AFBRYD = 1
0590 LET A = 1 / 0
0600 LET DX = ( X2 - X1 ) / 250 VEC = 0
0610 PROC KOORD
0620 CALL "GRAPH" , A1 , A2
0630 CALL "OUTVECT" , A3 , A4
0640 CALL "OUTVECT" , A3 + C1 , A4 + C2
0650 CALL "OUTVECT" , A3 + C3 , A4 + C4
0660 CALL "OUTVECT" , A3 , A4
0670 FOR T = START TO SLUT STEP S
0680 IF C5 THEN LET X = T
0690 IF C6 THEN LET Y = T
0700 CALL "GRAPH" , X , Y
0710 CALL "OUTVECT" , X - C6 , Y - C5
0720 NEXT
0730 DELAY = 1
0740 ENDPROC
0750 PROC IND
0760 PRINT " INDTAST MINDSTE OG ST0RSTE X-VAERDI: " ;
0770 INPUT "XMIN,XMAX ? " , X1 , X2
0780 IF X1 >= X2 THEN GOTO 0770
0790 PRINT
0800 PRINT " INDTAST MINDSTE OG ST0RSTE Y-VAERDI: " ;
0810 INPUT "YMIN,YMAX ? " , Y1 , Y2
0820 IF Y1 >= Y2 THEN GOTO 0810
0830 LET S = 50 FELT = 650
0840 LET E ( 1 ) = S * ( X2 - X1 ) / FELT E ( 2 ) = S * ( Y2 - Y1 ) / FELT
0850 FOR I = 1 TO 2
0860 LET ENH = 0
0870 IF E ( I ) > 1 THEN
0880 LET D1 = 2.5 D2 = 5 D3 = 7.5 D4 = 10
0890 REPEAT
0900 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 )
0910 LET D1 = 10 * D1 D2 = 10 * D2 D3 = 10 * D3 D4 = 10 * D4
0920 UNTIL ENH
0930 ELSE
0940 LET D1 = 0.1 D2 = 0.25 D3 = 0.5 D4 = 0.75
0950 REPEAT
0960 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 )
0970 LET D1 = D1 / 10 D2 = D2 / 10 D3 = D3 / 10 D4 = D4 / 10
0980 UNTIL ENH
0990 ENDIF
1000 LET E ( I ) = ENH
1010 NEXT
1020 LET XSTEP = S / E ( 1 ) YSTEP = S / E ( 2 )
1030 LET XAKS = - YSTEP * Y1 + 45 YAKS = - XSTEP * X1 + 145
1040 PRINT
1050 PRINT
1060 PRINT " ET INTERVAL PAA X-AKSEN ER LIG " ; E ( 1 )
1070 PRINT " ET INTERVAL PAA Y-AKSEN ER LIG " ; E ( 2 )
1080 PRINT
1090 PRINT
1100 INPUT " NAAR DU ER PARAT, TAST RETURN" , G$
1110 ENDPROC
1120 PRINT "" ;
1130 PROC CHOICE
1140 PRINT "DU HAR F0LGENDE MULIGHEDER (INDTAST TALLET):"
1150 PRINT "1 = KOORDINATS0GNING (KOORDINATERNE TIL KORSET FAAS VED AT"
1160 PRINT " TRYKKE PAA ET BOGSTAV. DU VENDER TILBAGE TIL HOVED-"
1170 PRINT " PROGRAMMET VED AT TASTE RETURN)"
1180 PRINT "2 = DEN NUVAERENDE GRAF TEGNES PAA PLOTTEREN"
1190 PRINT "3 = SAMME FUNKTION I NYT INTERVAL"
1205 PRINT "5 = STOP"
1210 INPUT Q
1220 LET Q = INT ( Q )
1230 IF ( Q < 1 ) + ( Q > 5 ) THEN GOTO 1210
1240 IF Q = 1 THEN EXEC CROSS
1250 IF Q = 2 THEN
1260 LET S = 60 FELT = 780
1270 LET XSTEP = S / E ( 1 ) YSTEP = S / E ( 2 )
1280 LET XAKS = - YSTEP * Y1 + 45 YAKS = - XSTEP * X1 + 145
1290 PRINT "<27>AE"
1300 EXEC TEGN
1310 PRINT "<27>AF"
1320 ENDIF
1330 IF Q = 3 THEN
1340 PRINT "<27><12>"
1350 DELAY = 1
1360 EXEC IND
1370 EXEC TEGN
1380 ENDIF
1382 IF Q = 4 THEN
1384 EXEC POLYN
1386 EXEC IND
1387 EXEC TEGN
1389 ENDIF
1390 IF Q = 1 THEN GOTO 1210
1400 IF ( Q = 2 ) + ( Q = 3 ) + ( Q = 4 ) THEN GOTO 1140
1410 ENDPROC
1420 PROC START
1430 PRINT "<27>AF"
1440 PRINT "<27><12>"
1450 DELAY = 1
1460 DIM G$ ( 5 )
1470 PRINT
1480 INPUT "ANTAL MAALEPUNKTER =" , N
1490 DIM KO ( 2 , N )
1510 FOR I = 1 TO N STEP 1
1520 PRINT "TALSAET NR " ; I ;
1530 INPUT " X=" , KO ( 1 , I ) , " Y=" , KO ( 2 , I )
1540 NEXT
1910 ON ESC THEN EXEC OUTESC
1920 LET AFBRYD = 1
1930 IF SYS ( 7 ) <> 0 THEN STOP «nul»«nul»
1940 DIM E ( 2 )
1950 ENDPROC
1960 PROC OUTESC
1970 ON ESC THEN EXEC OUTESC
1980 IF AFBRYD THEN
1990 END «nul»
2000 ENDIF
2010 ENDPROC
2020 PROC OUTERR
2030 LET FUNK = 0
2040 IF AFBRYD = 1 THEN GOTO 2070
2050 ON ERR THEN EXEC OUTERR
2060 LET AFBRYD = 3
2070 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 = 0x0000
stack[0] = 0x0000
stack[1] = 0x0000
stack[2] = 0x0000
stack[3] = 0x0000
stack[4] = 0x0000
stack[5] = 0x0000
stack[6] = 0x0000
FOR-NEXT stack pointer = 0x0000
Var# = 0x0000
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 = 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 = 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 = 0 (0x00000000)
Step Val = 0 (0x00000000)
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 0x0000 0x00
0x81 0xffff 0x00 START
0x82 0xffff 0x00 IND
0x83 0xffff 0x00 TEGN
0x84 0xffff 0x00 CHOICE
0x85 0xffff 0x00 A2
0x86 0xffff 0x00 XAKS
0x87 0xffff 0x00 FELT
0x88 0xffff 0x00 A1
0x89 0xffff 0x00 A3
0x8a 0xffff 0x00 A4
0x8b 0xffff 0x00 C1
0x8c 0xffff 0x00 C2
0x8d 0xffff 0x00 C3
0x8e 0xffff 0x00 C4
0x8f 0xffff 0x00 C5
0x90 0xffff 0x00 C6
0x91 0xffff 0x00 X0
0x92 0xffff 0x00 S
0x93 0xffff 0x00 Y0
0x94 0xffff 0x00 YAKS
0x95 0xffff 0x00 Y
0x96 0xffff 0x00 SLUT
0x97 0xffff 0x00 KOORD
0x98 0xffff 0x00 X
0x99 0xffff 0x00 VEC
0x9a 0xffff 0x00 KO
0x9b 0xffff 0x00 XSTEP
0x9c 0xffff 0x00 YSTEP
0x9d 0xffff 0x00 I
0x9e 0xffff 0x00 N
0x9f 0xffff 0x00 CROSS
0xa0 0xffff 0x00 OUTERR
0xa1 0xffff 0x00 AFBRYD
0xa2 0xffff 0x02 G$
0xa3 0xffff 0x00 XKOR
0xa4 0xffff 0x00 YKOR
0xa5 0xffff 0x00 A
0xa6 0xffff 0x00 DX
0xa7 0xffff 0x00 X2
0xa8 0xffff 0x00 X1
0xa9 0xffff 0x00 T
0xaa 0xffff 0x00 Y1
0xab 0xffff 0x00 Y2
0xac 0xffff 0x00 E
0xad 0xffff 0x00 ENH
0xae 0xffff 0x00 D1
0xaf 0xffff 0x00 D2
0xb0 0xffff 0x00 D3
0xb1 0xffff 0x00 D4
0xb2 0xffff 0x00 Q
0xb3 0xffff 0x00 POLYN
0xb4 0xffff 0x00 OUTESC
0xb5 0xffff 0x00 FUNK
.magic = 0x4e32 .u_pas = 0x0688 // Length of UPAS in words .u_das = 0x0176 // Length of UDAS in words .u_dvs = 0x0176 // Start på savede variabel indhold (word adr) .u_nds = 0x0000 // 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)