'===========================================================================
' Subject: MASTERCODE                         Date: Unknown Date           
'  Author: Ken Sweet                          Code: QB, PDS                
'  Origin: Like Cribbage                    Packet: GAMES.ABC
'===========================================================================
DEFINT A-Z

TYPE RegTypeX
     ax    AS INTEGER
     bx    AS INTEGER
     cx    AS INTEGER
     dx    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     flags AS INTEGER
     ds    AS INTEGER
     es    AS INTEGER
END TYPE

TYPE CodeMatrix
    Code AS STRING * 8
    Clue AS STRING * 8
    Blk AS INTEGER
    Wht AS INTEGER
END TYPE

DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)
DECLARE FUNCTION GetScreenMode% ()
DECLARE SUB MouseDriver (Mouse0%, Mouse1%, Mouse2%, Mouse3%)
DECLARE SUB MouseHide ()
DECLARE SUB MousePoll (Row%, Col%, LButton%, RButton%)
DECLARE SUB MouseInit ()
DECLARE SUB MouseShow ()
DECLARE SUB TitleScreen ()
DECLARE SUB Directions ()
DECLARE SUB StartUp ()
DECLARE SUB SetColors ()
DECLARE SUB CodeBar (NumPegs%)
DECLARE SUB ColorBar (NumColors%)
DECLARE SUB GameBoard (NumPegs%)
DECLARE SUB ScoreCard ()
DECLARE FUNCTION SelectCode$ (NumPegs%, NumColor%)
DECLARE SUB ShowCode (NumPegs%, Xcode$)
DECLARE SUB PegLarge (PegXloc%)
DECLARE SUB PegSmall (PegXloc%, PegYloc%)
DECLARE SUB GiveClues (Xcode$, Scode$, NumPegs%, TurnNum%)
DECLARE SUB SetClue (ClueNum%, TurnNum%, Clr%)
DECLARE SUB ComputerShow (Xcode$, NumPegs%)
DECLARE SUB ComputerMatrix (RightColors$, NumColors%, NumPegs%)
DECLARE SUB CalculateColors (NumColors%, NumPegs%, TurnNum%)
DECLARE SUB ColorWrongScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)
DECLARE SUB ColorRightScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)
DECLARE FUNCTION CalculateCode$ (NumPegs%, TurnNum%)
DECLARE SUB WordPrint (Row%, Col%, Fclr%, Bclr%, Text$)
DECLARE FUNCTION WordInput$ (Row%, Col%, Fclr%, Bclr%, HFclr%, HBclr%, TextLen%, Text$)
DECLARE FUNCTION Kbd$ ()
DECLARE SUB SetPalette (Number%, Red%, Green%, Blue%)
DECLARE SUB DrawBox (Row%, Col%, ColLen%, Fclr%, Bclr%, Format$, Style%)
DECLARE SUB Xalpha (Row%, Col%, Fclr%, Bclr%, Text$)
DECLARE SUB Xpatern (Row%, Col%, Fclr%, Bclr%, Patern$, BitNum%)
DECLARE SUB TimePause (TimeDelay%)
DECLARE FUNCTION PlayAgain% ()
DECLARE SUB GameInit ()

DIM SHARED PlayerName$(7), PlayerScore%(7), PlayerPeg%(7), PlayerColor%(7)
DIM SHARED NumPlayer%, NumGames%, Guess(29) AS CodeMatrix
DIM SHARED PegLoop%(7), PegMatrix0%(7), PegMatrix1%(7), PegMatrix2%(7, 7)
DIM SHARED CodeMatrix$(7), PegRight%(7), PegWrong%(7, 7)

CONST True% = -1: False% = 0

MouseInit

MainGameStart:
ON KEY(10) GOSUB ExitGame
KEY(10) ON

SCREEN 12: WIDTH 80, 30
TitleScreen
SetColors
GameInit

StartGame:
StartUp

CLS
FOR Zloop% = 0 TO NumPlayer%
    PlayerScore%(Zloop%) = 0
NEXT Zloop%
ScoreCard

IF INSTR(COMMAND$, "/DRACOS") > 0 THEN
    ON KEY(31) GOSUB GameHelp
    KEY(31) ON
END IF

FOR PlayGame% = 0 TO NumGames%
    FOR Player% = 0 TO NumPlayer%
        GameBoard PlayerPeg%(Player%)
        ColorBar PlayerColor%(Player%)
        SecretCode$ = SelectCode$(PlayerPeg%(Player%), PlayerColor%(Player%))
        WordPrint 2 + Player%, 24, Player% + 1, -1, ""
        CurrentColor% = 1
        IF LEFT$(UCASE$(PlayerName$(Player%)), 4) = "COMP" THEN
            FOR Zloop% = 0 TO 7
                PegRight%(Zloop%) = -1
                PegMatrix1%(Zloop%) = -1
                CodeMatrix$(Zloop%) = CHR$(255)
                FOR Xloop% = 0 TO 7
                    PegWrong%(Zloop%, Xloop%) = -1
                    PegMatrix2%(Zloop%, Xloop%) = -1
                NEXT Xloop%
            NEXT Zloop%
            ComputerCode$ = "": ComputerScan% = 0
            FOR Zloop% = 1 TO PlayerColor%(Player%)
SetComputerCode:
                Ztemp% = INT(RND * PlayerColor%(Player%)) + 1
                IF INSTR(ComputerCode$, CHR$(Ztemp%)) > 0 THEN GOTO SetComputerCode
                ComputerCode$ = ComputerCode$ + CHR$(Ztemp%)
            NEXT Zloop%
        END IF
        ERASE Guess
        FOR Turn% = 0 TO 29
            PlayerScore%(Player%) = PlayerScore%(Player%) + 1
            ScoreCard
            CodeBar PlayerPeg%(Player%)
            WordPrint 2 + Player%, 29, Player% + 1, -1, "Guess" + STR$(Turn% + 1) + "   Round" + STR$(PlayGame% + 1)
            currentGuess$ = STRING$(8, 255)
            IF LEFT$(UCASE$(PlayerName$(Player%)), 4) = "COMP" THEN
                GOSUB ComputerTurn
            ELSE
                GOSUB PlayerTurn
            END IF
            IF Guess(Turn%).Blk = PlayerPeg%(Player%) + 1 THEN
                EXIT FOR
            ELSEIF Guess(Turn%).Blk + Guess(Turn%).Wht = PlayerPeg%(Player%) + 1 THEN
                FOR Zloop% = 0 TO Turn%
                    FOR Xloop% = 0 TO PlayerPeg%(Player%)
                        IF INSTR(SecretCode$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) = 0 THEN
                            PegSmall Xloop%, Zloop%
                        END IF
                    NEXT Xloop%
                NEXT Zloop%
                FOR Zloop% = 1 TO PlayerColor%(Player%)
                    IF INSTR(SecretCode$, CHR$(Zloop%)) = 0 THEN
                        PAINT (18 + (Zloop% - 1) * 27, 361), 15, 15
                    END IF
                NEXT Zloop%
            END IF
        NEXT Turn%
        WordPrint 2 + Player%, 24, 0, -1, SPACE$(23)
        ShowCode PlayerPeg%(Player%), SecretCode$
        BEEP
WaitButton:
        MousePoll Row%, Col%, LButton%, RButton%
        IF NOT (LButton%) AND NOT (RButton%) THEN GOTO WaitButton
    NEXT Player%
NEXT PlayGame%

IF INSTR(COMMAND$, "/DRACOS") > 0 THEN
    KEY(31) OFF
END IF

PlayDone% = PlayAgain%

IF PlayDone% THEN
    GOTO StartGame
ELSE
    GOTO ExitGame
END IF



PlayerTurn:
    MouseShow
GetMouse:
    MousePoll Row%, Col%, LButton%, RButton%
    IF NOT (LButton%) AND NOT (RButton%) THEN GOTO GetMouse
    MouseHide

IF (Col% > 6 AND Col% < 383) AND (Row% > 204 AND Row% < 252) THEN
    CurrentPeg% = INT(Col% - 7) \ 47
    IF CurrentPeg% > PlayerPeg%(Player%) THEN GOTO nextClick
    IF LButton% THEN
        IF MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(255) THEN
            MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(CurrentColor%)
            CIRCLE (30 + CurrentPeg% * 47, 228), 21, CurrentColor% - 1
            PAINT (30 + CurrentPeg% * 47, 228), CurrentColor% - 1, CurrentColor% - 1
        ELSE
            NewColor% = ASC(MID$(currentGuess$, CurrentPeg% + 1, 1)) + 1
            IF NewColor% > PlayerColor%(Player%) THEN NewColor% = 1
            MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(NewColor%)
            CIRCLE (30 + CurrentPeg% * 47, 228), 21, NewColor% - 1
            PAINT (30 + CurrentPeg% * 47, 228), NewColor% - 1, NewColor% - 1
        END IF
    ELSEIF RButton% THEN
        MID$(currentGuess$, CurrentPeg% + 1, 1) = CHR$(255)
        PegLarge CurrentPeg%
    END IF
ELSEIF (Col% > 5 AND Col% < 383) AND (Row% > 347 AND Row% < 375) THEN
    NewColor% = INT(Col% - 6) \ 27 + 1
    IF NewColor% > PlayerColor%(Player%) THEN GOTO nextClick
    CurrentColor% = NewColor%
    PAINT (12, 319), CurrentColor% - 1, 14
ELSEIF (Col% > 136 AND Col% < 256) AND (Row% > 416 AND Row% < 464) THEN
    Done% = -1
    FOR Zloop% = 0 TO PlayerPeg%(Player%)
        IF MID$(currentGuess$, Zloop% + 1, 1) = CHR$(255) THEN Done% = 0
    NEXT Zloop%
    IF NOT (Done%) THEN
        GOTO nextClick
    ELSE
        GiveClues currentGuess$, SecretCode$, PlayerPeg%(Player%), Turn%
        RETURN
    END IF
ELSEIF (Col% > 507 AND Col% < 635) AND (Row% > 24 AND Row% < 475) THEN
    OldCode% = 29 - (Row% - 25) \ 15
    IF OldCode% > Turn% - 1 THEN
        GOTO nextClick
    ELSE
        currentGuess$ = Guess(OldCode%).Code
        FOR Zloop% = 0 TO PlayerPeg%(Player%)
            Ztemp% = ASC(MID$(currentGuess$, Zloop% + 1, 1))
            CIRCLE (30 + Zloop% * 47, 228), 21, Ztemp% - 1
            PAINT (30 + Zloop% * 47, 228), Ztemp% - 1, Ztemp% - 1
        NEXT Zloop%
    END IF
END IF

nextClick:
MouseShow
TimePause 2
GOTO GetMouse


ComputerTurn:
ShowCode PlayerPeg%(Player%), SecretCode$
IF LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1) = LEFT$(Guess(0).Code, PlayerPeg%(Player%) + 1) THEN
    IF ComputerScan% THEN
        currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)
    ELSE
        CalculateColors PlayerColor%(Player%), PlayerPeg%(Player%), Turn% - 2
        ComputerScan% = -1
        currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)
    END IF
ELSE
    IF Turn% = 0 THEN
        currentGuess$ = LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1)
        ComputerCode$ = MID$(ComputerCode$, 2) + LEFT$(ComputerCode$, 1)
    ELSEIF Guess(Turn% - 1).Blk + Guess(Turn% - 1).Wht = PlayerPeg%(Player%) + 1 THEN
        ComputerCode$ = Guess(0).Code
        ComputerMatrix Guess(Turn% - 1).Code, PlayerColor%(Player%), PlayerPeg%(Player%)
        ComputerScan% = -1
        currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)
    ELSEIF Turn% > 2 THEN
        CalculateColors PlayerColor%(Player%), PlayerPeg%(Player%), Turn% - 2
        IF CodeMatrix$(0) = CHR$(255) THEN
            currentGuess$ = LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1)
            ComputerCode$ = MID$(ComputerCode$, 2) + LEFT$(ComputerCode$, 1)
        ELSE
            ComputerCode$ = Guess(0).Code
            ComputerScan% = -1
            currentGuess$ = CalculateCode$(PlayerPeg%(Player%), Turn% - 1)
        END IF
    ELSE
        currentGuess$ = LEFT$(ComputerCode$, PlayerPeg%(Player%) + 1)
        ComputerCode$ = MID$(ComputerCode$, 2) + LEFT$(ComputerCode$, 1)
    END IF
END IF
         
ComputerShow currentGuess$, PlayerPeg%(Player%)
GiveClues currentGuess$, SecretCode$, PlayerPeg%(Player%), Turn%
RETURN


GameHelp:
    ShowCode PlayerPeg%(Player%), SecretCode$
    RETURN

ExitGame:
    CLS : END

FUNCTION CalculateCode$ (NumPegs%, TurnNum%)

ComputerRight$ = ""
FOR Zloop% = 0 TO NumPegs%
    ComputerRight$ = ComputerRight$ + CodeMatrix$(Zloop%)
NEXT Zloop%

FOR Zloop% = 0 TO TurnNum%
    IF Guess(Zloop%).Blk > 0 AND Guess(Zloop%).Wht = 0 THEN
        FOR Xloop% = 0 TO NumPegs%
            IF INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) > 0 THEN
                FOR Yloop% = 0 TO NumPegs%
                    PegWrong%(Xloop%, Yloop%) = Yloop%
                NEXT Yloop%
                PegWrong%(Xloop%, INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1) = -1
                PegRight%(Xloop%) = INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1
            END IF
        NEXT Xloop%
    ELSEIF Guess(Zloop%).Wht > 0 AND Guess(Zloop%).Blk = 0 THEN
        FOR Xloop% = 0 TO NumPegs%
            IF INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) > 0 THEN
                PegWrong%(Xloop%, INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1) = INSTR(ComputerRight$, MID$(Guess(Zloop%).Code, Xloop% + 1, 1)) - 1
            END IF
        NEXT Xloop%
    END IF
NEXT Zloop%

FOR Zloop% = 0 TO NumPegs%
    Ztemp0% = 0: Ztemp1% = -1: Xtemp0% = 0: Xtemp1% = -1
    FOR Xloop% = 0 TO NumPegs%
        IF PegWrong%(Zloop%, Xloop%) = -1 THEN Ztemp0% = Ztemp0% + 1: Ztemp1% = Xloop%
        IF PegWrong%(Xloop%, Zloop%) = -1 THEN Xtemp0% = Xtemp0% + 1: Xtemp1% = Xloop%
    NEXT Xloop%
    IF Ztemp0% = 1 THEN
        FOR Xloop% = 0 TO NumPegs%
            PegWrong%(Zloop%, Xloop%) = Xloop%
        NEXT Xloop%
        PegRight%(Zloop%) = Ztemp1%
        PegWrong%(Zloop%, Ztemp1%) = -1
    END IF
    IF Xtemp0% = 1 THEN
        FOR Xloop% = 0 TO NumPegs%
            PegWrong%(Xloop%, Zloop%) = Zloop%
        NEXT Xloop%
        PegRight%(Xtemp1%) = Zloop%
        PegWrong%(Xtemp1%, Zloop%) = -1
    END IF
    IF PegRight%(Zloop%) > -1 THEN
        FOR Xloop% = 0 TO NumPegs%
            PegWrong%(Zloop%, Xloop%) = Xloop%
            PegWrong%(Xloop%, PegRight%(Zloop%)) = PegRight%(Zloop%)
        NEXT Xloop%
        PegWrong%(Zloop%, PegRight%(Zloop%)) = -1
    END IF
NEXT Zloop%

FOR Zloop% = 0 TO NumPegs%
    IF PegRight%(Zloop%) > -1 THEN
        PegMatrix1%(Zloop%) = 0
        PegMatrix2%(Zloop%, 0) = PegRight%(Zloop%)
    ELSE
        PegMatrix1%(Zloop%) = -1
        FOR Xloop% = 0 TO NumPegs%
            IF PegWrong%(Zloop%, Xloop%) = -1 THEN
                PegMatrix1%(Zloop%) = PegMatrix1%(Zloop%) + 1
                PegMatrix2%(Zloop%, PegMatrix1%(Zloop%)) = Xloop%
            END IF
        NEXT Xloop%
    END IF
NEXT Zloop%

StartPegLoop:
PegLoop%(0) = PegLoop%(0) + 1
IF PegLoop%(0) > PegMatrix1%(0) THEN
    PegLoop%(0) = 0
    PegLoop%(1) = PegLoop%(1) + 1
    IF PegLoop%(1) > PegMatrix1%(1) THEN
        PegLoop%(1) = 0
        PegLoop%(2) = PegLoop%(2) + 1
        IF PegLoop%(2) > PegMatrix1%(2) THEN
            PegLoop%(2) = 0
            IF NumPegs% = 2 THEN GOTO EndPegLoop
            PegLoop%(3) = PegLoop%(3) + 1
            IF PegLoop%(3) > PegMatrix1%(3) THEN
                PegLoop%(3) = 0
                IF NumPegs% = 3 THEN GOTO EndPegLoop
                PegLoop%(4) = PegLoop%(4) + 1
                IF PegLoop%(4) > PegMatrix1%(4) THEN
                    PegLoop%(4) = 0
                    IF NumPegs% = 4 THEN GOTO EndPegLoop
                    PegLoop%(5) = PegLoop%(5) + 1
                    IF PegLoop%(5) > PegMatrix1%(5) THEN
                        PegLoop%(5) = 0
                        IF NumPegs% = 5 THEN GOTO EndPegLoop
                        PegLoop%(6) = PegLoop%(6) + 1
                        IF PegLoop%(6) > PegMatrix1%(6) THEN
                            PegLoop%(6) = 0
                            IF NumPegs% = 6 THEN GOTO EndPegLoop
                            PegLoop%(7) = PegLoop%(7) + 1
                            IF PegLoop%(7) > PegMatrix1%(7) THEN
                                PegLoop%(7) = 0
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        END IF
    END IF
END IF
EndPegLoop:

FOR Zloop% = 0 TO NumPegs%
    PegMatrix0%(Zloop%) = PegMatrix2%(Zloop%, PegLoop%(Zloop%))
NEXT Zloop%

Done% = -1
FOR Zloop% = 0 TO NumPegs%
    IF PegMatrix0%(Zloop%) < 0 OR PegMatrix0%(Zloop%) > NumPegs% THEN GOTO StartPegLoop
    FOR Xloop% = 0 TO NumPegs%
        IF (Xloop% <> Zloop%) AND (PegMatrix0%(Zloop%) = PegMatrix0%(Xloop%)) THEN
            Done% = 0
            EXIT FOR
        END IF
    NEXT Xloop%
    IF NOT (Done%) THEN EXIT FOR
NEXT Zloop%

IF NOT (Done%) THEN GOTO StartPegLoop
TestGuess$ = ""
FOR Zloop% = 0 TO NumPegs%
    TestGuess$ = TestGuess$ + CodeMatrix$(PegMatrix0%(Zloop%))
NEXT Zloop%
ComputerShow TestGuess$, NumPegs%

FOR Zloop% = TurnNum% TO 0 STEP -1
    Done% = -1: Black% = 0: White% = 0
    FOR Xloop% = 1 TO NumPegs% + 1
        IF INSTR(Guess(Zloop%).Code, MID$(TestGuess$, Xloop%, 1)) = Xloop% THEN Black% = Black% + 1
    NEXT Xloop%
    IF Black% <> Guess(Zloop%).Blk THEN
        Done% = 0
        EXIT FOR
    END IF
NEXT Zloop%

IF NOT (Done%) THEN GOTO StartPegLoop

CalculateCode$ = TestGuess$

END FUNCTION

SUB CalculateColors (NumColors%, NumPegs%, TurnNum%)

FOR Yloop% = 0 TO NumColors%
    FOR Zloop% = 0 TO TurnNum%
        Peg0% = Guess(Zloop%).Blk + Guess(Zloop%).Wht: Peg1% = Guess(Zloop% + 1).Blk + Guess(Zloop% + 1).Wht
        CodeNum0% = Zloop%: CodeNum1% = Zloop% + 1
        FirstPeg$ = MID$(Guess(Zloop%).Code, 1, 1): LastPeg$ = MID$(Guess(Zloop% + 1).Code, NumPegs% + 1, 1)
        GOSUB ComputerCheck
    NEXT Zloop%
NEXT Yloop%

IF LEN(ComputerWrong$) + 1 = NumColors% - NumPegs% THEN
    FOR Zloop% = 1 TO NumColors%
        IF INSTR(ComputerWrong$, CHR$(Zloop%)) = 0 THEN
            IF INSTR(ComputerRight$, CHR$(Zloop%)) = 0 THEN ComputerRight$ = ComputerRight$ + CHR$(Zloop%)
        END IF
    NEXT Zloop%
ELSEIF LEN(ComputerRight$) = NumPegs% + 1 THEN
    FOR Zloop% = 1 TO NumColors%
        IF INSTR(ComputerRight$, CHR$(Zloop%)) = 0 THEN
            IF INSTR(ComputerWrong$, CHR$(Zloop%)) = 0 THEN ComputerWrong$ = ComputerWrong$ + CHR$(Zloop%)
        END IF
    NEXT Zloop%
END IF

IF LEN(ComputerRight$) <> NumPegs% + 1 THEN EXIT SUB

ComputerMatrix ComputerRight$, NumColors%, NumPegs%

EXIT SUB

ComputerCheck:
IF (NumPegs% + 1) - Peg0% = NumColors% - (NumPegs% + 1) THEN
    FOR Xloop% = 1 TO NumColors%
        IF INSTR(Guess(CodeNum0%).Code, CHR$(Xloop%)) = 0 THEN
            IF INSTR(ComputerRight$, CHR$(Xloop%)) = 0 THEN
                ComputerRight$ = ComputerRight$ + CHR$(Xloop%)
            END IF
        END IF
    NEXT Xloop%
END IF
IF (NumPegs% + 1) - Peg1% = NumColors% - (NumPegs% + 1) THEN
    FOR Xloop% = 1 TO NumColors%
        IF INSTR(Guess(CodeNum1%).Code, CHR$(Xloop%)) = 0 THEN
            IF INSTR(ComputerRight$, CHR$(Xloop%)) = 0 THEN
                ComputerRight$ = ComputerRight$ + CHR$(Xloop%)
            END IF
        END IF
    NEXT Xloop%
END IF

ColorRightScan ComputerRight$, ComputerWrong$, Guess(CodeNum0%).Code, NumPegs%, Peg0%
ColorRightScan ComputerRight$, ComputerWrong$, Guess(CodeNum1%).Code, NumPegs%, Peg1%

ColorWrongScan ComputerRight$, ComputerWrong$, Guess(CodeNum0%).Code, NumPegs%, Peg0%
ColorWrongScan ComputerRight$, ComputerWrong$, Guess(CodeNum1%).Code, NumPegs%, Peg1%

IF Peg0% < Peg1% THEN
    IF INSTR(ComputerWrong$, FirstPeg$) = 0 AND INSTR(ComputerRight$, FirstPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + FirstPeg$
    IF INSTR(ComputerRight$, LastPeg$) = 0 AND INSTR(ComputerWrong$, LastPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + LastPeg$
ELSEIF Peg0% > Peg1% THEN
    IF INSTR(ComputerWrong$, LastPeg$) = 0 AND INSTR(ComputerRight$, LastPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + LastPeg$
    IF INSTR(ComputerRight$, FirstPeg$) = 0 AND INSTR(ComputerWrong$, FirstPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + FirstPeg$
ELSEIF Peg0% = Peg1% THEN
    IF INSTR(ComputerRight$, FirstPeg$) > 0 AND INSTR(ComputerWrong$, LastPeg$) = 0 THEN
        IF INSTR(ComputerRight$, LastPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + LastPeg$
    ELSEIF INSTR(ComputerRight$, LastPeg$) > 0 AND INSTR(ComputerWrong$, FirstPeg$) = 0 THEN
        IF INSTR(ComputerRight$, FirstPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + FirstPeg$
    ELSEIF INSTR(ComputerWrong$, FirstPeg$) > 0 AND INSTR(ComputerRight$, LastPeg$) = 0 THEN
        IF INSTR(ComputerWrong$, LastPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + LastPeg$
    ELSEIF INSTR(ComputerWrong$, LastPeg$) > 0 AND INSTR(ComputerRight$, FirstPeg$) = 0 THEN
        IF INSTR(ComputerWrong$, FirstPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + FirstPeg$
    ELSEIF LEN(ComputerWrong$) = NumColors% - (NumPegs% + 2) THEN
        IF INSTR(ComputerRight$, FirstPeg$) = 0 AND INSTR(ComputerWrong$, FirstPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + FirstPeg$
        IF INSTR(ComputerRight$, LastPeg$) = 0 AND INSTR(ComputerWrong$, LastPeg$) = 0 THEN ComputerRight$ = ComputerRight$ + LastPeg$
    ELSEIF LEN(ComputerRight$) = NumPegs% THEN
        IF INSTR(ComputerWrong$, FirstPeg$) = 0 AND INSTR(ComputerRight$, FirstPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + FirstPeg$
        IF INSTR(ComputerWrong$, LastPeg$) = 0 AND INSTR(ComputerRight$, LastPeg$) = 0 THEN ComputerWrong$ = ComputerWrong$ + LastPeg$
    END IF
END IF
RETURN

END SUB

SUB CodeBar (NumPegs%)

LINE (0, 200)-(388, 256), 14, BF: LINE (4, 204)-(384, 252), 15, BF
FOR Zloop% = 0 TO NumPegs%
    PegLarge Zloop%
NEXT Zloop%
WordPrint 12, -25, 13, -1, "ENTER CODE"

LINE (136, 416)-(256, 464), 14, BF: LINE (140, 420)-(252, 460), 15, BF
WordPrint 28, -25, 6, -1, " TEST CODE "

END SUB

SUB ColorBar (NumColors%)

LINE (0, 343)-(388, 379), 14, BF: LINE (4, 347)-(384, 375), 15, BF
LINE (0, 307)-(388, 343), 14, BF: LINE (4, 311)-(384, 339), 15, BF
LINE (8, 315)-(380, 335), 14, BF: LINE (12, 319)-(376, 331), 0, BF
FOR Zloop% = 1 TO NumColors%
    CIRCLE (18 + (Zloop% - 1) * 27, 361), 11, Zloop% - 1
    PAINT (18 + (Zloop% - 1) * 27, 361), Zloop% - 1, Zloop% - 1
NEXT Zloop%
WordPrint 19, -25, 13, -1, "COLOR BAR"
    
END SUB



SUB ColorRightScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)

Ztemp% = 0
FOR Xloop% = 1 TO NumPegs% + 1
    IF INSTR(CompRight$, MID$(Xcode$, Xloop%, 1)) > 0 THEN Ztemp% = Ztemp% + 1
NEXT Xloop%
IF Ztemp% = TotalPeg% THEN
    FOR Xloop% = 1 TO NumPegs% + 1
        IF INSTR(CompRight$, MID$(Xcode$, Xloop%, 1)) = 0 THEN
            IF INSTR(CompWrong$, MID$(Xcode$, Xloop%, 1)) = 0 THEN
                CompWrong$ = CompWrong$ + MID$(Xcode$, Xloop%, 1)
            END IF
        END IF
    NEXT Xloop%
END IF

END SUB

SUB ColorWrongScan (CompRight$, CompWrong$, Xcode$, NumPegs%, TotalPeg%)

Ztemp% = 0
FOR Xloop% = 1 TO NumPegs% + 1
    IF INSTR(CompWrong$, MID$(Xcode$, Xloop%, 1)) > 0 THEN Ztemp% = Ztemp% + 1
NEXT Xloop%
IF Ztemp% = (NumPegs% + 1) - TotalPeg% THEN
    FOR Xloop% = 1 TO NumPegs% + 1
        IF INSTR(CompWrong$, MID$(Xcode$, Xloop%, 1)) = 0 THEN
            IF INSTR(CompRight$, MID$(Xcode$, Xloop%, 1)) = 0 THEN
                CompRight$ = CompRight$ + MID$(Xcode$, Xloop%, 1)
            END IF
        END IF
    NEXT Xloop%
END IF

END SUB

SUB ComputerMatrix (RightColors$, NumColors%, NumPegs%)

Ztemp% = 0
FOR Zloop% = 1 TO NumColors%
    IF INSTR(RightColors$, CHR$(Zloop%)) > 0 THEN
        CodeMatrix$(Ztemp%) = CHR$(Zloop%)
        PegLoop%(Ztemp%) = NumPegs% - Ztemp%
        Ztemp% = Ztemp% + 1
    END IF
NEXT Zloop%
PegLoop%(0) = NumPegs% - 1

END SUB

SUB ComputerShow (Xcode$, NumPegs%)

FOR Zloop% = 0 TO NumPegs%
    NewColor% = ASC(MID$(Xcode$, Zloop% + 1, 1))
    CIRCLE (30 + Zloop% * 47, 228), 21, NewColor% - 1
    PAINT (30 + Zloop% * 47, 228), NewColor% - 1, NewColor% - 1
NEXT Zloop%

END SUB

SUB DrawBox (Row%, Col%, ColLen%, Fclr%, Bclr%, Format$, Style%)

SELECT CASE Style%
    CASE 0: Box0$ = "Ϊ": Box1$ = "Δ": Box2$ = "Ώ": Box3$ = "³": Box4$ = "Γ": Box5$ = "΄": Box6$ = "ΐ": Box7$ = "Ω"
    CASE 1: Box0$ = "Ι": Box1$ = "Ν": Box2$ = "»": Box3$ = "Ί": Box4$ = "Μ": Box5$ = "Ή": Box6$ = "Θ": Box7$ = "Ό"
    CASE 2: Box0$ = "Φ": Box1$ = "Δ": Box2$ = "·": Box3$ = "Ί": Box4$ = "Η": Box5$ = "Ά": Box6$ = "Σ": Box7$ = "½"
    CASE 3: Box0$ = "Υ": Box1$ = "Ν": Box2$ = "Έ": Box3$ = "³": Box4$ = "Ζ": Box5$ = "΅": Box6$ = "Τ": Box7$ = "Ύ"
END SELECT

IF Bclr% >= 0 THEN
    COLOR Fclr%, Bclr%
ELSE
    COLOR Fclr%
END IF

FOR Zloop% = 0 TO LEN(Format$) - 1
    LOCATE Row% + Zloop%, Col%
    BoxTemp$ = MID$(Format$, Zloop% + 1, 1)
    SELECT CASE UCASE$(BoxTemp$)
        CASE "T":  PRINT Box0$ + STRING$(ColLen%, Box1$) + Box2$;
        CASE "M":  PRINT Box4$ + STRING$(ColLen%, Box1$) + Box5$;
        CASE "S":  PRINT Box3$ + SPACE$(ColLen%) + Box3$;
        CASE "B":  PRINT Box6$ + STRING$(ColLen%, Box1$) + Box7$;
    END SELECT
NEXT Zloop%

END SUB

SUB GameBoard (NumPegs%)

LINE (503, 0)-(639, 479), 14, BF: LINE (399, 0)-(506, 479), 14, BF
LINE (507, 4)-(635, 475), 15, BF: LINE (403, 4)-(501, 475), 15, BF
FOR Xloop% = 0 TO NumPegs%
    FOR Zloop% = 0 TO 29
        PegSmall Xloop%, Zloop%
        CIRCLE (494 - Xloop% * 12, 467 - Zloop% * 15), 3, 14
        CIRCLE (494 - Xloop% * 12, 467 - Zloop% * 15), 2, 14
        LINE (399, 460 - Zloop% * 15)-(639, 460 - Zloop% * 15), 14
    NEXT Zloop%
    CIRCLE (518 + Xloop% * 15, 15), 5, 14
    PAINT (518 + Xloop% * 15, 15), 14, 14
    CIRCLE (518 + Xloop% * 15, 15), 3, 15
    LINE (518 + Xloop% * 15, 15)-(518 + Xloop% * 15, 467), 14
NEXT Xloop%

END SUB

SUB GameInit

FOR Zloop% = 0 TO 7
    PlayerName$(Zloop%) = "PLAYER  #" + LTRIM$(STR$(Zloop% + 1))
NEXT Zloop%

END SUB

FUNCTION GetScreenMode%

    TempMode% = True%
    
    ON LOCAL ERROR GOTO GetScreenModeError
        COLOR , 0

    GetScreenMode% = TempMode%

    EXIT FUNCTION

GetScreenModeError:
    TempMode% = False%
    RESUME NEXT

END FUNCTION

SUB GiveClues (Xcode$, Scode$, NumPegs%, TurnNum%)

CurrentClue% = 0: CurrentClue$ = STRING$(8, 255): CurrentCode$ = STRING$(8, 255)
Guess(TurnNum%).Code = Xcode$: Guess(TurnNum%).Clue = STRING$(8, 0)
FOR Zloop% = 0 TO NumPegs%
    Ztemp% = ASC(MID$(Xcode$, Zloop% + 1, 1))
    CIRCLE (518 + Zloop% * 15, 467 - TurnNum% * 15), 5, Ztemp% - 1
    PAINT (518 + Zloop% * 15, 467 - TurnNum% * 15), Ztemp% - 1, Ztemp% - 1
    IF MID$(Scode$, Zloop% + 1, 1) = MID$(Xcode$, Zloop% + 1, 1) THEN
        MID$(Guess(TurnNum%).Clue, CurrentClue% + 1, 1) = CHR$(1)
        MID$(CurrentClue$, Zloop% + 1, 1) = CHR$(1)
        MID$(CurrentCode$, Zloop% + 1, 1) = CHR$(1)
        SetClue CurrentClue%, TurnNum%, 0
        CurrentClue% = CurrentClue% + 1
        Guess(TurnNum%).Blk = Guess(TurnNum%).Blk + 1
    END IF
NEXT Zloop%
FOR Zloop% = 0 TO NumPegs%
    FOR Xloop% = 0 TO NumPegs%
        IF MID$(CurrentClue$, Xloop% + 1, 1) < CHR$(255) OR MID$(CurrentCode$, Zloop% + 1, 1) < CHR$(255) THEN
            GOTO NextPeg
        ELSEIF MID$(Scode$, Xloop% + 1, 1) = MID$(Xcode$, Zloop% + 1, 1) THEN
            MID$(Guess(TurnNum%).Clue, CurrentClue% + 1, 1) = CHR$(2)
            MID$(CurrentClue$, Xloop% + 1, 1) = CHR$(2)
            MID$(CurrentCode$, Zloop% + 1, 1) = CHR$(2)
            SetClue CurrentClue%, TurnNum%, 1
            CurrentClue% = CurrentClue% + 1
            Guess(TurnNum%).Wht = Guess(TurnNum%).Wht + 1
        END IF
NextPeg:
    NEXT Xloop%
NEXT Zloop%

END SUB

FUNCTION Kbd$

Key$ = ""
WHILE Key$ = ""
    Key$ = INKEY$
WEND

Kbd$ = Key$

END FUNCTION

SUB MouseDriver (Mouse0%, Mouse1%, Mouse2%, Mouse3%) STATIC

    DIM Registers AS RegTypeX

    IF NOT (MouseChecked%) THEN
        DEF SEG = 0
        MouseSegment& = 256& * PEEK(207) + PEEK(206)
        MouseOffset& = 256& * PEEK(205) + PEEK(204)
        DEF SEG = MouseSegment&
        IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THEN
            MousePresent% = False%: MouseChecked% = True%
            DEF SEG
        END IF
    END IF

    IF NOT (MousePresent%) AND MouseChecked% THEN
        Mouse0% = False%
        EXIT SUB
    END IF
    
    Registers.ax = Mouse0%: Registers.bx = Mouse1%: Registers.cx = Mouse2%: Registers.dx = Mouse3%
    InterruptX 51, Registers, Registers

    Mouse0% = Registers.ax: Mouse1% = Registers.bx: Mouse2% = Registers.cx: Mouse3% = Registers.dx

    IF MouseChecked% THEN EXIT SUB

    IF Mouse0% AND NOT MouseChecked% THEN
        MousePresent% = True%
        Mouse0% = True%
        DEF SEG
    END IF
    MouseChecked% = True%
    
END SUB

SUB MouseHide

   MouseDriver 2, 0, 0, 0

END SUB

SUB MouseInit

    MouseDriver 0, 0, 0, 0
    
END SUB

SUB MousePoll (Row%, Col%, LButton%, RButton%)

    ScreenMode% = GetScreenMode%

    MouseDriver 3, Button%, Col%, Row%

    IF ScreenMode% THEN
        Row% = Row% / 8 + 1: Col% = Col% / 8 + 1
    END IF
                                                
    IF Button% AND 1 THEN
        LButton% = True%
    ELSE
        LButton% = False%
    END IF

    IF Button% AND 2 THEN
        RButton% = True%
    ELSE
        RButton% = False%
    END IF

END SUB

SUB MouseShow

    MouseDriver 1, 0, 0, 0

END SUB

SUB PegLarge (PegXloc%)
       
CIRCLE (30 + PegXloc% * 47, 228), 21, 14
PAINT (30 + PegXloc% * 47, 228), 14, 14
CIRCLE (30 + PegXloc% * 47, 228), 17, 15
CIRCLE (30 + PegXloc% * 47, 228), 16, 15
CIRCLE (30 + PegXloc% * 47, 228), 15, 15

END SUB

SUB PegSmall (PegXloc%, PegYloc%)
       
CIRCLE (518 + PegXloc% * 15, 467 - PegYloc% * 15), 5, 14
PAINT (518 + PegXloc% * 15, 467 - PegYloc% * 15), 14, 14
CIRCLE (518 + PegXloc% * 15, 467 - PegYloc% * 15), 3, 15

END SUB

FUNCTION PlayAgain%

CodeBar -1
ColorBar 0
GameBoard -1

Clr% = 0: Peg% = 1
FOR Zloop% = 1 TO 2
    CIRCLE (30 + Peg% * 47, 228), 21, Clr%
    PAINT (30 + Peg% * 47, 228), Clr%, Clr%
    Clr% = 1: Peg% = 6
NEXT Zloop%

WordPrint 18, -25, 6, -1, "PLAY AGAIN                    EXIT GAME"
TimePause 2
MouseShow
PlayAgainPress:
MousePoll Row%, Col%, LButton%, RButton%

IF (Col% > 6 AND Col% < 383) AND (Row% > 204 AND Row% < 252) THEN
    IF LButton% THEN
        MouseHide
        TestPoint% = POINT(Col% + 1, Row% + 1)
        MouseShow
        IF TestPoint% = 0 THEN
            PlayAgain% = -1
        ELSEIF TestPoint% = 1 THEN
            PlayAgain% = 0
        ELSE
            GOTO PlayAgainPress
        END IF
    ELSE
        GOTO PlayAgainPress
    END IF
ELSE
    GOTO PlayAgainPress
END IF

MouseHide

END FUNCTION

SUB ScoreCard

DrawBox 1, 1, 20, 15, -1, "TS" + STRING$(NumPlayer%, "S") + "B", 1
FOR Zloop% = 0 TO NumPlayer%
    Ztemp$ = RIGHT$("000" + RIGHT$(STR$(PlayerScore%(Zloop%)), LEN(STR$(PlayerScore%(Zloop%))) - 1), 3)
    WordPrint 2 + Zloop%, 3, 1 + Zloop%, -1, PlayerName$(Zloop%) + SPACE$(15 - LEN(PlayerName$(Zloop%))) + Ztemp$
NEXT Zloop%

END SUB

FUNCTION SelectCode$ (NumPegs%, NumColor%)

RANDOMIZE (TIMER)

CodeColor$ = STRING$(14, 1)

FOR Zloop% = 0 TO NumPegs%
NewColor:
    Ztemp% = INT(RND * NumColor%) + 1
    IF MID$(CodeColor$, Ztemp%, 1) = CHR$(255) THEN GOTO NewColor
    TempCode$ = TempCode$ + CHR$(Ztemp%)
    MID$(CodeColor$, Ztemp%, 1) = CHR$(255)
NEXT Zloop%

SelectCode$ = TempCode$

END FUNCTION

SUB SetClue (ClueNum%, TurnNum%, Clr%)

CIRCLE (494 - ClueNum% * 12, 467 - TurnNum% * 15), 3, Clr%
PAINT (494 - ClueNum% * 12, 467 - TurnNum% * 15), Clr%, Clr%

END SUB

SUB SetColors

CLS
SetPalette 0, 0, 0, 0      ' BLACK
SetPalette 1, 55, 55, 55   ' WHITE
SetPalette 2, 25, 25, 25   ' GRAY
SetPalette 3, 45, 0, 0     ' RED
SetPalette 4, 0, 45, 0     ' GREEN
SetPalette 5, 0, 0, 45     ' BLUE
SetPalette 6, 53, 53, 0    ' YELLOW
SetPalette 7, 40, 0, 40    ' PURPLE
SetPalette 8, 60, 30, 0    ' ORANGE
SetPalette 9, 0, 40, 40   ' CYAN
SetPalette 10, 63, 31, 31  ' PEACH
SetPalette 11, 44, 0, 24   ' ROSE
SetPalette 12, 0, 20, 5    ' GRASS
SetPalette 13, 0, 20, 60   ' SKY
SetPalette 14, 18, 9, 0    ' BROWN 2
SetPalette 15, 32, 16, 0   ' BROWN 1

END SUB

SUB SetPalette (Number%, Red%, Green%, Blue%)

    PALETTE Number%, 65536 * Blue% + 256 * Green% + Red%

END SUB

SUB ShowCode (NumPegs%, Xcode$)

FOR Zloop% = 0 TO NumPegs%
    Ztemp% = ASC(MID$(Xcode$, Zloop% + 1, 1))
    CIRCLE (518 + Zloop% * 15, 15), 5, Ztemp% - 1
    PAINT (518 + Zloop% * 15, 15), Ztemp% - 1, Ztemp% - 1
NEXT Zloop%

END SUB

SUB StartUp

CLS

Xalpha 20, 1, 13, -1, "MASTERCODE"

WordPrint 2, -41, 4, -1, "ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»"
WordPrint 3, -41, 4, -1, "Ί                            Ί"
WordPrint 4, -41, 4, -1, "ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ"
WordPrint 3, -41, 12, -1, "NUMBER OF PLAYERS  (1-8)  "

Sloop.01:
    NumPlayer% = VAL(WordInput$(3, 53, 11, -1, 11, -1, 1, "1")) - 1
    IF NumPlayer% < 0 OR NumPlayer% > 7 THEN GOTO Sloop.01

WordPrint 5, -41, 4, -1, "ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»"
FOR Zloop% = 0 TO NumPlayer%
    WordPrint 6 + Zloop%, -41, 4, -1, "Ί                            Ί"
NEXT Zloop%
WordPrint 7 + NumPlayer%, -41, 4, -1, "ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ"

FOR Zloop% = 0 TO NumPlayer%
    WordPrint 6 + Zloop%, 28, 12, -1, "PLAYER  #" + RIGHT$(STR$(Zloop% + 1), 1)
    PlayerName$(Zloop%) = WordInput$(6 + Zloop%, 40, 11, -1, 12, -1, 14, PlayerName$(Zloop%))
NEXT Zloop%

WordPrint 8 + NumPlayer%, -41, 4, -1, "ΙΝΝΝΝΝΝΝ              ΝΝΝΝΝΝΝ»"
FOR Zloop% = 0 TO 1
    WordPrint 9 + Zloop% + NumPlayer%, -41, 4, -1, "Ί                            Ί"
NEXT Zloop%
WordPrint 11 + NumPlayer%, -41, 4, -1, "ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ"

FOR Zloop% = 0 TO NumPlayer%
    WordPrint 8 + NumPlayer%, -41, 0, -1, SPACE$(14)
    WordPrint 8 + NumPlayer%, -41, 9, -1, PlayerName$(Zloop%)
    WordPrint 9 + NumPlayer%, 28, 12, -1, "TOTAL PEGS IN CODE (3-8)"
    WordPrint 10 + NumPlayer%, -41, 0, -1, SPACE$(26)
SLOOP.02:
    PlayerPeg%(Zloop%) = VAL(WordInput$(9 + NumPlayer%, 53, 11, -1, 11, -1, 1, "3")) - 1
    IF PlayerPeg%(Zloop%) < 2 OR PlayerPeg%(Zloop%) > 7 THEN GOTO SLOOP.02
    LowDif$ = CHR$(PlayerPeg%(Zloop%) + 50)
    WordPrint 10 + NumPlayer%, 30, 12, -1, "TOTAL COLORS (" + LowDif$ + "-14)"
SLOOP.03:
    PlayerColor%(Zloop%) = VAL(WordInput$(10 + NumPlayer%, 50, 11, -1, 11, -1, 2, LowDif$))
    IF PlayerColor%(Zloop%) < VAL(LowDif$) OR PlayerColor%(Zloop%) > 14 THEN GOTO SLOOP.03
NEXT Zloop%

WordPrint 8 + NumPlayer%, -41, 4, -1, "ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»"
FOR Zloop% = 0 TO 1
    WordPrint 9 + NumPlayer%, -41, 4, -1, "Ί                            Ί"
NEXT Zloop%
WordPrint 11 + NumPlayer%, -41, 4, -1, "ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ"
WordPrint 9 + NumPlayer%, -41, 12, -1, "NUMBER OF ROUNDS TO PLAY"
WordPrint 10 + NumPlayer%, -41, 12, -1, " TOTAL ROUNDS (1-9) # "
SLOOP.04:
NumGames% = VAL(WordInput$(10 + NumPlayer%, 50, 11, -1, 11, -1, 1, "1")) - 1
IF NumGames% < 0 OR NumGames% > 8 THEN GOTO SLOOP.04

END SUB

SUB TimePause (TimeDelay%)

StartTime& = TIMER * 100 + TimeDelay% * 10

DO
LOOP UNTIL (TIMER * 100) > StartTime&

END SUB

SUB TitleScreen

SetPalette 1, 0, 0, 0: SetPalette 2, 0, 0, 0: SetPalette 3, 0, 0, 0
Xalpha 2, 1, 1, -1, "MASTERCODE"
GOSUB TitleExit
Xalpha 13, 32, 2, -1, "BY"
GOSUB TitleExit
Xalpha 23, 5, 3, -1, "KEN SWEET"
GOSUB TitleExit
FOR Zloop% = 0 TO 63
    SetPalette 1, Zloop%, 0, 0: SetPalette 2, 0, Zloop%, 0: SetPalette 3, 0, 0, Zloop%
    GOSUB TitleExit
NEXT Zloop%
FOR Zloop% = 0 TO 63
    SetPalette 1, 63 - Zloop%, Zloop%, 0: SetPalette 2, 0, 63 - Zloop%, Zloop%: SetPalette 3, Zloop%, 0, 63 - Zloop%
    GOSUB TitleExit
NEXT Zloop%
FOR Zloop% = 0 TO 63
    SetPalette 1, 0, 63 - Zloop%, Zloop%: SetPalette 2, Zloop%, 0, 63 - Zloop%: SetPalette 3, 63 - Zloop%, Zloop%, 0
    GOSUB TitleExit
NEXT Zloop%
FOR Zloop% = 0 TO 63
    SetPalette 1, Zloop%, 0, 63 - Zloop%: SetPalette 2, 63 - Zloop%, Zloop%, 0: SetPalette 3, 0, 63 - Zloop%, Zloop%
    GOSUB TitleExit
NEXT Zloop%

EXIT SUB

TitleExit:
IF INKEY$ <> "" THEN EXIT SUB
RETURN

END SUB

FUNCTION WordInput$ (Row%, Col%, Fclr%, Bclr%, HFclr%, HBclr%, TextLen%, Text$)

Text$ = LEFT$(Text$ + SPACE$(TextLen%), TextLen%)
TempText$ = Text$: Done% = 0: TextPos% = 1

DO WHILE NOT (Done%)
    LOCATE Row%, Col%
    IF Bclr% >= 0 THEN
        COLOR Fclr%, Bclr%
    ELSE
        COLOR Fclr%
    END IF
    PRINT LEFT$(RTRIM$(TempText$) + STRING$(TextLen%, "_"), TextLen%);
  
    LOCATE Row%, Col% + TextPos% - 1
    IF HBclr% >= 0 THEN
        COLOR HFclr%, HBclr%
    ELSE
        COLOR HFclr%
    END IF
    PRINT MID$(TempText$, TextPos%, 1);

    WKey$ = Kbd$

    SELECT CASE WKey$
        CASE CHR$(27): TempText$ = "": GOTO ENDINPUT
        CASE CHR$(0) + "G": TextPos% = 1
        CASE CHR$(0) + "O": TextPos% = TextLen%
        CASE CHR$(0) + "S": TempText$ = LEFT$(TempText$, TextPos% - 1) + MID$(TempText$, TextPos% + 1) + " "
        CASE CHR$(13): Done% = -1
        CASE CHR$(0) + "K": TextPos% = TextPos% - 1: IF TextPos% < 1 THEN TextPos% = 1
        CASE CHR$(0) + "M": TextPos% = TextPos% + 1: IF TextPos% > TextLen% THEN TextPos% = TextLen%
        CASE CHR$(0) + "R": TempText$ = LEFT$(LEFT$(TempText$, TextPos% - 1) + " " + MID$(TempText$, TextPos%), TextLen%)
        CASE CHR$(8)
            IF TextPos% > 1 THEN
                TempText$ = LEFT$(TempText$, TextPos% - 2) + MID$(TempText$, TextPos%) + " "
                TextPos% = TextPos% - 1
            ELSE
                TempText$ = MID$(TempText$, 2) + " "
            END IF
        CASE " " TO "~"
            MID$(TempText$, TextPos%, 1) = WKey$: TextPos% = TextPos% + 1
            IF TextPos% > TextLen% THEN TextPos% = TextLen%
    END SELECT
LOOP

ENDINPUT:

LOCATE Row%, Col%
IF Bclr% >= 0 THEN
    COLOR Fclr%, Bclr%
ELSE
    COLOR Fclr%
END IF
PRINT LEFT$(RTRIM$(TempText$) + SPACE$(TextLen%), TextLen%);
WordInput$ = RTRIM$(TempText$)

END FUNCTION

SUB WordPrint (Row%, Col%, Fclr%, Bclr%, Text$)

IF Col% >= 1 THEN
    LOCATE Row%, Col%
ELSE
    LOCATE Row%, ABS(Col%) - LEN(Text$) / 2
END IF

IF Bclr% >= 0 THEN
    COLOR Fclr%, Bclr%
ELSE
    COLOR Fclr%
END IF

PRINT Text$;

END SUB

SUB Xalpha (Row%, Col%, Fclr%, Bclr%, Text$)

FOR Zloop% = 1 TO LEN(Text$)
    ColTemp% = Col% + (Zloop% - 1) * 8
SELECT CASE UCASE$(MID$(Text$, Zloop%, 1))
    CASE " ": Xchr$ = "00000000000000"
    CASE "A": Xchr$ = "081422227F4141"
    CASE "B": Xchr$ = "7E41417E41417E"
    CASE "C": Xchr$ = "3E41404040413E"
    CASE "D": Xchr$ = "7E41414141417E"
    CASE "E": Xchr$ = "7F40407E40407F"
    CASE "K": Xchr$ = "41424478444241"
    CASE "M": Xchr$ = "41635549414141"
    CASE "N": Xchr$ = "41615149454341"
    CASE "O": Xchr$ = "3E41414141413E"
    CASE "R": Xchr$ = "7E41417E444241"
    CASE "S": Xchr$ = "3E41403E01413E"
    CASE "T": Xchr$ = "7F080808080808"
    CASE "W": Xchr$ = "41414149556341"
    CASE "Y": Xchr$ = "4141413E080808"
END SELECT

Xpatern Row%, ColTemp%, Fclr%, Bclr%, Xchr$, 6

NEXT Zloop%

END SUB

SUB Xpatern (Row%, Col%, Fclr%, Bclr%, Patern$, BitNum%)

IF Bclr% >= 0 THEN
    COLOR Fclr%, Bclr%
ELSE
    COLOR Fclr%
END IF

FOR Zloop0% = 1 TO LEN(Patern$) STEP 2
    LOCATE Row% + INT(Zloop0% / 2), Col%
    Pvalue% = VAL("&H" + MID$(Patern$, Zloop0%, 2))
    IF Pvalue% = 0 THEN
        PRINT SPACE$(BitNum% + 1);
    ELSE
        FOR Zloop1% = BitNum% TO 0 STEP -1
            IF (Pvalue% AND 2 ^ Zloop1%) = 2 ^ Zloop1% THEN PRINT "Ϋ";  ELSE PRINT " ";
        NEXT Zloop1%
    END IF
NEXT Zloop0%

END SUB

