Category : Pascal Source Code
Archive   : PINOCHLE.ZIP
Filename : PINOCHLE.PAS

PROGRAM PINOCHLE(INPUT,OUTPUT);
(* 1/80 - TRANSLATED TO PASCAL FROM PL1 BY STEPHEN DOVER *)
(* PL1 AUTHOR ANONYMOUS *)
CONST STRLEN=45;
TYPE INSTR = PACKED ARRAY [1..STRLEN] OF CHAR;
TWOPACK = PACKED ARRAY [1..2] OF CHAR;
THREPACK = PACKED ARRAY [1..3] OF CHAR;
FOURPACK = PACKED ARRAY [1..4] OF CHAR;
SIXPACK = PACKED ARRAY [1..6] OF CHAR;
EITPACK = PACKED ARRAY [1..8] OF CHAR;
FOURINT = ARRAY [1..4] OF INTEGER;
XFOURINT = ARRAY [1..4,1..4] OF INTEGER;
VAR HAND,
HAND1 : ARRAY [1..4] OF INSTR;
ANSW,
PLAY : THREPACK;
AB : FOURPACK;
AB1 : FOURPACK;
C : ARRAY [1..48] OF THREPACK;
A1 : ARRAY [1..6] OF TWOPACK;
NAME,
SUIT1 : ARRAY [1..4] OF EITPACK;
AROUND : ARRAY [1..4,1..6] OF INTEGER;
CARD : ARRAY [1..4,1..6,1..4] OF INTEGER;
ACES,
BID,
MELD,
PINOC,
TRUMP : FOURINT;
SCORE : ARRAY [1..2] OF INTEGER;
MRG,
POWER,
SUIT,
RUN : XFOURINT;
PLAYR : 1..4;
I,J,K : INTEGER;
NHAND : INTEGER;
TRUMP1,WINBID : 1..4;
KIND,HIBID : INTEGER;
STARTBID : INTEGER;
TEAM1,TEAM2 : INTEGER;

FUNCTION RAND : INTEGER[C]; EXTERN;
PROCEDURE SRAND (TEMP : WORD) [C]; EXTERN;
FUNCTION TICS : WORD; EXTERN;

FUNCTION INDEX(VAR TEMP : INSTR) : INTEGER;
VAR UNEQ : BOOLEAN;
BEGIN
I:=0;
REPEAT I:=I+1;
J:=0;
REPEAT J:=J+1;
UNEQ:=PLAY[J]<>TEMP[I+J-1]
UNTIL UNEQ OR (J=3);
UNTIL (NOT UNEQ) OR (I=STRLEN-2);
IF UNEQ THEN INDEX:=0 ELSE INDEX:=I
END; (* INDEX *)

FUNCTION INDEX1(TEMP : FOURPACK; VAR TEMP1 : THREPACK) : INTEGER;
VAR EQ : BOOLEAN;
BEGIN
I:=1;
REPEAT I:=I+1;
J:=0;
REPEAT J:=J+1;
EQ:=TEMP1[I]=TEMP[J];
UNTIL (EQ) OR (J=4);
UNTIL (EQ) OR (I=3);
IF EQ THEN INDEX1:=J ELSE INDEX1:=0
END; (* INDEX1 *)

FUNCTION INDEX2(TEMP : SIXPACK) : INTEGER;
BEGIN
J:=0;
REPEAT J:=J+1;
UNTIL (PLAY[1]=TEMP[J]) OR (J=6);
IF PLAY[1]=TEMP[J] THEN INDEX2:=J
ELSE INDEX2:=0
END; (* INDEX2 *)



PROCEDURE PUTHLP;
BEGIN
WRITELN(OUTPUT,'? typed for any question prints your current hand');
WRITELN(OUTPUT,'?? tells the computer to play your turn.')
END; (* PUTHLP *)


PROCEDURE SHOWIT;
BEGIN
WRITELN(OUTPUT,HAND[1]);
WRITELN(OUTPUT,'Trump is ',SUIT1[TRUMP1])
END; (* SHOWIT *)


PROCEDURE CONCAT(TEMP,TEMP1 : INTEGER);
VAR UNDO : TWOPACK;
BEGIN
PLAY[3]:=' ';
UNDO:=A1[TEMP];
PLAY[1]:=UNDO[1];
IF UNDO[2]=' ' THEN PLAY[2]:=AB[TEMP1] ELSE
BEGIN
PLAY[2]:=UNDO[2];
PLAY[3]:=AB[TEMP1]
END
END; (* CONCAT *)


PROCEDURE DELETE(VAR S : INSTR; START,SPAN : INTEGER);
VAR LIMIT : INTEGER;
BEGIN
SPAN:=SPAN+1;
LIMIT:=START+SPAN;
FOR I:=0 TO STRLEN-LIMIT DO S[START+I]:=S[LIMIT+I];
FOR I:=STRLEN-SPAN+1 TO STRLEN DO S[I]:=' '
END; (* DELETE *)

PROCEDURE INIT;
LABEL 11;
VAR PEOPLE : ARRAY [1..9] OF EITPACK;
WHO : ARRAY [1..4] OF INTEGER;
D : ARRAY [1..9] OF INTEGER;
SEED : WORD;
BEGIN
A1[1]:='9 ';
A1[2]:='J ';
A1[3]:='Q ';
A1[4]:='K ';
A1[5]:='10';
A1[6]:='A ';
AB[1]:='C'; AB[2]:='H'; AB[3]:='D'; AB[4]:='S';
AB1[1]:='c'; AB1[2]:='h'; AB1[3]:='d'; AB1[4]:='s';
NAME[1]:=' ';
NAME[2]:='Marian ';
NAME[3]:='Monte ';
NAME[4]:='Cathy ';
PEOPLE[1]:='TJ ';
PEOPLE[2]:=NAME[2];
PEOPLE[3]:='Keith ';
PEOPLE[4]:=NAME[4];
PEOPLE[5]:='Gary ';
PEOPLE[6]:='Linda ';
PEOPLE[7]:='Art ';
PEOPLE[8]:='Rick ';
PEOPLE[9]:='Jan ';
SUIT1[1]:='Clubs ';
SUIT1[2]:='Hearts ';
SUIT1[3]:='Diamonds';
SUIT1[4]:='Spades ';
REPEAT
WRITE(OUTPUT,'Hi - This is partnership (4-handed) Pinochle, what''s your name? ');
READLN(INPUT,NAME[1])
UNTIL NAME[1]<>' ';
FOR J:=1 TO 9 DO D[J]:=J;
SEED := TICS;
SRAND (SEED);
K:=RAND DIV 13;
FOR J:=9 DOWNTO 6 DO
BEGIN
I:=(K MOD J)+1;
WHO[10-J]:=D[I];
D[I]:=D[J]
END;

J:=2;
FOR I:=1 TO 4 DO
BEGIN
NAME[J]:=PEOPLE[WHO[I]];
IF NAME[I] <> NAME[J] THEN
BEGIN
J:=J+1;
IF J=5 THEN GOTO 11
END
END;
11:
WRITELN(OUTPUT,'Hi ',NAME[1],'your partner is ',NAME[3]);
WRITE(OUTPUT,'Do you need help? ');
READLN(INPUT,ANSW);
IF (ANSW[1]='Y') OR (ANSW[1]='y') THEN PUTHLP;
END; (* INIT *)

PROCEDURE ZEROINIT;
BEGIN
STARTBID:=(STARTBID MOD 4)+1;
FOR I:=1 TO 4 DO
BEGIN
HAND[I]:=' ';
BID[I]:=0;
ACES[I]:=0;
MELD[I]:=0;
TRUMP[I]:=0;
PINOC[I]:=0;
FOR J:=1 TO 4 DO
BEGIN
RUN[I,J]:=0;
MRG[I,J]:=0;
POWER[I,J]:=0;
SUIT[I,J]:=0
END;
FOR J:=1 TO 6 DO
BEGIN
AROUND[I,J]:=0;
FOR K:=1 TO 4 DO
BEGIN
CARD[I,J,K]:=0
END
END
END
END; (* ZEROINIT *)

PROCEDURE DEALING; (* THIS IS THE DEALING ROUTINE *)
VAR HANDY : INSTR;
A : ARRAY [1..48] OF THREPACK;
B,
D : ARRAY [1..48] OF INTEGER;
UNDO3 : THREPACK;
ZOOT : INTEGER;
HOLD,MIN : INTEGER;
TICK : WORD;
BEGIN
A[1]:='9C '; A[2]:='9C ';
A[3]:='JC '; A[4]:='JC ';
A[5]:='QC '; A[6]:='QC ';
A[7]:='KC '; A[8]:='KC ';
A[9]:='10C'; A[10]:='10C';
A[11]:='AC '; A[12]:='AC ';
A[13]:='9H '; A[14]:='9H ';
A[15]:='JH '; A[16]:='JH ';
A[17]:='QH '; A[18]:='QH ';
A[19]:='KH '; A[20]:='KH ';
A[21]:='10H'; A[22]:='10H';
A[23]:='AH '; A[24]:='AH ';
A[25]:='9D '; A[26]:='9D ';
A[27]:='JD '; A[28]:='JD ';
A[29]:='QD '; A[30]:='QD ';
A[31]:='KD '; A[32]:='KD ';
A[33]:='10D'; A[34]:='10D';
A[35]:='AD '; A[36]:='AD ';
A[37]:='9S '; A[38]:='9S ';
A[39]:='JS '; A[40]:='JS ';
A[41]:='QS '; A[42]:='QS ';
A[43]:='KS '; A[44]:='KS ';
A[45]:='10S'; A[46]:='10S';
A[47]:='AS '; A[48]:='AS ';
FOR J:=1 TO 48 DO D[J]:=J;
FOR J:=48 DOWNTO 1 DO
BEGIN
I:=(RAND MOD J)+1;
B[49-J]:=D[I];
D[I]:=D[J]
END;
FOR J:=0 TO 3 DO
BEGIN
FOR K:=J*12+1 TO J*12+12 DO
BEGIN
MIN:=K;
FOR I:=K TO J*12+12 DO
BEGIN
IF B[I] END;
HOLD:=B[K];
B[K]:=B[MIN];
B[MIN]:=HOLD
END
END;
FOR J:=1 TO 48 DO C[J]:=A[B[J]];
FOR J:=1 TO 48 DO
BEGIN
PLAYR:=TRUNC((J-1)/12)+1;
ZOOT:=TRUNC((B[J]-1)/12)+1;
KIND:=TRUNC((B[J]-TRUNC((B[J]-1)/12)*12-1)/2)+1;
CARD[PLAYR,KIND,ZOOT]:=CARD[PLAYR,KIND,ZOOT]+1;
SUIT[PLAYR,ZOOT]:=SUIT[PLAYR,ZOOT]+1;
POWER[PLAYR,ZOOT]:=POWER[PLAYR,ZOOT]+KIND;
HANDY:=HAND[PLAYR];
I:=0;
REPEAT I:=I+1;
K:=0;
IF (HANDY[I]=' ') AND (HANDY[I+1]=' ') THEN
BEGIN
K:=1;
UNDO3:=C[J];
HANDY[I+1]:=UNDO3[1];
HANDY[I+2]:=UNDO3[2];
HANDY[I+3]:=UNDO3[3];
HAND[PLAYR]:=HANDY;
END
UNTIL (K=1);
IF KIND=6 THEN ACES[PLAYR]:=ACES[PLAYR]+1
END
END; (* DEALING *)

PROCEDURE HIBIDANDMELD; (* THIS IS THE HIGH BID AND MELD ROUTINE *)
VAR COUNT : 1..2;
BEGIN
FOR J:=1 TO 4 DO
BEGIN
TRUMP[J]:=1;
FOR K:=2 TO 4 DO
BEGIN
IF POWER[J,K]*SUIT[J,K]>POWER[J,TRUMP[J]]*SUIT[J,TRUMP[J]]
THEN TRUMP[J]:=K
END
END;
FOR J:=1 TO 4 DO
BEGIN
FOR K:=1 TO 4 DO
BEGIN
IF (CARD[J,2,K]>0) AND (CARD[J,3,K]>0) AND (CARD[J,4,K]>0)
AND (CARD[J,5,K]>0) AND (CARD[J,6,K]>0) THEN
BEGIN
RUN[J,K]:=1;
MELD[J]:=MELD[J]+11;
TRUMP[J]:=K
END
END
END;
FOR J:=1 TO 4 DO
BEGIN
IF (CARD[J,2,1]>0) AND (CARD[J,2,2]>0) AND (CARD[J,2,3]>0) AND
(CARD[J,2,4]>0) THEN
BEGIN
AROUND[J,2]:=1;
MELD[J]:=MELD[J]+4
END;
IF (CARD[J,3,1]>0) AND (CARD[J,3,2]>0) AND (CARD[J,3,3]>0) AND
(CARD[J,3,4]>0) THEN
BEGIN
AROUND[J,3]:=1;
MELD[J]:=MELD[J]+6
END;
IF (CARD[J,6,1]>0) AND (CARD[J,6,2]>0) AND (CARD[J,6,3]>0) AND
(CARD[J,6,4]>0) THEN
BEGIN
AROUND[J,6]:=1;
MELD[J]:=MELD[J]+10
END;
IF (CARD[J,4,1]>0) AND (CARD[J,4,2]>0) AND (CARD[J,4,3]>0) AND
(CARD[J,4,4]>0) THEN
BEGIN
AROUND[J,4]:=1;
MELD[J]:=MELD[J]+8
END;
FOR K:=1 TO 4 DO
BEGIN
IF (CARD[J,3,K]>0) AND (CARD[J,4,K]>0) THEN
BEGIN
MRG[J,K]:=1;
IF (CARD[J,3,K]=2) AND (CARD[J,4,K]=2) THEN MRG[J,K]:=2;
IF TRUMP[J]=K THEN COUNT:=2 ELSE COUNT:=1;
MELD[J]:=MELD[J]+2*MRG[J,K]*COUNT
END
END;
MELD[J]:=MELD[J]+CARD[J,1,TRUMP[J]];
IF (CARD[J,2,3]>0) AND (CARD[J,3,4]>0) THEN
BEGIN
PINOC[J]:=TRUNC((CARD[J,2,3]+CARD[J,3,4])/2);
MELD[J]:=MELD[J]+4;
IF (CARD[J,2,3]=2) AND (CARD[J,3,4]=2) THEN MELD[J]:=MELD[J]+26
END;
BID[J]:=MELD[J]+2*ACES[J]+TRUNC((SUIT[J,TRUMP[J]]-1)/2)+5;
FOR K:=1 TO 4 DO
BEGIN
IF K<>TRUMP[J] THEN BID[J]:=BID[J]+3-SUIT[J,K]
END
END;
HAND1:=HAND
END; (* HIBIDANDMELD *)

PROCEDURE BIDDING; (* THIS IS THE BIDDING ROUTINE *)
LABEL 11,22,33,44,55,66,77,88;
VAR BU : FOURINT;
TST : INTEGER;
BEGIN
FOR J:=1 TO 4 DO BU[J]:=1;
HIBID:=14;
WRITELN(OUTPUT,'Your cards are ',HAND[1]);
K:=STARTBID;
11:
J:=(K MOD 4)+1;
IF BU[J]=0 THEN GOTO 66;
IF J=1 THEN
BEGIN
22:
ANSW[1]:=' ';
REPEAT WRITE(OUTPUT,'What do you want to bid? ');
READLN(INPUT,ANSW) UNTIL ANSW[1]<>' ';
IF (ANSW[1]='?') AND (ANSW[2]='?') THEN GOTO 33
ELSE IF ANSW[1]='?' THEN WRITELN(OUTPUT,HAND[1]);
IF ANSW[1]='P' THEN
BEGIN
BID[1]:=0;
GOTO 33
END;
IF NOT((ANSW[1] IN ['0'..'9']) AND (ANSW[2] IN ['0'..'9'])) THEN
GOTO 22;
TST:=10*(ORD(ANSW[1])-48)+(ORD(ANSW[2])-48);
IF TST<=HIBID THEN
BEGIN
WRITE(OUTPUT,'BID TOO LOW -- ');
GOTO 22
END;
HIBID:=TST;
GOTO 55;
33:
END;
IF (BU[STARTBID]=0) AND (K=STARTBID+1) THEN GOTO 44;
IF HIBID>=BID[J] THEN
BEGIN
WRITELN(OUTPUT,NAME[J],' passes');
BU[J]:=0;
GOTO 66
END;
44:
HIBID:=HIBID+1;
55:
WRITELN(OUTPUT,NAME[J],' bids',HIBID);
66:
IF (BU[1]+BU[2]+BU[3]+BU[4]>1) THEN
BEGIN
K:=K+1;
GOTO 11
END;
J:=1;
WHILE BU[J]<>1 DO J:=J+1;
WINBID:=J;
IF HIBID<15 THEN HIBID:=15;
WRITELN(OUTPUT,'The bid goes to ',NAME[J],' at',HIBID:3);
TRUMP1:=TRUMP[WINBID];
IF WINBID=1 THEN
77:
BEGIN
ANSW[1]:=' ';
REPEAT WRITE(OUTPUT,'You won the bid. What''s trump? ');
READLN(INPUT,ANSW) UNTIL ANSW[1]<>' ';
IF (ANSW[1]='?') AND (ANSW[2]='?') THEN GOTO 88
ELSE IF ANSW[1]='?' THEN
BEGIN
SHOWIT;
GOTO 77
END;
IF NOT(ANSW[1] IN ['C','c','H','h','D','d','S','s']) THEN
BEGIN
WRITELN(OUTPUT,'No such trump -- try that again.');
GOTO 77
END;
FOR J:=1 TO 4 DO IF (ANSW[1]=AB[J]) OR (ANSW[1]=AB1[J]) THEN TRUMP1:=J;
88:
END;
WRITELN(OUTPUT,'Trump is ',SUIT1[TRUMP1]);
FOR J:=1 TO 4 DO
BEGIN
WRITELN(OUTPUT,'Meld for ',NAME[J]);
IF AROUND[J,2]>0 THEN WRITELN(OUTPUT,' Jacks around');
IF AROUND[J,3]=1 THEN WRITELN(OUTPUT,' Queens around');
IF AROUND[J,4]=1 THEN WRITELN(OUTPUT,' Kings around');
IF AROUND[J,6]=1 THEN WRITELN(OUTPUT,' Aces around');
IF PINOC[J]>0 THEN WRITELN(OUTPUT,' ',PINOC[J]:1,' pinochle(s)');
FOR K:=1 TO 4 DO
BEGIN
IF (RUN[J,K]>0) AND (MRG[J,K]=2) THEN WRITELN(OUTPUT,' 1 marriage in trump');
IF (K=TRUMP1) AND (MRG[J,K]>0) AND (RUN[J,K]=0) THEN
WRITELN(OUTPUT,' ',MRG[J,K]:1,' marriage(s) in trump');
IF (K<>TRUMP1) AND (MRG[J,K]>0) THEN
WRITELN(OUTPUT,' ',MRG[J,K]:1,' marriage(s) in ',SUIT1[K])
END;
FOR K:=1 TO 4 DO
BEGIN
IF (K=TRUMP1) AND (RUN[J,K]>0) THEN WRITELN(OUTPUT,' A run in ',SUIT1[K])
END;
IF CARD[J,1,TRUMP1]>0 THEN WRITELN(OUTPUT,' ',CARD[J,1,TRUMP1]:1,' nines');
MELD[J]:=MELD[J]-RUN[J,TRUMP[J]]*11-MRG[J,TRUMP[J]]
*2-CARD[J,1,TRUMP[J]];
MELD[J]:=MELD[J]+CARD[J,1,TRUMP1]+MRG[J,TRUMP1]*2+RUN[J,TRUMP1]*11
END;
TEAM1:=MELD[1]+MELD[3];
TEAM2:=MELD[2]+MELD[4];
WRITELN(OUTPUT,'Meld for us:',TEAM1:3);
WRITELN(OUTPUT,'Meld for them:',TEAM2:3);
K:=((WINBID+1) MOD 4)+1;
IF (MELD[WINBID]+MELD[K]<=HIBID) AND (ODD(WINBID))
THEN WRITELN(OUTPUT,'We have to pull:',(HIBID-TEAM1):3)
ELSE IF MELD[WINBID]+MELD[K]<=HIBID THEN
WRITELN(OUTPUT,'They have to pull:',(HIBID-TEAM2):3);
PLAYR:=WINBID
END; (* BIDDING *)

PROCEDURE PLAYING; (* THIS IS THE PLAYING ROUTINE *)
LABEL 99,100,120,130,140,150,160,
170,180,190,200,210,220;
VAR HITRMP,BNTRMP,HICARD : INTEGER;
WINIT,ZOOT,ZOOT1 : INTEGER;
J1,J2,LENGTH,KIND1 : INTEGER;
POINT,POINT1,POINT2 : INTEGER;
ACES1 : FOURINT;
POINTS : ARRAY [1..2] OF INTEGER;
BEGIN
FOR J:=1 TO 4 DO ACES1[J]:=0;
POINTS[1]:=0; POINTS[2]:=0; POINT1:=0; POINT2:=0;
FOR J1:=1 TO 12 DO
BEGIN
POINT:=0; HICARD:=0; HITRMP:=0; WINIT:=0;
BNTRMP:=0; ZOOT:=0; ZOOT1:=0;
PLAY:=' ';
FOR J2:=1 TO 4 DO
BEGIN
IF J1<>12 THEN IF PLAYR=1 THEN
99:
BEGIN
ANSW:=' ';
REPEAT WRITE(OUTPUT,'What card do you want to play? ');
READLN(INPUT,ANSW) UNTIL ANSW[1]<>' ';
IF (ANSW[1]='?') AND (ANSW[2]='?') THEN GOTO 100
ELSE IF ANSW[1]='?' THEN
BEGIN
SHOWIT;
GOTO 99
END;
IF ANSW[1]='j' THEN ANSW[1]:='J';
IF ANSW[1]='q' THEN ANSW[1]:='Q';
IF ANSW[1]='k' THEN ANSW[1]:='K';
IF ANSW[1]='a' THEN ANSW[1]:='A';

IF ANSW[2]='c' THEN ANSW[2]:='C';
IF ANSW[2]='h' THEN ANSW[2]:='H';
IF ANSW[2]='d' THEN ANSW[2]:='D';
IF ANSW[2]='s' THEN ANSW[2]:='S';

IF ANSW[3]='c' THEN ANSW[3]:='C';
IF ANSW[3]='h' THEN ANSW[3]:='H';
IF ANSW[3]='d' THEN ANSW[3]:='D';
IF ANSW[3]='s' THEN ANSW[3]:='S';

IF (J2<>1) THEN
BEGIN
IF (SUIT[1,ZOOT]<>0) AND (INDEX1('CHDS',ANSW)
<>ZOOT) THEN
BEGIN
WRITELN(OUTPUT,'You didn''t follow suit. Try that again.');
GOTO 99
END
END;
FOR K:=1 TO 12 DO
BEGIN
IF (C[K]=ANSW) AND (ANSW[1]<>'X') THEN
BEGIN
PLAY:=ANSW;
C[K]:='XXX';
GOTO 170
END
END;
WRITELN(OUTPUT,'You don''t have that card. Reenter play -');
GOTO 99;
100:
END;



(* THIS IS THE LEADING ROUTINE *)

IF J2=1 THEN
BEGIN
IF ACES[PLAYR]=0 THEN GOTO 150;
FOR J:=10 DOWNTO 1 DO
BEGIN
FOR K:=1 TO 4 DO
BEGIN
IF(K=TRUMP1) AND (13-J1>SUIT[PLAYR,TRUMP1]) THEN GOTO 120;
IF(SUIT[PLAYR,K]=J) AND (CARD[PLAYR,6,K]>0) THEN CONCAT(6,K);
IF PLAY<>' ' THEN GOTO 130;
120:
END
END;
130:
FOR J:=1 TO 4 DO IF(SUIT[PLAYR,J]=1) AND (CARD[PLAYR,6,J]=1)
AND (ACES1[J]=0) THEN CONCAT(6,J);
IF PLAY=' ' THEN GOTO 150;
GOTO 140
END;

(* THIS IS THE TRUMPING ROUTINE *)

IF SUIT[PLAYR,ZOOT]=0 THEN
BEGIN
IF SUIT[PLAYR,TRUMP1]=0 THEN GOTO 150;
IF BNTRMP=0 THEN
BEGIN
K:=0;
WHILE K<>6 DO
BEGIN
CASE K OF
0 : K:=4;
4 : K:=3;
3 : K:=1;
1 : K:=2;
2 : K:=5;
5 : K:=6
END;
IF CARD[PLAYR,K,TRUMP1]>0 THEN
BEGIN
KIND:=K;
GOTO 160
END
END
END;
FOR J:=1 TO 6 DO
BEGIN
K:=((HITRMP-1+J) MOD 6)+1;
IF CARD[PLAYR,K,TRUMP1]>0 THEN
BEGIN
KIND:=K;
GOTO 160
END
END;
160:
IF (CARD[PLAYR,6,TRUMP1]=2) AND (HITRMP<5) AND
(CARD[PLAYR,5,TRUMP1]>0) THEN KIND:=5;
CONCAT(KIND,TRUMP1);
GOTO 170
END;
FOR J:=1 TO 6 DO
BEGIN
K:=((HICARD-1+J) MOD 6)+1;
IF CARD[PLAYR,K,ZOOT]>0 THEN
BEGIN
CONCAT(K,ZOOT);
GOTO 180
END
END;
180:
IF(CARD[PLAYR,6,ZOOT]>0) AND (HICARD<6) AND (BNTRMP=0) THEN
CONCAT(6,ZOOT);
140:
KIND:=INDEX2('9JQK1A');
ZOOT1:=INDEX1('CHDS',PLAY);
K:=((PLAYR+1) MOD 4)+1;
IF(BNTRMP=0) AND (ZOOT<>TRUMP1) AND (KIND (WINIT=K) THEN GOTO 190;
IF(BNTRMP=1) AND ((ZOOT1=TRUMP1) AND (KIND (ZOOT1<>TRUMP1)) AND (WINIT=K) THEN GOTO 190;
170:
WRITELN(OUTPUT,NAME[PLAYR],' plays the ',PLAY);


(* THIS ROUTINE DETERMINES WHO TAKES THE TRICK *)

IF PLAY[3]=' ' THEN LENGTH:=2 ELSE LENGTH:=3;
DELETE(HAND[PLAYR],INDEX(HAND[PLAYR]),LENGTH);
ZOOT1:=INDEX1('CHDS',PLAY);
KIND1:=INDEX2('9JQK1A');
SUIT[PLAYR,ZOOT1]:=SUIT[PLAYR,ZOOT1]-1;
CARD[PLAYR,KIND1,ZOOT1]:=CARD[PLAYR,KIND1,ZOOT1]-1;
IF J2=1 THEN ZOOT:=ZOOT1;
IF KIND1=6 THEN ACES1[ZOOT1]:=ACES1[ZOOT1]+1;
IF(ZOOT1<>ZOOT) AND (ZOOT1<>TRUMP1) THEN GOTO 200;
IF(BNTRMP=0) AND ((ZOOT=TRUMP1) OR ((ZOOT<>TRUMP1) AND
(ZOOT1<>TRUMP1))) THEN
BEGIN
IF KIND1>HICARD THEN
BEGIN
WINIT:=PLAYR;
HICARD:=KIND1
END
END;
IF(BNTRMP=0) AND (ZOOT<>TRUMP1) AND (ZOOT1=TRUMP1) THEN
BEGIN
BNTRMP:=1;
WINIT:=PLAYR;
HITRMP:=KIND1
END;
IF(BNTRMP=1) AND (ZOOT<>TRUMP1) AND (ZOOT1=TRUMP1) THEN
BEGIN
IF KIND1>HITRMP THEN
BEGIN
WINIT:=PLAYR;
HITRMP:=KIND1
END
END;
200:
IF KIND1>3 THEN POINT:=POINT+1;
PLAYR:=(PLAYR MOD 4)+1;
GOTO 210;
(* THIS ROUTINE DETERMINES A POINT TO GIVE YOUR PARTNER *)

190:

J:=0;
WHILE J<>6 DO
BEGIN
CASE J OF
0 : J:=4;
4 : J:=5;
5 : J:=3;
3 : J:=2;
2 : J:=1;
1 : J:=6
END;
IF CARD[PLAYR,J,ZOOT]>0 THEN
BEGIN
CONCAT(J,ZOOT);
GOTO 170
END
END;
IF(SUIT[PLAYR,TRUMP1]=0) AND (SUIT[PLAYR,ZOOT]=0) THEN
BEGIN
J:=0;
WHILE J<>6 DO
BEGIN
CASE J OF
0 : J:=4;
4 : J:=5;
5 : J:=3;
3 : J:=2;
2 : J:=1;
1 : J:=6
END;
FOR K:=1 TO 4 DO
BEGIN
IF CARD[PLAYR,J,K]>0 THEN
BEGIN
CONCAT(J,K);
GOTO 170
END
END
END;
150:
J:=0;
WHILE J<>6 DO
BEGIN
CASE J OF
0 : J:=3;
3 : J:=2;
2 : J:=1;
1 : J:=4;
4 : J:=5;
5 : J:=6
END;
FOR K:=1 TO 4 DO
BEGIN
IF (K=TRUMP1) AND (13-J1>SUIT[PLAYR,TRUMP1]) THEN GOTO 220;
IF CARD[PLAYR,J,K]>0 THEN
BEGIN
CONCAT(J,K);
GOTO 140
END;
220:
END
END;
210:
END
END;
IF ODD(WINIT) THEN POINT1:=POINT1+POINT
ELSE POINT2:=POINT2+POINT;
IF (J1=12) AND (ODD(WINIT)) THEN POINT1:=POINT1+1;
IF (J1=12) AND (NOT(ODD(WINIT))) THEN POINT2:=POINT2+1;
IF ODD(WINIT) THEN WRITELN(OUTPUT,'We took the trick')
ELSE WRITELN(OUTPUT,'They took the trick');
PLAYR:=WINIT
END;
WRITELN(OUTPUT,'We pulled',POINT1:3,' points');
WRITELN(OUTPUT,'They pulled',POINT2:3,' points');
POINTS[1]:=POINT1+TEAM1;
POINTS[2]:=POINT2+TEAM2;
IF POINT1=0 THEN
BEGIN
WRITELN(OUTPUT,'They pulled an all-tricker');
POINTS[1]:=0
END;
IF POINT2=0 THEN
BEGIN
WRITELN(OUTPUT,'***** We pulled an all-tricker *****');
POINTS[2]:=0
END;
IF (ODD(WINBID)) AND (HIBID>TEAM1+POINT1) AND (POINT2<>25) THEN
BEGIN
WRITELN(OUTPUT,'We got set');
POINTS[1]:=(-1)*HIBID
END;
IF (NOT(ODD(WINBID))) AND (HIBID>POINT2+TEAM2) AND (POINT1<>25) THEN
BEGIN
WRITELN(OUTPUT,'We set them');
POINTS[2]:=(-1)*HIBID
END;
SCORE[1]:=SCORE[1]+POINTS[1];
SCORE[2]:=SCORE[2]+POINTS[2]
END; (* PLAYING *)

PROCEDURE ENDING;
BEGIN
WRITE(OUTPUT,'Do you want to see the hands?');
READLN(INPUT,ANSW);
IF (ANSW[1]='Y') OR (ANSW[1]='y') THEN
BEGIN
WRITELN(OUTPUT,'The hands were:');
FOR J:=1 TO 4 DO WRITELN(OUTPUT,'For ',NAME[J],HAND1[J])
END;
WRITE(OUTPUT,'The score after',NHAND:4,' hands is ');
WRITELN(OUTPUT,'We:',SCORE[1]:5,' They:',SCORE[2]:5);
IF (SCORE[1]>99) OR (SCORE[2]>99) THEN
BEGIN
J:=0;
IF (SCORE[1]>99) AND (SCORE[2]>99) THEN
BEGIN
IF ODD(WINBID) THEN J:=1
END ELSE IF SCORE[1]>SCORE[2] THEN J:=1;
IF J=1 THEN WRITELN(OUTPUT,'*** WE WON ***') ELSE
WRITELN(OUTPUT,'*** THEY WON ***');
WRITE(OUTPUT,'Do you want to play another game?');
READLN(INPUT,ANSW);
SCORE[1]:=0; SCORE[2]:=0; STARTBID:=0; NHAND:=0
END
END; (* ENDING *)

LABEL 11;
BEGIN (* PINOCHLE *)
INIT;
NHAND:=1;
11:
ZEROINIT;
DEALING;
HIBIDANDMELD;
BIDDING;
PLAYING;
ENDING;
IF (ANSW[1]='Y') OR (ANSW[1]='y') OR (NHAND<>0) THEN
BEGIN
NHAND:=NHAND+1;
GOTO 11
END
END. (* PINOCHLE *)