PROGRAM PINOCHLE(TTY,OUTPUT); (* 1/80 - TRANSLATED TO PASCAL FROM PL1 BY STEPHEN DOVER *) (* PL1 AUTHOR ANONYMOUS *) CONST STRLEN=45; TYPE INSTR = 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; 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 INDEX(VAR TEMP : INSTR) : INTEGER; (*$Y+*) 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; (*$Y+*) 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; (*$Y+*) 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 *) FUNCTION TICK : INTEGER; EXTERN; PROCEDURE PUTHLP; (*$Y+*) BEGIN WRITELN(TTY,'? TYPED FOR ANY QUESTION PRINTS YOUR CURRENT HAND'); WRITELN(TTY,'?? TELLS THE COMPUTER TO PLAY YOUR TURN') END; (* PUTHLP *) PROCEDURE SHOWIT; (*$Y+*) BEGIN WRITELN(TTY,HAND[1]); WRITELN(TTY,'TRUMP IS ',SUIT1[TRUMP1]) END; (* SHOWIT *) PROCEDURE CONCAT(TEMP,TEMP1 : INTEGER); (*$Y+*) 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); (*$Y+*) 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; (*$Y+*) LABEL 11; VAR PEOPLE : ARRAY [1..9] OF EITPACK; WHO : ARRAY [1..4] OF INTEGER; D : ARRAY [1..9] OF INTEGER; 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'; 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(TTY,'HI - THIS IS PINOCHLE, WHAT''S YOUR NAME? '); BREAK; READLN(TTY); READ(TTY,NAME[1]) UNTIL NAME[1]<>' '; FOR J:=1 TO 9 DO D[J]:=J; K:=RUNTIME 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(TTY,'HI ',NAME[1],'YOUR PARTNER IS ',NAME[3]); WRITE(TTY,'DO YOU NEED HELP?'); BREAK; READLN(TTY); READ(TTY,ANSW); IF ANSW[1]='Y' THEN PUTHLP; END; (* INIT *) PROCEDURE ZEROINIT; (*$Y+*) 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; (*$Y+*) (* 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; 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:=(TICK 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]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; (*$Y+*) (* THIS IS THE BIDDING ROUTINE *) LABEL 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(TTY,'YOUR CARDS ARE ',HAND[1]); K:=STARTBID; LOOP J:=(K MOD 4)+1; IF BU[J]=0 THEN GOTO 66; IF J=1 THEN BEGIN 22: ANSW[1]:=' '; REPEAT WRITE(TTY,'WHAT DO YOU WANT TO BID? '); BREAK; READLN(TTY); READ(TTY,ANSW) UNTIL ANSW[1]<>' '; IF (ANSW[1]='?') AND (ANSW[2]='?') THEN GOTO 33 ELSE IF ANSW[1]='?' THEN WRITELN(TTY,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(TTY,'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(TTY,NAME[J],' PASSES'); BU[J]:=0; GOTO 66 END; 44: HIBID:=HIBID+1; 55: WRITELN(TTY,NAME[J],' BIDS',HIBID); 66: EXIT IF BU[1]+BU[2]+BU[3]+BU[4]<=1; K:=K+1 END; J:=1; WHILE BU[J]<>1 DO J:=J+1; WINBID:=J; IF HIBID<15 THEN HIBID:=15; WRITELN(TTY,'THE BID GOES TO ',NAME[J],' AT',HIBID:3); TRUMP1:=TRUMP[WINBID]; IF WINBID=1 THEN 77: BEGIN ANSW[1]:=' '; REPEAT WRITE(TTY,'YOU WON THE BID. WHAT''S TRUMP? '); BREAK; READLN(TTY); READ(TTY,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','H','D','S']) THEN BEGIN WRITELN(TTY,'NO SUCH TRUMP -- TRY THAT AGAIN'); GOTO 77 END; FOR J:=1 TO 4 DO IF ANSW[1]=AB[J] THEN TRUMP1:=J; 88: END; WRITELN(TTY,'TRUMP IS ',SUIT1[TRUMP1]); FOR J:=1 TO 4 DO BEGIN WRITELN(TTY,'MELD FOR ',NAME[J]); IF AROUND[J,2]>0 THEN WRITELN(TTY,'JACKS AROUND'); IF AROUND[J,3]=1 THEN WRITELN(TTY,'QUEENS AROUND'); IF AROUND[J,4]=1 THEN WRITELN(TTY,'KINGS AROUND'); IF AROUND[J,6]=1 THEN WRITELN(TTY,'ACES AROUND'); IF PINOC[J]>0 THEN WRITELN(TTY,PINOC[J]:1,' PINOCHLE(S)'); FOR K:=1 TO 4 DO BEGIN IF (RUN[J,K]>0) AND (MRG[J,K]=2) THEN WRITELN(TTY,'1 MARRIAGE IN TRUMP'); IF (K=TRUMP1) AND (MRG[J,K]>0) AND (RUN[J,K]=0) THEN WRITELN(TTY,MRG[J,K]:1,' MARRIAGE(S) IN TRUMP'); IF (K<>TRUMP1) AND (MRG[J,K]>0) THEN WRITELN(TTY,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(TTY,'A RUN IN ',SUIT1[K]) END; IF CARD[J,1,TRUMP1]>0 THEN WRITELN(TTY,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(TTY,'MELD FOR US:',TEAM1:3); WRITELN(TTY,'MELD FOR THEM:',TEAM2:3); K:=((WINBID+1) MOD 4)+1; IF (MELD[WINBID]+MELD[K]<=HIBID) AND (ODD(WINBID)) THEN WRITELN(TTY,'WE HAVE TO PULL',(HIBID-TEAM1):3) ELSE IF MELD[WINBID]+MELD[K]<=HIBID THEN WRITELN(TTY,'THEY HAVE TO PULL ',(HIBID-TEAM2):3); PLAYR:=WINBID END; (* BIDDING *) PROCEDURE PLAYING; (*$Y+*) (* 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(TTY,'WHAT CARD DO YOU WANT TO PLAY? '); BREAK; READLN(TTY); READ(TTY,ANSW) UNTIL ANSW[1]<>' '; IF (ANSW[1]='?') AND (ANSW[2]='?') THEN GOTO 100 ELSE IF ANSW[1]='?' THEN BEGIN SHOWIT; GOTO 99 END; IF (J2<>1) THEN BEGIN IF (SUIT[1,ZOOT]<>0) AND (INDEX1('CHDS',ANSW) <>ZOOT) THEN BEGIN WRITELN(TTY,'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(TTY,'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 (KINDTRUMP1)) AND (WINIT=K) THEN GOTO 190; 170: WRITELN(TTY,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(TTY,'WE TOOK THE TRICK') ELSE WRITELN(TTY,'THEY TOOK THE TRICK'); PLAYR:=WINIT END; WRITELN(TTY,'WE PULLED',POINT1:3,' POINTS'); WRITELN(TTY,'THEY PULLED',POINT2:3,' POINTS'); POINTS[1]:=POINT1+TEAM1; POINTS[2]:=POINT2+TEAM2; IF POINT1=0 THEN BEGIN WRITELN(TTY,'THEY PULLED AN ALL-TRICKER'); POINTS[1]:=0 END; IF POINT2=0 THEN BEGIN WRITELN(TTY,'***** WE PULLED AN ALL-TRICKER *****'); POINTS[2]:=0 END; IF (ODD(WINBID)) AND (HIBID>TEAM1+POINT1) AND (POINT2<>25) THEN BEGIN WRITELN(TTY,'WE GOT SET'); POINTS[1]:=(-1)*HIBID END; IF (NOT(ODD(WINBID))) AND (HIBID>POINT2+TEAM2) AND (POINT1<>25) THEN BEGIN WRITELN(TTY,'WE SET THEM'); POINTS[2]:=(-1)*HIBID END; SCORE[1]:=SCORE[1]+POINTS[1]; SCORE[2]:=SCORE[2]+POINTS[2] END; (* PLAYING *) PROCEDURE ENDING; (*$Y+*) BEGIN WRITE(TTY,'DO YOU WANT TO SEE THE HANDS?'); BREAK; READLN(TTY); READ(TTY,ANSW); IF ANSW[1]='Y' THEN BEGIN WRITELN(TTY,'THE HANDS WERE:'); FOR J:=1 TO 4 DO WRITELN(TTY,'FOR ',NAME[J],HAND1[J]) END; WRITE(TTY,'THE SCORE AFTER',NHAND:4,' HANDS IS '); WRITELN(TTY,'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(TTY,'*** WE WON ***') ELSE WRITELN(TTY,'*** THEY WON ***'); WRITE(TTY,'DO YOU WANT TO PLAY ANOTHER GAME?'); BREAK; READLN(TTY); READ(TTY,ANSW); SCORE[1]:=0; SCORE[2]:=0; STARTBID:=0; NHAND:=0 END END; (* ENDING *) BEGIN (* PINOCHLE *) INIT; NHAND:=1; LOOP ZEROINIT; DEALING; HIBIDANDMELD; BIDDING; PLAYING; ENDING; EXIT IF (ANSW[1]<>'Y') AND (NHAND=0); NHAND:=NHAND+1 END END. (* PINOCHLE *)