|
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: 15872 (0x3e00)
Types: TextFile
Names: »B25«
└─⟦6dbcc9c03⟧ Bits:30000463 DOMUS disk image
└─⟦this⟧ »/B25«
0001 ON ESC CHAIN "MENU" 0002 REM ******************** BEMÆRKNINGER ******************** 0003 REM 0004 REM ** 0005 REM ** PROGRAMMET ER I STAND TIL AT SPILLE KORTSPILLET "HALV-TOLV". 0006 REM ** 0007 REM ** PROGRAMMØR: KIM HANSEN, ØRUMVEJ 37, 2650 HVIDOVRE. 0008 REM ** 0009 REM ** FÆRDIGPROGRAMMERET: 1981-03-10 0010 REM ** 0011 REM 0012 REM ******************** HOVEDPROGRAM ******************** 0013 REM 0014 PRINT CHR(12) 0015 PRINT " DETTE PROGRAM, SOM DU LIGE HAR STARTET, KAN SPILLE KORTSPIL-" 0016 PRINT "LET 'HALV-TOLV' MED DIG." 0017 PRINT " REGLERNE ER DE ALMINDELIGE FOR 'HALV-TOLV', HVOR KORTENE" 0018 PRINT "2...10 GÆLDER FOR PÅLYDENDE, ES FOR 11 ELLER 1, OG DE ØVRIGE" 0019 PRINT "BILLEDEKORT FOR 1/2." 0020 PRINT " SPILLET GÅR UD PÅ AT KOMME SÅ TÆT PÅ 11.5 SOM MULIGT. COMPU-" 0021 PRINT "TEREN SPILLER BANK. SPILLEREN STARTER MED AT FÅ ET KORT SOM BAN-" 0022 PRINT "KEN INTET KENDER TIL. UDFRA DETTE KORT AFGØR SPILLEREN HVOR ME-" 0023 PRINT "GET HAN VIL SPILLE FOR. DEREFTER KAN HAN FÅ FLERE KORT (DE EF-" 0024 PRINT "TERFØLGENDE KORT ER ÅBNE - DVS. AT BANKEN KENDER DEM). HVIS" 0025 PRINT "POINTSUMMEN KOMMER OVER 11.5, HAR MAN TABT INDSATSEN. NÅR SPIL-" 0026 PRINT "LEREN IKKE VIL HAVE FLERE KORT, OG DENNES POINTSUM ER <= 11.5," 0027 PRINT "TAGER BANKEN KORT. DER GÆLDER DE SAMME POINTREGLER FOR BANKEN." 0028 PRINT "NÅR BANKEN IKKE VIL HAVE FLERE KORT, SAMMENLIGNES POINTSUMMERNE," 0029 PRINT "OG DEN DER HAR FLEST POINT VINDER INDSATSEN. EN SPECIEL POINT-" 0030 PRINT "REGEL ER, AT 5 KORT <= 11.5 GÆLDER FOR 11.5. HVIS SPILLER OG" 0031 PRINT "BANK HAR SAMME POINTSUM, VINDER BANKEN." 0032 PRINT " SPILLER OG COMPUTER FÅR FRA START KR 50 AT SPILLE FOR. DEN" 0033 PRINT "HØJESTE INDSATS ER KR 10." 0034 PRINT 0035 DIM DUMMY$(6) 0036 INPUT "TRYK 'RETURN' FOR START!",DUMMY$ 0037 DIM KORTSTAK(52) 0038 DIM HALV1(26) 0039 DIM HALV0(26) 0040 DIM KVART11(13) 0041 DIM KVART10(13) 0042 DIM KVART21(13) 0043 DIM KVART20(13) 0044 DIM OVER(10) 0045 DIM SVAR$(1) 0046 AA=0; A=0; B=0; C=0; D=0; E=0; CHECK=0; BELØB=0; SPILLERKONTO=50 0047 MASKINKONTO=50; KORTTÆLLER=0; FØRSTEKORT=0; SKORT=0; SPOINT=0 0048 ANTALSKORT=0; ANTALMKORT=0; FARVE=0; FØRSTEOVER=0; FØRSTEPOINT=0 0049 MKORT=0; MPOINT=0; FLEREKORT=0; SLUSE=0.6 0050 DEF FNOVERFLOW(X)=(X>11.5) 0051 DEF FNP(Q)=Q+95-(Q>32)*64-(Q>64)*64 0052 RANDOMIZE 0053 EXEC LÆSDATA 0054 EXEC BLANDKORT 0055 EXEC NULSTILOVER 0056 REPEAT 0057 PRINT CHR(12) 0058 EXEC SPIL 0059 EXEC TEKST1 0060 EXEC POSITION(1,24) 0061 INPUT "ØNSKES ET SPIL TIL (J/N)?: ",SVAR$ 0062 UNTIL (SVAR$<>"J") OR (SPILLERKONTO=0) OR (MASKINKONTO=0) 0063 IF SVAR$<>"J" THEN 0064 EXEC TEKST2 0065 ELSE 0066 IF SPILLERKONTO=0 THEN 0067 EXEC TEKST3 0068 ELSE 0069 EXEC TEKST4 0070 ENDIF 0071 ENDIF 0072 CHAIN "MENU" 0073 REM 0074 REM ******************** POSITION ******************** 0075 REM 0076 PROC POSITION(XX,YY) 0077 PRINT CHR(6); CHR(FNP(XX)); CHR(FNP(YY)); 0078 ENDPROC POSITION 0079 REM 0080 REM ******************** LÆSDATA ********************* 0081 REM 0082 PROC LÆSDATA 0083 FOR A=1 TO 52 0084 READ KORTSTAK(A) 0085 NEXT A 0086 ENDPROC LÆSDATA 0087 REM 0088 REM ******************** BLANDKORT ******************** 0089 REM 0090 PROC BLANDKORT 0091 EXEC TEKST5 0092 FOR AA=1 TO 3 0093 EXEC NIVEAU1 0094 EXEC NIVEAU2 0095 EXEC NIVEAU0 0096 NEXT AA 0097 EXEC POSITION(1,24) 0098 PRINT " " 0099 ENDPROC BLANDKORT 0100 REM 0101 REM ******************** NIVEAU1 ******************** 0102 REM 0103 PROC NIVEAU1 0104 B=0; C=0 0105 FOR A=1 TO 52 0106 IF (B<26) AND (C<26) THEN 0107 IF RND(0)=>0.5 THEN 0108 B=B+1 0109 HALV1(B)=KORTSTAK(A) 0110 ELSE 0111 C=C+1 0112 HALV0(C)=KORTSTAK(A) 0113 ENDIF 0114 ELSE 0115 IF B<26 THEN 0116 B=B+1 0117 HALV1(B)=KORTSTAK(A) 0118 ELSE 0119 C=C+1 0120 HALV0(C)=KORTSTAK(A) 0121 ENDIF 0122 ENDIF 0123 NEXT A 0124 ENDPROC NIVEAU1 0125 REM 0126 REM ******************** NIVEAU2 ******************** 0127 REM 0128 PROC NIVEAU2 0129 B=0; C=0; D=0; E=0 0130 FOR A=1 TO 26 0131 IF (B<13) AND (C<13) THEN 0132 IF RND(0)=>0.5 THEN 0133 B=B+1 0134 KVART11(B)=HALV1(A) 0135 ELSE 0136 C=C+1 0137 KVART10(C)=HALV1(A) 0138 ENDIF 0139 ELSE 0140 IF B<13 THEN 0141 B=B+1 0142 KVART11(B)=HALV1(A) 0143 ELSE 0144 C=C+1 0145 KVART10(C)=HALV1(A) 0146 ENDIF 0147 ENDIF 0148 IF (D<13) AND (E<13) THEN 0149 IF RND(0)=>0.5 THEN 0150 D=D+1 0151 KVART21(D)=HALV0(A) 0152 ELSE 0153 E=E+1 0154 KVART20(E)=HALV0(A) 0155 ENDIF 0156 ELSE 0157 IF D<13 THEN 0158 D=D+1 0159 KVART21(D)=HALV0(A) 0160 ELSE 0161 E=E+1 0162 KVART20(E)=HALV0(A) 0163 ENDIF 0164 ENDIF 0165 NEXT A 0166 ENDPROC NIVEAU2 0167 REM 0168 REM ******************** NIVEAU0 ******************** 0169 REM 0170 PROC NIVEAU0 0171 FOR A=1 TO 13 0172 KORTSTAK(A)=KVART11(A) 0173 NEXT A 0174 FOR A=14 TO 26 0175 KORTSTAK(A)=KVART10(A-13) 0176 NEXT A 0177 FOR A=27 TO 39 0178 KORTSTAK(A)=KVART21(A-26) 0179 NEXT A 0180 FOR A=40 TO 52 0181 KORTSTAK(A)=KVART20(A-39) 0182 NEXT A 0183 ENDPROC NIVEAU0 0184 REM 0185 REM ******************** NULSTILOVER ******************** 0186 REM 0187 PROC NULSTILOVER 0188 B=0 0189 FOR A=2 TO 10 0190 B=B+4 0191 OVER(A)=B 0192 NEXT A 0193 ENDPROC NULSTILOVER 0194 REM 0195 REM ******************** SPIL ******************** 0196 REM 0197 PROC SPIL 0198 SPOINT=0; MPOINT=0; ANTALSKORT=0; ANTALMKORT=0; JUSTERING=0 0199 EXEC GIVETKORT(SKORT,ANTALSKORT) 0200 EXEC TEKST6 0201 EXEC SKRIV(SKORT) 0202 FØRSTEOVER=SKORT 0203 EXEC POINT(SKORT,SPOINT) 0204 FØRSTEPOINT=SKORT 0205 EXEC INDSATS 0206 EXEC POSITION(1,24) 0207 INPUT "ØNSKES FLERE KORT (J/N)?: ",SVAR$ 0208 IF SVAR$="J" THEN 0209 REPEAT 0210 EXEC GIVETKORT(SKORT,ANTALSKORT) 0211 EXEC SKRIV(SKORT) 0212 EXEC AJOUROVER(SKORT) 0213 EXEC POINT(SKORT,SPOINT) 0214 IF SPOINT<12 THEN 0215 EXEC POSITION(1,24) 0216 INPUT "ØNSKES FLERE KORT (J/N)?: ",SVAR$ 0217 ENDIF 0218 UNTIL (SVAR$<>"J") OR (FNOVERFLOW(SPOINT)=1) OR (ANTALSKORT=5) 0219 ENDIF 0220 IF FNOVERFLOW(SPOINT)=0 THEN 0221 EXEC TEKST7 0222 JUSTERING=4 0223 REPEAT 0224 EXEC GIVETKORT(MKORT,ANTALMKORT) 0225 EXEC SKRIV(MKORT) 0226 EXEC AJOUROVER(MKORT) 0227 EXEC POINT(MKORT,MPOINT) 0228 EXEC BEREGN(FLEREKORT) 0229 UNTIL (FLEREKORT=0) OR (FNOVERFLOW(MPOINT)=1) OR (ANTALMKORT=5) 0230 ELSE 0231 EXEC TEKST8 0232 EXEC MASKINVINDER 0233 ENDIF 0234 IF (FNOVERFLOW(SPOINT)=0) AND (FNOVERFLOW(MPOINT)=0) THEN 0235 IF (SPOINT<11.5) AND (MPOINT<11.5) THEN 0236 IF (ANTALSKORT<5) AND (ANTALMKORT<5) THEN 0237 IF MPOINT=>SPOINT THEN 0238 EXEC TEKST8 0239 EXEC MASKINVINDER 0240 ELSE 0241 EXEC TEKST9 0242 EXEC SPILLERVINDER 0243 ENDIF 0244 ELSE 0245 IF ANTALMKORT=5 THEN 0246 EXEC TEKST8 0247 EXEC MASKINVINDER 0248 ELSE 0249 EXEC TEKST9 0250 EXEC SPILLERVINDER 0251 ENDIF 0252 ENDIF 0253 ELSE 0254 IF MPOINT=11.5 THEN 0255 EXEC TEKST8 0256 EXEC MASKINVINDER 0257 ELSE 0258 EXEC TEKST9 0259 EXEC SPILLERVINDER 0260 ENDIF 0261 ENDIF 0262 ELSE 0263 IF FNOVERFLOW(MPOINT)=1 THEN 0264 EXEC TEKST9 0265 EXEC SPILLERVINDER 0266 ENDIF 0267 ENDIF 0268 EXEC AJOUROVER(FØRSTEOVER) 0269 ENDPROC SPIL 0270 REM 0271 REM ******************** GIVETKORT ******************** 0272 REM 0273 PROC GIVETKORT(PARAM1A,PARAM1B) 0274 IF KORTTÆLLER<52 THEN 0275 KORTTÆLLER=KORTTÆLLER+1 0276 PARAM1A=KORTSTAK(KORTTÆLLER) 0277 ELSE 0278 EXEC BLANDKORT 0279 EXEC NULSTILOVER 0280 FØRSTEOVER=0 0281 KORTTÆLLER=1 0282 PARAM1A=KORTSTAK(KORTTÆLLER) 0283 ENDIF 0284 PARAM1B=PARAM1B+1 0285 ENDPROC GIVETKORT 0286 REM 0287 REM ******************** SKRIV ******************** 0288 REM 0289 PROC SKRIV(PARAM3) 0290 FARVE=PARAM3 DIV 100 0291 EXEC POSITION(40,(2+ANTALSKORT+ANTALMKORT+JUSTERING)) 0292 IF FARVE=1 THEN 0293 PRINT "SPAR "; 0294 ELSE 0295 IF FARVE=2 THEN 0296 PRINT "HJERTER "; 0297 ELSE 0298 IF FARVE=3 THEN 0299 PRINT "KLØR "; 0300 ELSE 0301 IF FARVE=4 THEN 0302 PRINT "RUDER "; 0303 ENDIF 0304 ENDIF 0305 ENDIF 0306 ENDIF 0307 EXEC SKRIVVALØR(PARAM3) 0308 ENDPROC SKRIV 0309 REM 0310 REM ******************** SKRIVVALØR ******************** 0311 REM 0312 PROC SKRIVVALØR(PARAM4) 0313 PARAM4=PARAM4 MOD 100 0314 IF (PARAM4=>2) AND (PARAM4<=10) THEN 0315 PRINT PARAM4 0316 ELSE 0317 IF PARAM4=11 THEN 0318 PRINT "ES" 0319 ELSE 0320 IF PARAM4=12 THEN 0321 PRINT "KNÆGT" 0322 ELSE 0323 IF PARAM4=13 THEN 0324 PRINT "DAME" 0325 ELSE 0326 PRINT "KONGE" 0327 ENDIF 0328 ENDIF 0329 ENDIF 0330 ENDIF 0331 ENDPROC SKRIVVALØR 0332 REM 0333 REM ******************** POINT ******************** 0334 REM 0335 PROC POINT(PARAM5A,PARAM5B) 0336 IF (PARAM5A=>2) AND (PARAM5A<=10) THEN 0337 PARAM5B=PARAM5B+PARAM5A 0338 ELSE 0339 IF PARAM5A=11 THEN 0340 IF PARAM5B<=0.5 THEN 0341 PARAM5B=PARAM5B+11 0342 ELSE 0343 PARAM5B=PARAM5B+1 0344 ENDIF 0345 ELSE 0346 PARAM5B=PARAM5B+0.5 0347 PARAM5A=0.5 0348 ENDIF 0349 ENDIF 0350 ENDPROC POINT 0351 REM 0352 REM ******************** INDSATS ******************** 0353 REM 0354 PROC INDSATS 0355 REPEAT 0356 CHECK=0 0357 EXEC POSITION(1,24) 0358 INPUT "HVOR MEGET SATSER DU?:",BELØB 0359 IF (BELØB<=10) AND (BELØB=>0) THEN 0360 IF ((SPILLERKONTO-BELØB)=>0) AND ((MASKINKONTO-BELØB)=>0) THEN 0361 CHECK=1 0362 ENDIF 0363 ENDIF 0364 UNTIL CHECK=1 0365 ENDPROC INDSATS 0366 REM 0367 REM ******************** AJOUROVER ******************** 0368 REM 0369 PROC AJOUROVER(PARAM2) 0370 IF (PARAM2=>2) AND (PARAM2<11) THEN 0371 OVER(10)=OVER(10)-1 0372 IF PARAM2=>3 THEN 0373 OVER(9)=OVER(9)-1 0374 IF PARAM2=>4 THEN 0375 OVER(8)=OVER(8)-1 0376 IF PARAM2=>5 THEN 0377 OVER(7)=OVER(7)-1 0378 IF PARAM2=>6 THEN 0379 OVER(6)=OVER(6)-1 0380 IF PARAM2=>7 THEN 0381 OVER(5)=OVER(5)-1 0382 IF PARAM2=>8 THEN 0383 OVER(4)=OVER(4)-1 0384 IF PARAM2=>9 THEN 0385 OVER(3)=OVER(3)-1 0386 IF PARAM2=10 THEN 0387 OVER(2)=OVER(2)-1 0388 ENDIF 0389 ENDIF 0390 ENDIF 0391 ENDIF 0392 ENDIF 0393 ENDIF 0394 ENDIF 0395 ENDIF 0396 ENDIF 0397 ENDPROC AJOUROVER 0398 REM 0399 REM ******************** BEREGN ******************** 0400 REM 0401 PROC BEREGN(PARAM6) 0402 IF MPOINT=>11.5 THEN 0403 PARAM6=0 0404 ELSE 0405 IF MPOINT=11 THEN 0406 IF ((SPOINT-FØRSTEPOINT)=11) OR (ANTALSKORT=5) THEN 0407 PARAM6=1 0408 ELSE 0409 PARAM6=0 0410 ENDIF 0411 ELSE 0412 IF ((SPOINT-FØRSTEPOINT)=>MPOINT) OR (ANTALSKORT=5) THEN 0413 PARAM6=1 0414 ELSE 0415 IF MPOINT=0.5 THEN 0416 PARAM6=1 0417 ELSE 0418 IF KORTTÆLLER<52 THEN 0419 PARAM6=((OVER(INT(MPOINT))/(52-KORTTÆLLER))<SLUSE) 0420 ELSE 0421 PARAM6=((OVER(INT(MPOINT))/52)<SLUSE) 0422 ENDIF 0423 ENDIF 0424 ENDIF 0425 ENDIF 0426 ENDIF 0427 ENDPROC BEREGN 0428 REM 0429 REM ******************** MASKINVINDER ******************** 0430 REM 0431 PROC MASKINVINDER 0432 MASKINKONTO=MASKINKONTO+BELØB 0433 SPILLERKONTO=SPILLERKONTO-BELØB 0434 ENDPROC MASKINVINDER 0435 REM 0436 REM ********************* SPILLERVINDER ******************** 0437 REM 0438 PROC SPILLERVINDER 0439 SPILLERKONTO=SPILLERKONTO+BELØB 0440 MASKINKONTO=MASKINKONTO-BELØB 0441 ENDPROC SPILLERVINDER 0442 REM 0443 REM ******************** TEKST 1 ******************** 0444 REM 0445 PROC TEKST1 0446 EXEC POSITION(1,21) 0447 PRINT "SPILLERKONTO: "; SPILLERKONTO; " KR" 0448 EXEC POSITION(1,22) 0449 PRINT "MASKINKONTO: "; MASKINKONTO; " KR" 0450 ENDPROC TEKST1 0451 REM 0452 REM ******************** TEKST 2 ******************** 0453 REM 0454 PROC TEKST2 0455 EXEC POSITION(1,24) 0456 PRINT "TAK FOR SPILLET..............." 0457 ENDPROC TEKST2 0458 REM 0459 REM ******************** TEKST 3 ******************** 0460 REM 0461 PROC TEKST3 0462 EXEC POSITION(1,24) 0463 PRINT "JEG VANDT - DU HAR IKKE FLERE PENGE" 0464 ENDPROC TEKST3 0465 REM 0466 REM ******************** TEKST 4 ******************** 0467 REM 0468 PROC TEKST4 0469 EXEC POSITION(1,24) 0470 PRINT "DU VANDT - JEG HAR IKKE FLERE PENGE" 0471 ENDPROC TEKST4 0472 REM 0473 REM ******************** TEKST 5 ******************** 0474 REM 0475 PROC TEKST5 0476 EXEC POSITION(1,24) 0477 PRINT "KORTENE BLANDES - DET TAR' LIDT TID" 0478 ENDPROC TEKST5 0479 REM 0480 REM ******************** TEKST 6 ******************** 0481 REM 0482 PROC TEKST6 0483 EXEC POSITION(40,1) 0484 PRINT "DINE KORT:" 0485 ENDPROC TEKST6 0486 REM 0487 REM ******************** TEKST 7 ******************** 0488 REM 0489 PROC TEKST7 0490 EXEC POSITION(40,(5+ANTALSKORT+ANTALMKORT)) 0491 PRINT "MINE KORT:" 0492 ENDPROC TEKST7 0493 REM 0494 REM ******************** TEKST 8 ******************** 0495 REM 0496 PROC TEKST8 0497 EXEC POSITION(1,19) 0498 PRINT "JEG VANDT INDSATSEN (KR "; BELØB; ")" 0499 ENDPROC TEKST8 0500 REM 0501 REM ******************** TEKST 9 ******************** 0502 REM 0503 PROC TEKST9 0504 EXEC POSITION(1,19) 0505 PRINT "DU VANDT INDSATSEN (KR "; BELØB; ")" 0506 ENDPROC TEKST9 0507 REM 0508 REM ******************** DATA ******************** 0509 REM 0510 DATA 102,103,104,105,106,107,108,109,110,111,112,113,114 0511 DATA 202,203,204,205,206,207,208,209,210,211,212,213,214 0512 DATA 302,303,304,305,306,307,308,309,310,311,312,313,314 0513 DATA 402,403,404,405,406,407,408,409,410,411,412,413,414 0514 END «eof»