DM3BB

by

DECLARE SUB Options (o%)
DECLARE SUB Recorder (cmd$, X%, Y%, Pickup$, Mode$)
DECLARE FUNCTION DisplayBoard$ (Mode$)
DECLARE SUB WindowSub (msg$)
DECLARE SUB BOARDMAP (B$, OLDX%, OLDY%, X%, Y%)
DECLARE SUB MDRIVER (EX%, B$, X%, Y%, Mode$)
DECLARE SUB SNAPTOCENTER (X%, Y%)
DECLARE SUB SimShow (m$)
DECLARE SUB ShowBoard (DoDis$)
DECLARE SUB MacTemp (Code$, zAH%, z18%)
CLS
PRINT "DM3BB-The Display Routines."
PRINT "---------------------------"
PRINT "This consists of 1) a driver which can be used to debug"
PRINT "the display routines and 2) simulated display routines"
PRINT
PRINT "Remove calls to Stall when simulated routines are"
PRINT "replaced by the actual routines."
PRINT
' =============================================
DIM SHARED Board(8, 8) AS INTEGER' column, row
' 1=K 2=Q 3=B 4=N 5=R 6=pawn (White)
' 7=K 8=R if the piece has moved (re: Castling)
' 9=P if the pawn can be taken en passent
' -1=K .... (Black)
' =============================================
DIM SHARED WBoard(8, 8) AS INTEGER' column, row
DIM SHARED BBoard(8, 8) AS INTEGER' column, row
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
zR = 8
FOR zC = 1 TO 8
  Board(zC, zR) = -VAL(MID$("54321345", zC, 1))
  Board(zC, zR - 1) = -6
NEXT zC
zR = 1
FOR zC = 1 TO 8
  Board(zC, zR) = VAL(MID$("54321345", zC, 1))
  Board(zC, zR + 1) = 6
NEXT zC
LINE INPUT "Press Enter to begin tests: "; e$
Move$ = DisplayBoard("BW")
WindowSub "Testing display of normal pieces"
GOSUB Stall
WindowSub "Open"
  PRINT "Shown is the whole chessboard"
  PRINT "Will now show the board as seen by White"
  PRINT "(and continue until no move is made)"
  LINE INPUT "Press Enter to continue: "; e$
WindowSub "Close --"
DO: c$ = "W": GOSUB DoMove: LOOP WHILE Move$ <> ""
WindowSub "Now the same for Black"
DO: c$ = "B": GOSUB DoMove: LOOP WHILE Move$ <> ""
' ===================================
FOR zR = 1 TO 8: FOR zC = 1 TO 8
    Board(zC, zR) = 0: BBoard(zC, zR) = 0: WBoard(zC, zR) = 0
NEXT zC: NEXT zR
Board(5, 1) = 7: Board(5, 8) = -7' Place kings that have moved
Board(1, 1) = 8: Board(1, 8) = -8' Place rooks that have moved
Board(3, 3) = 9: Board(6, 6) = -9' Place pawns subject to en passent
Move$ = DisplayBoard("w")
WindowSub "Open"
  PRINT "Beginning tests of special pieces."
  PRINT ""
  PRINT "There should be a White King, Rook and Pawn."
  LINE INPUT "Press Enter to continue: "; e$
WindowSub "Close --"
DO: c$ = "W": GOSUB DoMove: LOOP WHILE Move$ <> ""
WindowSub "Now the same for Black"
DO: c$ = "B": GOSUB DoMove: LOOP WHILE Move$ <> ""
' ======

WindowSub "Open"
PRINT "Will now test WindowSub functions"
PRINT "Between tests, there will be an undocumented pause"
PRINT "To continue at such pauses, press 'c'"
PRINT "(Starting NOW)"
WindowSub "Close --"
GOSUB Pause
' =======
WindowSub "Open"
PRINT "Testing Close --: No wait no clear"
GOSUB Pause: WindowSub "Close --": GOSUB Pause
WindowSub "Open"
PRINT "Testing Close w-: Wait, no clear"
GOSUB Pause: WindowSub "Close w-": GOSUB Pause
WindowSub "Open"
PRINT "Testing Close -c: No wait, clear window"
GOSUB Pause: WindowSub "Close -c": GOSUB Pause
WindowSub "Open"
PRINT "Testing Close wc: Wait, Clear window"
GOSUB Pause: WindowSub "Close wc": GOSUB Pause
WindowSub "That's all the tests!"
CLS
SYSTEM

Stall:
' Note: Remove this routine and all GOSUBs here
' when the actual routines are installed.
LINE INPUT "Press Enter to continue (Driver test)"; Dummy$
RETURN

Pause:
WHILE INKEY$ <> "": WEND
DO
  k$ = UCASE$(INKEY$)
  IF k$ = "C" THEN RETURN
  IF k$ = "Q" THEN SYSTEM
  IF k$ = CHR$(27) THEN STOP
LOOP
RETURN

DoMove:
Move$ = DisplayBoard(LCASE$(c$))
WindowSub "Open"
IF c$ = "W" THEN
  PRINT : PRINT SPACE$(10); "White to move"
ELSE
  PRINT : PRINT SPACE$(10); "Black to move"
END IF
WindowSub "Close --"
GOSUB Stall
Move$ = DisplayBoard(c$)
WindowSub "Move returned was [" + Move$ + "]"
Good1 = 1
IF INSTR("abcdefgh", MID$(Move$, 1, 1)) = 0 THEN Good1 = 0
IF INSTR("12345678", MID$(Move$, 2, 1)) = 0 THEN Good1 = 0
IF MID$(Move$, 3, 1) <> "-" THEN Good1 = 0
IF INSTR("abcdefgh", MID$(Move$, 4, 1)) = 0 THEN Good1 = 0
IF INSTR("12345678", MID$(Move$, 5, 1)) = 0 THEN Good1 = 0
IF Good1 = 0 THEN Move$ = ""
GOSUB Stall
RETURN
' =============================================
DIM SHARED TM%, LM%: TM% = 2: LM% = 3
' =============================================
DTM:
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00

' =============================================
SUB BOARDMAP (B$, OLDX%, OLDY%, X%, Y%)
REM MAP BOUNDRIES
IF (X% - TM%) >= 0 AND (X% - TM%) < 16 AND Y% >= LM% AND Y% - LM% < 40 THEN
ELSE
  B$ = "OUTOFBOUNDS"
END IF
END SUB

FUNCTION DisplayBoard$ (Mode$)
DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
SimShow "Simulating DisplayBoard"
SELECT CASE Mode$
CASE "W": GOSUB White: GOSUB GetMove
CASE "B": GOSUB Black: GOSUB GetMove
CASE "BW": GOSUB Both
CASE "w": GOSUB White
CASE "b": GOSUB Black
END SELECT
EXIT FUNCTION

Both:
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    IF zP < 0 THEN zP = -zP: COLOR 0, 7
    IF zP = 0 THEN
      PRINT "-";
    ELSE
      PRINT MID$("KQBNRPKRP", zP, 1);
    END IF
    COLOR 7, 0: PRINT " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "a b c d e f g h"
RETURN

White:
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    IF zP < 0 THEN zP = 0
    IF zP = 0 THEN
      PRINT "-";
    ELSE
      PRINT MID$("KQBNRPKRP", zP, 1);
    END IF
    COLOR 7, 0: PRINT " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "a b c d e f g h"
RETURN

Black:
FOR zR = 1 TO 8
  FOR zC = 8 TO 1 STEP -1
    zP = Board(zC, zR)
    IF zP > 0 THEN zP = 0
    IF zP = 0 THEN
      PRINT "-";
    ELSE
      COLOR 0, 7
      PRINT MID$("KQBNRPKRP", -zP, 1);
    END IF
    COLOR 7, 0: PRINT " ";
  NEXT zC
  PRINT zR
NEXT zR
PRINT : PRINT "h g f e d c b a"
RETURN

GetMove:
CALL ShowBoard("Sleep")
DO
  IF Mode$ = "B" THEN PRINT "Black";  ELSE PRINT "White";
  LINE INPUT "'s move: "; xxx$
  IF LCASE$(xxx$) = "break" THEN MacBreak% = -1
LOOP WHILE LCASE$(xxx$) = "break"
DisplayBoard$ = xxx$
IF xxx$ = "" THEN DisplayBoard$ = "Resign": RETURN
IF NOT (LEN(xxx$) = 5 AND MID$(xxx$, 3, 1) = "-") THEN
  INPUT "Really?"; r$
  IF UCASE$(r$) <> "Y" THEN GOTO GetMove ELSE RETURN
END IF
MacTemp LEFT$(xxx$, 2), zAH%, z18%
IF zAH% = 0 THEN GOTO MacGoof
SELECT CASE Board(zAH%, z18%)
CASE 0: GOTO MacGoof
CASE IS > 0: IF Mode$ = "B" THEN GOTO MacGoof
CASE IS < 0: IF Mode$ = "W" THEN GOTO MacGoof
END SELECT
MacTemp RIGHT$(xxx$, 2), yAH%, y18%
IF yAH% = 0 THEN GOTO MacGoof
IF MacBreak% THEN STOP
RETURN
MacGoof: PRINT "Try again, Mac": GOTO GetMove
END FUNCTION

SUB KEYBOARD (B$, X%, Y%, xxx$, Mode$, textloc%)
LOCATE , , 0
DO
  EX% = 1: CALL MDRIVER(EX%, B$, X%, Y%, Mode$)
  DO
    B$ = INKEY$
    EX% = 2: CALL MDRIVER(EX%, B$, X%, Y%, Mode$)
    IF B$ = CHR$(27) THEN EXIT DO: REM RESIGN
    IF B$ = "OUTOFBOUNDS" THEN B$ = ""
  LOOP UNTIL B$ <> ""
  EX% = -1: CALL MDRIVER(EX%, B$, X%, Y%, Mode$)
  IF B$ = CHR$(27) AND MOVESTAT% <> 0 THEN X% = OLDX%: Y% = OLDY%: GOSUB CANCELMOVE
  IF B$ = "L-CLICK" THEN
    CALL SNAPTOCENTER(X%, Y%)
    IF MOVESTAT% = 0 THEN
      LOCATE X%, Y%
      OLDX% = X%: OLDY% = Y%
      Piece$ = CHR$(SCREEN(X%, Y%))
      IF Piece$ = CHR$(32) THEN
        B$ = "": REM DO OVER EMPTY SQUARE
      ELSE
        COLORIT% = SCREEN(X%, Y%, 1)
        COLOR COLORIT% MOD 16 + 16, COLORIT% \ 16
        PRINT Piece$;
        COLOR 7, 1: B$ = ""
        GOSUB COORDERNATES
        CALL Options(2)
        LOCATE 23, textloc%: PRINT OLDALPHA$ + OLDNUMBER$ + "-";
        IF COLORIT% = 23 THEN MOVESTAT% = 1 ELSE MOVESTAT% = -1
      END IF
    ELSE
      IF OLDX% = X% AND OLDY% = Y% THEN
        CALL Options(1)
        GOSUB CANCELMOVE
      ELSE
        CALL Options(4)
        GOSUB COORDERNATES
        xxx$ = OLDALPHA$ + OLDNUMBER$ + "-" + NEWALPHA$ + NEWNUMBER$
        LOCATE 23, textloc%: PRINT xxx$;
        ' 'A% = SCREEN(OLDX% - 1, OLDY%, 1): COLOR A% MOD 16, A% \ 16
        ' 'LOCATE OLDX%, OLDY% - 1: PRINT SPACE$(3);
        ' 'LOCATE X%, Y% - 1: COLOR COLORIT% MOD 16, COLORIT% \ 16: PRINT " " + PIECE$ + " ";
        LOCATE OLDX%, OLDY% - 1: COLOR COLORIT% MOD 16, COLORIT% \ 16: PRINT " " + Piece$ + " ";
        COLOR 7, 1
        EXIT DO
      END IF
    END IF
  END IF
  IF B$ = CHR$(27) THEN EXIT DO
LOOP
LOCATE , , 1
EXIT SUB

COORDERNATES:
IF Mode$ = "B" THEN
  OLDNUMBER$ = LTRIM$(STR$(1 + INT((OLDX% - TM% + 1) / 2.1)))
  OLDALPHA$ = LCASE$(CHR$(72 - INT((OLDY% - LM% + 1) / 5.1)))
  NEWNUMBER$ = LTRIM$(STR$(1 + INT((X% - TM% + 1) / 2.1)))
  NEWALPHA$ = LCASE$(CHR$(72 - INT((Y% - LM% + 1) / 5.1)))
ELSE
  OLDNUMBER$ = LTRIM$(STR$(8 - INT((OLDX% - TM% + 1) / 2.1)))
  OLDALPHA$ = LCASE$(CHR$(65 + INT((OLDY% - LM% + 1) / 5.1)))
  NEWNUMBER$ = LTRIM$(STR$(8 - INT((X% - TM% + 1) / 2.1)))
  NEWALPHA$ = LCASE$(CHR$(65 + INT((Y% - LM% + 1) / 5.1)))
END IF
RETURN

CANCELMOVE:
LOCATE X%, Y%
COLOR COLORIT% MOD 16, COLORIT% \ 16
PRINT Piece$;
COLOR 7, 1
MOVESTAT% = 0
IF B$ <> CHR$(27) THEN B$ = ""
LOCATE 23, textloc%: PRINT SPACE$(80 - POS(1));
RETURN
END SUB

SUB MacTemp (Code$, zAH%, z18%)
IF LEN(Code$) <> 2 THEN STOP
tAH% = INSTR("abcdefgh", LEFT$(Code$, 1))
zAH% = tAH%
IF tAH% = 0 THEN EXIT SUB
t18% = VAL(RIGHT$(Code$, 1))
z18% = t18%
IF t18% = 0 THEN zAH% = 0
END SUB

SUB MDRIVER (EX%, B$, X%, Y%, Mode$)
STATIC MU$, PICKUPX%, PICKUPY%, Pickup$, OLDPIECE$, PICKUPCOLOR%, OLDPIECECOLOR%
IF B$ = CHR$(27) THEN
  IF PICKUPX% <> 0 THEN LOCATE X%, Y%: COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: PRINT OLDPIECE$;
  PICKUPX% = 0: PICKUPY% = 0: Pickup$ = "": OLDPIECE$ = ""
END IF
OLDX% = X%: OLDY% = Y%
REM INITIATE MOUSE
IF MU$ = "" THEN
  GOSUB INIMOUSE
END IF
IF EX% = -1 THEN
  REM HIDES MOUSE IF A KEY WAS PRESSED FOR NEXT MOUSE LOOP
  AX% = 2: GOSUB CALLI
  EX% = 2
  EXIT SUB
END IF
IF EX% = 1 THEN AX% = 1: GOSUB CALLI
AX% = 3: GOSUB CALLI
LB% = (BX% AND 1) <> 0
RB% = (BX% AND 2) <> 0
REM A LEFT CLICK CANCELS PICKUP ROUTINE
IF LB% <> 0 AND PICKUPX% <> 0 THEN Pickup$ = "": RB% = 1
REM MOUSE LOCATION (USES X% AND Y% TO CONVERT TO 25 * 80 SCREEN SIZE)
X% = DX% \ 8 + 1: Y% = CX% \ 8 + 1
IF X% <> OLDX% OR Y% <> OLDY% THEN
  IF PICKUPX% = 0 THEN
    CALL BOARDMAP(B$, OLDX%, OLDY%, X%, Y%)
  ELSE
    GOSUB DRAG
  END IF
END IF
REM MOUSE BUTTONS
IF RB% <> 0 THEN
  IF PICKUPX% <> 0 THEN
    LOCATE X%, Y%: COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: PRINT OLDPIECE$;
    CALL BOARDMAP(B$, OLDX%, OLDY%, X%, Y%)
    IF B$ <> "OUTOFBOUNDS" AND Pickup$ <> "" THEN
      REM PIECE$ IS CANCELLED AND SET TO "" IF LEFT MOUSE IS CLICKED DURING DRAG.
      CALL SNAPTOCENTER(X%, Y%)
      A% = SCREEN(X%, Y%, 1)
      IF Mode$ = "W" THEN
        IF A% = 23 THEN EXIT SUB
      ELSE
        IF A% = 96 THEN EXIT SUB
      END IF
      CALL Recorder("Put", X%, Y%, Pickup$, Mode$)
      COLOR PICKUPCOLOR% MOD 16, PICKUPCOLOR% \ 16
      LOCATE X%, Y% - 1
      PRINT " " + Pickup$ + " ";
    END IF
    COLOR 7, 1
    CALL Options(1)
    PICKUPX% = 0: PICKUPY% = 0: Pickup$ = "": OLDPIECE$ = "": OLDPIECECOLOR% = 0
    B$ = ""
    DO
      AX% = 3: GOSUB CALLI
      RB% = (BX% AND 2) <> 0
      IF RB% = 0 THEN EXIT DO
    LOOP
  ELSE
    DO
      AX% = 3: GOSUB CALLI
      RB% = (BX% AND 2) <> 0
      IF RB% = 0 THEN EXIT DO
    LOOP
    REM BOUNDRIES
    IF X% > 4 AND X% < 9 AND Y% > 51 AND Y% < 75 THEN TABLE% = 1
    IF TABLE% = 0 AND PICKUPX% = 0 THEN
      CALL BOARDMAP(B$, OLDX%, OLDY%, X%, Y%)
      IF B$ <> "OUTOFBOUNDS" THEN TABLE% = -1
    END IF
    IF TABLE% = -1 THEN
      CALL SNAPTOCENTER(X%, Y%)
      AX% = 2: GOSUB CALLI
      A% = SCREEN(X%, Y%, 1)
      AX% = 1: GOSUB CALLI
      IF Mode$ = "W" THEN
        IF A% <> 96 THEN TABLE% = 0
      ELSE
        IF A% <> 23 THEN TABLE% = 0
      END IF
    END IF
    IF TABLE% <> 0 THEN
      FOR i% = 1 TO 3
        Pickup$ = CHR$(SCREEN(X%, Y% - 2 + i%))
        IF Pickup$ <> " " THEN EXIT FOR
      NEXT i%
      Pickup$ = RTRIM$(Pickup$)
      CALL Recorder("Zap", X%, Y%, Pickup$, Mode$)
      IF Pickup$ <> "" THEN PICKUPX% = X%: PICKUPY% = Y%
      AX% = 2: GOSUB CALLI
      PICKUPCOLOR% = (SCREEN(X%, Y% - 2 + i%, 1))
      IF TABLE% = -1 THEN
        REM LIFT PIECE OFF BOARD
        OLDPIECECOLOR% = (SCREEN(X% - 1, Y%, 1))
        COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: LOCATE X%, Y% - 1: PRINT SPACE$(3);
        AX% = 1: GOSUB CALLI
        GOSUB DRAG
      END IF
      COLOR 7, 1
      CALL Options(3)
      AX% = 1: GOSUB CALLI
    END IF
  END IF
END IF
IF LB% <> 0 THEN
  CALL BOARDMAP(B$, OLDX%, OLDY%, X%, Y%)
  REM PLACE OTHER MOUSE FEATURES HERE
  IF B$ = "OUTOFBOUNDS" THEN B$ = "" ELSE B$ = "L-CLICK": REM LEFT MOUSE CLICK
END IF
REM DELAY TO SMOOTH THINGS OUT.
IF LB% <> 0 OR RB% <> 0 THEN
  DO
    AX% = 3: GOSUB CALLI
    LB% = (BX% AND 1) <> 0
    RB% = (BX% AND 2) <> 0
    IF LB% = 0 AND RB% = 0 THEN EXIT DO
  LOOP
END IF
EXIT SUB
REM SUBROUTINES
CALLI:
CALL ABSOLUTE(AX%, BX%, CX%, DX%, SADD(MU$))
RETURN

INIMOUSE:
MU$ = SPACE$(57)
FOR i% = 1 TO 57
  READ A$
  H$ = CHR$(VAL("&H" + A$))
  MID$(MU$, i%, 1) = H$
NEXT i%
RETURN

DRAG:
AX% = 2: GOSUB CALLI
LOCATE OLDX%, OLDY%: COLOR OLDPIECECOLOR% MOD 16, OLDPIECECOLOR% \ 16: PRINT OLDPIECE$;
OLDPIECECOLOR% = SCREEN(X%, Y%, 1)
OLDPIECE$ = CHR$(SCREEN(X%, Y%))
COLOR 14, OLDPIECECOLOR% \ 16: LOCATE X%, Y%: PRINT Pickup$;
OLDX% = X%: OLDY% = Y%
AX% = 1: GOSUB CALLI
RETURN
END SUB

SUB Options (o%)
o$ = SPACE$(28)
SELECT CASE o%
CASE 1:
  LSET o$ = "- Select Opponent Piece or": LOCATE 17, 50: PRINT o$;
  LSET o$ = "- Select Your Own Piece or": LOCATE 18, 50: PRINT o$;
  LSET o$ = "- Press ESC for more options": LOCATE 19, 50: PRINT o$;
CASE 2:
  LSET o$ = "- Place Your Own Piece": LOCATE 17, 50: PRINT o$;
  LSET o$ = "(Or Just Put It Back)": LOCATE 18, 50: PRINT o$;
  LSET o$ = "": LOCATE 19, 50: PRINT o$;
CASE 3:
  LSET o$ = "- Place Opponent Piece": LOCATE 17, 50: PRINT o$;
  LSET o$ = "(Or Drop It Outside Board)": LOCATE 18, 50: PRINT o$;
  LSET o$ = "": LOCATE 19, 50: PRINT o$;
CASE 4:
  LSET o$ = "- ": LOCATE 17, 50: PRINT o$;
  LSET o$ = "": LOCATE 18, 50: PRINT o$;
  LSET o$ = "": LOCATE 19, 50: PRINT o$;
CASE ELSE:
  STOP: 'bug
END SELECT
END SUB

SUB Recorder (cmd$, X%, Y%, Pickup$, Mode$)
IF X% < 4 THEN EXIT SUB
IF X% > 18 THEN EXIT SUB
IF Y% < 5 THEN EXIT SUB
IF Y% > 40 THEN EXIT SUB
p% = INSTR("KQBNRP", Pickup$): IF p% = 0 THEN STOP: 'bug
r% = (X% / 2) - 1
c% = (Y% / 5)
IF Mode$ = "W" THEN r% = 9 - r%
IF Mode$ = "B" THEN c% = 9 - c%
SELECT CASE cmd$
CASE "Put":
  IF Mode$ = "W" THEN WBoard(c%, r%) = -p% ELSE BBoard(c%, r%) = p%
CASE "Zap":
  IF Mode$ = "W" THEN
    IF WBoard(c%, r%) <> -p% THEN STOP: 'bug
    WBoard(c%, r%) = 0
  ELSE
    IF BBoard(c%, r%) <> p% THEN STOP: 'bug
    BBoard(c%, r%) = 0
  END IF
CASE ELSE: STOP: 'bug
END SELECT
END SUB

SUB RefereeSpeaks (msg$)
PRINT msg$
END SUB

SUB ShowBoard (DoDis$)
IF DoDis$ = "Sleep" THEN
  PRINT "Press key to show the full board (For DM4BAB debugging)"
  SLEEP
  FOR uR% = 1 TO 10000
    k$ = INKEY$: IF k$ = CHR$(27) THEN DoDat% = -1
  NEXT uR%
END IF

DIM zC AS INTEGER, zR AS INTEGER, zP AS INTEGER
CLS
FOR zR = 8 TO 1 STEP -1
  FOR zC = 1 TO 8
    zP = Board(zC, zR)
    IF Dull THEN
      IF zP < 0 THEN zP = -zP: COLOR 0, 7
      IF zP = 0 THEN
        PRINT "-";
      ELSE
        PRINT MID$("kQBNrPKRp", zP, 1);
      END IF
      COLOR 7, 0: PRINT " ";
    ELSE
      COLOR 13 + SGN(zP) * 2, 7 - ((((zC MOD 2) XOR (zR MOD 2)) <> 0) AND 5)
      PRINT " "; MID$(" kQBNrPKRp", ABS(zP) + 1, 1);
    END IF
  NEXT zC
  IF Dull THEN
    PRINT zR
  ELSE
    COLOR 7, 0
    PRINT " "; CHR$(&H30 + zR)
  END IF
NEXT zR
IF NOT Dull THEN PRINT " ";
PRINT "a b c d e f g h"
IF DoDat% THEN STOP
END SUB

SUB SimShow (m$)
p$ = "": GOSUB SlowMe
p$ = "": GOSUB SlowMe
p$ = STRING$(LEN(m$), "="): GOSUB SlowMe
p$ = m$: GOSUB SlowMe
p$ = STRING$(LEN(m$), "="): GOSUB SlowMe
EXIT SUB
SlowMe:
t! = TIMER + .1: WHILE TIMER < t!: WEND
PRINT p$
RETURN
END SUB

SUB SNAPTOCENTER (X%, Y%)
CNTY% = Y% - LM%
Y% = Y% - (3 - (5 - CNTY% MOD 5))
IF X% \ 2 <> X% / 2 THEN X% = X% + 1
END SUB

SUB WindowSub (msg$)
CONST ww = ">>(WindowSub would "
STATIC status AS INTEGER
SELECT CASE msg$
CASE "Close --": GOSUB CloseIt
CASE "Close w-": GOSUB CloseIt
CASE "Close -c": GOSUB CloseIt
CASE "Close wc": GOSUB CloseIt
CASE "Open":
  SimShow "Simulating WindowSub Open function"
  status = 1
CASE ELSE:
  IF status <> 0 THEN STOP: 'bug in program
  SimShow "Simulating WindowSub Quick-Print function"
  PRINT msg$
  PRINT ww; "WAIT 2, then"
  PRINT ww; "clear the window"
END SELECT
EXIT SUB
CloseIt:
IF status <> 1 THEN STOP: 'bug in program
status = 0
IF MID$(msg$, 7, 1) = "w" THEN PRINT ww; "WAIT 2, then"
IF MID$(msg$, 8, 1) = "c" THEN
  PRINT ww; "clear everything printed since Open)"
ELSE
  PRINT ww; "leave printed stuff in window until next call)"
END IF
RETURN
END SUB



    
This message has been edited by iorr5t from IP address 68.98.164.60 on Feb 11, 2006 12:00 PM
This message has been edited by iorr5t from IP address 68.98.164.60 on Feb 11, 2006 11:59 AM

Posted on Feb 5, 2006, 9:35 AM
from IP address 68.98.164.60

Respond to this message   

Return to Index