/*                           */
/*  KISMET X1.SL             */
/*                           */
/*   for S-OS SLANG COMPILER */
/*   ver. 1.01   '90.08.21   */
/*    T.SAKAKI & M.NAGIRA    */
/*                           */


ARRAY   BYTE DICE[4]=[1,1,1,1,1];
ARRAY   SC[3][14];

VAR  PS_MAX=3,PS=0,YK=0;
VAR  HOLD=0;

CONST   NONSELECT=851;
CONST   BUFF=$E000;
CONST   COLORF=$0026;


CAST_DICE()
  VAR I;
  BEGIN
     FOR I=0 TO 4 [
        IF BIT(HOLD,I) == FALSE
           DICE[I]=RND(6)+1;
     ]
     DICE_PRT();
  END;


CAST()
  VAR I,KEY;
  BEGIN
     IF HOLD == 00011111B
        EXIT;
     REPEAT [
        KBUF_CLR();
        WAIT(5);
        CAST_DICE();
        IF (KEY=INKEY(0)) == $1B   /* GETKEY */
           STOP();
     ] UNTIL KEY == ' ';
     KBUF_CLR();
     FOR I=0 TO 2 [
        WAIT(7+I*7);
        CAST_DICE();
     ]
  END;


HOLD_OR_CAST()
  VAR I,J,X,Y,XO,IO;
  BEGIN
     HOLD=00011111B;
     I=0; IO=0;
     XO=20; Y=1;
     KBUF_CLR();
     WHILE TRUE [
        X=I*4+20;
        IF BIT(HOLD,IO) == TRUE [
           DICE_SUB(IO,XO,Y);
        ] ELSE [
           HOLD_CUR(0,XO,Y);
        ] ENDIF;
           WAIT(10);
        HOLD_CUR(1,X,Y);
           WAIT(10);
        XO=X; IO=I;
        CASE INKEY(0) OF [         /* GETKEY */
           ' ' :    [
              DICE_PRT();
              EXIT;
           ]
           '4','A': [
              IF I == 0   I=4;
              ELSE  --I;
           ]
           '6','D': [
              IF I == 4   I=0;
              ELSE  ++I;
           ]
           $0D,'5','S':   [
              IF BIT(HOLD,I) == FALSE [
                 HOLD=SET(HOLD,I);
              ] ELSE [
                 HOLD=RESET(HOLD,I);
              ] ENDIF;
              KBUF_CLR();
           ]
           $1B :    STOP();
           'G' :    [
              HOLD=0;
              FOR J=0 TO 4 [
                 HOLD_CUR(0,J*4+20,Y);
              ]
           ]
        ]
        KEY_WAIT();
     ]
  END;


DICE_PRT()
  VAR I;
  BEGIN
     FOR I=0 TO 4 [
        DICE_SUB(I,20+I*4,1);
     ]
  END;


DICE_SUB(I,X,Y)
  BEGIN
     CASE DICE[I] OF [
        1 :   [
        /* COLOR(1);   */
           LOCATE(X,Y);   PRINT("   ");
           LOCATE(X,Y+1); PRINT(" * ");
           LOCATE(X,Y+2); PRINT("   ");
        ]
        2 :   [
        /* COLOR(2);   */
           LOCATE(X,Y);   PRINT("@  ");
           LOCATE(X,Y+1); PRINT("   ");
           LOCATE(X,Y+2); PRINT("  @");
        ]
        3 :   [
        /* COLOR(4);   */
           LOCATE(X,Y);   PRINT("O  ");
           LOCATE(X,Y+1); PRINT(" O ");
           LOCATE(X,Y+2); PRINT("  O");
        ]
        4 :   [
        /* COLOR(4);   */
           LOCATE(X,Y);   PRINT("O O");
           LOCATE(X,Y+1); PRINT("   ");
           LOCATE(X,Y+2); PRINT("O O");
        ]
        5 :   [
        /* COLOR(2);   */
           LOCATE(X,Y);   PRINT("@ @");
           LOCATE(X,Y+1); PRINT(" @ ");
           LOCATE(X,Y+2); PRINT("@ @");
        ]
        6 :   [
        /* COLOR(1);   */
           LOCATE(X,Y);   PRINT("* *");
           LOCATE(X,Y+1); PRINT("* *");
           LOCATE(X,Y+2); PRINT("* *");
        ]
     ]
  /* COLOR(7);   */
  END;


HOLD_CUR(I,X,Y)
  BEGIN
     CASE I OF [
        0 :   [
           LOCATE(X,Y);   PRINT("   ");
           LOCATE(X,Y+1); PRINT("   ");
           LOCATE(X,Y+2); PRINT("   ");
        ]
        1 :   [
           LOCATE(X,Y);   PRINT(" ? ");
           LOCATE(X,Y+1); PRINT("? ?");
           LOCATE(X,Y+2); PRINT(" ? ");
        ]
     ]
  END;


MAIN()
  VAR TURN;
  BEGIN
     WHILE TRUE [
        INIT();
        TITLE();
        INTGET();

        REPEAT [
           INIT_SC();
           BG_PRT();
           HIT_SPC();
           FOR TURN=1 TO 15 [
              FOR PS=0 TO PS_MAX [
                 HOLD=0;
                 NAME();
                 LOCATE(24+PS*4,5);
                    PRINT("*");
                 CAST();
                 HOLD_OR_CAST();
                 CAST();
                 LOCATE(1,2);
                    PRINT(" CAST ONCE MORE! ");
                 HOLD_OR_CAST();
                 CAST();
                 IF TURN != 15 [
                    SELECT();
                 ] ELSE [
                    LAST1();
                    HIT_SPC();
                 ] ENDIF;
                 LOCATE(24+PS*4,5);
                    PRINT(PS+1);
              ]
           ]

           TOTAL();
        ] UNTIL REPLAY();
      ]
  END;


KBUF_CLR()
  BEGIN
    WHILE INKEY(0) != 0 [        /*GETKEY */
    ]
  END;


WAIT(I)
  VAR WT,KEY;
  BEGIN
     WT=100;
     I=I*WT;
     WHILE I-- != 0 [
        IF (KEY=INKEY(0)) != 0 [   /* GETKEY */
           I=0;
        ] ENDIF;
     ]
  END(KEY);


SELECT()
  VAR Y,YO,KEY,YKO;
  BEGIN
     YK=0; YKO=14;
     Y=7;  YO=22;
     WHILE TRUE [
        LOCATE(1,2);
           PRINT(" * S E L E C T * ");
        IF Y != YO [
           LOCATE(2,YO);  PRINT(" ");
           IF SC[PS][YKO] == NONSELECT [
              LOCATE(23+PS*4,YO); PRINT("   ");
           ] ENDIF;
           IF SC[PS][YK] == NONSELECT [
              LOCATE(2,Y);  PRINT(">");
              LOCATE(23+PS*4,Y);  PRINT("---");
           ] ELSE [
              LOCATE(2,Y);  PRINT("*");
           ] ENDIF;
           YO=Y; YKO=YK;
        ] ENDIF;
        KEY=INKEY(0);           /* GETKEY */
        KEY_WAIT();
        CASE KEY OF [
           $0D :    [
              IF SC[PS][YK] == NONSELECT [
                 JUDGE();
                 LOCATE(23+PS*4,Y);
                    PRINT(FORM$(SC[PS][YK],3));
                 LOCATE(2 ,Y);  PRINT(" ");
                 IF HIT_SPC() == 'C' [
                    LOCATE(23+PS*4,Y);
                       PRINT("---");
                    LOCATE(2 ,Y);
                       PRINT(">");
                    SC[PS][YK]=NONSELECT;
                 ] ELSE [
                 EXIT FROM FUNC;
                 ] ENDIF;
              ] ENDIF;
           ]
           '2','X': [
              IF Y == 12 [
                 Y=14; YK=6;
              ] EF Y == 22 [
                 Y=7;  YK=0;
              ] ELSE [
                 ++Y;  ++YK;
              ] ENDIF;
           ]
           '8','W': [
              IF Y == 14 [
                 Y=12; YK=5;
              ] EF Y == 7 [
                 Y=22; YK=14;
              ] ELSE [
                 --Y;  --YK;
              ] ENDIF;
           ]
           $1B :    STOP();
        ]
     ]
  END;


INIT_SC()
  VAR I,J;
  BEGIN
     PRINT("\C");
     FOR I=0 TO PS_MAX [
        FOR J=0 TO 14 [
           SC[I][J]=NONSELECT;
        ]
     ]
  END;


KEY_WAIT()
  VAR I,J,K_WT1,K_WT2;
  BEGIN
     K_WT1=1500;
     K_WT2=1500;
     FOR I=0 TO K_WT1 [
        IF INKEY(0) == 0 [         /* GETKEY */
           FOR J=0 TO K_WT2 [
           ]
           EXIT FROM FUNC;
        ] ENDIF;
     ]
  END;


BG_PRT()
  VAR I;
  BEGIN
     LOCATE(0,0);
        PRINT(" ** K I S M E T ** ");
     LOCATE(0,4);
        PRINT(" ** BY M.N.&T.S.** ");
     LOCATE(0,6);
        PRINT("  BASIC SECTION SCORE\N");
        PRINT("   ACES\N");
        PRINT("   DEUCES\N");
        PRINT("   TREYS\N");
        PRINT("   FOURS\N");
        PRINT("   FIVES\N");
        PRINT("   SIXES\N");
        PRINT("  KISMET SECTION SCORE\N");
        PRINT("   TWO PAIR SAMECOLOR\N");
        PRINT("   THREE OF A KIND\N");
        PRINT("   STRAIGHT\N");
        PRINT("   FLASH\N");
        PRINT("   FULLHOUSE\N");
        PRINT("   FULLHOUSE SAMECOLOR\N");
        PRINT("   FOUR OF A KIND\N");
        PRINT("   YARBOROUGH\N");
        PRINT("   KISMET\N");
        PRINT("  TOTAL SCORE");

     BOX_PRT(0,1,18,3);
     FOR I=0 TO 4 [
        BOX_PRT(19+I*4,0,23+I*4,4);
     ]
     BOX_PRT(1,5,22,24);
     FOR I=0 TO 3 [
        BOX_PRT(22+I*4,5,26+I*4,24);
        LOCATE(23+I*4, 6);   PRINT("///");
        LOCATE(23+I*4,13);   PRINT("///");
        LOCATE(23+I*4,23);   PRINT("///");
     ]
     FOR I=0 TO PS_MAX [
        LOCATE(24+I*4,5); PRINT(I+1);
     ]

     DICE_PRT();
  END;


BOX_PRT(X,Y,XE,YE)
  VAR I;
  BEGIN
     LOCATE(X ,Y);  PRINT("O");
     FOR I=X+1 TO XE-1 [ PRINT("-"); ]
     LOCATE(XE,Y);  PRINT("O");

     FOR I=Y+1 TO YE-1 [
        LOCATE(X ,I);     PRINT("I");
        LOCATE(XE,I);     PRINT("I");
     ]

     LOCATE(X ,YE); PRINT("O");
     FOR I=X+1 TO XE-1 [ PRINT("-"); ]
     LOCATE(XE,YE); PRINT("O");
  END;


SN_CHK(I)
  VAR J,K;
  BEGIN
     K=0;
     FOR J=0 TO 4 [
        IF DICE[J] == DICE[I] [
           ++K;
        ] ENDIF;
     ]
  END(K);


SC_NUM(I)
  VAR J,K;
  BEGIN
     K=0;
     FOR J=0 TO 4 [
        IF DICE[J] == DICE[I] [
           ++K;
        ] EF (DICE[J] + DICE[I]) == 7 [
           ++K;
        ] ENDIF;
     ]
  END(K);


ALL_SUM()
  VAR I,SUM;
  BEGIN
     SUM=0;
     FOR I=0 TO 4 [
        SUM=SUM+DICE[I];
     ]
  END(SUM);


JUDGE()
  VAR I,J;
  BEGIN
     SC[PS][YK]=0;

     CASE YK OF [
        00 TO 05 :  [     /* BASIC SECTION */
           FOR I=0 TO 4 [
              IF DICE[I] == YK+1 [
                 SC[PS][YK]=SC[PS][YK]+YK+1;
              ] ENDIF;
           ]
        ]
        06  :       [     /* TWO PAIR SAMECOLOR */
           SORT();
           CASE SC_NUM(1) OF [
              01 TO 03 :  EXIT;
              04  :    [
                 IF SN_CHK(1) == 1 [
                    EXIT;
                 ] EF SN_CHK(1) == 3 [
                    EXIT;
                 ] ENDIF;
                 SC[PS][YK]=ALL_SUM();
              ]
              05  :    [
                 SC[PS][YK]=ALL_SUM();
              ]
           ]
        ]
        07  :       [     /* THREE OF A KIND */
           SORT();
           IF SN_CHK(2) >= 3 [
              SC[PS][YK]=ALL_SUM();
           ] ENDIF;
        ]
        08  :       [     /* STRAIGHT */
           SORT();
           J=1;
           FOR I=0 TO 3 [
              J=J*(DICE[I+1]-DICE[I]);
           ]
           IF J == 1 [
              SC[PS][YK]=30;
           ] ENDIF;
        ]
        09   :      [     /* FLASH */
           IF SC_NUM(0) == 5 [
              SC[PS][YK]=35;
           ] ENDIF;
        ]
        10   :      [     /* FULLHOUSE */
           SORT();
           I=SN_CHK(0);
           J=SN_CHK(4);
           IF (I*J) == 6 [
              SC[PS][YK]=ALL_SUM()+15;
           ] EF I == 5 [
              SC[PS][YK]=ALL_SUM()+15;
           ] ENDIF;
        ]
        11   :      [     /* FULLHOUSE SAMECOLOR */
           SORT();
           IF SC_NUM(0) != 5 [
              EXIT;
           ] ENDIF;
           I=SN_CHK(0);
           J=SN_CHK(4);
           IF (I*J) == 6 [
              SC[PS][YK]=ALL_SUM()+20;
           ] EF I == 5 [
              SC[PS][YK]=ALL_SUM()+20;
           ] ENDIF;
        ]
        12   :      [     /* FOUR OF A KIND */
           SORT();
           IF SN_CHK(2) >= 4
              SC[PS][YK]=ALL_SUM()+25;
        ]
        13   :      [     /* YARBOROUGH */
           SC[PS][YK]=ALL_SUM();
        ]
        14   :      [     /* KISMET! */
           IF SN_CHK(0) == 5
              SC[PS][YK]=ALL_SUM()+50;
        ]
     ]
  END;


SORT()
  VAR GAP,I,J;
  BEGIN
     GAP=3;
     FOR I=0 TO 2 [
        FOR J=0 TO 4-GAP [
           IF DICE[J] > DICE[J+GAP]
              SWAP(J,J+GAP);
        ]
        --GAP;
     ]
  END;


SWAP(I,J)
  VAR TEMP;
  BEGIN
     TEMP=DICE[I];
     DICE[I]=DICE[J];
     DICE[J]=TEMP;
  END;


TOTAL()
  VAR B_SC,K_SC,T_SC,BONUS;
  BEGIN
     FOR PS=0 TO PS_MAX [

        B_SC=0;
        K_SC=0;
        T_SC=0;
        BONUS=0;

        KBUF_CLR();
        NAME();
           WAIT(150);
        FOR YK=0 TO 5 [
           B_SC=B_SC+SC[PS][YK];
           LOCATE(23+PS*4,6);
              PRINT(FORM$(B_SC,3));
        ]
           WAIT(150);
        FOR YK=6 TO 14 [
           K_SC=K_SC+SC[PS][YK];
           LOCATE(23+PS*4,13);
              PRINT(FORM$(K_SC,3));
        ]
           WAIT(150);
        IF B_SC > 62   BONUS=35;
        IF B_SC > 70   BONUS=55;
        IF B_SC > 78   BONUS=75;
        T_SC=B_SC+K_SC+BONUS;
        LOCATE(23+PS*4,23);
           PRINT(FORM$(T_SC,3));
        ]
  END;


HIT_SPC()
  VAR KEY;
  BEGIN
     REPEAT [
        KBUF_CLR();
        LOCATE(1,2);   PRINT(" HIT SPACE KEY ! ");
        LOCATE(1,2);   PRINT(SPC$(17));
        IF (KEY=INKEY(0)) == $1B      /* GETKEY */
           STOP();
     ] UNTIL (KEY == ' ') OR (KEY == 'C');
  END(KEY);


HIT_ANY(X,Y)
  VAR KEY;
  BEGIN
     REPEAT [
        KBUF_CLR();
        LOCATE(X,Y);   PRINT(" HIT  ANY  KEY !!");
        LOCATE(X,Y);   PRINT(SPC$(17));
        IF (KEY=INKEY(0)) == $1B      /* GETKEY */
           STOP();
     ] UNTIL KEY != $00;
  END;


REPLAY()
  VAR I;
  BEGIN
     LOCATE(1,2);   PRINT("  REPLAY(Y/N)?   ");
     KBUF_CLR();
     LOCATE(15,2);
     WHILE TRUE [
        CASE INKEY(1) OF [
           'Y',' ',$0D :  [
                 I=FALSE; EXIT;
           ]
           'N'         :  [
                 I=TRUE;  EXIT;
           ]
           $1B         :  STOP();
        ]
     ]
  END(I);


TITLE()
  VAR I,J;
  BEGIN
     LOCATE(0,1);
     PRINT(" O  O                                   ");
     PRINT(" O O                 O   O              ");
     PRINT(" OOO                 OO OO        @@@@@ ");
     PRINT(" O  O   ***          O O O          @   ");
     PRINT(" O  O    *    @@@@   O   O          @   ");
     PRINT("         *    @      O   O   ****   @   ");
     PRINT("         *     @             *      @   ");
     PRINT("        ***     @            **         ");
     PRINT("              @@@@           *          ");
     PRINT("                             ****       ");
     LOCATE(0,12);
     PRINT("        PROGRAMMED BY M.N. & T.S.\N");
     PRINT("\N");
     PRINT("         FOR S-OS SLANG COMPILER\N");
     FOR I=0 TO 4 [
        BOX_PRT(2+I*8,19,6+I*8,23);
        DICE_SUB(I,3+I*8,20);
     ]
     HIT_ANY(11,17);
     KBUF_CLR();
     FOR J=0 TO 6 [
        FOR I=0 TO 4 [
           DICE[I]=RND(6)+1;
           DICE_SUB(I,3+I*8,20);
        ]
        WAIT(10);
     ]
     WAIT(50);
  END;


INTGET()
  VAR I,KEY;
  BEGIN
     FOR I=0 TO 7 [
        LOCATE(1,16+I);   PRINT(SPC$(38));
     ]
     BOX_PRT(02,16,37,23);

     LOCATE(04,17); PRINT("HOW MANY PLAYERS(1-4)");
     WHILE TRUE [
        LOCATE(26,17);
           PRINT(SPC$(5));
        LOCATE(26,17);
           KEY=INKEY(1);
           PRINT(KEY-'0');
        IF KEY<'5' AND KEY>'0' [
           PS_MAX=KEY-'0'-1;
           EXIT;
        ] EF KEY == $1B [
          STOP();
        ] ENDIF;
     ]

     FOR PS=0 TO PS_MAX [
        LOCATE(04,19+PS);
           PRINT("INPUT YOUR NAME,PLAYER");
           PRINT(PS+1);   PRINT(":");
           LINPUT(BUFF+PS*$10,9);

        IF MEMW[BUFF+PS*$10] == $2020 [
           CASE PS OF [
              00 :  MEMW[BUFF+$00]=$3158;
              01 :  MEMW[BUFF+$10]=$5A4D;
              02 :  [
                 MEMW[BUFF+$20]=$484F;
                 MEMW[BUFF+$22]=$5821;
              ]
              03 :  [
                 MEMW[BUFF+$30]=$3658;
                 MEMW[BUFF+$32]=$4B38;
              ]
           ]
        ] ENDIF;
     ]
  END;


NAME()
  BEGIN
     LOCATE(1,2);
     PRINT("PLAYER");
     PRINT(PS+1);   PRINT(":");
     PRINT(MSX$(BUFF+PS*$10));
  END;


INIT()
  BEGIN
     WIDTH(40);
     PRINT("\C");
  /* INIT_JS();  */
  END;


LAST1()
  VAR I,Y;
  BEGIN
     FOR I=0 TO 14 [
        IF SC[PS][YK] == NONSELECT [
           YK=I;
           Y=I+7+(YK>5);
           JUDGE();
           LOCATE(23+PS*4,Y);
              PRINT(FORM$(SC[PS][YK],3));
           EXIT FROM FUNC;
        ] ENDIF;
     ]
  END;


/*   ORIGINAL PROGRAMMED BY M.NAGUIRA
/*      FOR CZ-8BF01 V1.0
/*   S-OS VERSION PROGRAMMED BY T.SAKAKI
/*      FOR SLANG COMPILER
/*      MACHINE:CZ-851CR,CZ-880CB
/*   SPECIAL THANKS TO MR.ASO