|
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: 17408 (0x4400)
Types: TextFile
Names: »B23«
└─⟦6dbcc9c03⟧ Bits:30000463 DOMUS disk image
└─⟦this⟧
0010 REM ********************************************************************* ▶08◀▶08◀▶08◀▶08◀▶08◀ 0020 REM ********************************************************************* ▶08◀▶08◀▶08◀▶08◀▶08◀ 0030 REM ** ** ▶08◀▶08◀▶08◀▶08◀▶08◀ 0040 REM ** PROGRAM NAME: SCOREUP. ** ▶08◀▶08◀▶08◀▶08◀▶08◀ 0050 REM ** VERSION: 81.11.01. ** ▶08◀▶08◀▶08◀▶08◀▶08◀ 0060 REM ** ** ▶08◀▶08◀▶08◀▶08◀▶08◀ 0070 REM ** THE PROGRAM LISTS ON DISPLAY AND/OR PRINTER THE CONTENTS OF THE ** 0080 REM ** FILE "SCORE" (SCORE-TABLE FOR GAME "XANDO"). ** 0090 REM ** THE PROGRAM CAN ALSO PERFORM SELECTIVE UPDATING OF THE "SCORE" ** 0100 REM ** FILE. ** 0110 REM ** ** ▶08◀▶08◀▶08◀▶08◀▶08◀ 0120 REM ** THIS PROGRAM WAS CREATED BY BQRGE E. LARSEN, RC COMPUTER. ** ▶08◀▶08◀▶08◀▶08◀▶08◀ 0130 REM ** ** 0140 REM ********************************************************************* 0150 REM ********************************************************************* ▶08◀▶08◀▶08◀▶08◀▶08◀ 0160 REM 0170 REM 0180 NUL=0 0190 DIM BUF$(128),BBUF$(128),INIT$(5),BINIT$(5),UPDINIT$(5),PAS$(5),BPAS$(5) 0200 DIM NEWPAS$(5) 0210 ON ESC STOP 0220 REPEAT 0230 EXEC MENU(S) 0240 IF S=49 OR S=50 THEN EXEC LIST(S) 0250 REM ..1.......2..... 0260 IF S=51 OR S=52 THEN EXEC UPDAT(S) 0270 REM ..3.......4..... 0280 IF S=53 OR S=54 THEN EXEC SCORMOD(S) 0290 REM ..5.......6.... 0300 UNTIL S=55 OR S=81 OR S=113 0310 REM .....7......'Q'.....'Q'..... 0320 PRINT CHR(12) 0330 STOP 0340 REM ____________________________________________________________________ 0350 REM 0360 PROC MENU(SS) 0370 PRINT CHR(12) 0380 EXEC YX(2,37) 0390 PRINT "MENU" 0400 EXEC YX(3,37) 0410 PRINT "====" 0420 EXEC YX(6,1) 0430 PRINT "1: LISTING OF MEMBERS IN SCORE-TABLE." 0440 PRINT 0450 PRINT "2: LISTING WITH PRINTING OF MEMBERS IN SCORE-TABLE." 0460 PRINT 0470 PRINT "3: INSERTION, UPDATING OR DELETION OF SELECTED MEMBERS." 0480 PRINT 0490 PRINT "4: LISTING, UPDATING OR DELETION, MEMBER BY MEMBER." 0500 PRINT 0510 PRINT "5: CREATION OF NEW (EMPTY) SCORE-TABLE." 0520 PRINT 0530 PRINT "6: CHANGE LENGHT OF EXISTING SCORE-TABLE." 0540 PRINT 0550 PRINT "7: EXIT FROM THE PROGRAM." 0560 PRINT 0570 PRINT 0580 PRINT "KEY IN THE NUMBER OF THE SELECTED OPERATION: " 0590 EXEC YX(21,47) 0600 S=KEY(0) 0610 ENDPROC MENU 0620 REM ____________________________________________________________________ 0630 REM 0640 REM PROCEDURE LIST FOR LISTING AND/OR PRINTING OF MEMBERS OF SCORE-TABLE. ▶08◀▶08◀▶08◀▶08◀▶08◀ 0650 REM 0660 PROC LIST(SS) 0670 OPEN "SCORE",F,BUF$,22 0680 REPEAT 0690 REPEAT 0700 PRINT CHR(12) 0710 EXEC YX(8,1) 0720 PRINT "TO LIST, PRESS DOWN THE SPACE BAR." 0730 PRINT 0740 PRINT 0750 PRINT "TO EXIT, KEY IN 'Q'." 0760 EXEC YX(16,1) 0770 PRINT "ENTER YOUR COMMAND: " 0780 EXEC YX(16,22) 0790 Y=KEY(0) 0800 UNTIL Y=32 OR Y=81 OR Y=113 0810 REM ...<SP>.....'Q'.....'Q'... 0820 IF Y=32 THEN 0830 I=1; J=4 0840 IF SS=50 THEN EXEC INITPRT 0850 PRINT CHR(12) 0860 EXEC YX(1,10) 0870 PRINT "INITIALS: PASSWORD: GAMES: WON: LOST:" 0880 EXEC YX(2,10) 0890 PRINT "========= ========= ====== ==== =====" 0900 REPEAT 0910 GET F,I : INIT$,PAS$,GAMES,WON,LOST 0920 EXEC YX(J,12) 0930 PRINT INIT$; TAB(12); PAS$; TAB(22); 0940 PRINT USING "#### #### ####" : GAMES,LOST,WON 0950 J=J+(J<24)*1 0960 IF J=24 THEN 0970 J=J-1 0980 PRINT CHR(10) 0990 EXEC YX(1,10) 1000 PRINT "INITIALS: PASSWORD: GAMES: WON: LOST:" 1010 EXEC YX(2,10) 1020 PRINT "========= ========= ====== ==== =====" 1030 ENDIF 1040 IF SS=50 THEN 1050 OUTPUT P 1060 PRINT TAB(12); INIT$; TAB(24); PAS$; TAB(34); 1070 PRINT USING "#### #### ####" : GAMES,LOST,WON 1080 OUTPUT C 1090 ENDIF 1100 I=I+1 1110 Z=KEY(0) 1120 UNTIL Z<>32 OR INIT$="XXXXX" 1130 PRINT TAB(9); "=============================================" 1140 IF SS=50 THEN 1150 OUTPUT P 1160 PRINT 1170 PRINT TAB(10); "=============================================" 1180 OUTPUT C 1190 ENDIF 1200 ENDIF 1210 UNTIL Y=81 OR Y=113 1220 CLOSE F 1230 ENDPROC LIST 1240 REM ____________________________________________________________________ 1250 REM 1260 REM PROCEDURE UPDAT FOR UPDATING OF ONE OR MORE MEMBERS OF 1270 REM SCORE-TABLE. 1280 REM 1290 PROC UPDAT(SS) 1300 SIZEFLAG=0 1310 OPEN "SCORE",F,BUF$,22 1320 IF SS=51 THEN 1330 PRINT CHR(12) 1340 EXEC YX(3,22) 1350 PRINT "UPDATING OR INSERTION OF MEMBER(S)." 1360 EXEC YX(4,22) 1370 PRINT "===================================" 1380 LOOP 1390 REPEAT 1400 EXEC YX(7,0) 1410 PRINT CHR(31) 1420 EXEC YX(10,1) 1430 PRINT "SELECT FUNCTION:" 1440 PRINT 1450 PRINT " 'SPACE': UPDATE OR DELETE MEMBER." 1460 PRINT 1470 PRINT " I : INSERT NEW MEMBER." 1480 PRINT 1490 PRINT " Q : EXIT." 1500 PRINT 1510 PRINT 1520 PRINT "INPUT THE SELECTED FUNCTION CODE: " 1530 EXEC YX(19,35) 1540 Y=KEY(0) 1550 UNTIL Y=32 OR Y=73 OR Y=105 OR Y=81 OR Y=113 1560 REM ...'SP'....'I'......'I'.....'Q'......'Q'.... 1570 IF Y=81 OR Y=113 THEN EXIT 1580 EXEC YX(6,2) 1590 REPEAT 1600 PRINT CHR(31) 1610 EXEC YX(12,2) 1620 PRINT "INPUT INITIALS FOR THE MEMBER" 1630 INPUT " WHICH IS TO BE UPDATED, DELETED OR INSERTED: ",UPDINIT$ 1640 IF UPDINIT$="XXXXX" THEN 1650 EXEC YX(8,10) 1660 PRINT "'XXXXX' NOT ALLOWED AS INITIALS!!!" 1670 ENDIF 1680 UNTIL UPDINIT$<>"XXXXX" 1690 IGET=0; IPUT=0 1700 REPEAT 1710 IGET=IGET+1; IPUT=IPUT+1 1720 GET F,IGET : INIT$,PAS$,GAMES,WON,LOST 1730 UNTIL INIT$=UPDINIT$ OR INIT$="XXXXX" 1740 IF INIT$="XXXXX" THEN 1750 IF Y=73 OR Y=105 THEN 1760 SIZEFLAG=((IGET+1)>GAMES+1) 1770 IF SIZEFLAG=1 THEN 1780 EXEC YX(7,0) 1790 PRINT CHR(31) 1800 EXEC YX(10,10) 1810 PRINT "NO MORE SPACE IN SCORE-TABLE!!!!" 1820 EXEC YX(12,10) 1830 PRINT "BEFORE INSERTION OF NEW MEMBER," 1840 EXEC YX(13,10) 1850 PRINT "THE LENGHT OF SCORE-TABLE SHOULD BE EXTENDED." 1860 EXEC YX(15,10) 1870 PRINT "THE PRESENT LENGHT OF SCORE-TABLE IS"; GAMES; "MEMBERS." 1880 EXEC YX(20,5) 1890 PRINT "TO GET A NEW MENU, PRESS ANY KEY: " 1900 EXEC YX(20,39) 1910 Y=KEY(0) 1920 EXIT 1930 ENDIF 1940 REPEAT 1950 EXEC YX(7,1) 1960 PRINT CHR(31) 1970 PRINT "INSERT NEW MEMBER '"; UPDINIT$; "' ? (Y/N): " 1980 EXEC YX(8,35) 1990 Z=KEY(0) 2000 UNTIL Z=89 OR Z=121 OR Z=78 OR Z=110 2010 REM ...'Y'......'Y'.....'N'......'N'..... 2020 IF Z=78 OR Z=110 THEN EXIT 2030 EXEC YX(12,1) 2040 INPUT "INPUT PASSWORD FOR NEW MEMBER: ",NEWPAS$ 2050 EXEC INSERTNEW 2060 ELSE 2070 EXEC YX(6,2) 2080 IF UPDINIT$<>"XXXXX" THEN PRINT "MEMBER NOT FOUND!!!" 2090 ENDIF 2100 IF SIZEFLAG=1 THEN EXIT 2110 ELSE 2120 EXEC UPDMEMB(IGET,IPUT,SS) 2130 ENDIF 2140 IF SIZEFLAG=1 THEN EXIT 2150 EXEC YX(6,0) 2160 PRINT CHR(31) 2170 ENDLOOP 2180 ELSE 2190 PRINT CHR(12) 2200 EXEC YX(2,30) 2210 PRINT "UPDATE MEMBER" 2220 EXEC YX(3,30) 2230 PRINT "=============" 2240 IGET=1; IPUT=1 2250 REPEAT 2260 GET F,IGET : INIT$,PAS$,GAMES,WON,LOST 2270 IF INIT$="XXXXX" THEN 2280 PUT F,IPUT : INIT$,PAS$,GAMES,WON,LOST 2290 SS=0 2300 EXEC UPDMEMB(0,0,SS) 2310 PRINT 2320 ELSE 2330 EXEC UPDMEMB(IGET,IPUT,SS) 2340 IGET=IGET+1; IPUT=IPUT+1 2350 ENDIF 2360 UNTIL INIT$="XXXXX" 2370 ENDIF 2380 CLOSE F 2390 ENDPROC UPDAT 2400 REM ____________________________________________________________________ 2410 REM 2420 REM PROCEDURE UPDMEMB FOR UPDATING OF A SELECTED MEMBER. 2430 REM 2440 PROC UPDMEMB(IIGET,IIPUT,SSS) 2450 EXEC YX(4,0) 2460 PRINT CHR(31) 2470 EXEC YX(7,1) 2480 PRINT "MEMBER DATA:" 2490 EXEC YX(9,10) 2500 PRINT "INITIALS: PASSWORD: GAMES: WON: LOST:" 2510 EXEC YX(10,10) 2520 PRINT "========= ========= ====== ==== =====" 2530 PRINT 2540 PRINT TAB(11); INIT$; TAB(23); PAS$; TAB(33); 2550 PRINT USING "#### #### ####" : GAMES,LOST,WON 2560 PRINT 2570 IF SSS=0 AND IGET=1 THEN 2580 PRINT 2590 PRINT 2600 PRINT 2610 PRINT "NO MEMBERS IN SCORE-TABLE" 2620 PRINT " (- EXCEPT FOR THE SYSTEM RECORD XXXXX) !!!" 2630 PRINT 2640 PRINT 2650 PRINT "- TO GET THE MENU, PRESS ANY KEY." 2660 Y=KEY(0) 2670 ENDIF 2680 IF SSS=0 THEN EXIT 2690 PRINT 2700 PRINT "PLEASE SELECT OPERATION: " 2710 PRINT 2720 PRINT " 'SPACE': NO CHANGE OF MEMBER DATA." 2730 PRINT 2740 PRINT " 'D' : DELETE MEMBER." 2750 PRINT 2760 PRINT " 'P' : CHANGE PASSWORD." 2770 REPEAT 2780 EXEC YX(23,2) 2790 PRINT "OPERATION: " 2800 EXEC YX(23,15) 2810 Y=KEY(0) 2820 UNTIL Y=32 OR Y=68 OR Y=100 OR Y=80 OR Y=112 2830 REM ..."SP"...."D"......"D"....."P"......"P".... 2840 IF Y=80 OR Y=112 THEN 2850 EXEC YX(12,1) 2860 PRINT CHR(31) 2870 EXEC YX(17,1) 2880 INPUT "KEY IN NEW PASSWORD (MAX. 5 CHAR.): ",PAS$ 2890 PUT F,IIPUT : INIT$,PAS$,GAMES,WON,LOST 2900 ENDIF 2910 IF Y=68 OR Y=100 THEN 2920 IIPUT=IIPUT-1 2930 IF SSS=51 THEN 2940 REPEAT 2950 IIGET=IIGET+1; IIPUT=IIPUT+1 2960 GET F,IIGET : INIT$,PAS$,GAMES,WON,LOST 2970 PUT F,IIPUT : INIT$,PAS$,GAMES,WON,LOST 2980 UNTIL INIT$="XXXXX" 2990 ENDIF 3000 ENDIF 3010 ENDPROC UPDMEMB 3020 REM ____________________________________________________________________ 3030 REM 3040 REM PROCEDURE INSERTNEW FOR INSERTING OF NEW MEMBER IN 3050 REM ALPHABETICAL ORDER. 3060 REM 3070 PROC INSERTNEW 3080 IGET=0; IPUT=0 3090 REPEAT 3100 IGET=IGET+1; IPUT=IPUT+1 3110 GET F,IGET : INIT$,PAS$,GAMES,WON,LOST 3120 FOR I=1 TO 5 DO 3130 A=ORD(INIT$(I : 1)) 3140 B=ORD(UPDINIT$(I : 1)) 3150 IF A=255 THEN A=32 3160 IF B=255 THEN B=32 3170 IF A>95 THEN A=A-32.5 3180 IF B>95 THEN B=B-32.5 3190 IF A<>B THEN EXIT 3200 NEXT I 3210 UNTIL B<A OR INIT$="XXXXX" 3220 PUT F,IPUT : UPDINIT$,NEWPAS$,NUL,NUL,NUL 3230 IGET=IGET+1; IPUT=IPUT+1 3240 IF INIT$="XXXXX" THEN 3250 PUT F,IPUT : INIT$,PAS$,GAMES,NUL,NUL 3260 ELSE 3270 REPEAT 3280 GET F,IGET : BINIT$,BPAS$,BGAMES,BWON,BLOST 3290 PUT F,IPUT : INIT$,PAS$,GAMES,WON,LOST 3300 IGET=IGET+1; IPUT=IPUT+1 3310 IF BINIT$="XXXXX" THEN 3320 INIT$=BINIT$ 3330 PAS$=BPAS$ 3340 GAMES=BGAMES 3350 EXIT 3360 ENDIF 3370 GET F,IGET : INIT$,PAS$,GAMES,WON,LOST 3380 PUT F,IPUT : BINIT$,BPAS$,BGAMES,BWON,BLOST 3390 IGET=IGET+1; IPUT=IPUT+1 3400 UNTIL INIT$="XXXXX" 3410 PUT F,IPUT : INIT$,PAS$,GAMES,NUL,NUL 3420 ENDIF 3430 ENDPROC INSERTNEW 3440 REM ____________________________________________________________________ 3450 REM 3460 REM PROCEDURE SCORMOD(SS) FOR CREATING NEW "SCORE" TABLE OR 3470 REM FOR EXTENDING LENGHT OF EXISTING TABLE. 3480 REM 3490 PROC SCORMOD(SS) 3500 PRINT CHR(12) 3510 EXEC YX(5,20) 3520 IF SS=53 THEN 3530 PRINT "CREATION OF NEW (EMPTY) SCORE-TABLE." 3540 EXEC YX(6,20) 3550 PRINT "====================================" 3560 EXEC YX(8,10) 3570 PRINT "ANY EXISTING SCORE-FILE MUST BE DELETED BEFORE" 3580 EXEC YX(9,10) 3590 PRINT "A NEW SCORE-FILE CAN BE CREATED!!!" 3600 EXEC YX(12,5) 3610 PRINT "SELECT OPERATION:" 3620 PRINT 3630 PRINT " D: DELETE EXISTING SCORE-FILE AND CREATE A NEW ONE." 3640 PRINT 3650 PRINT " N: CREATE NEW SCORE-FILE. NO FILE WITH NAME 'SCORE'" 3660 PRINT " EXISTS ON THE DISKETTE." 3670 PRINT 3680 PRINT " Q: EXIT." 3690 PRINT 3700 PRINT 3710 PRINT " INPUT THE SELECTED OPERATION: " 3720 REPEAT 3730 EXEC YX(22,37) 3740 Y=KEY(0) 3750 UNTIL Y=68 OR Y=100 OR Y=78 OR Y=110 OR Y=81 OR Y=113 3760 REM ...'D'......'D'.....'N'......'N'.....'Q'......'Q'... 3770 IF Y=81 OR Y=113 THEN EXIT 3780 IF Y=68 OR Y=100 THEN DELETE "SCORE" 3790 EXEC YX(8,1) 3800 PRINT CHR(31) 3810 EXEC MEMBSINP(MEMBS) 3820 PRINT "CREATING NEW SCORE-TABLE WITH"; MEMBS; "MEMBERS." 3830 RECS=MEMBS+1 3840 CREATE "SCORE",F,BUF$,22,RECS 3850 INIT$="XXXXX" 3860 PAS$=" " 3870 PUT F,1 : INIT$,PAS$,MEMBS,NUL,NUL 3880 ELSE 3890 PRINT "CHANGE OF LENGHT OF SCORE-TABLE." 3900 EXEC YX(6,20) 3910 PRINT "================================" 3920 EXEC MEMBSINP(MEMBS) 3930 PRINT "CHANGING SCORE-TABLE TO ALLOW A MAXIMUM OF"; MEMBS; "MEMBERS." 3940 RECS=MEMBS+1 3950 OPEN "SCORE",F,BUF$,22 3960 CREATE "INTER",FF,BBUF$,22,RECS 3970 COUNT=1 3980 REPEAT 3990 GET F,COUNT : INIT$,PAS$,GAMES,WON,LOST 4000 PUT FF,COUNT : INIT$,PAS$,GAMES,WON,LOST 4010 COUNT=COUNT+1 4020 UNTIL INIT$="XXXXX" OR COUNT>RECS 4030 CLOSE F 4040 DELETE "SCORE" 4050 CREATE "SCORE",F,BUF$,22,RECS 4060 COUNT=0 4070 REPEAT 4080 COUNT=COUNT+1 4090 GET FF,COUNT : INIT$,PAS$,GAMES,WON,LOST 4100 PUT F,COUNT : INIT$,PAS$,GAMES,WON,LOST 4110 UNTIL INIT$="XXXXX" OR COUNT=>RECS 4120 INIT$="XXXXX" 4130 PAS$=" " 4140 PUT F,COUNT : INIT$,PAS$,MEMBS,NUL,NUL 4150 CLOSE FF 4160 DELETE "INTER" 4170 ENDIF 4180 CLOSE F 4190 ENDPROC SCORMOD 4200 REM ____________________________________________________________________ 4210 REM 4220 REM PROCEDURE MEMBSINP FOR INPUT AND CHECK OF MAX. NO. OF 4230 REM MEMBERS IN SCORE-TABLE. 4240 REM 4250 PROC MEMBSINP(MMEMBS) 4260 REPEAT 4270 EXEC YX(12,10) 4280 INPUT "INPUT MAX. NUMBER OF MEMBERS IN NEW SCORE-TABLE: ",MMEMBS 4290 EXEC YX(12,0) 4300 PRINT CHR(31) 4310 IF MMEMBS<1 THEN 4320 EXEC YX(15,10) 4330 PRINT "NUMBER TOO LOW!!! (1 IS LOWEST ALLOWABLE VALUE)." 4340 ENDIF 4350 IF MMEMBS>1000 THEN 4360 EXEC YX(15,10) 4370 PRINT "NUMBER TOO HIGH!!! (1000 IS HIGHEST ALLOWABLE VALUE)." 4380 ENDIF 4390 UNTIL MMEMBS>0 AND MMEMBS<1001 4400 EXEC YX(12,10) 4410 PRINT CHR(31) 4420 ENDPROC MEMBSINP 4430 REM ____________________________________________________________________ 4440 REM 4450 REM PROCEDURE INITPRT FOR INITIALIZING THE PRINTER 4460 REM 4470 PROC INITPRT 4480 OUTPUT P 4490 FOR K=1 TO 10 4500 PRINT 4510 NEXT K 4520 PRINT " INITIALS: PASSWORD: GAMES: WON: LOST:" 4530 PRINT " ========= ========= ====== ==== =====" 4540 PRINT 4550 OUTPUT C 4560 ENDPROC INITPRT 4570 REM ____________________________________________________________________ 4580 REM 4590 REM PROCEDURE YX(LINE-NO.,CHAR.-POS) FOR CURSOR POSITIONING 4600 REM 4610 PROC YX(YCOR,XCOR) 4620 DUMMY=CRT(6)+CRT(95+XCOR-(XCOR>32)*64-(XCOR>64)*64)+CRT(95+YCOR) 4630 ENDPROC YX 4640 REM 4650 REM ********************************************************************** ▶08◀▶08◀▶08◀▶08◀▶08◀ 4660 REM ********************************************************************** «eof»