|
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: 13824 (0x3600)
Types: TextFile
Names: »B18«
└─⟦6dbcc9c03⟧ Bits:30000463 DOMUS disk image
└─⟦this⟧ »/B18«
0010 ON ESC CHAIN "MENUE"
0020 REM RUMKRIG, FGK 28/12/80.
0030 REM EFTER COMPUTING TODAY, OKT 1980.
0040 DIM SVAR$(3),KOM$(1),SKIB$(1),PARTI$(4),TYPE$(18)
0050 DIM X(20),Y(20),G(20),E(20),B(20),SLAGM$(31,33)
0060 RANDOMIZE
0070 DEF FNR(Z5)=INT(Z5*RND(0))
0080 REPEAT
0090 REPEAT
0100 PRINT CHR(12); "WOULD YOU LIKE TO SEE THE RULES (YES/NO) : ";
0110 INPUT SVAR$
0120 IF SVAR$="Y" OR SVAR$="YES" OR SVAR$="Y" THEN SVAR$="YES"
0130 IF SVAR$="N" OR SVAR$="NO" OR SVAR$="N" THEN SVAR$="NO"
0140 UNTIL SVAR$="YES" OR SVAR$="NO"
0150 IF SVAR$="YES" THEN EXEC REGLER
0160 PRINT CHR(12)
0170 EXEC START
0180 EXEC DISPLAY
0190 REPEAT
0200 EXEC AFVIKLING
0210 UNTIL W9=0 OR B9=0
0220 REPEAT
0230 INPUT "NEW ROUND (YES/NO) : ",SVAR$
0240 IF SVAR$="Y" OR SVAR$="Y" OR SVAR$="YES" THEN SVAR$="YES"
0250 IF SVAR$="N" OR SVAR$="N" OR SVAR$="NO" THEN SVAR$="NO"
0260 UNTIL SVAR$="YES" OR SVAR$="NO"
0270 UNTIL SVAR$="NO"
0280 END RUMKRIG
0290 REM //----------//
0300 PROC START
0310 TYPE$="ABCD><123WXYZ*#789"; TRUE=1; FALSE=0
0320 N=18; B9,W9=N/2; W=INT(RND(0)*2)
0330 SLAGM$(1)="000000000000000000000000000000000"
0340 FOR I=1 TO 31
0350 SLAGM$(I)=SLAGM$(1)
0360 NEXT I
0370 FOR I=1 TO INT(N/2)
0380 REPEAT
0390 X(I)=R(10-I+4); G(I)=1
0400 Y(I)=R(10-I+4); E(I)=500; B(I)=0
0410 UNTIL SLAGM$(X(I)+1,Y(I)+2 : 1)="0"
0420 EXEC SMARK(X(I),Y(I),1)
0430 IF I>4 THEN E(I)=300
0440 IF I>6 THEN B(I)=3
0450 NEXT I
0460 FOR I=INT(N/2)+1 TO N
0470 REPEAT
0480 X(I)=R(I/2)+22; G(I)=1
0490 Y(I)=R(I/1.5)+I; E(I)=500; B(I)=0
0500 UNTIL SLAGM$(X(I)+1,Y(I)+2 : 1)="0"
0510 EXEC SMARK(X(I),Y(I),1)
0520 IF I>INT(N/2)+4 THEN E(I)=300
0530 IF I>INT(N/2)+6 THEN B(I)=3
0540 NEXT I
0550 ENDPROC START
0560 REM //----------//
0570 PROC DISPLAY
0580 EXEC RAMME
0590 FOR I=1 TO N
0600 IF G(I)<>0 THEN EXEC TEGN(I,FALSE)
0610 NEXT I
0620 ENDPROC DISPLAY
0630 REM //----------//
0640 PROC AFVIKLING
0650 REPEAT
0660 IF W=1 THEN
0670 PARTI$="WHITE"; P=1; Q=INT(N/2)
0680 ELSE
0690 PARTI$="BLACK"; P=INT(N/2)+1; Q=N
0700 ENDIF
0710 EXEC CUR(1,20)
0720 PRINT CHR(31); PARTI$;
0730 INPUT "! WHICH SPACECRAFT : ",KOM$
0740 B1=0
0750 FOR I=P TO Q
0760 IF TYPE$(I : 1)=KOM$ AND G(I)=1 THEN A=I; B1=1
0770 NEXT I
0780 UNTIL B1=1
0790 INPUT "COMMAND : ",KOM$
0800 IF KOM$="M" OR KOM$="M" THEN EXEC FLYTTE
0810 IF KOM$="R" OR KOM$="R" THEN
0820 EXEC REGLER
0830 W=1-(W=1)
0840 EXEC DISPLAY
0850 ENDIF
0860 IF KOM$="L" OR KOM$="L" THEN EXEC LASER
0870 IF KOM$="S" OR KOM$="S" THEN EXEC STATUS
0880 IF KOM$="B" OR KOM$="B" THEN EXEC BOMBE
0890 IF W9=0 OR B9=0 THEN EXEC SEJR
0900 W=1-(W=1)
0910 ENDPROC AFVIKLING
0920 REM //----------//
0930 PROC FLYTTE
0940 FOR D1=1 TO 2
0950 IF D1=1 THEN
0960 EXEC FLYT1
0970 ELSE
0980 IF W9*B9<>0 THEN
0990 REPEAT
1000 EXEC CUR(1,20)
1010 PRINT CHR(31);
1020 INPUT "DO YOU WISH TO MOVE ANOTHER SPACECRAFT (YES/NO) : ",SVAR$
1030 IF SVAR$="Y" OR SVAR$="Y" OR SVAR$="YES" THEN SVAR$="YES"
1040 IF SVAR$="N" OR SVAR$="N" OR SVAR$="NO" THEN SVAR$="NO"
1050 UNTIL SVAR$="YES" OR SVAR$="NO"
1060 IF SVAR$="YES" THEN EXEC FLYT2
1070 ENDIF
1080 ENDIF
1090 NEXT D1
1100 ENDPROC FLYTTE
1110 REM //----------//
1120 PROC FLYT1
1130 REPEAT
1140 VIDERE=FALSE
1150 EXEC CUR(1,21)
1160 INPUT "VECTORS (X Y) : ",S1,S2
1170 R1=SQR(S1*S1+S2*S2); B1=6
1180 IF A<P+6 THEN B1=10
1190 IF A<P+4 THEN B1=8
1200 IF R1>B1 THEN
1210 EXEC CUR(1,22)
1220 PRINT CHR(31);
1230 PRINT "OUT OF REACH!"
1240 ELSE
1250 IF B1=10 THEN B1=20
1260 IF E(A)-R1*(18-B1)<=0 THEN
1270 PRINT "THE ENERGY IS ONLY"; E(A); "TERA-JOULES!"
1280 ELSE
1290 VIDERE=TRUE
1300 ENDIF
1310 ENDIF
1320 UNTIL VIDERE=TRUE
1330 EXEC VISKUD(A)
1340 X(A)=X(A)+S1; Y(A)=Y(A)+S2
1350 IF X(A)<0 OR X(A)>30 OR Y(A)<0 OR Y(A)>30 THEN
1360 EXEC CUR(50,20)
1370 PRINT TYPE$(A : 1); " IS LOST IN OUTER SPACE!"
1380 EXEC PAUSE
1390 G(A)=0; W9=W9-(W=1); B9=B9-(W=0)
1400 ELSE
1410 EXEC TEGN(A,TRUE)
1420 E(A)=E(A)-R1*(21-B1)
1430 ENDIF
1440 ENDPROC FLYT1
1450 REM //----------//
1460 PROC FLYT2
1470 REPEAT
1480 B1=0
1490 EXEC CUR(1,20)
1500 PRINT CHR(31);
1510 INPUT "WHICH SPACECRAFT : ",SKIB$
1520 FOR I=P TO Q
1530 IF TYPE$(I : 1)=SKIB$ AND G(I)=1 THEN B1=I; I=Q
1540 NEXT I
1550 UNTIL B1<>0
1560 IF B1=A THEN
1570 PRINT "THIS SPACECRAFT HAS JUST BEEN MOVED!"
1580 EXEC PAUSE
1590 ELSE
1600 A=B1
1610 EXEC FLYT1
1620 ENDIF
1630 ENDPROC FLYT2
1640 REM //----------//
1650 PROC LASER
1660 IF A<P+6 THEN
1670 REPEAT
1680 REPEAT
1690 EXEC CUR(1,20)
1700 PRINT CHR(31);
1710 C=0
1720 INPUT "WHICH SPACECRAFT IS THE TARGET : ",SKIB$
1730 FOR I=1 TO N
1740 IF TYPE$(I : 1)=SKIB$ AND G(I)=1 THEN C=I; I=N
1750 NEXT I
1760 UNTIL C>0
1770 UNTIL G(C)<>0
1780 R1=SQR((X(A)-X(C))*(X(A)-X(C))+(Y(A)-Y(C))*(Y(A)-Y(C)))
1790 IF R1>12 THEN
1800 PRINT "OUT OF REACH!"
1810 ELSE
1820 PRINT "DISTANCE"; R1; ". ";
1830 INPUT "LASER-ENERGY : ",P8
1840 IF E(A)-P8<0 THEN
1850 PRINT "THE AVAILABLE ENERGY IS ONLY"; E(A); "TERA-JOULES!"
1860 ELSE
1870 EXEC LASERRESULTAT
1880 ENDIF
1890 ENDIF
1900 ELSE
1910 PRINT "NO LASER ON FIGHTERS!"
1920 ENDIF
1930 EXEC PAUSE
1940 ENDPROC LASER
1950 REM //----------//
1960 PROC LASERRESULTAT
1970 P7=(P8/((R1*.7)+.05))*(200/(E(C)+1))
1980 E(A)=E(A)-P8; FTAB=TRUE
1990 IF R(P7)<17 THEN
2000 FTAB=FALSE
2010 PRINT "LASERBEAM DEFLECTED!"
2020 L=R(5*P8/((R1*.8)+.05))+INT(100/((R1*.5)+1))
2030 PRINT "ENERGYLOSS FOR THE TARGET:"; L; "TERAJOULES!"
2040 E(C)=E(C)-L
2050 IF E(C)<=0 THEN FTAB=TRUE
2060 ENDIF
2070 IF FTAB=TRUE THEN EXEC TAB(C)
2080 ENDPROC LASERRESULTAT
2090 REM //----------//
2100 PROC STATUS
2110 PRINT CHR(12)
2120 PRINT " "; PARTI$; " FLEET STATUS."
2130 PRINT " "; "_______________________"
2140 PRINT
2150 PRINT "SPACECRAFT","POSITION","ENERGY","BOMBS"
2160 PRINT "__________","________","______","_____"
2170 PRINT
2180 FOR I=P TO Q
2190 IF I=P THEN PRINT "BATTLESHIP"
2200 IF I=P+4 THEN PRINT "CRUISER"
2210 IF I=P+6 THEN PRINT "FIGHTER"
2220 IF G(I)>0 THEN
2230 PRINT TYPE$(I : 1),X(I); Y(I),E(I),B(I)
2240 ELSE
2250 PRINT TYPE$(I : 1); " DESTROYED!"
2260 ENDIF
2270 NEXT I
2280 PRINT
2290 PRINT
2300 EXEC PAUSE
2310 IF W9<>0 AND B9<>0 THEN
2320 EXEC DISPLAY
2330 ENDIF
2340 ENDPROC STATUS
2350 REM //----------//
2360 PROC BOMBE
2370 IF B(A)>0 THEN
2380 EXEC CUR(1,20)
2390 PRINT CHR(31);
2400 INPUT "TARGET AREA (X Y) : ",S1,S2
2410 R1=SQR((X(A)-S1)*(X(A)-S1)+(Y(A)-S2)*(Y(A)-S2))
2420 IF R1=0 THEN R1=1E-10
2430 S1=S1-X(A); S2=S2-Y(A)
2440 PRINT "ESTIMATED TIME TILL THE TARGET IS"; R1/2; "SEK."
2450 INPUT "TYPE FIRE TO FIRE THE BOMB : ",KOM$
2460 IF KOM$="F" OR KOM$="F" THEN EXEC BFLUGT
2470 ELSE
2480 PRINT "NO BOMBS ON THE SPACECRAFT!"
2490 EXEC PAUSE
2500 ENDIF
2510 ENDPROC BOMBE
2520 REM //----------//
2530 PROC BFLUGT
2540 PRINT "TYPE D-KEY, TO DETONATE THE BOMB!"
2550 I=1
2560 REPEAT
2570 I=I+1
2580 IN 16,TAST
2590 UNTIL TAST=ORD("D") OR TAST=ORD("D")
2600 R2=I/43
2610 S1=INT(S1*(R2/R1)); S2=INT(S2*(R2/R1))
2620 S1=S1+X(A); S2=S2+Y(A); B(A)=B(A)-1
2630 EXEC CUR(1,21)
2640 PRINT CHR(31);
2650 PRINT "THE CENTER OF THE EXPLOSION IS :"; S1; S2; CHR(7)
2660 F=0
2670 FOR I=1 TO N
2680 IF G(I)<>0 THEN
2690 B1=SQR((X(I)-S1)*(X(I)-S1)+(Y(I)-S2)*(Y(I)-S2))
2700 IF B1<=2.25 THEN
2710 F=1
2720 IF R(10*B1)>4.5 THEN
2730 EXEC CUR(50,20)
2740 PRINT "SPACECRAFT "; TYPE$(I : 1); " IS IN FIRE!"
2750 L=R(225/(B1+.05))
2760 EXEC CUR(50,21)
2770 PRINT "ENERGYLOSS ON"; L; "TERAJOULES!"
2780 EXEC PAUSE
2790 E(I)=E(I)-L
2800 IF E(I)<0 THEN EXEC TAB(I)
2810 ELSE
2820 EXEC TAB(I)
2830 ENDIF
2840 ENDIF
2850 ENDIF
2860 NEXT I
2870 IF F=0 THEN
2880 PRINT "NO SPACECRAFTS INSIDE THE REACH OF EXPLOSION !!!!"
2890 EXEC PAUSE
2900 ENDIF
2910 ENDPROC BFLUGT
2920 REM //----------//
2930 PROC TAB(UD)
2940 EXEC CUR(1,1)
2950 PRINT CHR(130)
2960 FOR TTID=1 TO 300
2970 NEXT TTID
2980 EXEC CUR(1,1)
2990 PRINT CHR(128)
3000 EXEC CUR(50,20)
3010 PRINT "SPACECRAFT "; TYPE$(UD : 1); " IS DESTROYED !"
3020 EXEC CUR(50,21)
3030 PRINT CHR(30)
3040 G(UD)=0
3050 EXEC VISKUD(UD)
3060 IF UD>INT(N/2) THEN B9=B9-1
3070 IF UD<=INT(N/2) THEN W9=W9-1
3080 EXEC PAUSE
3090 ENDPROC TAB
3100 REM //----------//
3110 PROC SEJR
3120 PRINT CHR(12)
3130 PARTI$="WHITE"; P=1; Q=INT(N/2)
3140 IF W9=0 THEN PARTI$="BLACK"; P=INT(N/2)+1; Q=N
3150 PRINT " VICTORY FOR "; PARTI$; "!"
3160 FOR I=1 TO 10
3170 PRINT CHR(7);
3180 NEXT I
3190 PRINT
3200 REPEAT
3210 INPUT "DO YOU WISH TO SEE YOUR STATUS (YES/NO) : ",SVAR$
3220 IF SVAR$="Y" OR SVAR$="Y" OR SVAR$="YES" THEN SVAR$="YES"
3230 IF SVAR$="N" OR SVAR$="N" OR SVAR$="NO" THEN SVAR$="NO"
3240 UNTIL SVAR$="YES" OR SVAR$="NO"
3250 IF SVAR$="YES" THEN EXEC STATUS
3260 ENDPROC SEJR
3270 REM //----------//
3280 PROC PAUSE
3290 EXEC CUR(60,23)
3300 PRINT CHR(134);
3310 PRINT "PRESS RETURN "; CHR(128);
3320 INPUT SVAR$
3330 EXEC CUR(60,24)
3340 PRINT CHR(128); " "
3350 ENDPROC PAUSE
3360 REM //-----------//
3370 PROC SMARK(Æ9,Ø9,MÆRKE)
3380 FOR PLADSER=1 TO 3
3390 SLAGM$(Æ9+1,Ø9+PLADSER : 1)=CHR(48+MÆRKE)
3400 NEXT PLADSER
3410 ENDPROC SMARK
3420 PROC RAMME
3430 PRINT CHR(12)
3440 EXEC CUR(1,1)
3450 PRINT " 0 2 4 6 8 10 12 14";
3460 PRINT " 16 18 20 22 24 26 28 30"
3470 FOR J=0 TO 15
3480 EXEC CUR(1,J+2)
3490 PRINT 2*J
3500 EXEC CUR(65,J+2)
3510 PRINT 2*J
3520 NEXT J
3530 PRINT " 0 2 4 6 8 10 12 14";
3540 PRINT " 16 18 20 22 24 26 28 30"
3550 ENDPROC RAMME
3560 REM //----------//
3570 PROC VISKUD(GL)
3580 EXEC CUR(X(GL)*2+5,Y(GL)/2+2)
3590 PRINT " "
3600 EXEC SMARK(X(GL),Y(GL),0)
3610 FOR PL=1 TO N
3620 IF G(PL)=1 THEN EXEC SMARK(X(PL),Y(PL),1)
3630 NEXT PL
3640 ENDPROC VISKUD
3650 REM //-----------//
3660 PROC TEGN(NY,SKTR)
3670 IF SKTR=TRUE THEN
3680 REPEAT
3690 IF SLAGM$(X(NY)+1,Y(NY)+2 : 1)="1" THEN
3700 IF X(NY)<15 THEN
3710 X(NY)=X(NY)+1
3720 ELSE
3730 X(NY)=X(NY)-1
3740 ENDIF
3750 ENDIF
3760 UNTIL SLAGM$(X(NY)+1,Y(NY)+2 : 1)="0"
3770 EXEC SMARK(X(NY),Y(NY),1)
3780 ENDIF
3790 EXEC CUR(X(NY)*2+5,Y(NY)/2+2)
3800 PRINT TYPE$(NY : 1)
3810 ENDPROC TEGN
3820 REM //----------//
3830 PROC CUR(Æ,Ø)
3840 PRINT CHR(6); CHR(Æ+95-(Æ>32)*64-(Æ>64)*64); CHR(Ø+95);
3850 ENDPROC CUR
3860 REM //----------//
3870 PROC REGLER
3880 PRINT CHR(12)
3890 PRINT "YOU ARE THE COMMANDER OF A FLEET OF SPACECRAFTS !"
3900 PRINT
3910 PRINT "POSSIBLE COMMANDS ARE : MOVE LASER STATUS BOMB RULES"
3920 PRINT " ---- ----- ------ ---- -----"
3930 PRINT "COMMANDS ARE GIVEN BY TYPING THE FIRST LETTER (M/L/S/B/R) "
3940 PRINT "YOU CAN MOVE 2 SPACECRAFTS OR ATTACK FROM 1 SPACECRAFT"
3950 PRINT
3960 PRINT "BLACK AND WHITE TAKE TURNS TO EITHER MOVE OR ATTACK."
3970 PRINT
3980 PRINT "SPACECRAFTS","MAX. MOVEMENT","ENERGY-STORAGE"," BOMBS ","LASER"
3990 PRINT "-----------","-------------","--------------"," ----- ","-----"
4000 PRINT "BATTLESHIP "," 8 UNITS ","500 TERA-JOULES"," NONE ","YES"
4010 PRINT "(A,B,C,D,W,X,Y,Z)"
4020 PRINT "KRYDSER ","10 UNITS ","300 TERA-JOULES"," NONE ","YES"
4030 PRINT "(<,>,*,#)"
4040 PRINT "FIGHTER "," 6 UNITS ","300 TERA-JOULES"," 3 PCS","NONE"
4050 PRINT "(1,2,3,7,8,9)"
4060 PRINT
4070 PRINT "ENERGY CONSUMPSTION FOR MOVEMENT IS: FIGHTER>BATTLESHIP>CRUISER"
4080 PRINT
4090 PRINT "REACH OF LASER IS 12 UNITS. REACH OF BOMBS IS UNLIMMITED !"
4100 EXEC PAUSE
4110 ENDPROC REGLER
4120 REM //----------//
▶03◀«nul»