'=========================================================================== ' 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