COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER I INTEGER ANS(2) SHORTCALL MKONU$(18) EXTERNAL QUITF0 INTEGER AAAAA0(4) INTEGER AAAAB0(26) INTEGER AAAAC0(9) INTEGER AAAAD0(13) DATA AAAAA0/5,-11819,-13868,-23392/ DATA AAAAB0/195,239,238,231,242,225,244,245,236,225,244,233,239,23 *8,243,172,160,217,239,245,160,247,239,238,161,0/ DATA AAAAC0/211,239,242,242,249,174,174,174,0/ DATA AAAAD0/208,236,225,249,160,225,231,225,233,238,191,160,0/ CALL MKONU$(AAAAA0,LOC(QUITF0)) CALL INITI0 10000 CALL MESSA0(0) GAMEO0=.FALSE. TIMES0=0 CALL SETGA0 CALL SHUFF0 CALL DEAL 10001 CALL DISPL0 CALL TURN IF((.NOT.GAMEO0))GOTO 10001 IF((GAMET0.NE.0))GOTO 10002 CALL TALLY GOTO 10003 10002 CALL COUNT0(I) IF((I.GT.0))GOTO 10004 CALL MESSA0(AAAAB0) GOTO 10005 10004 CALL MESSA0(AAAAC0) 10005 CONTINUE 10003 CALL PROMPT(AAAAD0) CALL VTENB(20,13,2) CALL VTREAD(20,13,1) CALL VTGETL(ANS,20,13,2) IF((ANS(1).EQ.249))GOTO 10000 IF((ANS(1).EQ.217))GOTO 10000 CALL LOGRE0 CALL VTSTOP CALL SWT END SUBROUTINE ADDCA0(CARD,TO) INTEGER CARD,TO COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 PILEA0(1,TO)=PILEA0(1,TO)+(1) DECKA0(1,CARD)=PILEA0(2,TO) DECKA0(2,CARD)=TO PILEA0(2,TO)=CARD RETURN END INTEGER FUNCTION CARDI0(CARD) INTEGER CARD COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER LOC LOC=DECKA0(2,CARD) IF((PILEA0(2,20).EQ.CARD))GOTO 10007 IF((1.GT.LOC-0))GOTO 10006 IF((LOC-0.GT.7))GOTO 10006 GOTO 10007 10007 CARDI0=1 RETURN 10006 CARDI0=0 RETURN END INTEGER FUNCTION CHECK0(CARD,SUIT) INTEGER CARD,SUIT COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER CARDR0,CARDS0,LOC,RANK CARDS0=DECKA0(3,CARD)/16 CARDR0=MOD(DECKA0(3,CARD),16) LOC=DECKA0(2,CARD) IF((PILEA0(1,14+SUIT).GT.0))GOTO 10009 RANK=0 GOTO 10010 10009 RANK=MOD(DECKA0(3,PILEA0(2,14+SUIT)),16) 10010 IF((CARDS0.NE.SUIT))GOTO 10012 IF((CARDR0-RANK.NE.1))GOTO 10012 IF((PILEA0(2,LOC).NE.CARD))GOTO 10012 GOTO 10011 10012 CHECK0=0 RETURN 10011 CHECK0=1 RETURN END INTEGER FUNCTION CHECL0(CARD,PILE) INTEGER CARD,PILE COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER RANK,I RANK=MOD(DECKA0(3,CARD),16) IF((RANK.EQ.13))GOTO 10013 CHECL0=0 RETURN 10013 I=0+1 GOTO 10016 10014 I=I+(1) 10016 IF((I.GT.0+7))GOTO 10015 IF((PILEA0(1,I).GT.0))GOTO 10014 PILE=I CHECL0=1 RETURN 10015 CHECL0=0 RETURN END INTEGER FUNCTION CHECM0(CARD,STACK) INTEGER CARD,STACK COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER COLOR(4),CARDS0,CARDR0,SUIT,RANK DATA COLOR/1,0,0,1/ IF((PILEA0(1,0+STACK).GT.0))GOTO 10018 CHECM0=0 RETURN 10018 CARDS0=DECKA0(3,CARD)/16 CARDR0=MOD(DECKA0(3,CARD),16) SUIT=DECKA0(3,PILEA0(2,0+STACK))/16 RANK=MOD(DECKA0(3,PILEA0(2,0+STACK)),16) IF((COLOR(SUIT).EQ.COLOR(CARDS0)))GOTO 10020 IF((RANK-CARDR0.NE.1))GOTO 10020 GOTO 10019 10020 CHECM0=0 RETURN 10019 CHECM0=1 RETURN END SUBROUTINE COUNT0(COUNT) INTEGER COUNT COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER I COUNT=PILEA0(1,20)+PILEA0(1,19) DO 10021 I=1,7 COUNT=COUNT+(PILEA0(1,7+I)) 10021 CONTINUE 10022 RETURN END SUBROUTINE DEAL COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER I,J PILEA0(1,19)=0 PILEA0(1,20)=0 DO 10023 I=1,7 PILEA0(1,0+I)=0 PILEA0(1,7+I)=0 10023 CONTINUE 10024 DO 10025 I=1,4 PILEA0(1,14+I)=0 10025 CONTINUE 10026 I=52 GOTO 10029 10027 I=I-(1) 10029 IF((I.LE.0))GOTO 10028 CALL ADDCA0(I,19) GOTO 10027 10028 DO 10030 I=1,7 CALL MOVEC0(19,0+I) J=I+1 GOTO 10034 10032 J=J+(1) 10034 IF((J.GT.7))GOTO 10033 CALL MOVEC0(19,7+J) GOTO 10032 10033 CONTINUE 10030 CONTINUE 10031 RETURN END SUBROUTINE DISPL0 COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER COL,CARD,I,J INTEGER TIME(9) INTEGER AAAAE0(4) INTEGER AAAAF0(6) INTEGER AAAAG0(4) INTEGER AAAAH0(6) INTEGER AAAAI0(5) INTEGER AAAAJ0(4) INTEGER AAAAK0(5) INTEGER AAAAL0(5) INTEGER AAAAM0(4) INTEGER AAAAN0(4) DATA AAAAE0/160,160,160,0/ DATA AAAAF0/168,170,178,233,169,0/ DATA AAAAG0/170,178,233,0/ DATA AAAAH0/168,170,233,169,160,0/ DATA AAAAI0/160,160,160,160,0/ DATA AAAAJ0/160,160,160,0/ DATA AAAAK0/160,160,160,160,0/ DATA AAAAL0/168,170,233,169,0/ DATA AAAAM0/160,160,160,0/ DATA AAAAN0/160,160,160,0/ CALL DATE(2,TIME) TIME(6)=0 CALL VTPUTL(TIME,1,41) DO 10035 I=1,4 IF((PILEA0(1,14+I).LE.0))GOTO 10037 CALL DISPM0(3,18+(I-1)*7,PILEA0(2,14+I)) GOTO 10038 10037 CALL VTPUTL(AAAAE0,3,18+(I-1)*7) 10038 CONTINUE 10035 CONTINUE 10036 CALL VTPRT(3,67,AAAAF0,PILEA0(1,19)) CALL VTPRT(4,60,AAAAG0,TIMES0) IF((PILEA0(1,20).LE.0))GOTO 10039 CALL DISPM0(4,68,PILEA0(2,20)) IF((PILEA0(1,20).LE.1))GOTO 10040 CALL VTPRT(4,68+4,AAAAH0,PILEA0(1,20)-1) GOTO 10042 10040 CALL VTPUTL(AAAAI0,4,68+4) 10041 GOTO 10042 10039 CALL VTPUTL(AAAAJ0,4,68) CALL VTPUTL(AAAAK0,4,68+4) 10042 I=1 GOTO 10045 10043 I=I+(1) 10045 IF((I.GT.7))GOTO 10044 COL=30+(I-1)*7 IF((PILEA0(1,7+I).LE.0))GOTO 10046 CALL VTPRT(6,COL,AAAAL0,PILEA0(1,7+I)) GOTO 10047 10046 CALL VTPUTL(AAAAM0,6,COL) 10047 CARD=PILEA0(2,0+I) J=PILEA0(1,0+I) GOTO 10050 10048 J=J-(1) 10050 IF((J.LE.0))GOTO 10049 CALL DISPM0(6+J,COL,CARD) CARD=DECKA0(1,CARD) GOTO 10048 10049 J=PILEA0(1,0+I)+1 GOTO 10053 10051 J=J+(1) 10053 IF((J.GT.12))GOTO 10043 CALL VTPUTL(AAAAN0,6+J,COL) GOTO 10051 10044 CALL VTUPD(0) RETURN END SUBROUTINE DISPM0(ROW,COL,CARD) INTEGER ROW,COL,CARD COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER COLOR INTEGER S,V INTEGER SUIT(5) INTEGER VALUE(14) INTEGER AAAAO0(7) DATA SUIT/243,232,228,227,0/ DATA VALUE/193,178,179,180,181,182,183,184,185,212,202,209,203,0/ DATA AAAAO0/170,227,170,227,170,227,0/ S=DECKA0(3,CARD)/16 V=MOD(DECKA0(3,CARD),16) IF((S.EQ.2))GOTO 10055 IF((S.EQ.3))GOTO 10055 GOTO 10054 10055 COLOR=REDAA0 GOTO 10056 10054 COLOR=BLACK0 10056 CALL VTPRT(ROW,COL,AAAAO0,VALUE(V),SUIT(S),COLOR) RETURN END SUBROUTINE FLIPS0 COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER I IF((PILEA0(1,19).GT.0))GOTO 10057 IF((GAMET0.EQ.0))GOTO 10057 TIMES0=TIMES0+(1) 10058 IF((PILEA0(1,20).LE.0))GOTO 10059 CALL MOVEC0(20,19) GOTO 10058 10059 CONTINUE 10057 IF((PILEA0(1,19).GT.0))GOTO 10060 GAMEO0=.TRUE. RETURN 10060 IF((GAMET0.NE.0))GOTO 10061 CALL MOVEC0(19,20) GOTO 10062 10061 I=1 GOTO 10065 10063 I=I+(1) 10065 IF((I.GT.3))GOTO 10064 IF((PILEA0(1,19).LE.0))GOTO 10064 CALL MOVEC0(19,20) GOTO 10063 10064 CONTINUE 10062 RETURN END SUBROUTINE INITI0 COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER VTINIT INTEGER * 4 TIME INTEGER * 4 READC0 INTEGER TERM(7) INTEGER AAAAP0(35) INTEGER AAAAQ0(10) INTEGER AAAAR0(7) INTEGER AAAAS0(6) INTEGER AAAAT0(12) INTEGER AAAAU0(8) INTEGER AAAAV0(10) INTEGER AAAAW0(24) INTEGER AAAAX0(24) INTEGER AAAAY0(24) INTEGER AAAAZ0(24) INTEGER AAABA0(24) INTEGER AAABB0(24) INTEGER AAABC0(24) DATA AAAAP0/212,229,242,237,233,238,225,236,160,244,249,240,229,16 *0,167,170,243,167,160,238,239,244,160,243,245,240,240,239,242,244, *229,228,170,238,0/ DATA AAAAQ0/211,239,236,233,244,225,233,242,229,0/ DATA AAAAR0/211,244,225,227,235,186,0/ DATA AAAAS0/193,227,229,243,186,0/ DATA AAAAT0/244,233,237,229,243,160,244,232,242,245,186,0/ DATA AAAAU0/204,225,249,239,245,244,186,0/ DATA AAAAV0/195,239,237,237,225,238,228,243,186,0/ DATA AAAAW0/160,188,242,229,244,245,242,238,190,160,173,190,160,23 *0,236,233,240,160,243,244,225,227,235,0/ DATA AAAAX0/160,188,227,225,242,228,190,219,188,227,225,242,228,19 *0,221,160,173,190,160,237,239,246,229,0/ DATA AAAAY0/160,160,160,160,239,238,229,160,227,225,242,228,160,24 *4,239,160,225,238,239,244,232,229,242,0/ DATA AAAAZ0/160,233,188,242,229,228,190,188,226,236,235,190,160,16 *0,160,173,190,160,160,160,243,229,244,0/ DATA AAABA0/160,160,160,160,160,160,160,227,239,236,239,242,160,23 *3,238,228,233,227,225,244,239,242,243,0/ DATA AAABB0/160,248,160,160,160,173,190,160,160,160,229,248,233,24 *4,160,244,232,229,160,231,225,237,229,0/ DATA AAABC0/188,227,244,242,236,175,241,190,160,173,190,160,242,22 *9,228,242,225,247,160,231,225,237,229,0/ IF((VTINIT(TERM).EQ.-2))GOTO 10066 CALL PRINT(-15,AAAAP0,TERM) CALL ERROR('.') 10066 CALL VTOPT(1,24) CALL RND(INTS(READC0(TIME))) REDAA0=170 BLACK0=160 TOTAL0=0 GAMES0=0 GAMET0=1 CALL VTPUTL(AAAAQ0,1,30) CALL VTPUTL(AAAAR0,3,59) CALL VTPUTL(AAAAS0,3,7) CALL VTPUTL(AAAAT0,4,48) CALL VTPUTL(AAAAU0,6,17) CALL VTPUTL(AAAAV0,9,1) CALL VTPUTL(AAAAW0,9+2,1) CALL VTPUTL(AAAAX0,9+3,1) CALL VTPUTL(AAAAY0,9+4,1) CALL VTPUTL(AAAAZ0,9+5,1) CALL VTPUTL(AAABA0,9+6,1) CALL VTPUTL(AAABB0,9+7,1) CALL VTPUTL(AAABC0,9+8,1) CALL VTUPD(1) RETURN END INTEGER FUNCTION INTER0(STR,POS) INTEGER STR(1) INTEGER POS COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER S,R,CARD INTEGER INDEX INTEGER MAPUP INTEGER SUIT(5) INTEGER RANK(14) DATA SUIT/211,200,196,195,0/ DATA RANK/193,178,179,180,181,182,183,184,185,212,202,209,203,0/ 10067 IF((STR(POS).NE.160))GOTO 10068 POS=POS+(1) GOTO 10067 10068 R=INDEX(RANK,MAPUP(STR(POS))) POS=POS+(1) 10069 IF((STR(POS).NE.160))GOTO 10070 POS=POS+(1) GOTO 10069 10070 S=INDEX(SUIT,MAPUP(STR(POS))) POS=POS+(1) IF((R.EQ.0))GOTO 10072 IF((S.EQ.0))GOTO 10072 GOTO 10071 10072 CARD=-1 GOTO 10073 10071 CARD=DECKI0(13*(S-1)+R) 10073 INTER0=CARD RETURN END SUBROUTINE LOGRE0 COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER FD INTEGER OPEN INTEGER USR(33),DAT(9),TIM(9) INTEGER AAABD0(16) INTEGER AAABE0(16) DATA AAABD0/175,175,231,225,237,229,243,175,243,239,236,174,236,23 *9,231,0/ DATA AAABE0/170,163,243,160,170,182,233,160,170,243,160,170,243,17 *0,238,0/ IF((TOTAL0.NE.0))GOTO 10074 RETURN 10074 FD=OPEN(AAABD0,2) IF((FD.EQ.-3))GOTO 10075 CALL DATE(1,DAT) CALL DATE(2,TIM) CALL DATE(3,USR) CALL WIND(FD) CALL PRINT(FD,AAABE0,33-1,USR,TOTAL0,DAT,TIM) CALL CLOSE(FD) 10075 RETURN END SUBROUTINE MESSA0(STR) INTEGER STR(1) INTEGER AAABF0(5) DATA AAABF0/170,184,176,243,0/ CALL VTPRT(21,1,AAABF0,STR) CALL VTUPD(0) RETURN END INTEGER FUNCTION MOVE(C1,C2) INTEGER C1,C2 COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER LEGAL0,RANK,SUIT,PILE,I INTEGER CHECL0,CHECK0,CHECM0,CARDI0 INTEGER AAABG0(25) INTEGER AAABH0(18) INTEGER AAABI0(19) INTEGER AAABJ0(16) DATA AAABG0/217,239,245,160,227,225,238,167,244,160,237,239,246,22 *9,160,244,232,225,244,160,227,225,242,228,0/ DATA AAABH0/205,239,246,229,160,233,243,160,225,237,226,233,231,24 *5,239,245,243,0/ DATA AAABI0/205,239,246,229,160,233,243,160,233,237,240,239,243,24 *3,233,226,236,229,0/ DATA AAABJ0/205,239,246,229,160,233,243,160,233,236,236,229,231,22 *5,236,0/ IF((CARDI0(C1).NE.0))GOTO 10076 CALL MESSA0(AAABG0) MOVE=-3 RETURN 10076 IF((C2.NE.-1))GOTO 10077 SUIT=DECKA0(3,C1)/16 RANK=MOD(DECKA0(3,C1),16) IF((CHECL0(C1,PILE).NE.1))GOTO 10078 CALL MOVES0(C1,PILE) GOTO 10090 10078 IF((RANK.NE.1))GOTO 10080 CALL MOVES0(C1,14+SUIT) GOTO 10081 10080 PILE=0 LEGAL0=0 IF((CHECK0(C1,SUIT).NE.1))GOTO 10082 LEGAL0=LEGAL0+(1) PILE=14+SUIT 10082 DO 10083 I=1,7 IF((CHECM0(C1,I).NE.1))GOTO 10085 LEGAL0=LEGAL0+(1) PILE=0+I 10085 CONTINUE 10083 CONTINUE 10084 GOTO 10086 10087 CALL MESSA0(AAABH0) GOTO 10088 10089 CALL MESSA0(AAABI0) GOTO 10088 10088 MOVE=-3 RETURN 10086 IF((LEGAL0.GT.1))GOTO 10087 IF((LEGAL0.LT.1))GOTO 10089 CALL MOVES0(C1,PILE) 10081 CONTINUE 10079 GOTO 10090 10077 PILE=DECKA0(2,C2) IF((1.GT.PILE-14))GOTO 10093 IF((PILE-14.GT.4))GOTO 10093 IF((CHECK0(C1,PILE-14).EQ.0))GOTO 10093 GOTO 10092 10093 IF((1.GT.PILE-0))GOTO 10091 IF((PILE-0.GT.7))GOTO 10091 IF((CHECM0(C1,PILE-0).EQ.0))GOTO 10091 GOTO 10092 10092 CALL MOVES0(C1,PILE) GOTO 10095 10091 CALL MESSA0(AAABJ0) MOVE=-3 RETURN 10095 CONTINUE 10090 MOVE=-2 RETURN END SUBROUTINE MOVEC0(FROM,TO) INTEGER FROM,TO COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER CARD INTEGER REMOV0 IF((REMOV0(FROM,CARD).EQ.-1))GOTO 10096 CALL ADDCA0(CARD,TO) 10096 RETURN END SUBROUTINE MOVES0(CARD,TO) INTEGER CARD,TO COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER FROM PILEA0(1,21)=0 FROM=DECKA0(2,CARD) 10097 IF((PILEA0(2,FROM).EQ.CARD))GOTO 10098 CALL MOVEC0(FROM,21) GOTO 10097 10098 CALL MOVEC0(FROM,TO) 10099 IF((PILEA0(1,21).LE.0))GOTO 10100 CALL MOVEC0(21,TO) GOTO 10099 10100 IF((PILEA0(1,FROM).GT.0))GOTO 10101 IF((1.GT.FROM-0))GOTO 10101 IF((FROM-0.GT.7))GOTO 10101 CALL MOVEC0(7+FROM-0,FROM) 10101 RETURN END SUBROUTINE PROMPT(STR) INTEGER STR(1) INTEGER LENGTH INTEGER AAABK0(5) DATA AAABK0/170,184,176,243,0/ CALL VTPRT(20,1,AAABK0,STR) CALL VTUPD(0) CALL VTMOVE(20,LENGTH(STR)+1) CALL VTPAD(80) RETURN END SUBROUTINE QUITF0(DUMMY) INTEGER DUMMY COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 IF((GAMET0.NE.0))GOTO 10102 CALL TALLY 10102 CALL LOGRE0 CALL VTSTOP CALL SWT END INTEGER * 4 FUNCTION READC0(TIME) INTEGER * 4 TIME INTEGER AR(5) CALL TIMDAT(AR,5) TIME=60*AR(4)+AR(5) READC0=TIME RETURN END INTEGER FUNCTION REMOV0(FROM,CARD) INTEGER FROM,CARD COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 IF((PILEA0(1,FROM).GT.0))GOTO 10103 CARD=-1 GOTO 10104 10103 PILEA0(1,FROM)=PILEA0(1,FROM)-(1) CARD=PILEA0(2,FROM) PILEA0(2,FROM)=DECKA0(1,CARD) 10104 REMOV0=CARD RETURN END SUBROUTINE SETGA0 COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER ANS(2) INTEGER AAABL0(29) DATA AAABL0/168,227,169,225,243,233,238,239,160,239,242,160,168,24 *2,169,229,231,245,236,225,242,160,231,225,237,229,191,160,0/ CALL PROMPT(AAABL0) CALL VTENB(20,29,2) CALL VTREAD(20,29,1) CALL VTGETL(ANS,20,29,2) IF((ANS(1).EQ.227))GOTO 10106 IF((ANS(1).EQ.195))GOTO 10106 GOTO 10105 10106 GAMET0=0 GOTO 10107 10105 GAMET0=1 10107 CALL VTENB(20,29,0) RETURN END SUBROUTINE SHUFF0 COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER I,J,CARD,RANK,SUIT INTEGER UNIFO0 INTEGER AAABO0 INTEGER AAABM0,AAABN0 INTEGER AAABP0,AAABQ0 CARD=1 DO 10109 SUIT=1,4 DO 10111 RANK=1,13 DECKA0(3,CARD)=16*SUIT+RANK DECKA0(1,CARD)=UNIFO0(1,1000) DECKA0(2,CARD)=19 CARD=CARD+(1) 10111 CONTINUE 10112 CONTINUE 10109 CONTINUE 10110 I=1 GOTO 10115 10113 I=I+(1) 10115 IF((I.GE.52))GOTO 10114 J=1 GOTO 10118 10116 J=J+(1) 10118 IF((J.GT.52))GOTO 10113 AAABM0=UNIFO0(1,52) AAABN0=UNIFO0(1,52) AAABO0=1 GOTO 10108 10114 DO 10120 I=1,52 SUIT=DECKA0(3,I)/16 RANK=MOD(DECKA0(3,I),16) DECKI0((SUIT-1)*13+RANK)=I 10120 CONTINUE 10121 RETURN 10108 AAABP0=DECKA0(1,AAABM0) AAABQ0=DECKA0(3,AAABM0) DECKA0(1,AAABM0)=DECKA0(1,AAABN0) DECKA0(1,AAABN0)=AAABP0 DECKA0(3,AAABM0)=DECKA0(3,AAABN0) DECKA0(3,AAABN0)=AAABQ0 GOTO 10116 END SUBROUTINE TALLY COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER MONEY,SUM,I INTEGER WL(5),MSG(102) INTEGER AAABR0(27) INTEGER AAABS0(10) INTEGER AAABT0(11) INTEGER AAABU0(4) INTEGER AAABV0(5) INTEGER AAABW0(11) DATA AAABR0/195,225,243,233,238,239,160,242,229,243,245,236,244,24 *3,186,160,160,199,225,237,229,243,186,160,170,233,0/ DATA AAABS0/215,239,238,160,164,170,173,182,233,0/ DATA AAABT0/204,239,243,244,160,164,170,173,181,233,0/ DATA AAABU0/247,239,238,0/ DATA AAABV0/236,239,243,244,0/ DATA AAABW0/217,239,245,160,170,243,160,164,170,233,0/ GAMES0=GAMES0+(1) CALL COUNT0(SUM) IF((SUM.EQ.0))GOTO 10123 SUM=0 DO 10124 I=1,4 SUM=SUM+(PILEA0(1,14+I)) 10124 CONTINUE 10125 GOTO 10126 10123 SUM=52 10126 MONEY=5*SUM-50 TOTAL0=TOTAL0+(MONEY) CALL VTPRT(22,50,AAABR0,GAMES0) IF((TOTAL0.LT.0))GOTO 10127 CALL VTPRT(23,67,AAABS0,TOTAL0) GOTO 10129 10127 CALL VTPRT(23,67,AAABT0,-TOTAL0) 10128 GOTO 10129 10130 CALL CTOC(AAABU0,WL,5) GOTO 10131 10132 CALL CTOC(AAABV0,WL,5) GOTO 10131 10131 CALL ENCODE(MSG,102,AAABW0,WL,IABS(MONEY)) CALL MESSA0(MSG) GOTO 10133 10129 IF((MONEY.GT.0))GOTO 10130 IF((MONEY.LT.0))GOTO 10132 CALL VTUPD(0) 10133 GAMET0=1 RETURN END SUBROUTINE TURN COMMON /SOLCOM/DECKA0,DECKI0,PILEA0,TIMES0,GAMET0,GAMES0,TOTAL0,RE *DAA0,BLACK0,GAMEO0 INTEGER DECKA0(3,52),DECKI0(52),PILEA0(2,21),TIMES0,GAMET0,GAMES0, *TOTAL0 INTEGER REDAA0,BLACK0 LOGICAL GAMEO0 INTEGER COMMA0(102) INTEGER POS,CARD1,CARD2,I INTEGER INTER0,MOVE INTEGER AAABX0(15) INTEGER AAABY0(33) DATA AAABX0/195,225,242,228,160,244,239,160,237,239,246,229,186,16 *0,0/ DATA AAABY0/197,238,244,229,242,160,227,225,242,228,243,160,233,23 *8,160,230,239,242,237,160,188,242,225,238,235,190,188,243,245,233, *244,190,0/ 10134 CALL PROMPT(AAABX0) CALL VTENB(20,15,10) CALL VTREAD(20,15,1) CALL VTGETL(COMMA0,20,15,10) I=1 10135 IF((COMMA0(I).NE.160))GOTO 10137 I=I+(1) GOTO 10135 10138 GAMEO0=.TRUE. GOTO 10139 10140 IF((COMMA0(I+1).EQ.0))GOTO 10142 IF((COMMA0(I+1).EQ.160))GOTO 10142 GOTO 10141 10142 REDAA0=170 BLACK0=160 GOTO 10139 10141 REDAA0=COMMA0(I+1) BLACK0=COMMA0(I+2) 10143 GOTO 10139 10144 CALL FLIPS0 GOTO 10139 10139 CALL MESSA0(0) GOTO 10145 10137 IF((COMMA0(I).EQ.248))GOTO 10138 IF((COMMA0(I).EQ.216))GOTO 10138 IF((COMMA0(I).EQ.233))GOTO 10140 IF((COMMA0(I).EQ.201))GOTO 10140 IF((COMMA0(I).EQ.0))GOTO 10144 POS=1 CARD1=INTER0(COMMA0,POS) IF((CARD1.EQ.-1))GOTO 10146 CARD2=INTER0(COMMA0,POS) IF((MOVE(CARD1,CARD2).NE.-2))GOTO 10148 CALL MESSA0(0) GOTO 10145 10146 CALL MESSA0(AAABY0) 10148 CONTINUE GOTO 10134 10145 RETURN END INTEGER FUNCTION UNIFO0(LWB,UPB) INTEGER LWB,UPB UNIFO0=LWB+(UPB-LWB)*RND(0)+0.5 RETURN END C ---- Long Name Map ---- C checkstack checm0 C Pile pilea0 C Gametype gamet0 C Gamesplayed games0 C message messa0 C Totalwinnings total0 C flipstack flips0 C quitfinish quitf0 C Timesthru times0 C interpretcard inter0 C shuffle shuff0 C addcard addca0 C cardrank cardr0 C movestack moves0 C setgametype setga0 C display displ0 C Red redaa0 C removecard remov0 C logresults logre0 C checkking checl0 C movecard movec0 C readclock readc0 C checkace check0 C cardismovable cardi0 C Deck decka0 C swapcard swapc0 C legalmoves legal0 C countunplayed count0 C uniform unifo0 C initialize initi0 C cardsuit cards0 C displaycard dispm0 C Gameover gameo0 C command comma0 C Deckindex decki0 C Black black0