|
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: 5120 (0x1400) Types: TextFile Names: »B13«
└─⟦6dbcc9c03⟧ Bits:30000463 DOMUS disk image └─⟦this⟧
0010 ON ESC CHAIN "MENUE" 0020 REM PHANTNUM I RC 700 COMAL, FEB 80. 0030 REM COMAL PROGRAM VED ERIK T NIELSEN, TORBEN NIELSEN OG 0040 REM F G KNUDSEN, RISMØLLESKOLEN. L3-2-79. 0050 DIM SVAR$(10),FÆRDIG$(10),BOGSTAV$(10) 0060 DIM TAL(10) 0070 REPEAT 0080 PRINT CHR(12) 0090 PRINT 0100 PRINT 0110 INPUT " INSTRUCTIONS NEEDED (YES/NO) ? ",SVAR$ 0120 IF SVAR$="YES" THEN SVAR$="YES" 0130 IF SVAR$="NO" THEN SVAR$="NO" 0140 UNTIL SVAR$="YES" OR SVAR$="NO" 0150 IF SVAR$="YES" THEN EXEC INSTR 0160 REPEAT 0170 FÆRDIG$=" "; GANG=0 0180 PRINT CHR(12) 0190 EXEC KODE 0200 REPEAT 0210 EXEC IND 0220 UNTIL FÆRDIG$="1111111111" 0230 REPEAT 0240 EXEC CUR(1,21) 0250 PRINT "THERE YOU GO ! "; 0260 INPUT "WOULD YOU LIKE TO TRY AGAIN ? (YES/NO) ? ",SVAR$ 0270 IF SVAR$="YES" THEN SVAR$="YES" 0280 IF SVAR$="NO" THEN SVAR$="NO" 0290 UNTIL SVAR$="YES" OR SVAR$="NO" 0300 UNTIL SVAR$="NO" 0310 CHAIN "MENUE" 0320 END PHANTNUM 0330 REM //----------// 0340 PROC IND 0350 GANG=GANG+1 0360 EXEC PLADS 0370 EXEC CUR(SØJLE,RÆKKE) 0380 PRINT GANG; 0390 SØJLE=SØJLE+4 0400 EXEC CUR(SØJLE,RÆKKE) 0410 INPUT " : ",SVAR$ 0420 SØJLE=SØJLE+8 0430 EXEC CUR(SØJLE,RÆKKE) 0440 OK=1 0450 EXEC TEST 0460 IF OK=0 THEN PRINT "ERROR" 0470 ENDPROC IND 0480 REM //----------// 0490 PROC TEST 0500 IF LEN(SVAR$)>2 THEN 0510 IF SVAR$(2 : 1)="=" THEN 0520 IF SVAR$(3 : 1)>"/" AND SVAR$(3 : 1)<":" THEN 0530 EXEC SVARTAL 0540 ELSE 0550 OK=0 0560 ENDIF 0570 ENDIF 0580 IF SVAR$(2 : 1)="*" OR SVAR$(2 : 1)="+" OR SVAR$(2 : 1)="-" THEN 0590 EXEC UDREGN 0600 ELSE 0610 IF SVAR$(2 : 1)<>"=" THEN OK=0 0620 ENDIF 0630 ELSE 0640 OK=0 0650 ENDIF 0660 ENDPROC TEST 0670 REM //----------// 0680 PROC SVARTAL 0690 IF BOGSTAV$(ORD(SVAR$(3 : 1))-47 : 1)=SVAR$(1 : 1) THEN 0700 PRINT "YES" 0710 EXEC SKEMA 0720 FÆRDIG$(ORD(SVAR$(3 : 1))-47 : 1)="1" 0730 ELSE 0740 PRINT "NO" 0750 ENDIF 0760 ENDPROC SVARTAL 0770 REM //----------// 0780 PROC UDREGN 0790 FOR X=1 TO 3 STEP 2 0800 TAL(X)=-1 0810 FOR Y=1 TO 10 0820 IF SVAR$(X : 1)=BOGSTAV$(Y : 1) THEN TAL(X)=Y-1 0830 NEXT Y 0840 NEXT X 0850 IF TAL(1)=>0 AND TAL(3)=>0 THEN 0860 IF SVAR$(2 : 1)="*" THEN FACIT=TAL(1)*TAL(3) 0870 IF SVAR$(2 : 1)="+" THEN FACIT=TAL(1)+TAL(3) 0880 IF SVAR$(2 : 1)="-" THEN 0890 FACIT=TAL(1)-TAL(3) 0900 IF FACIT<0 THEN FACIT=FACIT+10 0910 ENDIF 0920 FACIT=FACIT-10*INT(FACIT/10) 0930 PRINT BOGSTAV$(FACIT+1 : 1) 0940 ELSE 0950 OK=0 0960 ENDIF 0970 ENDPROC UDREGN 0980 REM //----------// 0990 PROC KODE 1000 RANDOMIZE 1010 BOGSTAV$=" " 1020 X=1 1030 REPEAT 1040 T=INT(RND(0)*10+1) 1050 IF BOGSTAV$(T : 1)=" " THEN 1060 BOGSTAV$(T : 1)=CHR(X+96); X=X+1 1070 ENDIF 1080 UNTIL X=11 1090 ENDPROC KODE 1100 REM //----------// 1110 PROC INSTR 1120 PRINT CHR(12) 1130 PRINT 1140 PRINT 1150 PRINT "THIS PROGRAM GIVES YOU A TEST, CALLED PHANTNUM." 1160 PRINT 1170 PRINT "THE PROGRAM GIVES THE LETTERS A B C D E F G H I J " 1180 PRINT "GIVEN THE VALUE FROM 0 TO 9, BUT IN A RANDOM SEQUENCE." 1190 PRINT 1200 PRINT "YOUR JOB IS NOW TO FIND EACH LETTERS VALUE BY ASKING" 1210 PRINT "QUESTIONS LIKE THE FOLLOWING : A+B, A-B, A*B OR A=6." 1220 PRINT 1230 PRINT "THE ANSWER ON THE LAST KIND OF QUESTION WILL BE YES OR " 1240 PRINT "NO, WHILE THE ANSWER ON THE OTHER QUESTIONS, WILL BE THE LET-" 1250 PRINT "TER WHICH IS THE LAST DIGIT IN THE RESULT." 1260 PRINT "IF THE RESULT IS NEGARTIVE, THERE WILL ADDED 10 TO THE RESULT" 1270 PRINT "BEFORE THE ANSWER IS GIVEN." 1280 PRINT 1290 PRINT "TYPE"; CHR(128+2+16); "'SPACEBAR'"; CHR(128); 1300 PRINT "TO START."; CHR(26) 1310 REPEAT 1320 IN 16,X 1330 UNTIL X=32 1340 PRINT CHR(12) 1350 ENDPROC INSTR 1360 REM //----------// 1370 PROC PLADS 1380 RÆKKE=GANG; SØJLE=3; KONTROL=GANG 1390 WHILE KONTROL>20 DO 1400 KONTROL=KONTROL-20; RÆKKE=KONTROL; SØJLE=SØJLE+20 1410 ENDWHILE 1420 ENDPROC 1430 REM //----------// 1440 PROC CUR(HEN,NED) 1450 PRINT CHR(6); 1460 PRINT CHR(95+HEN-(HEN>32)*64-(HEN>64)*64); 1470 PRINT CHR(95+NED-(NED>32)*64-(NED>64)*64); 1480 ENDPROC 1490 REM //----------// 1500 PROC SKEMA 1510 EXEC CUR(6,22) 1520 PRINT "A B C D E F G H I J" 1530 INDRYK=(ORD(SVAR$(1 : 1))-96)*3+3 1540 EXEC CUR(INDRYK,23) 1550 PRINT SVAR$(3 : 1) 1560 ENDPROC SKEMA 1570 REM //----------// 1580 CHAIN "MENUE" «eof»