File SPIEL4.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

C****************************************************************
C*****                                                    *******
C*****        G L U E C K S S P I E L   17 + 4           ********
C*****                                                     ******
C****************************************************************
	DIMENSION KARTEN(32),KONTO(5)
	WRITE(1,1)
1	FORMAT('      WIR SPIELEN JETZT DAS GLUECKSSPIEL 17+4',//,
	110X,'V I E L   S P A S S !!!!!'//)
C
C   BERECHNUNG VON X (ANFANGSWERT FUER ZUFALLSZAHLENGENERATOR)
C
	WRITE(1,5)
5	FORMAT('GIB BITTE DAS DATUM AN! Z.B.: 21.03.77')
	READ(1,6)I1,I2,I3,I4,I5,I6,I7,I8
6	FORMAT(8A1)
	X1=FLOAT(I1)+FLOAT(I2)
	X2=FLOAT(I4)+FLOAT(I5)
	X3=FLOAT(I7)+FLOAT(I8)
	X=X1/(X2+X3)
C
C   FESTLEGEN DER KARTENWERTE
C
	K=1
	DO 10 I=2,4
	DO 10 J=1,4
	KARTEN(K)=I
10	K=K+1
	DO 11 I=7,11
	DO 11 J=1,4
	KARTEN(K)=I
11	K=K+1
C
C   MISCHEN DER KARTENWERTE
C
2000	WRITE(1,2001)
2001	FORMAT(/'MOMENT, ICH MUSS DIE KARTEN MISCHEN'/)
2002	DO 40 L=1,100
	CALL IRAND(K,1,32,X)
	IH1=K
	CALL IRAND(K,1,32,X)
	IH2=K
	IH3=KARTEN(IH1)
	KARTEN(IH1)=KARTEN(IH2)
	KARTEN(IH2)=IH3
40	CONTINUE
C
C   TEILALGORITHMUS SPIELEN
C
C   VARIABLEN:NUMMER=ANZAHL DER SPIELER
C             KONTO =PUNKTEKONTO
C             IZ1   =ZAEHLER1
C             IZ2   =ZAEHLER2
C             IANT  =ANTWORT
C             IRAUS =ANZAHL DER SPIELER,DIE NICHT IN DIE WERTUNG KAMEN
C             IGEW  =GEWINNKONTO
C
	MINUS=0
499	READ(1,501)NUMMER
501	FORMAT('WIEVIELE SPIELER MOECHTEN MITSPIELEN? (MAX. 4) 'I1)
C
C  ANZAHL DER MITSPIELER FESTSTELLEN UND UEBERPRUEFEN
C
	IF(NUMMER-4)503,503,504
504	WRITE(1,505)
505	FORMAT('ZU VIELE SPIELER!!!!')
	MINUS=MINUS+1
	IF(MINUS-2)499,506,709
506	WRITE(1,507)
507	FORMAT('WENN IHR EUCH NICHT  AUF WENIGER SPIELER EINIGEN ',
	1'KOENNT'/5X,'DANN IST SCHLUSS!!!!!!!!')
	GOTO 499
503	WRITE(1,502)
502	FORMAT(/)
C   
C   JEDER SPIELER ERHAELT EINE KARTE
C
	IZ1=1
	DO 500 IZ2=1,NUMMER
	WRITE(1,510)IZ2,KARTEN(IZ1)
510	FORMAT('SPIELER NR.',I2,' ERHAELT DEN KARTENWERT',I3)
	KONTO(IZ2)=KARTEN(IZ1)
	IZ1=IZ1+1
500	CONTINUE
C
C   SPIELER GIBT AN,WIEVIELE KARTEN ER HABEN MOECHTE
C
	DO 520 IZ2=1,NUMMER
	WRITE(1,530)IZ2
530	FORMAT(//'S P I E L E R  NR. ',I2,':',/,22('-')/)
525	READ(1,540)IANT
540	FORMAT(' NOCH EINE KARTE? (J ODER N) ',1A1)
	IF(IANT-672)520,560,520
C
C   DAS PUNKTEKONTO EINES SPIELERS DARF NICHT >21 WERDEN
C
560	WRITE(1,565)IZ2,KARTEN(IZ1)
565	FORMAT('SPIELER NR.',I2,' ERHAELT DEN KARTENWERT',I3) 
	KONTO(IZ2)=KONTO(IZ2)+KARTEN(IZ1)
	IZ1=IZ1+1
	IF(KONTO(IZ2)-21)525,520,520
520	CONTINUE
C
C  TEILALGORITHMUS "GEWINNER"
C	
C   WELCHE SPIELER KOMMEN IN DIE WERTUNG
C
	IRAUS=0
	DO 610 IZ2=1,NUMMER
	IF(KONTO(IZ2)-21)630,630,620
620	IRAUS=IRAUS+1
	WRITE(1,625)IZ2,KONTO(IZ2)
625	FORMAT('SPIELER NR.',I2,' , DU BIST LEIDER NICHT IN ',
	1'DER WERTUNG, WEIL DU  ',I2,' PUNKTE HAST')
	KONTO(IZ2)=0
	GOTO 610
630	IF(KONTO(IZ2)-17)620,610,610
610	CONTINUE
C
C   WELCHE PUNKTZAHL HAT GEWONNEN?
C   IGEW = GEWINNPUNKTZAHL
C
650	IGEW=0
	DO 660 IZ2=1,NUMMER
	IF(KONTO(IZ2)-IGEW)660,660,665
665	IGEW=KONTO(IZ2)
660	CONTINUE
C
C   JETZT SPIELT DER COMPUTER
C
	WRITE(1,1000)
1000	FORMAT(/'JETZT SPIELE ICH'/)
	ICOMP=NUMMER+1
	KONTO(ICOMP)=0
C
C  DER COMPUTER NIMMT SOLANGE KARTEN BIS ER MINDESTENS 17 PUNKTE HAT
C
1002	IF(KONTO(ICOMP)-17)1001,1200,1200
1001	WRITE(1,1235)KARTEN(IZ1)
	KONTO(ICOMP)=KONTO(ICOMP)+KARTEN(IZ1)
	IZ1=IZ1+1
	GOTO 1002
C
C  DER COMPUTER NIMMT NOCH WEITERE KARTEN SOLANGE ER WENIGER ALS 22 PUNKTE
C  UND WENIGER ALS IGEW (GEWINNPUNKTZAHL) PUNKTE HAT
C
1200	IF(KONTO(ICOMP)-22)1210,1220,1220
1210	IF(KONTO(ICOMP)-IGEW)1230,1220,1220
1230	WRITE(1,1235)KARTEN(IZ1)
1235	FORMAT('MEINE KARTE HAT DEN WERT: ',I2)
	KONTO(ICOMP)=KONTO(ICOMP)+KARTEN(IZ1)
	IZ1=IZ1+1
	GOTO 1200
C
C  AUSGABE UND AUSWERTUNG DES PUNKTEKONTOS DES COMPUTERS
C
1220	WRITE(1,1270)KONTO(ICOMP)
1270	FORMAT('PUNKTEKONTO DES COMPUTERS : ',I2,' PUNKTE!')
	IF(KONTO(ICOMP)-21)1280,1280,1285
1285	 WRITE(1,1290)KONTO(ICOMP)
1290	FORMAT('ICH HABE LEIDER VERLOREN, DA ICH ',I2,
	1' PUNKTE HABE!')
C
C  AUSWERTUNG DES GESAMTEN SPIELS
C
	IF(IRAUS-NUMMER)669,640,669
640	WRITE(1,645)
645	FORMAT('KEIN SPIELER HAT GEWONNEN, DA KEINER IN DIE ',
	1'WERTUNG KAM!')
	GOTO 691
1280	IF(KONTO(ICOMP)-IGEW)1300,1300,1310
1310	WRITE(1,1320)KONTO(ICOMP)
1320	FORMAT(/'ICH HABE MIT ',I2,' PUNKTEN GEWONNEN!')
	GOTO 691
1300	GOTO 669
C
C   GEWINNERFESTSTELLUNG
C
669	WRITE(1,670)IGEW
670	FORMAT('GEWINNER MIT DER PUNKTZAHL ',I2,' IST (SIND) SPIELER ',
	1'NR.:')
	DO 680 IZ2=1,ICOMP
	IF(KONTO(IZ2)-IGEW)680,685,680
685	WRITE(1,686)IZ2
686	FORMAT(10X,I2)
680	CONTINUE
691	READ(1,700)IANT
700	FORMAT('SOLL DAS SPIEL NOCH EINMAL LAUFEN? (J ODER N)',1A1)
	IF(IANT-672)701,2000,701
701	WRITE(1,705)
705	FORMAT(//'NA DANN...BIS ZUM NAECHSTEN SPIEL...BIS ZUM ',
	1'NAECHSTEN SP...')
709	STOP
	END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search