Programmer 7500/MAX_PROGRAMMERS.iso/INFO/QBASIC/QBSCR15.ZIP/DEMO.BAS

BASIC Source File | 1989-09-01 | 43.6 KB | 1,248 lines

'┌─────────────────────────────────────────────────────────────────────────┐
'│                                                                         │
'│                            D E M O . B A S                              │
'│                                                                         │
'│                  ░▒▓█  A Demonstration Program  █▓▒░                    │
'│                                                                         │
'│                   making known the capabilities of                      │
'│                       the QBSCR Screen Routines                         │
'│                                                                         │
'├─────────────────────────────────────────────────────────────────────────┤
'│                                                                         │
'│  The QBSCR Screen Routines and this DEMO program are (C) Copyright 1989 │
'│               by Tony Martin of the BAD SOFTWARE Company.               │
'│                                                                         │
'├─────────────────────────────────────────────────────────────────────────┤
'│                                                                         │
'│  Author  : Tony Martin                                                  │
'│  Date    : September 1, 1989                                            │
'│  Language: Microsoft QuickBASIC 4.0+                                    │
'│                                                                         │
'└─────────────────────────────────────────────────────────────────────────┘

'----------------------------------------------------------------------------
' CONSTants
'----------------------------------------------------------------------------
' Color constants
CONST BLACK = 0
CONST BLUE = 1
CONST GREEN = 2
CONST CYAN = 3
CONST RED = 4
CONST MAGENTA = 5
CONST BROWN = 6
CONST WHITE = 7
CONST BRIGHT = 8
CONST YELLOW = BRIGHT + BROWN
CONST BLINK = 16

' General constants
CONST FALSE = 0, TRUE = NOT FALSE
CONST maxEntries = 13

'----------------------------------------------------------------------------
' SHARED variables (keep these to an absolute minimum)
'----------------------------------------------------------------------------
COMMON SHARED kolor%

'----------------------------------------------------------------------------
' DECLARE statements for the QBSCR Screen Routines
'----------------------------------------------------------------------------
DECLARE FUNCTION BlockSize% (l%, r%, t%, b%)
DECLARE FUNCTION ColorChk ()
DECLARE FUNCTION GetBackground% (row%, col%)
DECLARE FUNCTION GetForeground% (row%, col%)
DECLARE FUNCTION GetString$ (leftCol!, row%, strLen%, foreColor%, backColor%)
DECLARE FUNCTION GetVideoSegment! ()
DECLARE FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
DECLARE FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
DECLARE FUNCTION ScreenBlank$ (delay)
DECLARE SUB Banner (st$, row%)
DECLARE SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!)
DECLARE SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!)
DECLARE SUB BuildScreen (file$, mode%)
DECLARE SUB Center (st$, row%)
DECLARE SUB ClrScr (mode%, fillChar$)
DECLARE SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%)
DECLARE SUB GetScreen (file$)
DECLARE SUB PutScreen (file$)
DECLARE SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$)
DECLARE SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%)
DECLARE SUB OffCenter (st$, row%, leftCol%, rightCol%)
DECLARE SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment)
DECLARE SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment)
DECLARE SUB Wipe (top%, bottom%, lft%, rght%, back%)

'----------------------------------------------------------------------------
' DECLARE statements for routines local to this program
'----------------------------------------------------------------------------
DECLARE FUNCTION Pause% (delay!)
DECLARE SUB BannerDemo ()
DECLARE SUB BlockDemo ()
DECLARE SUB BuildScreenDemo ()
DECLARE SUB CenterOffCenterDemo ()
DECLARE SUB ClosingScreen ()
DECLARE SUB ClrScrDemo ()
DECLARE SUB GetFgBgDemo ()
DECLARE SUB GetPutScreenInfo ()
DECLARE SUB Initialize ()
DECLARE SUB KeyPause ()
DECLARE SUB MenuScreen ()
DECLARE SUB MakeMenuInfo ()
DECLARE SUB MakeWindowDemo ()
DECLARE SUB MovingMessage ()
DECLARE SUB MultiMenuDemo ()
DECLARE SUB OpenScreen ()
DECLARE SUB PointerBox (row%, col%)
DECLARE SUB ScreenBlankDemo ()
DECLARE SUB ScreenInfo ()
DECLARE SUB WipeDemo ()

'----------------------------------------------------------------------------
' The whole of the module-level program...
'----------------------------------------------------------------------------

    Initialize
    OpenScreen
    MenuScreen
    ClosingScreen

'----------------------------------------------------------------------------
'                                The END
'----------------------------------------------------------------------------

SUB BannerDemo

    ' Set the colors for "Quit" at the bottom of the screen.  Make it blink.
    IF kolor% THEN
        COLOR BLINK + BRIGHT + RED, BLACK
    ELSE
        COLOR BLINK + BRIGHT + WHITE, BLACK
    END IF

    Center "Quit ∙ ESC", 21

    ' Set colors for the banner itself
    IF kolor% THEN
        COLOR BRIGHT + RED, BLACK
    ELSE
        COLOR BRIGHT + WHITE, BLACK
    END IF

    st$ = "  The QBSCR Screen Routines Demonstration!  "
    k$ = ""

    ' Let the banner scroll until the user hits a key
    done% = FALSE
    DO
        k$ = INKEY$
        IF k$ <> "" THEN
            done% = TRUE
        ELSE
            Banner st$, 3
        END IF
    LOOP UNTIL done%

END SUB

SUB BlockDemo

    ' Define colors for this demo
    IF kolor% THEN
        infoFG% = BRIGHT + CYAN: infoBG% = RED
        blockFG% = RED: blockBG% = CYAN
    ELSE
        infoFG% = BLACK: infoBG% = WHITE
        blockFG% = BLACK: blockBG% = WHITE
    END IF

    ' Make the window explaining what's going on
    MakeWindow 7, 36, 22, 75, infoFG%, infoBG%, 0, 1, 16, 1, " Block Save/Restore "
    OffCenter "Using the Block Save and Restore", 9, 35, 75
    OffCenter "routines is easy.  Simply Save a", 10, 35, 75
    OffCenter "portion of the screen with Block", 11, 35, 75
    OffCenter "Save, write overtop of that area", 12, 35, 75
    OffCenter "and then restore the area with", 13, 35, 75
    OffCenter "the Block Restore routine.", 14, 35, 75
    OffCenter "In the example at the left, this", 16, 35, 75
    OffCenter "is being done repeatedly to", 17, 35, 75
    OffCenter "achieve the movement effect.", 18, 35, 75
    OffCenter "Hit any key when you are done.", 20, 35, 75

    ' DIMensions a couple arrays to save screen information
    DIM blockArray%(BlockSize%(10, 25, 15, 19))
    DIM winArray%(BlockSize%(10, 25, 15, 19))

    ' Perform initial save of screen block
    l% = 10: r% = 25: t% = 15: b% = 19
    BlockSave l%, r%, t%, b%, blockArray%(), GetVideoSegment

    ' Make the window to move
    MakeWindow 15, 10, 19, 25, blockFG%, blockBG%, 0, 1, -1, 0, ""
    OffCenter "A", 16, 10, 25
    OffCenter "Moving", 17, 10, 25
    OffCenter "Window", 18, 10, 25
    BlockSave l%, r%, t%, b%, winArray%(), GetVideoSegment

    ' Sit in a loop performing the animation until user hits a key
    done% = FALSE
    stage% = 0    ' Stage = 0 : window moves up
                  ' Stage = 1 : window moves right
                  ' Stage = 2 : window moves down and left
    intraDelay = 100

    DO
        SELECT CASE stage%
        CASE 0    ' window moves up

            FOR x% = 14 TO 5 STEP -1

                ' Pause the movement.  If key hit, then exit
                i% = Pause%(intraDelay)
                IF NOT (i%) THEN
                    done% = TRUE
                    EXIT FOR
                END IF

                ' Step 1 in animation - restore old saved area
                BlockRestore l%, r%, t%, b%, blockArray%(), GetVideoSegment

                ' Step 2 - increment counters and save new area
                t% = t% - 1
                b% = b% - 1
                BlockSave l%, r%, t%, b%, blockArray%(), GetVideoSegment

                ' Step 3 - restore the window in blockArray()
                BlockRestore l%, r%, t%, b%, winArray%(), GetVideoSegment

            NEXT x%

            ' Step 4 - update the stage indicator
            stage% = 1

        CASE 1   ' window moves right

            FOR x% = 12 TO 30 STEP 2

                ' Pause the movement.  If key hit, then exit
                i% = Pause%(intraDelay)
                IF NOT (i%) THEN
                    done% = TRUE
                    EXIT FOR
                END IF

                ' Step 1 in animation - restore old saved area
                BlockRestore l%, r%, t%, b%, blockArray%(), GetVideoSegment

                ' Step 2 - increment counters and save new area
                l% = l% + 2
                r% = r% + 2
                BlockSave l%, r%, t%, b%, blockArray%(), GetVideoSegment

                ' Step 3 - restore the window in blockArray()
                BlockRestore l%, r%, t%, b%, winArray%(), GetVideoSegment

            NEXT x%

            ' Step 4 - update the stage indicator
            stage% = 2

        CASE 2   ' window move down and left

            FOR x% = 6 TO 15

                ' Pause the movement.  If key hit, then exit
                i% = Pause%(intraDelay)
                IF NOT (i%) THEN
                    done% = TRUE
                    EXIT FOR
                END IF

                ' Step 1 in animation - restore old saved area
                BlockRestore l%, r%, t%, b%, blockArray%(), GetVideoSegment

                ' Step 2 - increment counters and save new area
                t% = t% + 1
                b% = b% + 1
                l% = l% - 2
                r% = r% - 2
                BlockSave l%, r%, t%, b%, blockArray%(), GetVideoSegment

                ' Step 3 - restore the window in blockArray()
                BlockRestore l%, r%, t%, b%, winArray%(), GetVideoSegment

            NEXT x%

            ' Step 4 - update the stage indicator
            stage% = 0

        END SELECT

        ' Check for user keypress
        IF INKEY$ <> "" THEN
            done% = TRUE
        END IF

    LOOP UNTIL done%

END SUB

SUB BuildScreenDemo

    ' Determine colors for this portion of the demo
    IF kolor% THEN
        winFG% = YELLOW: winBG% = GREEN
        file$ = "DEMO_C.CLR"
    ELSE
        winFG% = BLACK: winBG% = WHITE
        file$ = "DEMO_C.MON"
    END IF
    entryFG% = BRIGHT + WHITE: entryBG% = BLACK

    ' Make a window with instructions
    MakeWindow 9, 16, 18, 65, winFG%, winBG%, 0, 1, 16, 1, " BuildScreen Demonstration "
    Center "The QBSCR BuildScreen routine will display a", 11
    Center "screen using any of 16 fascinating methods.", 12
    Center "Enter a BuildScreen mode below (0 - 15):", 14

    ' Get the user's response - loop until in valid range
    DO
        mode% = VAL(GetString$(39, 16, 2, entryFG%, entryBG%))
    LOOP UNTIL (mode% >= 0) AND (mode% <= 15)

    ' Clear the screen using the user-entered mode
    BuildScreen file$, mode%

    ' Wait for user to hit a key
    KeyPause

END SUB

SUB CenterOffCenterDemo

    ' Initialize a few variables for this demo routine
    minLeft% = 3: maxLeft% = 65
    minRight% = 16: maxRight% = 78
    leftPos% = minLeft%
    rightPos% = maxRight%
    leftEnd$ = CHR$(16)
    rightEnd$ = CHR$(17)
    sampleString$ = "Some Sample Text"

    ' Set up the screen for this demo
    IF kolor% THEN
        winFG% = BRIGHT + WHITE: winBG% = BLUE
        textFG% = YELLOW: textBG% = BLACK
        COLOR BRIGHT + BLUE, BLACK
    ELSE
        winFG% = BLACK: winBG% = WHITE
        textFG% = BRIGHT + WHITE: textBG% = BLACK
        COLOR BRIGHT + WHITE, BLACK
    END IF
    CLS
    Center "═══ Center / OffCenter Demonstration ═══", 2
    COLOR textFG%, textBG%
    Center "This portion of the program will demonstrate the use of the Center and", 10
    Center "OffCenter routines.  These lines were centered with the Center routine", 11
    Center "which will center a string with respect to the entire screen.", 12
    Center "OffCenter will center text between any two specified points on the", 14
    Center "screen.  In the window above, the two symbols  and  represent", 15
    Center "the points between which text will be centered.  Use the < and > keys", 16
    Center "(, and .) to move the RIGHT endpoint left and right, and the X and C keys", 17
    Center "to move the LEFT endpoint left and right.  The string " + CHR$(34) + "Some Sample Text" + CHR$(34), 18
    Center "will be centered with the OffCenter routine between the endpoints each", 19
    Center "time you move them.  To quit this demo and return to the menu, hit the", 20
    Center "ESC key.", 21
    MakeWindow 5, 1, 7, 80, winFG%, winBG%, 0, 1, -1, 2, ""
    LOCATE 6, leftPos%, 0: PRINT leftEnd$;
    LOCATE 6, rightPos%, 0: PRINT rightEnd$;
    OffCenter sampleString$, 6, leftPos%, rightPos%

    ' Sit in a loop reading keys from the user.  Exit when ESC is hit
    done% = FALSE
    DO
        ' Get a keystroke
        k$ = UCASE$(INPUT$(1))

        ' Calculate new position boundaries, so the endpoints won't go
        ' overtop of the sample text
        leftBound% = rightPos% - LEN(sampleString$) - 1
        rightBound% = leftPos% + LEN(sampleString$) + 1

        ' Update the endpoint positions or quit, based on user keystroke
        SELECT CASE k$
        CASE ","   ' Right endpoint moves left
            IF (rightPos% > minRight%) AND (rightPos% > rightBound%) THEN
                rightPos% = rightPos% - 1
            END IF
        CASE "."   ' Right endpoint moves right
            IF rightPos% < maxRight% THEN
                rightPos% = rightPos% + 1
            END IF
        CASE "C"   ' Left endpoint moves right
            IF (leftPos% < maxLeft%) AND (leftPos% < leftBound%) THEN
                leftPos% = leftPos% + 1
            END IF
        CASE "X"   ' Left endpoint moves left
            IF leftPos% > minLeft% THEN
                leftPos% = leftPos% - 1
            END IF
        CASE CHR$(27)   ' The ESC key - quit this portion of the demo
            done% = TRUE
        CASE ELSE
        END SELECT

        ' Update the window contents (string and endpoints) based on new
        ' values of the endpoints...but only if we're NOT done here
        IF NOT (done%) THEN
            LOCATE 6, 2, 0             ' Clear out the window
            PRINT SPACE$(78);
            LOCATE 6, leftPos%, 0      ' Draw in the left endpoint
            PRINT leftEnd$;
            LOCATE 6, rightPos%, 0     ' Draw in the right endpoint
            PRINT rightEnd$;
            OffCenter sampleString$, 6, leftPos%, rightPos%
        END IF

    LOOP UNTIL done%

END SUB

SUB ClosingScreen

    ' Place the closing screen on the display.
    IF kolor% THEN
        BuildScreen "DEMO_A.CLR", 14
    ELSE
        BuildScreen "DEMO_A.MON", 14
    END IF

    ' Make sure the colors are set properly, and the cursor is out of the
    ' way.  And we're finished!
    COLOR 7, 0
    LOCATE 23, 1, 1

END SUB

SUB ClrScrDemo

    ' Determine colors for this portion of the demo
    IF kolor% THEN
        winFG% = BRIGHT + CYAN: winBG% = MAGENTA
    ELSE
        winFG% = BLACK: winBG% = WHITE
    END IF
    entryFG% = BRIGHT + WHITE: entryBG% = BLACK

    ' Make a window with instructions
    MakeWindow 9, 16, 18, 65, winFG%, winBG%, 0, 1, 16, 1, " ClrScr Demonstration "
    Center "The QBSCR ClrScr routine will clear the screen", 11
    Center "using any of 16 fascinating methods.", 12
    Center "Enter a ClrScr mode below (0 - 15):", 14

    ' Get the user's response - loop until in valid range
    DO
        mode% = VAL(GetString$(39, 16, 2, entryFG%, entryBG%))
    LOOP UNTIL (mode% >= 0) AND (mode% <= 15)

    ' Clear the screen using the user-entered mode
    ClrScr mode%, " "

    ' Tell user to hit a key
    LOCATE 25, 1, 0: PRINT "Hit a key...";
    KeyPause

END SUB

SUB GetFgBgDemo

    ' Define a few values for this routine
    upArrow$ = CHR$(0) + CHR$(72)
    downArrow$ = CHR$(0) + CHR$(80)
    leftArrow$ = CHR$(0) + CHR$(75)
    rightArrow$ = CHR$(0) + CHR$(77)

    ' Set up colors for this portion of the demo
    IF kolor% THEN
        winFG% = BRIGHT + WHITE: winBG% = BLUE
        pointerFG% = YELLOW: pointerBG% = BLACK
    ELSE
        winFG% = BLACK: winBG% = WHITE
        pointerFG% = BRIGHT + WHITE: pointerBG% = BLACK
    END IF

    ' Load the pre-made screen that will serve as a background
    ' for this demonstration
    IF kolor% THEN
        PutScreen "DEMO_B.CLR"
    ELSE
        PutScreen "DEMO_B.MON"
    END IF

    ' Make the window and add instructional text
    MakeWindow 16, 1, 25, 80, winFG%, winBG%, 0, 1, -1, 0, " GetForeground ∙ GetBackground "
    Center "This pair of functions will return the foreground or background color of", 18
    Center "any location on the screen.  For this demo, use the arrow keys to move the ", 19
    Center "small box around the screen.  The foreground and background colors of", 20
    Center "the character cell inside the box will be shown below.  To quit, hit ESC.", 21

    ' Save the area of the screen where the pointer box will be
    DIM pointerArray%(BlockSize%(39, 41, 12, 14))
    BlockSave 39, 41, 12, 14, pointerArray%(), GetVideoSegment

    ' Draw in the pointer box
    COLOR pointerFG%, pointerBG%
    pointerRow% = 12
    pointerCol% = 39
    PointerBox pointerRow%, pointerCol%

    ' Update the Foreground/Background color indicators
    COLOR winFG%, winBG%
    Center SPACE$(78), 23
    Center "Foreground:" + STR$(GetForeground(pointerRow% + 1, pointerCol% + 1)) + "  Background:" + STR$(GetBackground(pointerRow% + 1, pointerCol% + 1)), 23

    ' Now we're all set to let the user do their thing.  Sit in a loop
    ' and read keystrokes
    done% = FALSE
    DO
        ' Get a keystroke
        k$ = ""
        DO
            k$ = INKEY$
        LOOP UNTIL k$ <> ""

        ' Save the current box location for restore
        oldPointerRow% = pointerRow%
        oldPointerCol% = pointerCol%

        ' Update our internal (logical) pointer box position based on the
        ' user keystroke; or quit, if ESC was hit
        SELECT CASE k$
        CASE upArrow$
            IF pointerRow% > 1 THEN
                pointerRow% = pointerRow% - 1
            ELSE
                pointerRow% = 13
            END IF
        CASE downArrow$
            IF pointerRow% < 13 THEN
                pointerRow% = pointerRow% + 1
            ELSE
                pointerRow% = 1
            END IF
        CASE leftArrow$
            IF pointerCol% > 1 THEN
                pointerCol% = pointerCol% - 1
            ELSE
                pointerCol% = 78
            END IF
        CASE rightArrow$
            IF pointerCol% < 78 THEN
                pointerCol% = pointerCol% + 1
            ELSE
                pointerCol% = 1
            END IF
        CASE CHR$(27)    ' The ESC character - QUIT this demo
            done% = TRUE
        CASE ELSE
        END SELECT

        IF NOT (done%) THEN

            ' Update the pointer box position
            BlockRestore oldPointerCol%, oldPointerCol% + 2, oldPointerRow%, oldPointerRow% + 2, pointerArray%(), GetVideoSegment
            BlockSave pointerCol%, pointerCol% + 2, pointerRow%, pointerRow% + 2, pointerArray%(), GetVideoSegment
            COLOR pointerFG%, pointerBG%
            PointerBox pointerRow%, pointerCol%

            ' Update the Foreground/Background color indicators
            COLOR winFG%, winBG%
            Center SPACE$(78), 23
            Center "Foreground:" + STR$(GetForeground(pointerRow% + 1, pointerCol% + 1)) + "  Background:" + STR$(GetBackground(pointerRow% + 1, pointerCol% + 1)), 23

        END IF

    LOOP UNTIL done%

END SUB

SUB GetPutScreenInfo

    ' Set up colors for this function
    IF kolor% THEN
        fg% = WHITE: bg% = BLUE
    ELSE
        fg% = BLACK: bg% = WHITE
    END IF

    ' Make a window to hold the info
    MakeWindow 4, 11, 19, 70, fg%, bg%, 0, 1, 16, 1, " GetScreen and PutScreen Info "

    ' Add text to window explaining the Get/PutScreen functions
    Center "The QBSCR PutScreen routine will load a premade screen", 6
    Center "(generated using Screen Builder) from disk and display", 7
    Center "it on the monitor.  This is very fast.  From a fixed", 8
    Center "disk, the time to the display is less than 1 second!", 9
    Center "Many of the displays in this demo, including the", 10
    Center "opening screen and the menu, were generated with", 11
    Center "Screen Builder and displayed with PutScreen.", 12

    Center "GetScreen peforms the opposite service.  It will get", 14
    Center "a copy of the display and save it to disk very", 15
    Center "quickly.  GetScreen is the heart of the SAVE", 16
    Center "function in Screen Builder.", 17

    Center " Hit any key to continue ", 19

    ' Wait for user to hit a key before exiting
    KeyPause

END SUB

SUB Initialize

    IF ColorChk THEN
        kolor% = TRUE
    ELSE
        kolor% = FALSE
    END IF

END SUB

SUB KeyPause

    kee$ = INPUT$(1)

END SUB

SUB MakeMenuInfo

    ' Set up colors for this function
    IF kolor% THEN
        fg% = BRIGHT + WHITE: bg% = RED
    ELSE
        fg% = BLACK: bg% = WHITE
    END IF

    ' Make a window to hold the info
    MakeWindow 2, 11, 22, 70, fg%, bg%, 0, 1, 16, 1, " MakeMenu Info "

    ' Add text to window
    Center "The main menu for this demo, the one you've been", 4
    Center "selecting options from, is the result of the QBSCR", 5
    Center "MakeMenu routine.", 6
    Center "This routine is a function, and returns the user's", 8
    Center "selection by number.  For instance, if your user", 9
    Center "had chosen the third selection, MakeMenu would", 10
    Center "return a value of 3.", 11
    Center "Make menu includes the use of " + CHR$(34) + "Quick Access" + CHR$(34) + " keys.", 13
    Center "Each entry has a unique letter associated with it,", 14
    Center "highlighted on the screen, that may be used for", 15
    Center "direct access to that menu selection.", 16
    Center "MakeMenu can center or right or left justify your", 18
    Center "menu entries, has a wrapping selection bar, and can", 19
    Center "make your programs simple to use.", 20
    Center " Hit any key to continue ", 22

    ' Wait for the user to hit a key
    KeyPause

END SUB

SUB MakeWindowDemo

    ' Set up some variables for the five demo windows
    DIM windowFG%(1 TO 5)
    DIM windowBG%(1 TO 5)
    winDelay = 750

    ' Set up 5 arrays to save the screen between each window. This could be
    ' done much more efficiently memory-wise by using BlockSave and
    ' BlockRestore, since they require only an array the size of the area
    ' to be saved.  I'm just feeling lazy right now, as all programmers will.
    DIM scrArray1%(4000)
    DIM scrArray2%(4000)
    DIM scrArray3%(4000)
    DIM scrArray4%(4000)
    DIM scrArray5%(4000)

    ' Set colors for windows
    IF kolor% THEN
        windowFG%(1) = BRIGHT + WHITE: windowBG%(1) = BLUE
        windowFG%(2) = BLUE: windowBG%(2) = CYAN
        windowFG%(3) = YELLOW: windowBG%(3) = RED
        windowFG%(4) = BRIGHT + WHITE: windowBG%(4) = GREEN
        windowFG%(5) = BRIGHT + CYAN: windowBG%(5) = MAGENTA
    ELSE
        windowFG%(1) = BRIGHT + WHITE: windowBG%(1) = BLACK
        windowFG%(2) = BLACK: windowBG%(2) = WHITE
        windowFG%(3) = WHITE: windowBG%(3) = BLACK
        windowFG%(4) = BLACK: windowBG%(4) = WHITE
        windowFG%(5) = BRIGHT + WHITE: windowBG%(5) = BLACK
    END IF

    ' First Window
    ScrnSave 1, 25, scrArray1%(), GetVideoSegment
    PLAY "MB L64 N1 N10 N20 N30 N40 N50 N60 N70 N80"
    MakeWindow 1, 5, 10, 30, windowFG%(1), windowBG%(1), 0, 1, 16, 1, " First Window "
    x% = Pause(winDelay)

    ' Second Window
    ScrnSave 1, 25, scrArray2%(), GetVideoSegment
    PLAY "MB L64 N1 N10 N20 N30 N40 N50 N60 N70 N80"
    MakeWindow 2, 38, 8, 68, windowFG%(2), windowBG%(2), 4, 0, 16, 1, " Second Window "
    x% = Pause(winDelay)

    ' Third Window
    ScrnSave 1, 25, scrArray3%(), GetVideoSegment
    PLAY "MB L64 N1 N10 N20 N30 N40 N50 N60 N70 N80"
    MakeWindow 11, 40, 22, 75, windowFG%(3), windowBG%(3), 7, 2, 16, 1, " Third Window "
    x% = Pause(winDelay)

    ' Fourth Window
    ScrnSave 1, 25, scrArray4%(), GetVideoSegment
    PLAY "MB L64 N1 N10 N20 N30 N40 N50 N60 N70 N80"
    MakeWindow 13, 3, 21, 34, windowFG%(4), windowBG%(4), 5, 3, 16, 1, " Fourth Window "
    x% = Pause(winDelay)

    ' Fifth Window
    ScrnSave 1, 25, scrArray5%(), GetVideoSegment
    PLAY "MB L64 N1 N10 N20 N30 N40 N50 N60 N70 N80"
    MakeWindow 7, 16, 18, 65, windowFG%(5), windowBG%(5), 0, 1, 16, 1, " Fifth Window "

    ' Add text to fifth window
    Center "These windows were all generated with the", 9
    Center "QBSCR MakeWindow routine. At your", 10
    Center "disposal are ten types of windows, six", 11
    Center "types of window frames, 17 kinds of", 12
    Center "window shadows, four modes of placing", 13
    Center "windows on the screen, and much more.", 14
    Center "Hit any key to continue", 16

    ' Wait for user to press a key
    KeyPause

    ' Make a noise and remove each window in turn
    PLAY "MB L16 N10"
    ScrnRestore 1, 25, scrArray5%(), GetVideoSegment: x% = Pause%(winDelay)
    PLAY "MB L16 N10"
    ScrnRestore 1, 25, scrArray4%(), GetVideoSegment: x% = Pause%(winDelay)
    PLAY "MB L16 N10"
    ScrnRestore 1, 25, scrArray3%(), GetVideoSegment: x% = Pause%(winDelay)
    PLAY "MB L16 N10"
    ScrnRestore 1, 25, scrArray2%(), GetVideoSegment: x% = Pause%(winDelay)
    PLAY "MB L16 N10"
    ScrnRestore 1, 25, scrArray1%(), GetVideoSegment

END SUB

SUB MenuScreen

    ' Define menu screen file name and set colors for menu
    IF kolor% THEN
        scrFile$ = "MENU.CLR"
        fg% = CYAN: bg% = BLACK
        hfg% = YELLOW: hbg% = CYAN
        qfg% = BRIGHT + WHITE: qbg% = BLACK
        COLOR BLUE, BLACK
    ELSE
        scrFile$ = "MENU.MON"
        fg% = WHITE: bg% = BLACK
        hfg% = BLACK: hbg% = WHITE
        qfg% = BRIGHT + WHITE: qbg% = BLACK
        COLOR WHITE, BLACK
    END IF

    ' Define menu array for MakeMenu call
    DIM menu$(maxEntries)
        menu$(1) = "^Banner"
        menu$(2) = "Build^Screen"
        menu$(3) = "Center/OffCe^nter"
        menu$(4) = "^ClrScr"
        menu$(5) = "^Foreground or Background"
        menu$(6) = "^GetScreen/PutScreen Info"
        menu$(7) = "^MakeMenu Info"
        menu$(8) = "Make^Window"
        menu$(9) = "M^ultiMenu"
        menu$(10) = "Save/Restore Sc^reen"
        menu$(11) = "Save/Restore B^lock"
        menu$(12) = "ScreenBlan^k"
        menu$(13) = "Wi^pe"

    ' Place the menu screen on the display, in a very nifty fashion
    ClrScr 3, CHR$(176)
    BuildScreen scrFile$, 2

    ' Save the screen for fast restore later
    DIM scrArray%(4000)
    ScrnSave 1, 25, scrArray%(), GetVideoSegment

    ' We'll sit in a loop until the user is done pushing keys
    done% = FALSE
    DO
        ' Make the menu first of all
        choice% = MakeMenu%(menu$(), maxEntries, "C", 29, 53, 7, "^", fg%, bg%, hfg%, hbg%, qfg%, qbg%)

        ' Decide what to do based on the user's selection
        SELECT CASE choice%
        CASE 0    ' The ESC key was hit - MakeMenu exits with 0
            done% = TRUE
        CASE 1    ' Banner
            BannerDemo
        CASE 2    ' BuildScreen
            BuildScreenDemo
        CASE 3    ' Center/OffCenter
            CenterOffCenterDemo
        CASE 4    ' ClrScr
            ClrScrDemo
        CASE 5    ' Get Foreground/Background
            GetFgBgDemo
        CASE 6    ' GetScreen/PutScreen Info
            GetPutScreenInfo
        CASE 7    ' MakeMenu Info
            MakeMenuInfo
        CASE 8    ' MakeWindow
            MakeWindowDemo
        CASE 9    ' MultiMenu
            MultiMenuDemo
        CASE 10   ' Save/Restore Screen
            ScreenInfo
        CASE 11   ' Save/Restore Block
            BlockDemo
        CASE 12   ' ScreenBlank
            ScreenBlankDemo
        CASE 13   ' Wipe
            WipeDemo
        CASE ELSE
        END SELECT

        ' Restore the screen after selected demo returns
        IF NOT (done%) THEN
            ScrnRestore 1, 25, scrArray%(), GetVideoSegment
        END IF

    LOOP UNTIL done%

END SUB

SUB MovingMessage

    ' A few local vars
    bigPause = 750
    littlePause = 35

    ' Setup our scrnsave arrays
    DIM under%(BlockSize%(34, 46, 19, 19))
    DIM over%(BlockSize%(34, 46, 19, 19))
    segment = GetVideoSegment

    ' Set colors
    IF kolor% THEN
        COLOR 15, 4
    ELSE
        COLOR 0, 7
    END IF

    ' Save portion of screen and make the initial message
    BlockSave 34, 46, 19, 19, under%(), segment
    LOCATE 19, 34, 0: PRINT " Hit any key ";
    BlockSave 34, 46, 19, 19, over%(), segment
    IF Pause%(bigPause) = FALSE THEN
        EXIT SUB
    END IF

    ' Move message to left side of screen
    FOR x% = 34 TO 6 STEP -2
        BlockRestore x%, x% + 12, 19, 19, over%(), segment
        IF Pause%(littlePause) = FALSE THEN
            EXIT SUB
        END IF
        BlockRestore x%, x% + 12, 19, 19, under%(), segment
    NEXT x%
    BlockRestore x%, x% + 12, 19, 19, over%(), segment
    IF Pause%(bigPause) = FALSE THEN
        EXIT SUB
    END IF

    ' Sit in a loop that moves the message while waiting for a keypress
    done% = FALSE
    DO
        ' Move up
        FOR y% = 18 TO 4 STEP -1
            BlockRestore 4, 16, y% + 1, y% + 1, under%(), segment
            BlockSave 4, 16, y%, y%, under%(), segment
            BlockRestore 4, 16, y%, y%, over%(), segment
            IF Pause%(littlePause) = FALSE THEN
                EXIT SUB
            END IF
        NEXT y%
        IF Pause%(bigPause) = FALSE THEN
            EXIT SUB
        END IF

        'Move right
        FOR x% = 4 TO 64 STEP 2
            BlockRestore x%, x% + 12, 4, 4, over%(), segment
            IF Pause%(littlePause) = FALSE THEN
                EXIT SUB
            END IF
            BlockRestore x%, x% + 12, 4, 4, under%(), segment
        NEXT x%
        BlockRestore x%, x% + 12, 4, 4, over%(), segment
        IF Pause%(bigPause) = FALSE THEN
            EXIT SUB
        END IF

        ' Move down
        FOR y% = 5 TO 19
            BlockRestore 66, 78, y% - 1, y% - 1, under%(), segment
            BlockSave 66, 78, y%, y%, under%(), segment
            BlockRestore 66, 78, y%, y%, over%(), segment
            IF Pause%(littlePause) = FALSE THEN
                EXIT SUB
            END IF
        NEXT y%
        IF Pause%(bigPause) = FALSE THEN
            EXIT SUB
        END IF

        ' Move left
        FOR x% = 66 TO 6 STEP -2
            BlockRestore x%, x% + 12, 19, 19, over%(), segment
            IF Pause%(littlePause) = FALSE THEN
                EXIT SUB
            END IF
            BlockRestore x%, x% + 12, 19, 19, under%(), segment
        NEXT x%
        BlockRestore x%, x% + 12, 19, 19, over%(), segment
        IF Pause%(bigPause) = FALSE THEN
            EXIT SUB
        END IF

    LOOP UNTIL done%

END SUB

SUB MultiMenuDemo

    ' Define a few constants for this routine
    maxChoices% = 9
    maxMenus% = 6
    F10$ = CHR$(0) + CHR$(68)

    ' DIMension screen saving arrays
    DIM scrArray%(4000)   ' For entire screen

    ' Set colors for MultiMenu demo
    IF kolor% THEN
        fg% = WHITE: bg% = BLUE
        hfg% = YELLOW: hbg% = BLACK
        qfg% = BRIGHT + WHITE: qbg% = BLUE
        headerFG% = BRIGHT + WHITE: headerBG% = BLUE
        rulerFG% = BRIGHT + MAGENTA: rulerBG% = BLACK
        editFG% = BRIGHT + CYAN: editBG% = BLACK
    ELSE
        fg% = BLACK: bg% = WHITE
        hfg% = BRIGHT + WHITE: hbg% = BLACK
        qfg% = BRIGHT + WHITE: qbg% = BLACK
        headerFG% = BRIGHT + WHITE: headerBG% = BLACK
        rulerFG% = BLACK: rulerBG% = WHITE
        editFG% = BRIGHT + WHITE: editBG% = BLACK
    END IF

    ' DIMension and initialize arrays for MultiMenu
    DIM menusArray$(1 TO maxMenus%, 1 TO maxChoices%)
    DIM numEntries%(1 TO maxMenus%)
    DIM menuTitles$(1 TO maxMenus%)

    ' Assign the menu titles
    menuTitles$(1) = "^File"
    menuTitles$(2) = "^Block"
    menuTitles$(3) = "^Search"
    menuTitles$(4) = "^Print"
    menuTitles$(5) = "^Options"
    menuTitles$(6) = "^Help"

    ' Choices for first menu, FILE
    menusArray$(1, 1) = "^Load File"
    menusArray$(1, 2) = "^Save File"
    menusArray$(1, 3) = "Sa^ve File As"
    menusArray$(1, 4) = "^Merge File"
    menusArray$(1, 5) = "^Abandon File"
    menusArray$(1, 6) = "^Directory"
    menusArray$(1, 7) = "^Quit DummyEDIT"

    ' Choices for second menu, BLOCK
    menusArray$(2, 1) = "^Begin Block"
    menusArray$(2, 2) = "^End Block"
    menusArray$(2, 3) = "^Unmark Block"
    menusArray$(2, 4) = "^Move Block"
    menusArray$(2, 5) = "^Delete Block"
    menusArray$(2, 6) = "^Copy Block"
    menusArray$(2, 7) = "^Print Block"
    menusArray$(2, 8) = "^Write Block"
    menusArray$(2, 9) = "^Spell Check"

    ' Choices for third menu, SEARCH
    menusArray$(3, 1) = "^Find text"
    menusArray$(3, 2) = "^Repeat Last Find"
    menusArray$(3, 3) = "^Search and Replace"

    ' Choices for fourth menu, PRINT
    menusArray$(4, 1) = "^Print Current File"
    menusArray$(4, 2) = "Print From ^Disk"
    menusArray$(4, 3) = "Print ^Options"

    ' Choices for fifth menu, OPTIONS
    menusArray$(5, 1) = "^Colors"
    menusArray$(5, 2) = "^Tab Settings"
    menusArray$(5, 3) = "^Margin Settings"
    menusArray$(5, 4) = "^Page Length"

    ' Choices for sixth menu, HELP
    menusArray$(6, 1) = "^General Help"
    menusArray$(6, 2) = "Function ^Keys"
    menusArray$(6, 3) = "^Editing Help"
    menusArray$(6, 4) = "^File Help"
    menusArray$(6, 5) = "^Block Help"
    menusArray$(6, 6) = "^Search Help"
    menusArray$(6, 7) = "^Print Help"
    menusArray$(6, 8) = "^Options Help"

    ' Assign the actual number of entries in each menu
    numEntries%(1) = 7
    numEntries%(2) = 9
    numEntries%(3) = 3
    numEntries%(4) = 3
    numEntries%(5) = 4
    numEntries%(6) = 8

    ' Set up the fake edit display
    COLOR 7, 0
    CLS
    COLOR headerFG%, headerBG%
    LOCATE 1, 1, 0: PRINT SPACE$(80);
    Center "DummyEDIT  ■  Page: 1  Line: 10  Column: 5  Mode: INS  ■  For menu, hit F10", 1
    LOCATE 2, 1, 0: PRINT STRING$(80, 205);
    COLOR rulerFG%, rulerBG%
    PRINT "────L────┬────┬────┬────┬────┬────┬────┬────┬────┬────┬────┬────┬────┬────R─────";

    ' Add the explanatory text, posing as a document being edited
    COLOR editFG%, editBG%
    LOCATE 5, 5, 0: PRINT "     Welcome to the demo for MultiMenu.  This routine will allow you to";
    LOCATE 6, 5, 0: PRINT "create  a pull-down menu system such as the one used in the  QuickBASIC";
    LOCATE 7, 5, 0: PRINT "environment.";
    LOCATE 9, 5, 0: PRINT "     This  demo will simulate a fictitious text editor, which  we  will";
    LOCATE 10, 5, 0: PRINT "call DummyEDIT.  No editing functions will be available, but the editor";
    LOCATE 11, 5, 0: PRINT "menu  system  will work.  This menu will be generated entirely  by  the";
    LOCATE 12, 5, 0: PRINT "QBSCR  MultiMenu routine.  When you select a menu operation, your entry";
    LOCATE 13, 5, 0: PRINT "will be echoed in a small window,  to show that MultiMenu is  returning";
    LOCATE 14, 5, 0: PRINT "values  based on your selection.   To clear the small window,  hit  any";
    LOCATE 15, 5, 0: PRINT "key.  To quit the demo, select Quit DummyEDIT from the File menu.";
    LOCATE 17, 5, 0: PRINT "     To get the menu, hit the F10 key.  This is just part of the editor";
    LOCATE 18, 5, 0: PRINT "simulator.   Once the menu is up,  you can use the left and right arrow";
    LOCATE 19, 5, 0: PRINT "keys or Home and End keys to move the highlight.  Use ENTER or the down";
    LOCATE 20, 5, 0: PRINT "arrow key to 'pull down' the menu.   Once the menu is visible,  you can";
    LOCATE 21, 5, 0: PRINT "use  the  up and down arrow keys and ENTER to select an entry,  or  the";
    LOCATE 22, 5, 0: PRINT "highlighted  'Quick Access' keys.   While the menu is visible,  you can";
    LOCATE 23, 5, 0: PRINT "use the left and right arrow keys to move to a new menu.";
    LOCATE 25, 5, 0: PRINT "     Remember, to quit this demo, select Quit from the File menu.";

    ' Prepare to unleash MultiMenu!
    ' Save entire screen, because I'm still feeling lazy
    ScrnSave 1, 25, scrArray%(), GetVideoSegment

    ' Sit in a loop while the user has not hit ESC.
    done% = FALSE
    DO
        k$ = ""
        DO
            k$ = INKEY$
        LOOP UNTIL k$ <> ""
        IF k$ = F10$ THEN
            MultiMenu menusArray$(), numEntries%(), menuTitles$(), "L", "^", 16, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%
            IF menuSelected% = 1 AND menuEntrySelected% = 7 THEN
                done% = TRUE
            ELSE
                ' Display window with user's choice
                MakeWindow 15, 10, 17, 70, fg%, bg%, 0, 1, 16, 0, ""
                Center "You selected item" + STR$(menuEntrySelected%) + " from menu" + STR$(menuSelected%) + "   (Hit any key)", 16
                KeyPause
            END IF

            ' Restore the screen
            ScrnRestore 1, 25, scrArray%(), GetVideoSegment
        END IF
    LOOP UNTIL done%

END SUB

SUB OpenScreen

    ' Are we COLOR or MONO?
    IF kolor% THEN
        f$ = "DEMO.CLR"
    ELSE
        f$ = "DEMO.MON"
    END IF

    ' Load the proper opening screen
    PutScreen f$

    ' Make a moving "Hit any key" message
    MovingMessage

END SUB

FUNCTION Pause% (delay)

    ' Wait in a loop checking for a keystroke the whole time.  If a key
    ' is hit before the delay is used up, then set the return value to
    ' FALSE.  If the delay expires without a key being pressed, then
    ' return a value of TRUE.
    FOR x = 1 TO delay
        IF INKEY$ <> "" THEN
            Pause% = FALSE
            EXIT FUNCTION
        END IF
    NEXT x
    Pause% = TRUE

END FUNCTION

SUB PointerBox (row%, col%)

    ' This routine is used by the GetFgBgDemo routine only.

    ' Draw the pointer box with the upper-left corner at the
    ' row and column passed into this routine
    LOCATE row%, col%, 0
    PRINT "┌─┐";
    LOCATE row% + 1, col%, 0
    PRINT "│";
    LOCATE row% + 1, col% + 2, 0
    PRINT "│";
    LOCATE row% + 2, col%, 0
    PRINT "└─┘";

END SUB

SUB ScreenBlankDemo

    ' Set up colors for ScreenBlank Demo
    IF kolor% THEN
        winFG% = BRIGHT + WHITE: winBG% = BROWN
        entryFG% = YELLOW: entryBG% = BLACK
    ELSE
        winFG% = BLACK: winBG% = WHITE
        entryFG% = BRIGHT + WHITE: entryBG% = BLACK
    END IF

    ' Display a window with some info in it
    MakeWindow 5, 13, 20, 68, winFG%, winBG%, 0, 1, 16, 1, " ScreenBlank Demo "
    Center "The ScreenBlank function will provide you with a", 7
    Center "capable mechanism to spare your users from the", 8
    Center "woes of burn-in.  Provide ScreenBlank with a", 9
    Center "delay value, and the screen will be cleared.", 10
    Center "To inform your users of what's going on, a small", 11
    Center "message will be displayed telling them that they", 12
    Center "may hit a key to return to your program.  To", 13
    Center "prevent THAT message from burning into the", 14
    Center "screen, it bounces periodically.", 15
    Center "Enter a delay value below (>1000):", 17

    ' Get entry from user
    DO
        value = VAL(GetString$(38, 18, 5, entryFG%, entryBG%))
    LOOP UNTIL value > 999

    ' Perform the screen blank operation
    dummy$ = ScreenBlank$(value)

END SUB

SUB ScreenInfo

    ' Set up colors for this function
    IF kolor% THEN
        fg% = BLUE: bg% = CYAN
    ELSE
        fg% = BLACK: bg% = WHITE
    END IF

    ' Make a window to hold the info
    MakeWindow 2, 11, 23, 70, fg%, bg%, 0, 1, 16, 1, " Save/Restore Screen Info "

    ' Add text to window
    Center "This demo, by it's very nature, will show its", 4
    Center "capabilities when it closes, after you finish reading", 5
    Center "this screen of information.", 6
    Center "The ScrnSave and ScrnRestore routines allow you to", 8
    Center "give the appearance of popping items onto and off of", 9
    Center "the existing display.  This is done by first saving", 10
    Center "the contents of the current display using ScrnSave.", 11
    Center "This information is stored in an integer array.", 12
    Center "The second step is to display whatever you want", 13
    Center "on the existing display.  You could put a menu there,", 14
    Center "a window containing an error message, or anything,", 15
    Center "really.  It all depends on your needs.", 16
    Center "The last step, which takes place when you have", 17
    Center "finished with your window, menu etc., is to restore", 18
    Center "the screen using ScrnRestore.  Your original display", 19
    Center "is restored.  When you hit a key to exit this demo,", 20
    Center "the screen will be restored with ScrnRestore.", 21

    ' Wait for the user to hit a key
    KeyPause

END SUB

SUB WipeDemo

    ' Set colors for this demo
    IF kolor% THEN
        win1FG% = BRIGHT + WHITE: win1BG% = RED
        win2FG% = BRIGHT + WHITE: win2BG% = BLUE
    ELSE
        win1FG% = BLACK: win1BG% = WHITE
        win2FG% = BLACK: win2BG% = WHITE
    END IF

    ' Make 2 windows for this demo
    ' Window 1, with text...
    MakeWindow 2, 3, 20, 38, win1FG%, win1BG%, 0, 1, 16, 1, "Wipe Demo "
    OffCenter "Wipe will clear out a window", 4, 3, 38
    OffCenter "of all its contents, leaving", 5, 3, 38
    OffCenter "it empty and ready for reuse", 6, 3, 38
    OffCenter "by your program. You can use", 7, 3, 38
    OffCenter "Wipe to wipe any rectangular", 8, 3, 38
    OffCenter "area of the screen.", 9, 3, 38
    OffCenter "Wipe always clears out the", 11, 3, 38
    OffCenter "INSIDE area of the defined", 12, 3, 38
    OffCenter "area, so you can give it the", 13, 3, 38
    OffCenter "same coordinates you gave to", 14, 3, 38
    OffCenter "MakeWindow.", 15, 3, 38
    OffCenter "To see Wipe clear the window", 17, 3, 38
    OffCenter "to the right, hit any key...", 18, 3, 38

    ' ...and window number two.
    MakeWindow 5, 42, 18, 76, win2FG%, win2BG%, 0, 1, 16, 1, " Second Window "
    FOR x% = 6 TO 17
        LOCATE x%, 42 + (x% - 5), 0
        PRINT "Text about to be WIPEd";
    NEXT x%

    ' Wait for user to hit a key
    KeyPause

    ' WIPE window numer two
    Wipe 5, 18, 42, 76, win2BG%

    ' Wait for user to hit a key
    COLOR BLINK + win2FG%, win2BG%
    OffCenter " Hit any key to continue ", 18, 42, 76
    KeyPause

END SUB