Microsoft Programmer's Library 1.3/Microsoft_Programmers_Library.7z/MPL/basic/qbtbox.txt

Text File | 2013-11-08 | 853.5 KB | 21,340 lines

 Microsoft QuickBASIC Programmer's Toolbox


 ════════════════════════════════════════════════════════════════════════════


 Microsoft(R) QuickBASIC Programmer's Toolbox

 By John Clark Craig


 ════════════════════════════════════════════════════════════════════════════


   PUBLISHED BY
   Microsoft Press
   A Division of Microsoft Corporation
   16011 NE 36th Way, Box 97017, Redmond, Washington 98073-9717
   Copyright (C) 1988 by John Clark Craig
   All rights reserved. No part of the contents of this book may be
   reproduced or transmitted in any form or by any means without the written
   permission of the publisher.
   Library of Congress Cataloging in Publication Data
   Craig, John Clark.
   The Microsoft QuickBASIC programmer's toolbox.
   1. BASIC (Computer program language)  2. Microsoft QuickBASIC
   (Computer program)  I. Title.
   QA76.73.B3C7    1988    005.13'3    88-5115
   ISBN 1-55615-127-6
   Printed and bound in the United States of America.
   1 2 3 4 5 6 7 8 9  MLML  3 2 1 0 9 8
   Distributed to the book trade in the
   United States by Harper & Row.
   Distributed to the book trade in
   Canada by General Publishing Company, Ltd.
   Distributed to the book trade outside the
   United States and Canada by Penguin Books Ltd.
   Penguin Books Ltd., Harmondsworth, Middlesex, England
   Penguin Books Australia Ltd., Ringwood, Victoria, Australia
   Penguin Books N.Z. Ltd., 182─190 Wairau Road, Auckland 10, New Zealand
   British Cataloging in Publication Data available
   ──────────────────────────────────────────────────────────────────────────
   Project Editor: Suzanne Viescas  Manuscript Editor: Michele Tomiak
   Technical Editor: Jon Harshaw
   ──────────────────────────────────────────────────────────────────────────



                         Dedication

               This book is dedicated with love to
           the three most important people in my life:
                    Jeanie, Jennifer, and Adam.



 ────────────────────────────────────────────────────────────────────────────
 Contents


 PART I:  GETTING STARTED

 QUICKBASIC AND TOOLBOXES
    Advantages of Structured Programming
    The Toolboxes in This Book
 MINICAL.BAS──A COMPLETE PROGRAM
    Modular Source-Code Editing
    Building a Quick Library
    Creating the Source Code for MINICAL
    Compiling and Running as an Executable (.EXE) Program

 PART II:  QUICKBASIC TOOLBOXES AND PROGRAMS
 USING QUICKBASIC TOOLBOXES
    Special Requirements
    QuickBASIC vs Executable Files
 ATTRIB
 BIN2HEX
 BIOSCALL
 BITS
 CALENDAR
 CARTESIA
 CIPHER
 COLORS
 COMPLEX
 DOLLARS
 DOSCALLS
 EDIT
 ERROR
 FIGETPUT
 FILEINFO
 FRACTION
 GAMES
 HEX2BIN
 JUSTIFY
 KEYS
 LOOK
 MONTH
 MOUSGCRS
 MOUSSUBS
 MOUSTCRS
 OBJECT
 PARSE
 PROBSTAT
 QBFMT
 QBTREE
 QCAL
 QCALMATH
 RANDOMS
 STDOUT
 STRINGS
 TRIANGLE
 WINDOWS
 WORDCOUN

 PART III:  MIXED-LANGUAGE TOOLBOXES
 USING MIXED-LANGUAGE TOOLBOXES
    Near and Far Addressing
    Passing Variables
    Creating Mixed-Language Toolboxes
 CDEMO1.BAS AND CTOOLS1.C
 CDEMO2.BAS AND CTOOLS2.C

 PART IV:  APPENDIXES
 APPENDIX A  Requirements for Running Toolboxes/Programs
 APPENDIX B  Functions-to-Modules Cross Reference
 APPENDIX C  Subprograms-to-Modules Cross Reference
 APPENDIX D  Hexadecimal Format (.OBJ) Files
 APPENDIX E  Line-Drawing Characters



 ────────────────────────────────────────────────────────────────────────────
 PART 1  GETTING STARTED



 ────────────────────────────────────────────────────────────────────────────
 Chapter One  QuickBASIC and Toolboxes

   Thanks to Microsoft QuickBASIC 4.0, BASIC has finally grown into a
   flexible, full-featured, and powerful programming language. By thumbing
   through this book and glancing at the program listings, you'll see that
   BASIC isn't what it used to be. Microsoft QuickBASIC is easier to read,
   has a faster learning curve, and gives you the power to quickly create
   sophisticated programs that would have been difficult, if not impossible,
   with traditional BASIC.

   A key difference between traditional BASIC and QuickBASIC is that
   QuickBASIC allows structured programming, an important feature that makes
   large programs easier to create and maintain.


 Advantages of Structured Programming

   With early versions of BASIC, a program was written and executed as a
   single block of program lines. Inexperienced programmers writing large
   programs could unknowingly create "spaghetti code" (programs that make
   frequent and improper use of GOTO statements) making them generally
   difficult to follow and maintain.

   A key feature of QuickBASIC is its ability to let you create structured
   programs──large programs constructed of small, individual program modules.
   Instead of having to create and work with a large (and often overwhelming)
   single block of code, the QuickBASIC programmer need only construct the
   program modules, which are in turn constructed from procedures called
   subprograms and functions. Each of these procedures performs a specific,
   well-defined task. By concentrating on the functionality of a single
   procedure, the programmer is freed from having to worry about other parts
   of the program and can devote full concentration to the task at hand. It's
   been proven that programmers can develop complex programs more quickly and
   accurately using this modular approach.

   An additional advantage to structured programming is that these modules
   and procedures can be organized and saved in such a way that they can be
   reused with other programs──avoiding duplication of effort from one
   programming project to another. By grouping modules with complementary
   functionality, a programmer can easily create "toolboxes" of useful
   routines that can, over time, make large programming projects progress
   quickly because major portions of the program are already written.

   After construction, a module can also be organized into a Quick Library,
   which is a file saved on disk in a special format. You can then load Quick
   Libraries with the QuickBASIC program, effectively adding the routines in
   the Quick Library to the ones built into QuickBASIC.


 The Toolboxes in This Book

   If you are using (or even thinking of using) QuickBASIC, this book will be
   a valuable reference. If you're only starting out and learning QuickBASIC
   as a first language, you'll find the book immediately useful for learning
   by example. If you're a seasoned, professional programmer using QuickBASIC
   as a software development system, you'll find the routines in this book to
   be valuable extensions to the QuickBASIC language.

   Part 1 provides step-by-step instructions for constructing a complete,
   working program called MINICAL. Beginning programmers in particular will
   find this tutorial helpful. Part II contains all the QuickBASIC toolboxes
   and begins with a brief section that explains how to load and run them.
   Part III describes the use of mixed-language toolboxes and contains
   several examples. Finally, five appendixes contain information on the
   requirements for running the toolboxes, cross references to functions and
   subprograms, and additional important information.

   If you're an experienced programmer, you may want to skip ahead to Part
   II and start using some of the toolboxes. If you're new to QuickBASIC,
   turn now to the next section. You'll create two modules containing
   functions and subprograms and use them to build a Quick Library. Once
   you've learned the steps needed to create your own programs and your own
   Quick Library, you can use the modules in Parts II and III of this book,
   as well as modules of your own, to create even more Quick Libraries.
   You'll soon have powerful toolboxes that you can use to build programs
   quickly.



 ────────────────────────────────────────────────────────────────────────────
 Chapter Two  MINICAL.BAS──A Complete Program

   In this section we will start from scratch and build a complete, working
   program. We'll construct the program, build a Quick Library to extend the
   QuickBASIC language, and build a stand-alone, executable program.

   Before we begin, let's take a quick look at the capabilities of the
   QuickBASIC programming environment and at some of the major concepts
   involved. The sample program in this section is made up of two separate
   modules, each consisting of several subprograms and functions. Let's look
   at how QuickBASIC handles each of these.


 Modular Source-Code Editing

   One of the new features of Microsoft QuickBASIC 4.0 is the way that you
   review and edit programs from within the QuickBASIC environment. If you've
   programmed in QuickBASIC, perhaps you've noticed that a program comprising
   several subprograms and functions can't be shown and edited all in one
   piece on the screen. If you haven't yet programmed in QuickBASIC, you need
   only know at this point that you select one subprogram or function from a
   list of currently loaded subprograms and functions as the one you want to
   view and edit. All the other routines are hidden from view. This might
   seem strange at first, but after working on a few programs, you'll begin
   to appreciate the power that this modular editing provides.

   A second major advance in QuickBASIC 4.0 is its ability to load into
   memory more than one source-code file at a time. This opens the door to
   creating collections of subprograms and functions, stored in separate
   source-code files by subject, that several different programs can load and
   use independently.

   The important concepts about these new features can be summarized in this
   way: A program can be made up of one or more source-code files (modules),
   and each source-code file can be made up of one or more subprograms or
   functions. You can load several of these source files into the QuickBASIC
   environment simultaneously, and all modules can work together to make a
   complete program. Although you can display and edit only one portion of a
   source file at a time, it's easy to jump from one portion to another while
   editing a program.


 Building a Quick Library

   Wouldn't it be nice to create new QuickBASIC statements and functions that
   you could add to the language in such a way that they'd be available for
   your use every time you fired up QuickBASIC? That's what Quick Libraries
   can do for you!

   For example, suppose you use hyperbolic functions in almost every program
   you write. You could create these functions in a source-code file to be
   loaded into memory along with each main program you write, or you could
   create a Quick Library so that these functions load at the same time you
   load QuickBASIC. To build a Quick Library, you would simply load the
   hyperbolic function source-code file and select the appropriate menu
   choices from the Run menu.


 Creating the Source Code for MINICAL

   Let's walk through the creation of a complete programming project, step by
   step, to get your feet wet. Fire up your computer and follow along to get
   the maximum benefit. The MINICAL program performs five functions:
   addition, subtraction, multiplication, division, and square root. The
   program is simple in scope, yet it has most of the major components of
   much larger software projects.

   Before we start coding, let's look at how the program should run once we
   get it built. The MINICAL program uses Reverse Polish Notation (RPN) for
   input. Using RPN simplifies the programming considerably because it
   eliminates the coding necessary to rearrange those math commands
   enshrouded in parentheses.

   Using RPN, you enter numbers first, followed by the operators. For
   example, to add 3 and 4, you would enter:


     3 4 +

   (We'll show how these numbers are actually entered later in the section.)
   To add 1 and 2 and then multiply the result by 3, you would enter:


     1 2 + 3 *

   MINICAL uses double-precision numbers, so you can enter any type of
   integer or floating-point numeric values. Results are displayed using as
   many as 16 digits. For example, to divide 1.2 by -3.45, you would enter:


     1.2 -3.45 /

   and the display would read:


     Result... -.3478260869565217

   NOTE: Because a computer keyboard does not have x and ÷ keys, an asterisk
   (*) is used for multiplication and a forward slash (/) is used for
   division.

   By the way, MINICAL uses a structure called a stack to hold the numbers
   and the operators while performing the calculations. (Technically, the
   structure used in MINICAL only mimics a traditional stack, but for
   discussion purposes it can be thought of as a stack.) A stack is a
   sequential series of memory locations set aside to hold a number of
   separate items──in this case, the numbers and operators provided by the
   user. RPN is used for specifying numbers and operators primarily because
   of the existence of the stack──the RPN syntax is ideal for stack-based
   calculations. The alternative method, parsing, involves "reading" the
   equation entered by the user, rearranging and selecting the separate
   elements, and acting on them. This latter method involves much more
   coding.

   The stack in MINICAL can hold as many as 20 values plus the associated
   operators. You can enter numbers as explained above, or you can enter all
   numbers and then the operators. For example, to add the numbers 1 through
   5, you can enter either of these two command lines:


     1 2 + 3 + 4 + 5 +
     1 2 3 4 5 + + + +

 The MINIMATH Module

   This project consists of two parts: the MINIMATH module and the MINICAL
   module. Let's begin with MINIMATH.

   If you haven't done so yet, at the system prompt type QB and press Enter
   to start QuickBASIC. Type in the title block on the following page.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MINIMATH                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        MINIMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Collection of math subprograms for the MINICAL
     ' program.
   ──────────────────────────────────────────────────────────────────────────

   At this point, it's convenient to tell QuickBASIC this module's name. Pull
   down the File menu and choose Save As. Type the filename MINIMATH, and
   press the Enter key or move your mouse pointer to the OK box and click the
   left mouse button. The file is then saved to disk, and you're ready to
   continue entering more of the program. Note that if you omit the .BAS
   extension, as you did here, QuickBASIC automatically adds it for you.

   This first module will be made up of the five subprograms that perform the
   math functions. First, let's create the Add subprogram. Pull down the Edit
   menu and choose New SUB. When you're asked for the name of the subprogram,
   respond with Add. QuickBASIC then creates the first and last lines of your
   new subprogram:


     SUB Add
     END SUB

   Note that QuickBASIC also adjusts the editing window so that only the Add
   subprogram is displayed, allowing you to concentrate on this subprogram
   only. (You'll greatly appreciate this feature later on, when your
   programming projects become larger.) The next step is to add comment
   information before the first line of the subprogram and to insert the
   "guts" of the subprogram between the two lines displayed by QuickBASIC.

   Start by adding comments. Move the cursor to the first character of the
   first line of the subprogram and press Enter. When you do, a dialog box
   appears with the message Blank lines not allowed before SUB/FUNCTION line.
   Is remark OK? Since a remark (comment) is what you want, choose OK.
   QuickBASIC then inserts a blank line preceded by a ' character for the
   comment. After you type the first comment line (taken from the lines on
   the following page) and press Enter, the dialog box appears again. Click
   OK and then type the next comment line.

   Use the lines below to build the Add subprogram. Note the locations of the
   SUB Add and END SUB lines, and note that you need to append items to the
   SUB Add line. Also note that some lines are indented: Although this
   indention is not required, it is good programming style to indent
   subordinate lines so that the program is easier to read and relationships
   between lines are visually apparent. When you're done, your Add subprogram
   should look exactly like this:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Add                        **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MINIMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Performs addition for the MINICAL program.
     '
       SUB Add (stack#(), ptr%) STATIC
           ptr% = ptr% - 1
           IF ptr% THEN
               stack#(ptr%) = stack#(ptr%) + stack#(ptr% + 1)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────

   You can save your work at any point. (It's a good idea to back up your
   work often to prevent losing your work in case of a power failure or other
   disaster.) Do so now by pulling down the File menu and choosing Save All.

   You're well on your way now! You will create and edit the other four math
   subprograms (shown on pages 11-12) in the same way.

   Here's a tip that can speed up the process. Notice that the initial
   comment lines for each of the five subprograms are nearly identical. So,
   instead of retyping each one, you'll copy the lines you typed in for the
   Add subprogram and paste them into the other subprograms. Let's do that
   now.

   First, set up the new subprograms. For the Subtract subprogram, choose
   New SUB from the Edit menu, enter the name Subtract, and press Enter.
   After the two lines of the Subtract subprogram are displayed, repeat the
   New SUB process for the Multiply, Divide, and SquareRoot subprograms.
   Be sure you type the subprogram names as shown here──each starts with a
   capital letter, and no space is allowed in the subprogram name SquareRoot.

   Next, make a copy of the comment lines in the Add subprogram. Pull down
   the View menu and choose SUBS. QuickBASIC displays a list of all
   subprogram names you entered. Here's where the power of QuickBASIC is
   really apparent: Using the SUBS command, you can jump to any subprogram
   for editing by simply selecting the name of the desired subprogram. You do
   this by double-clicking on the desired subprogram name with your mouse or
   by using the cursor movement keys followed by the Enter key. For now,
   choose Add.

   To copy the comment lines, move the cursor to the first character of the
   first comment line, and then (using the keyboard) hold down either Shift
   key and press the Down arrow key until all comment lines are highlighted;
   or (using the mouse) move the mouse pointer to the location of the cursor,
   hold down the left mouse button, and drag down until all comment lines are
   highlighted. Finally, choose Copy from the Edit menu to copy the
   highlighted lines to the Clipboard.

   Next, copy those lines into the four other subprograms. Choose SUBS from
   the View menu to again display a list of subprograms. Select Subtract,
   move the cursor to the first character of the first line, pull down the
   Edit menu, and choose Paste. The lines copied from the Add subprogram
   should appear. (If they don't or if you get a dialog box telling you that
   blank lines can't appear before a subprogram, go back to the Add
   subprogram and repeat the Edit-Copy process. Remember to copy only comment
   lines──those preceded by a ' character.)

   Select the remaining subprogram names in the same way, and repeat the
   Edit-Paste process. You don't have to repeat the Copy operation, because
   an item copied to the Clipboard stays there until something else is copied
   to the Clipboard or until you quit QuickBASIC. When you're done, go back
   to each subprogram. Edit the comment lines and enter the program lines as
   you did for the Add subprogram. Be sure to choose Save All from the File
   menu after completing each subprogram. Also, be sure to go back and review
   your work──the ability to view each subprogram separately using the SUBS
   option on the View menu makes this important task easier and your program
   clearer to read. Your results should match the four subprograms on the
   following two pages.

   NOTE: Don't forget to edit the comments! Remember──the comments you pasted
   in were the comments for the Add subprogram. You must change the name in
   each comment block and the information on the line below the block to
   reflect the subprogram the comments identify.

   The following is the Subtract subprogram:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Subtract                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MINIMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Performs subtraction for the MINICAL program.
     '
       SUB Subtract (stack#(), ptr%) STATIC
           ptr% = ptr% - 1
           IF ptr% THEN
               stack#(ptr%) = stack#(ptr%) - stack#(ptr% + 1)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────

   The following is the Multiply subprogram:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Multiply                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MINIMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Performs multiplication for the MINICAL program.
     '
       SUB Multiply (stack#(), ptr%) STATIC
           ptr% = ptr% - 1
           IF ptr% THEN
               stack#(ptr%) = stack#(ptr%) * stack#(ptr% + 1)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────

   The following is the Divide subprogram:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Divide                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MINIMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Performs division for the MINICAL program.
     '
       SUB Divide (stack#(), ptr%) STATIC
           ptr% = ptr% - 1
           IF ptr% THEN
               stack#(ptr%) = stack#(ptr%) / stack#(ptr% + 1)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────

   The following is the SquareRoot subprogram:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SquareRoot                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MINIMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Determines square root for the MINICAL program.
     '
       SUB SquareRoot (stack#(), ptr%) STATIC
           stack#(ptr%) = SQR(stack#(ptr%))
       END SUB
   ──────────────────────────────────────────────────────────────────────────

   This completes the first part of the MINICAL program. The subprograms you
   created and saved as MINIMATH form the heart of MINICAL because they
   perform the actual calculations. The next part involves creating MINICAL
   itself. MINICAL performs the overhead work──taking the numbers the user
   wants to calculate, passing them to the appropriate subprograms in
   MINIMATH, and displaying the result.

 The MINICAL Module

   From here, you can proceed in one of two ways. Because both MINIMATH and
   MINICAL are small, you can build the MINICAL program entirely in memory by
   creating a second module named MINICAL. (You do this by choosing Create
   File from the File menu, accepting the default choice of Module, and then
   choosing OK.) Or you can turn MINIMATH into a Quick Library and load it
   with the QuickBASIC system so that it becomes an extension to the
   language. We'll use the second method to see how easy it is to use this
   advanced QuickBASIC feature.

   To create a Quick Library, pull down the Run menu and choose Make Library.
   You'll be asked to name the library. MINIMATH will be fine, because
   QuickBASIC automatically appends a default extension of .QLB for the Quick
   Library and .LIB for the normal library it also builds. After you type
   MINIMATH, choose Make Library. (You can ignore the other options in the
   dialog box for now.) When completed, QuickBASIC will have created two new
   files in the current directory: MINIMATH.QLB and MINIMATH.LIB.

   Now quit QuickBASIC so that you can restart it and load the new Quick
   Library with it. To do this, pull down the File menu and choose Exit. Then
   start QuickBASIC from the system prompt by entering:


     QB /L MINIMATH

   You'll see no obvious sign that anything is different, but a very exciting
   event has actually taken place! Your QuickBASIC has been extended. It's
   now more than it used to be. The subprograms in MINIMATH are part of the
   QuickBASIC language, ready to be used like many of the other QuickBASIC
   keywords. In fact, because you can optionally use the CALL keyword when
   calling subprograms, these new subprograms will appear much like new
   keywords in QuickBASIC.

   Proceed with the rest of the program now so that you can try out the new,
   extended QuickBASIC. Be sure QuickBASIC is loaded, as described earlier,
   with the MINIMATH Quick Library as part of the system. Then type in the
   following program, MINICAL.BAS:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MINICAL                    **
     ' **  Type:          Program                    **
     ' **  Module:        MINICAL.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************

     ' Functions
       DECLARE FUNCTION NextParameter$ (cmd$)

     ' Subprograms
       DECLARE SUB Process (cmd$, stack#(), ptr%)
       DECLARE SUB DisplayStack (stack#(), ptr%)
       DECLARE SUB Add (stack#(), ptr%)
       DECLARE SUB Subtract (stack#(), ptr%)
       DECLARE SUB Multiply (stack#(), ptr%)
       DECLARE SUB Divide (stack#(), ptr%)
       DECLARE SUB SquareRoot (stack#(), ptr%)

     ' Get the command line
       cmd$ = COMMAND$

     ' Create a pseudo stack
       DIM stack#(1 TO 20)
       ptr% = 0

     ' Process each part of the command line
       DO UNTIL cmd$ = ""
           parm$ = NextParameter$(cmd$)
           Process parm$, stack#(), ptr%
           IF ptr% < 1 THEN
               PRINT "Not enough stack values"
               SYSTEM
           END IF
       LOOP

     ' Display results
       DisplayStack stack#(), ptr%

     ' All done
       END
   ──────────────────────────────────────────────────────────────────────────

   This is the main part of the MINICAL program, where all the action begins.
   Note the first two lines in the DO-LOOP structure, the ones that read
   parm$ = NextParameter$(cmd$) and Process parm$, stack#(), ptr%. The first
   line calls the user-defined function named NextParameter$, and the second
   line calls the user-defined subprogram named Process. (No, you haven't
   defined them yet. That's next on the list of tasks to do.) Notice that the
   keyword CALL was not used to call the Process subprogram. You can use CALL
   if desired, but there's no need to anymore. Because of the way QuickBASIC
   deals with subprograms, the Process subprogram that you'll create shortly
   will be more like part of the QuickBASIC system, rather than part of the
   program, because you can't list it or modify it while this portion of the
   program is on the screen. You also don't have to think about it or
   recompile it! Your creative energies are free to tackle the next higher
   level of the program's complexity.

   Once you've entered the main program's lines, it's again time to save this
   module to disk. Select Save As from the File menu and enter the filename
   MINICAL.

   You still have a few pieces of coding to do before you can try the
   program. To create the one function of this program, select New Function
   from the Edit menu. Type in the function name NextParameter$, and press
   the Enter key. Creating and editing functions are really no different from
   creating and editing subprograms. In fact, the only major difference
   between a function and a subprogram is that a function returns a value to
   be used in a calculation or assigned to a QuickBASIC variable. Subprograms
   return values only through passed variables. Follow the same steps you
   used to create the subprograms in MINIMATH to create the function
   NextParameter$:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          NextParameter$             **
     ' **  Type:          Function                   **
     ' **  Module:        MINICAL.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Extracts parameters from the front of the
     ' command line. Parameters are groups of any
     ' characters separated by spaces.
     '
       FUNCTION NextParameter$ (cmd$) STATIC
           parm$ = ""
           DO WHILE LEFT$(cmd$, 1) <> " " AND cmd$ <> ""
               parm$ = parm$ + LEFT$(cmd$, 1)
               cmd$ = MID$(cmd$, 2)
           LOOP
           DO WHILE LEFT$(cmd$, 1) = " " AND cmd$ <> ""
               cmd$ = MID$(cmd$, 2)
           LOOP
           NextParameter$ = parm$
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────

   Now create and edit the following two subprograms as part of the MINICAL
   module.

   Create the subprogram DisplayStack:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DisplayStack               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MINICAL.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Displays anything left on the stack when MINICAL
     ' finishes processing the command line.
     '
       SUB DisplayStack (stack#(), ptr%) STATIC
           PRINT
           IF ptr% > 1 THEN
               PRINT "Stack... ",
           ELSE
               PRINT "Result... ",
           END IF
           FOR i% = 1 TO ptr%
               PRINT stack#(i%),
           NEXT i%
           PRINT
       END SUB
   ──────────────────────────────────────────────────────────────────────────

   Next create the subprogram Process:

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Process                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MINICAL.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Processes each command parameter for the MINICAL
     ' program.
     '
       SUB Process (parm$, stack#(), ptr%) STATIC
           SELECT CASE parm$
           CASE "+"
               Add stack#(), ptr%
           CASE "-"
               Subtract stack#(), ptr%
           CASE "*"
               Multiply stack#(), ptr%
           CASE "/"
               Divide stack#(), ptr%
           CASE "SQR"
               SquareRoot stack#(), ptr%
           CASE ELSE
               ptr% = ptr% + 1
               stack#(ptr%) = VAL(parm$)
           END SELECT
       END SUB
   ──────────────────────────────────────────────────────────────────────────

   Be sure you save your efforts on disk by selecting Save All from the File
   menu.

   You've done it! One last detail remains, however. This program reads the
   command line and assumes that numbers and operators were typed in
   following the name of the program at the system prompt. Fortunately,
   QuickBASIC provides a mechanism to let you type in a command line, even
   though you're currently going to be running the program in memory from the
   QuickBASIC system. From the Run menu select Modify COMMAND$. You'll be
   asked to enter a new command line. Enter this for the first try:


     3 4 +

   Everything should be in place now, so try running the program. Select
   Start from the Run menu. If all is well, you'll see the following:


     Result...  7

   If all is not well, you'll probably find yourself staring at an error
   message from QuickBASIC, describing an error that's probably the indirect
   result of a typographical error. If so, double-check your typing, and
   rebuild the library if the problem was in the MINIMATH module.

   Once you get the program working, take a little time to try different
   command line parameters. See what happens if several numbers are placed on
   the stack but not enough operators are given to reduce the stack to a
   final result. For example, try entering:


     3 4 5 6 7 + *

   Also, find out what happens if not enough numbers are on the stack. For
   example, enter:


     3 4 + *


 Compiling and Running as an Executable (.EXE) Program

   Finally, to see how you can create programs that you can run from MS-DOS,
   select Make EXE File from the Run menu. You can create two types of .EXE
   files. The first type results in a smaller MINICAL.EXE file, but it
   requires access to the QuickBASIC file named BRUN40.EXE at runtime. The
   second type results in a larger MINICAL.EXE file that stands completely on
   its own. When you select Make EXE File from the Run menu, you are prompted
   to select the type of .EXE file you want to create. Try it both ways. Take
   a look at the resulting file sizes, and note that the BRUN40.EXE file must
   be accessible in the current directory or in a place defined by the MS-DOS
   PATH setting. (Your QuickBASIC manual discusses this subject in more
   detail.)

   Either way, running the MINICAL.EXE program from the system prompt uses
   the command line in the way that COMMAND$ expects. For example, to
   subtract 5 from 17, enter the following at the system prompt:


     MINICAL 17 5 -

   While building MINICAL, you've learned how easy it is to create toolboxes
   of your own or to edit existing toolboxes. Turn now to Part II of this
   book. Be sure to read the first section, which explains how to use the
   QuickBASIC toolboxes. Then choose a toolbox that interests you, and have
   fun.



 ────────────────────────────────────────────────────────────────────────────
 PART 2  QUICKBASIC TOOLBOXES AND PROGRAMS



 ────────────────────────────────────────────────────────────────────────────
 Chapter Three  Using QuickBASIC Toolboxes

   The toolboxes in Part II cover a wide range of topics and are presented
   alphabetically by subject. Each is designed to be loaded and called by
   user-written application software. You can run the demo module that begins
   each toolbox to illustrate the routines within the toolbox, you can ignore
   the demo module and use the routines as they are written, or you can
   restructure the routines so that they meet your application requirements.

   The toolboxes and utility programs do not require any knowledge of
   previously presented toolboxes, so you can run them in any order. Try them
   all at least once, and review the code as you run them. You'll find unique
   techniques and programming concepts in most of the listings. You'll also
   find that these toolbox routines, along with your own creations, will be
   useful in your future programming projects.

   Many of the utility programs use command line input or the COMMAND$
   variable from within QuickBASIC to pass values or parameters to the
   program. Others (those using toolboxes from different programs) might
   require an associated .MAK file. A few programs require color and graphics
   capability, and others require a mouse. Check the comments at the
   beginning of each listing or Appendix A to determine environmental and
   running requirements for each toolbox and utility program.


 Special Requirements

   The following toolboxes require that the MIXED.QLB Quick Library be loaded
   into memory with QuickBASIC: BIOSCALL, CDEMO1, CDEMO2, COLORS,
   DOSCALLS, FILEINFO, MOUSGCRS, MOUSSUBS, MOUSTCRS, QBTREE, STDOUT,
   and WINDOWS. MIXED.QLB consists of a handful of subprograms and functions
   written in assembly language and in Microsoft QuickC. (The
   assembly-language and C source listings for MIXED.QLB are in Part III.)

   Although MIXED.QLB isn't required by all toolboxes in this book, it's a
   good idea to load it each time you start QuickBASIC to use the toolboxes
   in this book. Toolboxes that do not require its presence will not be
   affected if MIXED.QLB is loaded.

   Below are instructions for creating MIXED.QLB, which was written in
   Microsoft QuickC and assembly language to demonstrate how other languages
   can be used with QuickBASIC. It is beyond the scope of this book to
   explain in detail mixed-language programming concepts, so simply follow
   the steps presented here to create MIXED.QLB. In Part III of the book, you
   will have the opportunity to try some examples of mixed-language programs.

 Creating MIXED.QLB

   If you own Microsoft QuickC, the first step is to compile an object-code
   file for CTOOLS1.C and CTOOLS2.C.

   You can load the C source-code files from the companion disk if you have
   purchased it, or you can type them in yourself. You will find CTOOLS1.C
   on page 445, and CTOOLS2.C on page 462. Once you have these files, enter
   the following commands at the system prompt to compile the CTOOLS1.C and
   CTOOLS2.C source-code files to create object-code files:


     QCL /Ox /AM /Gs /c CTOOLS1.C
     QCL /Ox /AM /Gs /c CTOOLS2.C

   NOTE: If you don't have QuickC, you can still create MIXED.QLB. Compile
   the assembly-language source-code files as explained below. You will then
   be able to run all toolboxes in this book except CDEMO1 and CDEMO2.

   If you have version 5.0 or later of the Microsoft Macro Assembler, load
   the assembly-language source-code files from the companion disk or type
   them in. MOUSE.ASM is on page 437 and CASEMAP.ASM is on page 436. The
   third assembly-language file, INTRPT.ASM, is part of QuickBASIC itself and
   can be found on the disk that comes with the program. Then, enter the
   following commands at the system prompt to compile the source-code files
   into object-code files:


     MASM MOUSE;
     MASM CASEMAP;
     MASM INTRPT;

   If you have an earlier version of the Microsoft Macro Assembler, follow
   the guidelines in your QuickBASIC documentation to replace the .MODEL
   directives with appropriate statements.

   If you don't have the Microsoft Macro Assembler, you can use HEX2BIN (on
   pages 210 and 211) to convert the MOUSE.HEX, CASEMAP.HEX, and INTRPT.HEX
   files into object-code files. The hexadecimal character files are listed
   in Appendix D.

   Once you've created the object-code files, you can build the MIXED library
   files to use with QuickBASIC. (Note that two files will be created:
   MIXED.QLB and MIXED.LIB. MIXED.QLB will be loaded with the QuickBASIC
   program because it is needed by some toolboxes; MIXED.LIB will be used for
   creating stand-alone programs that can be executed directly from MS-DOS.)
   The following commands accomplish this task:


     LINK /Q INTRPT+MOUSE+CASEMAP+CTOOLS1+CTOOLS2,MIXED.QLB,,BQLB40.LIB;
     DEL MIXED.LIB
     LIB MIXED.LIB+INTRPT+MOUSE+CASEMAP+CTOOLS1+CTOOLS2;

   NOTE: If you don't have QuickC, remember that you cannot run CDEMO1 and
   CDEMO2; therefore, you must delete +CTOOLS1 and +CTOOLS2 from the above
   commands.

   If you have a problem, the cause might be that the necessary files can't
   be located. Try moving all the files and programs into the current
   directory, including the programs LINK.EXE and LIB.EXE; the QuickBASIC
   library file, BQLB40.LIB; and, if you have Quick C, MLIBCE.LIB.

   Finally, after the MIXED.QLB and MIXED.LIB files are successfully created,
   enter the following lines to create a file named Q.BAT:


     COPY CON Q.BAT
     QB /L MIXED.QLB
     ^Z

   NOTE: The ^Z is obtained by pressing F6 or Ctrl-Z.

   Using this batch file automates the loading process so that MIXED.QLB
   loads along with QuickBASIC. To use it, type Q and press the Enter key at
   the system prompt.

 Using a .MAK File

   Those toolboxes that consist of more than one module require a .MAK file.
   When you save a program consisting of more than one module, QuickBASIC
   automatically creates a .MAK file so that it knows where to locate each
   module the next time it loads the program. If the .MAK file is not
   available, or if you must create a new .MAK file, you must load each
   module from within QuickBASIC by selecting Load File from the File menu,
   selecting the module to load, and then repeating the process for each
   additional module. After loading all the modules, choose Save All from the
   File menu and QuickBASIC creates the new .MAK file. Appendix A lists all
   toolboxes and required .MAK files.


 QuickBASIC vs Executable Files

   You can run the demo modules and utility programs from within the
   QuickBASIC environment by selecting the applicable source-code file, or
   you can compile the code and create files to execute directly from MS-DOS.
   Source-code files are those with the .BAS file extension. Executable files
   are created from .BAS files from within the QuickBASIC environment and are
   saved with a .EXE file extension. All toolbox and utility programs on the
   companion diskettes are .BAS files. The steps necessary for loading and
   running the programs and toolboxes are simple.

 Running Programs from the QuickBASIC Environment

   Check your QuickBASIC manual, "Learning and Using Microsoft QuickBASIC,"
   for starting QuickBASIC on your system. When the program starts, you are
   ready to load and run a demo module or utility program. Using the
   keyboard, the steps are:

   1.  Press the Alt key and then F to display the File menu.

   2.  Press O to choose the Open Program command.

   3.  Select the demo module or program from the list of .BAS files shown.
       If the file is not shown, you must set the path to the drive and
       directory where the file resides. First, type the correct path in the
       File Name box and press Enter to display the .BAS files in that path.
       Then type the name of the file you want to load, or use the Tab key to
       move to the list box and use the arrow keys to select the filename you
       want and press Enter. Filenames are displayed in all lowercase,
       directory names in all uppercase. You can also select directory names,
       including the parent(..) directory, in the list box until the .BAS
       files you want are displayed.

   4.  If command line parameters are required for execution, press Alt and
       then R to pull down the Run menu, and then press C to choose the
       Modify COMMAND$ option. Type the value(s) or input parameter(s)
       separated by spaces in the dialog box provided, and press the Enter
       key. You are now ready to execute the program and can do so by
       pressing Alt-R again and then S (or in this case Enter because the
       option is already highlighted) to choose the Start option.

   NOTE: Each listing contains a USAGE line within the comments to let you
   know when user input is expected and in what format. Parameters might be
   other filenames, numeric values, alphanumeric characters, math functions,
   drive designators, paths to directories and subdirectories, or symbols.
   You can also find parameters in Appendix A.

   5.  If no command line parameters are required, simply press Alt-R and
       then S to start the selected module. (You can also press Shift-F5 to
       start.)

   These steps are basically the same for systems using a mouse device.
   Instead of pressing the Alt key, however, you move the mouse pointer to
   the desired menu names, menu options, and dialog box fields and press the
   left mouse button to make dialog box selections and execute menu commands.

   If you receive no response or the program doesn't seem to work correctly,
   look up the module in Appendix A and check that .MAK files, libraries
   (including MIXED.QLB), color graphics requirements, and so on are resident
   and that the paths to them are properly set.

 Running Programs as Executable Files

   Some of the utility programs, especially those expecting command line
   variable input, are more conveniently run as stand-alone executable files
   (.EXE). If you plan to develop commercial or public domain software, the
   .EXE format is usually preferable.

   Before you can run the toolboxes and utility programs directly from
   MS-DOS, you must first compile a .BAS file or files using a special option
   to create a .EXE file. Two options are available for compiling programs.
   The first option is to compile the source code into a stand-alone .EXE
   file that runs by itself when executed from MS-DOS. The file, however,
   will be quite large, even if it is a simple application or module. The
   second option is to create a .EXE file that requires another file,
   BRUN40.EXE, to be in the same drive and directory at runtime (when you
   execute the program). The resulting compiled program file will be much
   smaller, but BRUN40.EXE must always accompany the executable file.

   To create a stand-alone executable file from within QuickBASIC, follow the
   steps below. Refer to your QuickBASIC manual for instructions on how to
   create other .EXE files from within the QuickBASIC environment or from
   MS-DOS using BC.EXE.

   1.  Load the file using steps 1 through 3 above in "Running Programs from
       the QuickBASIC Environment."

   2.  Press Alt-R to display the Run Menu.

   3.  Press X (Make EXE File).

   4.  Press Alt-A to select the Stand-Alone .EXE File option. (This method
       produces a file with the same filename as the .BAS file but appends
       the .EXE file extension. To change the filename, type over the
       displayed name before pressing Alt-A.)

   5.  Press E to choose the Make EXE and Exit command.

   QuickBASIC then creates the executable file, the QuickBASIC program is
   terminated, and you return to the system prompt. To verify that the file
   exists, type DIR and press Enter, and look for that program's filename
   with a .EXE extension.

   To run the program as a stand-alone .EXE file, type the filename (without
   the .EXE extension) from the system prompt. Type any command line values
   or input parameters after the filename, with spaces between the filename
   and parameters. The program or toolbox module begins executing as soon as
   you press the Enter key.



 ────────────────────────────────────────────────────────────────────────────
 ATTRIB

   The ATTRIB program generates a table showing combinations of text-mode
   character attributes, including all combinations of foreground and
   background colors. Only the blink attribute isn't demonstrated, but it is
   described at the head of the table. Use this program as a utility program.
   Compile it as a stand-alone executable program, and run it to decide what
   colors to use in your own programs.

   The sole purpose of the ATTRIB main program is to call the single
   subprogram, also named Attrib. Actually, the program has only enough
   supporting module-level code to demonstrate the subprogram.

   The Attrib subprogram may be called by other programs, either by loading
   the entire ATTRIB module into memory or by copying only the Attrib
   subprogram into another module. Refer to the MOUSTCRS program for an
   example.


 Program Module: ATTRIB

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ATTRIB                     **
     ' **  Type:          Program                    **
     ' **  Module:        ATTRIB.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Displays all combinations of text mode character
     ' attributes on the screen for review.
     '
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    CGA
     ' .MAK FILE:       (none)
     ' FUNCTIONS:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
       DECLARE SUB Attrib ()

     ' Call the subprogram
       Attrib

     ' All done
       END
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Attrib

   Creates the color attribute table on the screen for the ATTRIB module.
   Sixteen foreground and eight background color attributes are available in
   the default SCREEN 0 text mode, not counting the blink attribute for the
   foreground color. This subprogram displays all 128 combinations in a way
   that makes it easy to see which numbers result in which colors.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Attrib                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        ATTRIB.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Displays table of color attributes for text mode.
     '
     ' EXAMPLE OF USE:  Attrib
     ' PARAMETERS:      (none)
     ' VARIABLES:       bgd%        Background number for COLOR statement
     '                  fgd%        Foreground number for COLOR statement
     ' MODULE LEVEL
     '   DECLARATIONS:              DECLARE SUB Attrib ()
     '
       SUB Attrib STATIC
           SCREEN 0
           CLS
           PRINT "Attributes for the COLOR statement in text mode (SCREEN 0)."
           PRINT "Add 16 to the foreground to cause the character to blink."
           FOR bgd% = 0 TO 7
               COLOR bgd% XOR 7, bgd%
               PRINT
               PRINT "Background%"; STR$(bgd%),
               PRINT "Foreground% ..."; SPACE$(41)
               FOR fgd% = 0 TO 15
                   COLOR fgd%, bgd%
                   PRINT STR$(fgd%); "  ";
               NEXT fgd%
           NEXT bgd%
           COLOR 7, 0
           PRINT
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 BIN2HEX

   The BIN2HEX program is a utility that creates hexadecimal format files
   showing the contents of a given binary file. In this book, its most useful
   purpose is in displaying the contents of .OBJ files created by the
   Microsoft Macro Assembler. This enables you to create the necessary files
   for using the assembly-language routines in this book, even if you don't
   have the Macro Assembler.

   The program reads bytes of the input file using binary mode, converts each
   to a two-character hexadecimal string, and then formats the output by
   blocking the hexadecimal numbers into two groups of eight bytes per line.
   The output file can be listed or printed and can easily be transferred
   over a modem using conventional ASCII protocol.

   The HEX2BIN program performs the opposite function of this program,
   converting a hexadecimal listing back to a binary file.

   You will find several assembly-language subprograms in Part III of this
   book, and Microsoft provides two assembly listings with the QuickBASIC
   language. The suggested method of creating the .OBJ files from these
   listings is to use the Microsoft Macro Assembler, version 5.0. However, if
   you don't have the Macro Assembler, type in the hexadecimal files using
   the QuickBASIC Document editing capability, and then run the HEX2BIN
   program to convert each to the required .OBJ file.

   To use BIN2HEX, type the input filename and output filename on the command
   line when you run the program. For example, to convert MOUSE.OBJ to the
   hexadecimal listing MOUSE.HEX, enter these two command line parameters:


     MOUSE.OBJ MOUSE.HEX

   Be sure to use the full filename, including the extension. Separate
   filenames with spaces, as shown, or with commas if preferred.

   The BIN2HEX program was used to create the hexadecimal listings in
   Appendix D.

   Also review the HEX2BIN program for more information on using these
   routines.


 Program Module: BIN2HEX

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BIN2HEX                    **
     ' **  Type:          Program                    **
     ' **  Module:        BIN2HEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reads in any file and writes out a hexadecimal format file
     ' suitable for rebuilding the original file using the HEX2BIN
     ' program.
     '
     ' USAGE:          BIN2HEX inFileName.ext outFileName.ext
     ' .MAK FILE:      BIN2HEX.BAS
     '                 PARSE.BAS
     ' PARAMETERS:     inFileName    Name of file to be duplicated in hexadeci
     '                               format
     '                 outFileName   Name of hexadecimal format file to be cre
     ' VARIABLES:      cmd$          Working copy of the command line
     '                 inFile$       Name of input file
     '                 outFile$      Name of output file
     '                 byte$         Buffer for binary file access
     '                 i&            Index to each byte of input file
     '                 h$            Pair of hexadecimal characters representi
     '                               each byte

       DECLARE SUB ParseWord (a$, sep$, word$)
     ' Initialization
       CLS
       PRINT "BIN2HEX "; COMMAND$
       PRINT

     ' Get the input and output filenames from the command line
       cmd$ = COMMAND$
       ParseWord cmd$, " ,", inFile$
       ParseWord cmd$, " ,", outFile$

     ' Verify that both filenames were given
       IF outFile$ = "" THEN
           PRINT
           PRINT "Usage: BIN2HEX inFileName outFileName"
           SYSTEM
       END IF

     ' Open the input file
       OPEN inFile$ FOR BINARY AS #1 LEN = 1
       IF LOF(1) = 0 THEN
           CLOSE #1
           KILL inFile$
           PRINT
           PRINT "File not found - "; inFile$
           SYSTEM
       END IF

     ' Open the output file
       OPEN outFile$ FOR OUTPUT AS #2

     ' Process each byte of the file
       byte$ = SPACE$(1)
       FOR i& = 1 TO LOF(1)
           GET #1, , byte$
           h$ = RIGHT$("0" + HEX$(ASC(byte$)), 2)
           PRINT #2, h$; SPACE$(1);
           IF i& = LOF(1) THEN
               PRINT #2, ""
           ELSEIF i& MOD 16 = 0 THEN
               PRINT #2, ""
           ELSEIF i& MOD 8 = 0 THEN
               PRINT #2, "- ";
           END IF
       NEXT i&

     ' Clean up and quit
       CLOSE
       END
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 BIOSCALL

   The BIOSCALL toolbox provides a collection of utility BIOS system calls.

   Several useful routines and data tables are in your computer's BIOS ROM
   (Basic Input/Output Services, Read Only Memory), ready to be tapped into
   by your QuickBASIC programs. This toolbox of routines provides a sampler
   of the most useful interrupt calls that return the information provided by
   BIOS. With QuickBASIC, it's easy to access the BIOS ROM.

   The module-level code provides demonstrations of the available subprograms
   when BIOSCALL is the designated main program. Later, load the BIOSCALL
   module along with any program you're developing when you need any
   information provided by the subprograms.

   Be aware that whenever you use the BIOSCALL toolbox, the mixed-language
   subprograms Interrupt and InterruptX must be accessible. Refer to "Using
   QuickBASIC Toolboxes" on page 21 for instructions on creating and loading
   the Quick Library MIXED.QLB with the QuickBASIC system.

   The Scroll subprogram, demonstrated first, prints a block of fifteen
   lines of uppercase characters on the screen. The first line is filled with
   As, the second with Bs, and so on. Each line is also printed in a
   different color scheme to make it easier to see exactly which characters
   are scrolled. The Scroll subprogram scrolls the rectangular area (from
   row 2, column 3 to row 6, column 16) up 3 lines. The attribute byte is set
   to green foreground on blue background, the same as the attribute byte at
   row 2, column 3. Study the displayed result, and notice that the lines
   moved up three rows and that the three blank lines show the blue
   background.

   The Equipment subprogram determines the computer equipment settings as
   maintained by BIOS. A short table is displayed, listing the availability
   or count of the printers, the game adapter, the serial I/O ports, the
   floppy disk drives, and the math coprocessor. Also displayed is the
   initial video state at boot-up time.

   VideoState, the next subprogram demonstrated, determines the current
   video state. The current video mode, number of text columns, and current
   active video page are displayed. Finally, GetShiftStates displays a table
   of the shift keys and shift states. This table is continuously updated
   until you press the Enter key, allowing you to try out the various shift
   keys. For example, press the left and right shift keys, singly or
   together, and notice how the state of each is monitored independently.

   In the demo module, two subprograms, PrintScreen and ReBoot, are
   commented out, as the actions they take are a bit extreme. To demo these
   subprograms, remove the apostrophes in front of these statements, which
   you'll find near the end of the module-level code. Don't forget that once
   you reboot, everything currently in memory is erased, and you'll be
   starting fresh.

   For more information on the available BIOS calls, refer to the technical
   reference manual for your computer.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   BIOSCALL.BAS                    Demo module
   Equipment               Sub     Equipment/hardware information
   GetShiftStates          Sub     Shift key states
   PrintScreen             Sub     Screen dump
   ReBoot                  Sub     System reboot
   Scroll                  Sub     Moves text in designated area of screen
   VideoState              Sub     Mode, col, and page display of current
                                    state
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: BIOSCALL

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BIOSCALL                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        BIOSCALL.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates several interrupt calls to the ROM BIOS.
     '
     ' USAGE: No command line parameters
     ' REQUIREMENTS:    MIXED.QLB/.LIB
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       i%         Loop index for creating lines to scroll
     '                  equip      Structure of type EquipmentType
     '                  mode%      Video mode returned by VideoState
     '                  columns%   Video columns returned by VideoState
     '                  page%      Video page returned by VideoState
     '                  shift      Structure of type ShiftType


     ' Constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Declare the Type structures
       TYPE RegType
           ax    AS INTEGER
           bx    AS INTEGER
           cx    AS INTEGER
           dx    AS INTEGER
           Bp    AS INTEGER
           si    AS INTEGER
           di    AS INTEGER
           flags AS INTEGER
       END TYPE

       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 EquipmentType
           printers     AS INTEGER
           gameAdapter  AS INTEGER
           serial       AS INTEGER
           floppies     AS INTEGER
           initialVideo AS INTEGER
           coprocessor  AS INTEGER
       END TYPE

       TYPE ShiftType
           right           AS INTEGER
           left            AS INTEGER
           ctrl            AS INTEGER
           alt             AS INTEGER
           scrollLockState AS INTEGER
           numLockState    AS INTEGER
           capsLockState   AS INTEGER
           insertState     AS INTEGER
       END TYPE

       DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegType)
       DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)
       DECLARE SUB PrintScreen ()
       DECLARE SUB Scroll (row1%, col1%, row2%, col2%, lines%, attribute%)
       DECLARE SUB Equipment (equip AS EquipmentType)
       DECLARE SUB VideoState (mode%, columns%, page%)
       DECLARE SUB GetShiftStates (shift AS ShiftType)
       DECLARE SUB ReBoot ()

     ' Demonstrate the Scroll subprogram
       CLS
       FOR i% = 1 TO 15
           COLOR i%, i% - 1
           PRINT STRING$(25, i% + 64)
       NEXT i%
       COLOR 7, 0
       PRINT
       PRINT "Press <Enter> to scroll part of the screen"
       DO
       LOOP UNTIL INKEY$ = CHR$(13)
       Scroll 2, 3, 6, 16, 3, SCREEN(2, 3, 1)

     ' Wait for user before continuing
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""
       CLS

     ' Determine the equipment information
       DIM equip AS EquipmentType
       Equipment equip
       PRINT "Printers:", equip.printers
       PRINT "Game adapter:", equip.gameAdapter
       PRINT "Serial IO:", equip.serial
       PRINT "Floppies:", equip.floppies
       PRINT "Video:", equip.initialVideo
       PRINT "Coprocessor:", equip.coprocessor

     ' Determine the current video state
       PRINT
       VideoState mode%, columns%, page%
       PRINT "Video mode:", mode%
       PRINT "Text columns:", columns%
       PRINT "Video page:", page%

     ' Wait for user before continuing
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""

     ' Demonstrate the shift key states
       CLS
       PRINT "(Press shift keys, then <Enter> to continue...)"
       DIM shift AS ShiftType
       DO
           LOCATE 4, 1
           PRINT "Shift states:"
           GetShiftStates shift
           PRINT
           PRINT "Left shift:", shift.left
           PRINT "Right shift:", shift.right
           PRINT "Ctrl:", shift.ctrl
           PRINT "Alt:", shift.alt
           PRINT "Scroll Lock:", shift.scrollLockState
           PRINT "Num Lock:", shift.numLockState
           PRINT "Caps Lock:", shift.capsLockState
           PRINT "Insert:", shift.insertState
       LOOP UNTIL INKEY$ = CHR$(13)

     ' Uncomment the following line to cause a screen dump to printer....
     ' PrintScreen

     ' Uncomment the following line only if you want to reboot....
     ' ReBoot

       END
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Equipment

   Returns information about the available computer hardware by calling the
   BIOS service at interrupt 11H, which returns bit patterns indicating the
   equipment configuration. The definition of the data structure named
   EquipmentType lists the items that this call can determine.

   This subprogram allows your program to decide how to handle input and
   output chores. As one example, the user can be prompted to Remove the
   first disk and insert the second or to Insert the second disk in drive B,
   depending on whether the computer has one or two floppy disk drives
   available.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Equipment                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BIOSCALL.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns equipment configuration information from BIOS.
     '
     ' EXAMPLE OF USE:  Equipment equip
     ' PARAMETERS:      equip      Structure of type EquipmentType
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     Bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '                  TYPE EquipmentType
     '                     printers     AS INTEGER
     '                     gameAdapter  AS INTEGER
     '                     serial       AS INTEGER
     '                     floppies     AS INTEGER
     '                     initialVideo AS INTEGER
     '                     coprocessor  AS INTEGER
     '                  END TYPE
     '     DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegType
     '     DECLARE SUB Equipment (equip AS EquipmentType)
     '
        SUB Equipment (equip AS EquipmentType) STATIC
           DIM reg AS RegType
           Interrupt &H11, reg, reg
           equip.printers = (reg.ax AND &HC000&) \ 16384
           equip.gameAdapter = (reg.ax AND &H1000) \ 4096
           equip.serial = (reg.ax AND &HE00) \ 512
           equip.floppies = (reg.ax AND &HC0) \ 64 + 1
           equip.initialVideo = (reg.ax AND &H30) \ 16
           equip.coprocessor = (reg.ax AND 2) \ 2
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: GetShiftStates

   Returns the state of each shift key at the moment the subprogram is called
   and the current shift key states.

   The left Shift, right Shift, Ctrl, and Alt keys return a 1 in the
   appropriate structure variables if they are pressed at the moment this
   subprogram is called. If not pressed, a 0 is returned instead.

   This subprogram can also monitor the four shift states. If active, the
   Scroll Lock, Num Lock, Caps Lock, and Insert states return a value of 1 in
   the appropriate variable. If your keyboard has lights indicating the
   current states of these shift keys, this subprogram returns a 1 whenever a
   light is on and a 0 when the light is off.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetShiftStates             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BIOSCALL.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns state of the various shift keys.
     '
     ' EXAMPLE OF USE:  GetShiftStates shift
     ' PARAMETERS:      shift      Structure of type ShiftType
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     Bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '                  TYPE ShiftType
     '                     right           AS INTEGER
     '                     left            AS INTEGER
     '                     ctrl            AS INTEGER
     '                     alt             AS INTEGER
     '                     scrollLockState AS INTEGER
     '                     numLockState    AS INTEGER
     '                     capsLockState   AS INTEGER
     '                     insertState     AS INTEGER
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB GetShiftStates (shift AS ShiftType)
     '
       SUB GetShiftStates (shift AS ShiftType) STATIC
           DIM reg AS RegType
           reg.ax = &H200
           Interrupt &H16, reg, reg
           shift.right = reg.ax AND 1
           shift.left = (reg.ax AND 2) \ 2
           shift.ctrl = (reg.ax AND 4) \ 4
           shift.alt = (reg.ax AND 8) \ 8
           shift.scrollLockState = (reg.ax AND 16) \ 16
           shift.numLockState = (reg.ax AND 32) \ 32
           shift.capsLockState = (reg.ax AND 64) \ 64
           shift.insertState = (reg.ax AND 128) \ 128
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: PrintScreen

   Performs exactly the same screen-to-printer dump that occurs when the
   Shift-Print Screen keys are pressed.

   Whenever you press the Shift-Print Screen keys, the operating system
   performs an interrupt 5 to activate the BIOS-level code for performing the
   screen dump. With the PrintScreen subprogram, you can program such a
   screen dump at any point in the operation of a running program without
   requiring user intervention.

   Because the screen dump BIOS routine is interrupt driven, any changes to
   the screen dump code are automatically taken into account. For example, if
   your computer loads and patches in an improved version of the screen dump
   at boot-up time, this subprogram activates the new routine with no
   problem. That's one of the nice features of the interrupt mechanism
   provided by the 8086 family of computers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          PrintScreen                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BIOSCALL.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Activates interrupt 5 to cause a dump of the
     ' screen's contents to the printer.
     '
     ' EXAMPLE OF USE:  PrintScreen
     ' PARAMETERS:      (none)
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     Bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB PrintScreen ()
     '
       SUB PrintScreen STATIC
           DIM reg AS RegType
           Interrupt 5, reg, reg
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ReBoot

   Causes the system to reboot. Depending on the computer and its
   configuration, this reboot won't always work perfectly. Be sure to test
   the subprogram carefully for your specific circumstances if you plan to
   use it on a routine basis.

   Perhaps the best and safest use for this subprogram is as an escape route
   for unauthorized access to software, because rebooting can frustrate
   attempts to overcome copy protection schemes. For example, try rebooting
   after a user fails a password check for the third time or if an
   unauthorized copy of a program is detected.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ReBoot                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BIOSCALL.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Causes the computer to reboot.
     '
     ' EXAMPLE OF USE:  ReBoot
     ' PARAMETERS:      (none)
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     Bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB ReBoot ()
     '
       SUB ReBoot STATIC
           DIM reg AS RegType
           Interrupt &H19, reg, reg
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Scroll

   Provides a quick scroll of text lines in a rectangular area of the
   display. The BIOS video interrupt 10H is set up to scroll. You place the
   correct parameters in the processor registers, and the BIOS code does the
   rest.

   Six parameters are passed to this subprogram. The first four define the
   upper left and lower right corners of the area to be scrolled. These
   coordinates refer to text-mode character locations, with the upper left
   corner of the screen defined as row 1, column 1. The lower right corner of
   the screen is defined as row 25, column 80 for 80-column text mode, or row
   25, column 40 for 40-column text mode.

   The last two parameters provide the line count and the color attribute. If
   the line count is a positive number, the lines scroll up by the indicated
   number of rows, leaving blank lines at the bottom of the scrolled area. If
   the line count is negative, the lines scroll down. The blank lines are
   filled with space characters, and the color attribute is set by the
   attribute byte passed in the sixth parameter.

   Usually this subprogram is used to scroll text one line at a time, such as
   when displaying the contents of a long file using the MS-DOS TYPE command.
   A handy feature is the subprogram's ability to completely clear any or all
   of the screen, setting the background color at the same time. To do this,
   pass a line count of 0. The BIOS routine will fill the entire rectangular
   area with spaces, much faster than if you were to PRINT the same number of
   space strings.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Scroll                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BIOSCALL.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Scrolls the screen in the rectangular area defined
     ' by the row and col parameters.  Positive line count
     ' moves the lines up, leaving blank lines at bottom;
     ' negative line count moves the lines down.
     '
     ' EXAMPLE OF USE:  Scroll row1%, col1%, row2%, col2%, lines%, attr%
     ' PARAMETERS:      row1%    Upper left character row defining rectangular
     '                           scroll area
     '                  col1     Upper left character column defining rectangu
     '                           scroll area
     '                  row2%    Lower right character row defining rectangula
     '                           scroll area
     '                  col2%    Lower right character column defining
     '                           rectangular scroll area
     '                  lines%   Number of character lines to scroll
     '                  attr%    Color attribute byte to be used in new text
     '                           lines scrolled onto the screen
     ' VARIABLES:       reg      Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     Bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB Scroll (row1%, col1%, row2%, col2%, lines%, attribute%
     '
       SUB Scroll (row1%, col1%, row2%, col2%, lines%, attribute%) STATIC
           DIM reg AS RegType
           IF lines% > 0 THEN
               reg.ax = &H600 + lines% MOD 256
           ELSE
               reg.ax = &H700 + ABS(lines%) MOD 256
           END IF
           reg.bx = (attribute% * 256&) AND &HFF00
           reg.cx = (row1% - 1) * 256 + col1% - 1
           reg.dx = (row2% - 1) * 256 + col2% - 1
           Interrupt &H10, reg, reg
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: VideoState

   Returns the current mode, the number of columns, and the page of the
   display.

   This subprogram returns information about the current video mode. The
   mode% parameter returned by the ROM BIOS is different from the number used
   in the SCREEN statement to set a video mode. The two parameters do
   correlate, however, and the following table provides a useful comparison:

   SCREEN Mode    WIDTH          Mode% (from VideoState)
   ──────────────────────────────────────────────────────────────────────────
    0             40              1
    0             80              3
    1             40              4
    2             80              6
    7             40             13
    8             80             14
    9             80             16
   10             80             15
   11             80             17
   12             80             18
   13             40             19
   ──────────────────────────────────────────────────────────────────────────

   The column% parameter is always 40 or 80, depending on the current SCREEN
   and WIDTH settings.

   The page% parameter is the currently active page number as set by the
   SCREEN statement. The default is page 0, and the maximum active page
   number is a function of the current screen mode. See the SCREEN statement
   in your QuickBASIC documentation for more information about active and
   virtual pages as set by the SCREEN statement.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          VideoState                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BIOSCALL.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Determines the current video mode parameters.
     '
     ' EXAMPLE OF USE:  VideoState mode%, columns%, page%
     ' PARAMETERS:      mode%      Current video mode
     '                  columns%   Current number of text columns
     '                  page%      Current active display page
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     Bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB VideoState (mode%, columns%, page%)
     '
       SUB VideoState (mode%, columns%, page%) STATIC
           DIM reg AS RegType
           reg.ax = &HF00
           Interrupt &H10, reg, reg
           mode% = reg.ax AND &HFF
           columns% = (CLNG(reg.ax) AND &HFF00) \ 256
           page% = (CLNG(reg.bx) AND &HFF00) \ 256
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 BITS

   The BITS toolbox provides four bit manipulation routines. The
   Bin2BinStr$ and BinStr2Bin% functions convert integer numbers to and
   from binary string representations. This action is similar to that of the
   QuickBASIC HEX$, OCT$, and VAL functions, except that the conversions deal
   with base 2 representations.

   The BitGet and BitPut subprograms let you store and retrieve single bits
   from any location in any string. Up to 32767 bits can be accessed in a
   single string, which results in a string of 4096 bytes. These subprograms
   would be useful for data acquisition and process control applications
   involving a large number of contact closures. The famous sieve of
   Eratosthenes for finding prime numbers is used to demonstrate these two
   subprograms. Prime numbers from 1 through 1000 are found and printed by
   keeping track of a string of bits, each representing an integer from 1
   through 1000.

   You can change the value of max% in this demonstration to find prime
   numbers up to about 10937. Larger values of max% will cause overflow, but
   by reprogramming the variables involved, you can probably find even bigger
   primes.

   Name                 Type       Description
   ──────────────────────────────────────────────────────────────────────────
   BITS.BAS                       Demo module
   Bin2BinStr$         Func       Integer to 16-character binary string
   BinStr2Bin%         Func       16-character binary string to integer
   BitGet              Sub        Value from any bit position in a string
   BitPut              Sub        Sets or clears bit at location in a string
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: BITS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BITS                       **
     ' **  Type:          Toolbox                    **
     ' **  Module:        BITS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates the bit manipulation functions
     ' and subprograms.
     '
     ' USAGE: No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       max%       Upper limit for the prime number generator
     '                  b$         Bit string for finding prime numbers
     '                  n%         Loop index for sieve of Eratosthenes
     '                  bit%       Bit retrieved from b$
     '                  i%         Bit loop index
     '                  q$         The double quote character

       DECLARE FUNCTION BinStr2Bin% (b$)
       DECLARE FUNCTION Bin2BinStr$ (b%)

     ' Subprograms
       DECLARE SUB BitGet (a$, bitIndex%, bit%)
       DECLARE SUB BitPut (b$, bitIndex%, bit%)

     ' Prime numbers less than max%, using bit fields in B$
       CLS
       max% = 1000
       PRINT "Primes up to"; max%; "using BitGet and BitPut for sieve..."
       PRINT
       PRINT 1; 2;
       b$ = STRING$(max% \ 8 + 1, 0)
       FOR n% = 3 TO max% STEP 2
           BitGet b$, n%, bit%
           IF bit% = 0 THEN
               PRINT n%;
               FOR i% = 3 * n% TO max% STEP n% + n%
                   BitPut b$, i%, 1
               NEXT i%
           END IF
       NEXT n%
       PRINT

     ' Demonstration of the Bin2BinStr$ function
       PRINT
       PRINT "Bin2BinStr$(12345) = "; Bin2BinStr$(12345)

     ' Demonstration of the BinStr2Bin% function
       PRINT
       q$ = CHR$(34)
       PRINT "BinStr2Bin%("; q$; "1001011"; q$; ") = ";
       PRINT BinStr2Bin%("1001011")

     ' That's all
       END
   ──────────────────────────────────────────────────────────────────────────


 Function: Bin2BinStr$

   Returns a 16-character binary representation of an integer value. This
   function is similar to QuickBASIC's HEX$ and OCT$ functions, except that
   the conversion base is 2 instead of 16 or 8, and that 16 characters are
   always returned. For example, Bin2BinStr$(7) returns 0000000000000111, and
   Bin2BinStr$(-1) returns 1111111111111111.

   You can easily remove leading zeros in the 16-character string by using
   the LtrimSet$ function, as shown in the STRINGS module:


     bin$ = LtrimSet$(bin$, "0")

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Bin2BinStr$                **
     ' **  Type:          Function                   **
     ' **  Module:        BITS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string of sixteen "0" and "1" characters
     ' that represent the binary value of b%.
     '
     ' EXAMPLE OF USE:  PRINT Bin2BinStr$(b%)
     ' PARAMETERS:      b%         Integer number
     ' VARIABLES:       t$         Working string space for forming
                                                 binary string
     '                  b%         Integer number
     '                  mask%      Bit isolation mask
     '                  i%         Looping index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Bin2BinStr$ (b%)
     '
       FUNCTION Bin2BinStr$ (b%) STATIC
           t$ = STRING$(16, "0")
           IF b% THEN
               IF b% < 0 THEN
                   MID$(t$, 1, 1) = "1"
               END IF
               mask% = &H4000
               FOR i% = 2 TO 16
                   IF b% AND mask% THEN
                       MID$(t$, i%, 1) = "1"
                   END IF
                   mask% = mask% \ 2
               NEXT i%
           END IF
           Bin2BinStr$ = t$
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: BinStr2Bin%

   Returns the integer represented by a string of up to 16 0s and 1s. For
   example, BinStr2Bin%("111") returns 7; BinStr2Bin%("000101") returns 5.

   If the string has more than 16 characters, only the rightmost 16 are used.
   Any character other than 1 is treated as 0.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BinStr2Bin%                **
     ' **  Type:          Function                   **
     ' **  Module:        BITS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the integer represented by a string of up
     ' to 16 "0" and "1" characters.
     '
     ' EXAMPLE OF USE:  PRINT BinStr2Bin%(b$)
     ' PARAMETERS:      b$         Binary representation string
     ' VARIABLES:       bin%       Working variable for finding value
     '                  t$         Working copy of b$
     '                  mask%      Bit mask for forming value
     '                  i%         Looping index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION BinStr2Bin% (b$)
     '
       FUNCTION BinStr2Bin% (b$) STATIC
           bin% = 0
           t$ = RIGHT$(STRING$(16, "0") + b$, 16)
           IF LEFT$(t$, 1) = "1" THEN
               bin% = &H8000
           END IF
           mask% = &H4000
           FOR i% = 2 TO 16
               IF MID$(t$, i%, 1) = "1" THEN
                   bin% = bin% OR mask%
               END IF
               mask% = mask% \ 2
           NEXT i%
           BinStr2Bin% = bin%
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: BitGet

   Returns a bit value extracted from any bit position in a string. The bits
   are numbered consecutively, starting with bit 1 in the most significant
   bit position of the first byte of the string. Bit 8 is the least
   significant bit of this same byte, bit 9 is the most significant bit of
   the second byte, and so on. This subprogram can access up to 32767 bits,
   in which case the string must be 4096 bytes in length. For example:



     a$ = "A B C"    0 1 0 0 0 0 0 1   0 1 0 0 0 0 1 0   0 1 0 0 0 0 1 1

     BitGet (a$, 17, bit%) ... bit% = 0
     BitGet (a$, 18, bit%) ... bit% = 1

   The BitPut subprogram lets you set the bits in a string as desired.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BitGet                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BITS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Extracts the bit at bitIndex% into a$ and returns
     ' either 0 or 1 in bit%.  The value of bitIndex%
     ' can range from 1 to 8 * LEN(a$).
     '
     ' EXAMPLE OF USE:  BitGet a$, bitIndex%, bit%
     ' PARAMETERS:      a$         String where bit is stored
     '                  bitIndex%  Bit position in string
     '                  bit%       Extracted bit value, 0 or 1
     ' VARIABLES:       byte%      Byte location in string of the bit
     '                  mask%      Bit isolation mask for given bit
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB BitGet (a$, bitIndex%, bit%)
     '
        SUB BitGet (a$, bitIndex%, bit%) STATIC
           byte% = (bitIndex% - 1) \ 8 + 1
           SELECT CASE bitIndex% MOD 8
           CASE 1
               mask% = 128
           CASE 2
               mask% = 64
           CASE 3
               mask% = 32
           CASE 4
               mask% = 16
           CASE 5
               mask% = 8
           CASE 6
               mask% = 4
           CASE 7
               mask% = 2
           CASE 0
               mask% = 1
           END SELECT
           IF ASC(MID$(a$, byte%, 1)) AND mask% THEN
               bit% = 1
           ELSE
               bit% = 0
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: BitPut

   Sets or clears a single bit at any bit location in a string. The string
   can be up to 4096 bytes in length, allowing access of up to 32767 bits.
   Bits are numbered from left to right; the most significant bit of the
   first byte is bit 1, the least significant bit of the first byte is bit 8,
   the most significant bit of the second byte is bit 9, and so on. You can
   use the BitGet subprogram to get the bit values from the string as
   necessary. To initialize a string to all zeros or ones, use the STRING$
   function. For example, STRING$(4096, 0) returns a string of 32767 cleared
   bits, and STRING$(4096, 255) returns a string of 32767 set bits.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BitPut                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        BITS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' If bit% is non-zero, then the bit at bitIndex% into
     ' a$ is set to 1; otherwise, it's set to 0. The value
     ' of bitIndex% can range from 1 to 8 * LEN(a$).
     '
     ' EXAMPLE OF USE:  BitPut a$, bitIndex%, bit%
     ' PARAMETERS:      a$         String containing the bits
     '                  bitIndex%  Index to the bit of concern
     '                  bit%       Value of bit (1 to set, 0 to clear)
     ' VARIABLES:       bytePtr%   Pointer to the byte position in the string
     '                  mask%      Bit isolation mask
     '                  byteNow%   Current numeric value of string byte
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB BitPut (b$, bitIndex%, bit%)
     '
       SUB BitPut (a$, bitIndex%, bit%) STATIC
           bytePtr% = bitIndex% \ 8 + 1
           SELECT CASE bitIndex% MOD 8
           CASE 1
               mask% = 128
           CASE 2
               mask% = 64
           CASE 3
               mask% = 32
           CASE 4
               mask% = 16
           CASE 5
               mask% = 8
           CASE 6
               mask% = 4
           CASE 7
               mask% = 2
           CASE 0
               mask% = 1
               bytePtr% = bytePtr% - 1
           END SELECT
           byteNow% = ASC(MID$(a$, bytePtr%, 1))
           IF byteNow% AND mask% THEN
               IF bit% = 0 THEN
                   MID$(a$, bytePtr%, 1) = CHR$(byteNow% XOR mask%)
               END IF
           ELSE
               IF bit% THEN
                   MID$(a$, bytePtr%, 1) = CHR$(byteNow% XOR mask%)
               END IF
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 CALENDAR

   The CALENDAR toolbox is a collection of easy-to-use functions and
   subprograms for date and time conversions and calculations. See the
   MONTH program for an example of how this module can be loaded as a
   toolbox for use by another main program.

   Wherever possible, dates and times are passed in a string format identical
   to that used by the QuickBASIC DATE$ and TIME$ functions. This makes the
   required parameters easier to remember and makes it possible to define
   many of the routines as functions that would otherwise have to be defined
   as subprograms. For example, the Julian2Date$ function returns a date in
   the string format mentioned. Alternative approaches would require defining
   three functions (one for returning the year, one for the month, and one
   for the day) or defining a subprogram that returned the three numbers in
   the parameter list. Returning dates in this string format also eliminates
   output numeric formatting because the string is ready to be printed as is.

   The Julian day number is an astronomical convention that allows dates to
   be cataloged by a single, large integer. A useful feature of the Julian
   day number is that a simple subtraction can calculate the number of days
   between any two dates. Leap years and the strange pattern of days in the
   various months make this calculation difficult when dealing with the usual
   month, day, and year numbers. The Date2Julian& and Julian2Date$
   conversion functions take care of all the details for you, making calendar
   calculations a breeze. Other functions return the day of the week, day of
   the year, day of the century, name of each month, and other related
   details──just about everything you ever wanted to know, but were afraid to
   ask, about dates and time.

   The calculations are usually accurate for dates from 1583 to the
   indefinite future, although some functions generate errors for dates
   between 1583 and 1599 if the calculations involve earlier dates. For
   example, consider how the DayOfTheCentury& function would attempt to
   calculate the day of the century for July 4, 1599. First, the function
   calculates the Julian day number for 07-04-1599 and then it attempts to
   subtract from that the Julian day number for the last day of the previous
   century. Because 12-31-1499 is earlier than 1583, the function will not
   work correctly.

╓┌─┌─────────────────────────────┌─────────────┌─────────────────────────────╖
   Name                          Type          Description
   ──────────────────────────────────────────────────────────────────────────
   CALENDAR.BAS                               Demo module
   CheckDate%                   Func          Validates date with return of
                                               TRUE/FALSE
   Date2Day%                    Func          Day of month number from date
                                               string
   Date2Julian&                 Func          Julian day number for a given
   Name                          Type          Description
   ──────────────────────────────────────────────────────────────────────────
  Date2Julian&                 Func          Julian day number for a given
                                               date
   Date2Month%                  Func          Month number from date string
   Date2Year%                   Func          Year number from date string
   DayOfTheCentury&             Func          Day of the given century
   DayOfTheWeek$                Func          Name of day of the week for
                                               given date
   DayOfTheYear%                Func          Day of the year (1 through
                                               366) for given date
   DaysBetweenDates&            Func          Number of days between two
                                               dates
   HMS2Time$                    Func          Time string for given hour,
                                               minute, and second
   Julian2Date$                 Func          Date string from given Julian
                                               day number
   MDY2Date$                    Func          Date string from given month,
                                               day, and year
   MonthName$                   Func          Name of month for a given date
   OneMonthCalendar             Sub           One-month calendar for given
   Name                          Type          Description
   ──────────────────────────────────────────────────────────────────────────
  OneMonthCalendar             Sub           One-month calendar for given
                                               date
   Second2Date$                 Func          Seconds from last of 1979 to
                                               date given
   Second2Time$                 Func          Time of day from seconds since
                                               last of 1979
   Time2Hour%                   Func          Hour number from time string
   Time2Minute%                 Func          Minute number from time string
   Time2Second%                 Func          Seconds number from time
                                               string
   TimeDate2Second&             Func          Seconds from last of 1979 from
                                               date/time
   ──────────────────────────────────────────────────────────────────────────



 Demo Module: CALENDAR

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CALENDAR                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE: No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       month%     Month for demonstration
     '                  day%       Day for demonstration
     '                  year%      Year for demonstration
     '                  dat$       Date for demonstration
     '                  j&         Julian day number
     '                  tim$       System time right now
     '                  hour%      Hour right now
     '                  minute%    Minute right now
     '                  second%    Second right now
     '                  sec&       Seconds since last second of 1979


       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Functions
       DECLARE FUNCTION CheckDate% (dat$)
       DECLARE FUNCTION Date2Day% (dat$)
       DECLARE FUNCTION Date2Julian& (dat$)
       DECLARE FUNCTION Date2Month% (dat$)
       DECLARE FUNCTION Date2Year% (dat$)
       DECLARE FUNCTION DayOfTheCentury& (dat$)
       DECLARE FUNCTION DayOfTheWeek$ (dat$)
       DECLARE FUNCTION DayOfTheYear% (dat$)
       DECLARE FUNCTION DaysBetweenDates& (dat1$, dat2$)
       DECLARE FUNCTION HMS2Time$ (hour%, minute%, second%)
       DECLARE FUNCTION Julian2Date$ (julian&)
       DECLARE FUNCTION MDY2Date$ (month%, day%, year%)
       DECLARE FUNCTION MonthName$ (dat$)
       DECLARE FUNCTION Second2Date$ (second&)
       DECLARE FUNCTION Second2Time$ (second&)
       DECLARE FUNCTION Time2Hour% (tim$)
       DECLARE FUNCTION Time2Minute% (tim$)
       DECLARE FUNCTION Time2Second% (tim$)
       DECLARE FUNCTION TimeDate2Second& (tim$, dat$)

     ' Subprograms
       DECLARE SUB OneMonthCalendar (dat$, row%, col%)

     ' Let's choose the fourth of July for the demonstration
       CLS
       PRINT "All about the fourth of July for this year..."
       month% = 7
       day% = 4
       year% = Date2Year%(DATE$)

     ' Demonstrate the conversion to dat$
       PRINT
       dat$ = MDY2Date$(month%, day%, year%)
       PRINT "QuickBASIC string format for this date is "; dat$

     ' Check the validity of this date
       IF CheckDate%(dat$) = FALSE THEN
           PRINT "The date you entered is faulty... " + dat$
           SYSTEM
       END IF

     ' Day of the week and name of the month
       PRINT "The day of the week is "; DayOfTheWeek$(dat$); "."

     ' Astronomical Julian day number
       j& = Date2Julian&(dat$)
       PRINT "The Julian day number is"; j&

     ' Conversion of Julian number to date
       PRINT "Date for the given Julian number is "; Julian2Date$(j&); "."

     ' Convert the date string to numbers
       PRINT "The month, day, and year numbers are ";
       PRINT Date2Month%(dat$); ","; Date2Day%(dat$); ","; Date2Year%(dat$)

     ' The month name
       PRINT "The month name is "; MonthName$(dat$)

     ' Day of the year
       PRINT "The day of the year is"; DayOfTheYear%(dat$)

     ' Day of the century
       PRINT "The day of the century is"; DayOfTheCentury&(dat$)

     ' Days from right now
       IF Date2Julian&(dat$) < Date2Julian&(DATE$) THEN
           PRINT "That was"; DaysBetweenDates&(dat$, DATE$); "days ago."
       ELSEIF Date2Julian&(dat$) > Date2Julian&(DATE$) THEN
           PRINT "That is"; DaysBetweenDates&(dat$, DATE$); "days from now."
       ELSE
           PRINT "The date you entered is today's date."
       END IF

     ' Print a one-month calendar
       OneMonthCalendar dat$, 14, 25

     ' Wait for user
       LOCATE 23, 1
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""
       CLS

     ' Demonstrate extracting hour, minute, and second from tim$
       dat$ = DATE$
       tim$ = TIME$
       hour% = Time2Hour%(tim$)
       minute% = Time2Minute%(tim$)
       second% = Time2Second%(tim$)
       PRINT "The date today... "; dat$
       PRINT "The time now  ... "; tim$
       PRINT "The hour, minute, and second numbers are ";
       PRINT hour%; ","; minute%; ","; second%

     ' Now put it all back together again
       PRINT "Time string created from hour, minute, and second is ";
       PRINT HMS2Time$(hour%, minute%, second%)

     ' Seconds since end of 1979
       dat$ = DATE$
       PRINT "The number of seconds since the last second of 1979 is";
       sec& = TimeDate2Second&(tim$, dat$)
       PRINT sec&
       PRINT "From this number we can extract the date and time..."
       PRINT Second2Date$(sec&); " and "; Second2Time$(sec&); "."
   ──────────────────────────────────────────────────────────────────────────


 Function: CheckDate%

   Returns TRUE if date is valid or FALSE if date is faulty.

   Was February 29, 1726, a real date? The CheckDate% function quickly finds
   the answer to this question. If the date checks out as valid, a value of
   TRUE (non-zero) is returned. If the date is faulty, a value of FALSE (0)
   is returned.

   This function is useful in any program that prompts the user to enter a
   date. A quick check can be made of the entered date, and the user can be
   asked to repeat the input if the entered date is faulty.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CheckDate%                 **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns TRUE if the given date represents a real
     ' date or FALSE if the date is in error.
     '
     ' EXAMPLE OF USE:  test% = CheckDate%(dat$)
     ' PARAMETERS:      dat$       Date to be checked
     ' VARIABLES:       julian&    Julian day number for the date
     '                  test$      Date string for given Julian day number
     ' MODULE LEVEL
     '   DECLARATIONS:  CONST FALSE = 0
     '                  CONST TRUE = NOT FALSE
     '
     '                  DECLARE FUNCTION CheckDate% (dat$)
     '                  DECLARE FUNCTION Date2Julian& (dat$)
     '                  DECLARE FUNCTION Julian2Date$ (julian&)
     '
       FUNCTION CheckDate% (dat$) STATIC
           julian& = Date2Julian&(dat$)
           test$ = Julian2Date$(julian&)
           IF dat$ = test$ THEN
               CheckDate% = TRUE
           ELSE
               CheckDate% = FALSE
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Date2Day%

   Extracts the day number from a date string that is in the standard format
   MM-DD-YYYY.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Date2Day%                  **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the day number given a date in the
     ' QuickBASIC string format MM-DD-YYYY.
     '
     ' EXAMPLE OF USE:  day% = Date2Day%(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Date2Day% (dat$)
     '
       FUNCTION Date2Day% (dat$) STATIC
           Date2Day% = VAL(MID$(dat$, 4, 2))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Date2Julian&

   Returns the Julian day number for a given date. This function and the
   related function Julian2Date$ are at the heart of many of the other
   functions in this toolbox. This function calculates the astronomical
   Julian day number for any date from January 1, 1583, into the indefinite
   future, accounting for leap years and century adjustments.

   The main advantage of converting dates to long integer numbers is in being
   able to easily calculate the number of days between dates and the day of
   the week for any date. Further, if you need to store a large number of
   dates in a disk file, storing them as four-byte, long integers is more
   efficient than storing them in the longer string format or as separate
   integers representing the month, day, and year.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Date2Julian&               **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the astronomical Julian day number given a
     ' date in the QuickBASIC string format MM-DD-YYYY.
     '
     ' EXAMPLE OF USE:  j& = Date2Julian&(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       month%     Month number for given date
     '                  day%       Day number for given date
     '                  year%      Year number for given date
     '                  ta&        First term of the Julian day number calcula
     '                  tb&        Second term of the Julian day number calcul
     '                  tc&        Third term of the Julian day number calcula
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Date2Day% (dat$)
     '                  DECLARE FUNCTION Date2Julian& (dat$)
     '                  DECLARE FUNCTION Date2Month% (dat$)
     '                  DECLARE FUNCTION Date2Year% (dat$)
     '
       FUNCTION Date2Julian& (dat$) STATIC
           month% = Date2Month%(dat$)
           day% = Date2Day%(dat$)
           year% = Date2Year%(dat$)
           IF year% < 1583 THEN
               PRINT "Date2Julian: Year is less than 1583"
               SYSTEM
           END IF
           IF month% > 2 THEN
               month% = month% - 3
           ELSE
               month% = month% + 9
               year% = year% - 1
           END IF
           ta& = 146097 * (year% \ 100) \ 4
           tb& = 1461& * (year% MOD 100) \ 4
           tc& = (153 * month% + 2) \ 5 + day% + 1721119
           Date2Julian& = ta& + tb& + tc&
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Date2Month%

   Extracts the month number from a date string that is in the standard
   format MM-DD-YYYY.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Date2Month%                **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the month number given a date in the
     ' QuickBASIC string format MM-DD-YYYY.
     '
     ' EXAMPLE OF USE:  month% = Date2Month%(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Date2Month% (dat$)
     '
       FUNCTION Date2Month% (dat$) STATIC
           Date2Month% = VAL(MID$(dat$, 1, 2))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Date2Year%

   Extracts the year number from a date string that is in the standard format
   MM-DD-YYYY.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Date2Year%                 **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the year number given a date in the
     ' QuickBASIC string format MM-DD-YYYY.
     '
     ' EXAMPLE OF USE:  year% = Date2Year%(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Date2Year% (dat$)
     '
       FUNCTION Date2Year% (dat$) STATIC
           Date2Year% = VAL(MID$(dat$, 7))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: DayOfTheCentury&

   Returns the day of the given century. Each century has more than 32767
   days, requiring this function to be declared as returning a long integer
   result.

   Dates before 01-01-1600 generate an error. See page 55 for an
   explanation.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DayOfTheCentury%           **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the number of the day of the century.
     '
     ' EXAMPLE OF USE:  cDay& = DayOfTheCentury&(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       year%      Year for given date
     '                  dat1$      Date for last day of previous century
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION DayOfTheCentury& (dat$)
     '
       FUNCTION DayOfTheCentury& (dat$)
           year% = Date2Year%(dat$)
           dat1$ = MDY2Date$(12, 31, year% - (year% MOD 100) - 1)
           DayOfTheCentury& = DaysBetweenDates&(dat1$, dat$)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: DayOfTheWeek$

   Finds the name of the day of the week for any date. In displaying calendar
   calculation results, it's often desirable to be able to print the name of
   the day of the week. This function lets you conveniently do so.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DayOfTheWeek$              **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string stating the day of the week.
     ' Input is a date expressed in the QuickBASIC string
     ' format MM-DD-YYYY.
     '
     ' EXAMPLE OF USE:  PRINT "The day of the week is "; DayOfTheWeek$(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION DayOfTheWeek$ (dat$)
     '
       FUNCTION DayOfTheWeek$ (dat$) STATIC
           SELECT CASE Date2Julian&(dat$) MOD 7
           CASE 0
               DayOfTheWeek$ = "Monday"
           CASE 1
               DayOfTheWeek$ = "Tuesday"
           CASE 2
               DayOfTheWeek$ = "Wednesday"
           CASE 3
               DayOfTheWeek$ = "Thursday"
           CASE 4
               DayOfTheWeek$ = "Friday"
           CASE 5
               DayOfTheWeek$ = "Saturday"
           CASE 6
               DayOfTheWeek$ = "Sunday"
           END SELECT
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: DayOfTheYear%

   Returns a number in the range 1 through 366, indicating the day of the
   year for the given date, by subtracting the Julian day number for the last
   day of the previous year from that of the given date. This calculation
   generates an error if the date is before January 1, 1584.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DayOfTheYear%              **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the number of the day of the year (1-366).
     '
     ' EXAMPLE OF USE:  PRINT "The day of the year is"; DayOfTheYear%(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       dat1$      Date of last day of previous year
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION DayOfTheYear% (dat$)
     '
       FUNCTION DayOfTheYear% (dat$) STATIC
           dat1$ = MDY2Date$(12, 31, Date2Year%(dat$) - 1)
           DayOfTheYear% = DaysBetweenDates&(dat1$, dat$)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: DaysBetweenDates&

   Returns the number of days between two dates by subtracting the Julian day
   numbers of the dates. The absolute value of the difference is returned, so
   the first date can be earlier or later than the second. The number of days
   returned will always be a positive value.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DaysBetweenDates&          **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the number of days between any two dates.
     '
     ' EXAMPLE OF USE:  days& = DaysBetweenDates&(dat1$, dat2$)
     ' PARAMETERS:      dat1$      First date
     '                  dat2$      Second date
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION DaysBetweenDates& (dat1$, dat2$)
     '
       FUNCTION DaysBetweenDates& (dat1$, dat2$) STATIC
           DaysBetweenDates& = ABS(Date2Julian&(dat1$) - Date2Julian&(dat2$))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: HMS2Time$

   Given hour, minute, and second numbers, returns a time string, in the same
   format as the string returned by QuickBASIC's TIME$ function. For example,
   HMS2Time$(23, 59, 59) returns 23:59:59.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          HMS2Time$                  **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the time in the QuickBASIC string format
     ' HH:MM:SS given hour%, minute%, and second%.
     '
     ' EXAMPLE OF USE:  PRINT HMS2Time$(hour%, minute%, second%)
     ' PARAMETERS:      hour%      Hour number
     '                  minute%    Minutes number
     '                  second%    Seconds number
     ' VARIABLES:       t$         Workspace for building the time string
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION HMS2Time$ (hour%, minute%, second%)
     '
       FUNCTION HMS2Time$ (hour%, minute%, second%) STATIC
           t$ = RIGHT$("0" + MID$(STR$(hour%), 2), 2) + ":"
           t$ = t$ + RIGHT$("0" + MID$(STR$(minute%), 2), 2) + ":"
           HMS2Time$ = t$ + RIGHT$("0" + MID$(STR$(second%), 2), 2)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Julian2Date$

   Converts a Julian day number to a date. The smallest long integer number
   that can be passed to this function without generating an error is
   2299239, the Julian number for the date 01-01-1583.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Julian2Date$               **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a date in the QuickBASIC string format
     ' MM-DD-YYYY as calculated from a Julian day number.
     '
     ' EXAMPLE OF USE:
     '        PRINT "Date for the given Julian number is ";Julian2Date$(j&)
     ' PARAMETERS:      j&         Julian day number
     ' VARIABLES:       x&         Temporary calculation variable
     '                  y&         Temporary calculation variable
     '                  d&         Day number in long integer form
     '                  m&         Month number before adjustment
     '                  month%     Month number
     '                  year%      Year number
     '                  day%       Day number
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Julian2Date$ (julian&)
     '
       FUNCTION Julian2Date$ (julian&) STATIC

           x& = 4 * julian& - 6884477
           y& = (x& \ 146097) * 100
           d& = (x& MOD 146097) \ 4

           x& = 4 * d& + 3
           y& = (x& \ 1461) + y&
           d& = (x& MOD 1461) \ 4 + 1

           x& = 5 * d& - 3
           m& = x& \ 153 + 1
           d& = (x& MOD 153) \ 5 + 1

           IF m& < 11 THEN
               month% = m& + 2
           ELSE
               month% = m& - 10
           END IF
           day% = d&
           year% = y& + m& \ 11

           dat$ = MDY2Date$(month%, day%, year%)
           Julian2Date$ = dat$
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: MDY2Date$

   Creates a date string from the numeric values of month, day, and year for
   a given date. The string format is the same as that returned by the
   QuickBASIC DATE$ function, MM-DD-YYYY.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MDY2Date$                  **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts month%, day%, and year% to a date string
     ' in the QuickBASIC string format MM-DD-YYYY.
     '
     ' EXAMPLE OF USE:  dat$ = MDY2Date$(month%, day%, year%)
     ' PARAMETERS:      month%     Month for the date
     '                  day%       Day of the month
     '                  year%      Year number
     ' VARIABLES:       y$         Temporary year string
     '                  m$         Temporary month string
     '                  d$         Temporary day string
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION MDY2Date$ (month%, day%, year%)
     '
       FUNCTION MDY2Date$ (month%, day%, year%) STATIC
           y$ = RIGHT$("000" + MID$(STR$(year%), 2), 4)
           m$ = RIGHT$("0" + MID$(STR$(month%), 2), 2)
           d$ = RIGHT$("0" + MID$(STR$(day%), 2), 2)
           MDY2Date$ = m$ + "-" + d$ + "-" + y$
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: MonthName$

   Returns the name of the month for a given date. If the passed date string
   has the wrong number of characters, the returned name defaults to
   MM-DD-YYYY to remind you of the required format for date strings. If the
   string is the right length but the first two characters don't represent a
   valid month number, ?MonthName? is returned.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MonthName$                 **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string stating the month as indicated
     ' in dat$ (QuickBASIC string format MM-DD-YYYY).
     '
     ' EXAMPLE OF USE:  PRINT MonthName$(dat$)
     ' PARAMETERS:      dat$       Date of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION MonthName$ (dat$)
     '
       FUNCTION MonthName$ (dat$) STATIC

           IF LEN(dat$) <> 10 THEN
               dat$ = "MM-DD-YYYY"
           END IF

           SELECT CASE LEFT$(dat$, 2)
           CASE "01"
               MonthName$ = "January"
           CASE "02"
               MonthName$ = "February"
           CASE "03"
               MonthName$ = "March"
           CASE "04"
               MonthName$ = "April"
           CASE "05"
               MonthName$ = "May"
           CASE "06"
               MonthName$ = "June"
           CASE "07"
               MonthName$ = "July"
           CASE "08"
               MonthName$ = "August"
           CASE "09"
               MonthName$ = "September"
           CASE "10"
               MonthName$ = "October"
           CASE "11"
               MonthName$ = "November"
           CASE "12"
               MonthName$ = "December"
           CASE ELSE
               MonthName$ = "?MonthName?"
           END SELECT

       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: OneMonthCalendar

   Uses several functions from the CALENDAR toolbox to print a small,
   one-month calendar at any location on the screen. The stand-alone program
   named MONTH provides a good demonstration of this subprogram at work.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          OneMonthCalendar           **
     ' **  Type:          Subprogram                 **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Prints a small, one-month calendar at the row%
     ' and col% indicated.
     '
     ' EXAMPLE OF USE:  OneMonthCalendar dat$, row%, col%
     ' PARAMETERS:      dat$       Date of concern
     '                  row%       Screen row for upper left corner of calenda
     '                  col%       Screen column for upper left corner of cale
     ' VARIABLES:       mname$     Name of given month
     '                  month%     Month number
     '                  day%       Day number
     '                  year%      Year number
     '                  dat1$      Date for first of the given month
     '                  j&         Julian day number for each day of the month
     '                  heading$   Title line for calendar
     '                  wa%        Day of the week for each day of the month
     '                  rowloc%    Row for printing each day number
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB OneMonthCalendar (dat$, row%, col%)
     '
       SUB OneMonthCalendar (dat$, row%, col%) STATIC
           mname$ = MonthName$(dat$)
           LOCATE row%, col% + 12 - LEN(mname$) \ 2
           PRINT mname$; ","; Date2Year%(dat$)
           month% = Date2Month%(dat$)
           day% = 1
           year% = Date2Year%(dat$)
           dat1$ = MDY2Date$(month%, day%, year%)
           j& = Date2Julian&(dat1$)
           heading$ = " Sun Mon Tue Wed Thu Fri Sat"
           wa% = INSTR(heading$, LEFT$(DayOfTheWeek$(dat1$), 3)) \ 4
           LOCATE row% + 1, col%
           PRINT heading$
           rowloc% = row% + 2
           LOCATE rowloc%, col% + 4 * wa%
           DO
               PRINT USING "####"; day%;
               IF wa% = 6 THEN
                   rowloc% = rowloc% + 1
                   LOCATE rowloc%, col%
               END IF
               wa% = (wa% + 1) MOD 7
               j& = j& + 1
               day% = Date2Day%(Julian2Date$(j&))
           LOOP UNTIL day% = 1
           PRINT
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: Second2Date$

   Returns a date string given the number of seconds since the last second of
   1979. The number of seconds is limited to the range of positive long
   integers (1 to 2147483647). Given the largest possible long integer, the
   function returns the date 01-19-2048.

   Related functions are Second2Time$ and TimeDate2Second&. The
   Second2Time$ function finds the time string for a given second, and the
   TimeDate2Second$ function finds the seconds since 1979 for a given date
   and time.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Second2Date$               **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the date in the QuickBASIC string format
     ' MM-DD-YYYY given a number of seconds since the
     ' last second of 1979.  Use Second2Time$ to find
     ' the time of day at the indicated second.
     '
     ' EXAMPLE OF USE:  dat$ = Second2Date$(second&)
     ' PARAMETERS:      second&    Number of seconds since the last second of
     ' VARIABLES:       days&      Julian day number of the date
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Second2Date$ (second&)
     '
       FUNCTION Second2Date$ (second&) STATIC
           days& = second& \ 86400 + 2444240
           Second2Date$ = Julian2Date$(days&)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Second2Time$

   Returns a time string given the number of seconds since the last second of
   1979.

   Related functions are Second2Date$ and TimeDate2Second&. The
   Second2Date$ function finds the date string for a given second, and the
   TimeDate2Second$ function finds the seconds since 1979 for a given date
   and time.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Second2Time$               **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the time in the QuickBASIC string format
     ' HH:MM:SS given the number of seconds since the
     ' last second of 1979.  Use Second2Date$ to find
     ' the date at the indicated second.
     '
     ' EXAMPLE OF USE:  tim$ = Second2Time$(second&)
     ' PARAMETERS:      second&    Number of seconds since the last second of
     ' VARIABLES:       time&      Number of seconds in current day
     '                  second%    Current second of the minute
     '                  minute%    Current minute of the hour
     '                  hour%      Current hour of the day
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Second2Time$ (second&)
     '
       FUNCTION Second2Time$ (second&) STATIC
           IF second& > 0 THEN
               time& = second& MOD 86400
               second% = time& MOD 60
               time& = time& \ 60
               minute% = time& MOD 60
               hour% = time& \ 60
               Second2Time$ = HMS2Time$(hour%, minute%, second%)
           ELSE
               Second2Time$ = "HH:MM:SS"
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Time2Hour%

   Extracts the numeric value of the hour from a time string if in the
   standard TIME$ format HH:MM:SS.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Time2Hour%                 **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the hour number as indicated in a time
     ' string in the format HH:MM:SS.
     '
     ' EXAMPLE OF USE:  hour% = Time2Hour%(tim$)
     ' PARAMETERS:      tim$       Time of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Time2Hour% (tim$)
     '
       FUNCTION Time2Hour% (tim$) STATIC
           Time2Hour% = VAL(LEFT$(tim$, 2))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Time2Minute%

   Extracts the numeric value of the hour from a time string that is in the
   standard TIME$ format HH:MM:SS.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Time2Minute%               **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the minute number as indicated in a time
     ' string in the format HH:MM:SS.
     '
     ' EXAMPLE OF USE:  minute% = Time2Minute%(tim$)
     ' PARAMETERS:      tim$       Time of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Time2Minute% (tim$)
     '
       FUNCTION Time2Minute% (tim$) STATIC
           Time2Minute% = VAL(MID$(tim$, 4, 2))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Time2Second%

   Extracts the numeric value of the seconds from a time string that is in
   the standard TIME$ format HH:MM:SS.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Time2Second%               **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the second number as indicated in a time
     ' string in the format HH:MM:SS.
     '
     ' EXAMPLE OF USE:  second% = Time2Second%(tim$)
     ' PARAMETERS:      tim$       Time of concern
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Time2Second% (tim$)
     '
       FUNCTION Time2Second% (tim$) STATIC
           Time2Second% = VAL(MID$(tim$, 7))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: TimeDate2Second&

   Returns the number of seconds since the last second of 1979 given any date
   and time between the first second of 1980 and a moment in the year 2048.

   The largest positive long integer that can be stored in four bytes using
   two's complement notation is 2147483647. From the arbitrary point in time
   at the start of 1980, counting in seconds reaches this largest possible
   positive integer at 03:14:07 on 01-19-2048.

   One advantage of converting date and time to a number of seconds is that
   this long integer is more compact; this is an advantage, for example, when
   a large number of dates and times must be recorded in a disk file. Event
   logging, data acquisition, and business transaction time stamping are
   examples of the use of this type of subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          TimeDate2Second&           **
     ' **  Type:          Function                   **
     ' **  Module:        CALENDAR.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the number of seconds since the last
     ' second of 1979.  If the date is not in the years
     ' 1980 to 2047, an error message is output.
     '
     ' EXAMPLE OF USE:  sec& = TimeDate2Second&(tim$, dat$)
     ' PARAMETERS:      tim$       Time of concern
     '                  dat$       Date of concern
     ' VARIABLES:       days&      Days since 12-31-1979
     '                  hour%      Hour of the day
     '                  minute%    Minute of the hour
     '                  second%    Second of the minute
     '                  secs&      Working number of total seconds
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION TimeDate2Second& (tim$, dat$)
     '
       FUNCTION TimeDate2Second& (tim$, dat$) STATIC
           days& = Date2Julian&(dat$) - 2444240
           hour% = VAL(LEFT$(tim$, 2))
           minute% = VAL(MID$(tim$, 4, 2))
           second% = VAL(RIGHT$(tim$, 2))
           secs& = CLNG(hour%) * 3600 + minute% * 60 + second%
           IF days& >= 0 AND days& < 24857 THEN
               TimeDate2Second& = days& * 86400 + secs&
           ELSE
               PRINT "TimeDate2Second: Not in range 1980 to 2047"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 CARTESIA

   The CARTESIA toolbox contains two subprograms and two functions that
   convert between Cartesian and polar coordinates. The program first prompts
   you to enter x and y values defining a point on the Cartesian plane and
   then prints the equivalent coordinate in polar notation.

   ┌────────────────────────────────────────────────────────────────────────┐
   │ This figure can be found on p.78 of the printed version of the book.   │
   └────────────────────────────────────────────────────────────────────────┘

   All of the variables in this module are defined as single-precision,
   floating-point values. If you need greater precision, globally change all
   exclamation point characters to pound sign characters. You'll also want to
   change the CONST PI statement in the Angle! function to provide a
   double-precision value for PI.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   CARTESIA.BAS                    Demo module
   Angle!                  Func    Angle between X axis and line to x, y
                                    point
   Magnitude!              Func    Distance from origin to x, y point
   Pol2Rec                 Sub     Polar to Cartesian conversion
   Rec2Pol                 Sub     Cartesian to polar conversion
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: CARTESIA

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CARTESIA                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        CARTESIA.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates a set of functions and subprograms
     ' dealing with Cartesian coordinates.
     '
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       x!     X value of Cartesian coordinate
     '                  y!     Y value of Cartesian coordinate
     '                  r!     Polar notation distance from origin
     '                  theta! Polar notation angle from X axis

       DECLARE FUNCTION Angle! (x!, y!)
       DECLARE FUNCTION Magnitude! (x!, y!)

       DECLARE SUB Pol2Rec (r!, theta!, x!, y!)
       DECLARE SUB Rec2Pol (x!, y!, r!, theta!)

       CLS
       INPUT "Enter X  ", x!
       INPUT "Enter Y  ", y!
       PRINT
       PRINT "Magnitude!(x!, y!)", Magnitude!(x!, y!)
       PRINT "Angle!(x!, y!)", Angle!(x!, y!)
       PRINT
       Rec2Pol x!, y!, r!, theta!
       PRINT "Rec2Pol", , r!; theta!
       Pol2Rec r!, theta!, x!, y!
       PRINT "Pol2Rec", , x!; y!
   ──────────────────────────────────────────────────────────────────────────


 Function: Angle!

   Returns the angle from the origin to a given Cartesian coordinate,
   measured from the positive X axis. The angle, expressed in radians, is
   returned in the range -PI < Angle! <= +PI.

   This function has a good example of an IF-ELSEIF-ELSE-ENDIF structured
   statement. Notice that even though this function contains quite a few
   statements, the routine quickly skips over the unnecessary instructions.
   These tests let the function cover all the special case situations, such
   as when the coordinate falls on one or both axes.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Angle!                     **
     ' **  Type:          Function                   **
     ' **  Module:        CARTESIA.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the angle (in radians) between the X axis
     ' and the line from the origin to the point x!,y!
     '
     ' EXAMPLE OF USE:  a! = Angle!(x!, y!)
     ' PARAMETERS:      x!         X part of the Cartesian coordinate
     '                  y!         Y part of the Cartesian coordinate
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Angle! (x!, y!)
     '
       FUNCTION Angle! (x!, y!) STATIC

        CONST PI = 3.141593
        CONST HALFPI = PI / 2

        IF x! = 0! THEN
            IF y! > 0! THEN
             Angle! = HALFPI
            ELSEIF y! < 0! THEN
             Angle! = -HALFPI
            ELSE
             Angle! = 0!
            END IF
        ELSEIF y! = 0! THEN
            IF x! < 0! THEN
             Angle! = PI
            ELSE
             Angle! = 0!
            END IF
        ELSE
            IF x! < 0! THEN
             IF y! > 0! THEN
                 Angle! = ATN(y! / x!) + PI
             ELSE
                 Angle! = ATN(y! / x!) - PI
             END IF
            ELSE
             Angle! = ATN(y! / x!)
            END IF
        END IF

       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Magnitude!

   Returns the distance from the origin to a given Cartesian coordinate.

   This function, together with the Angle! function, provides the
   calculations that perform rectangular to polar coordinate conversions.
   They are both called by the Rec2Pol subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Magnitude!                 **
     ' **  Type:          Function                   **
     ' **  Module:        CARTESIA.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the distance from the origin to the
     ' point x!,y!
     '
     ' EXAMPLE OF USE:  r! =  Magnitude!(x!, y!)
     ' PARAMETERS:      x!         X part of the Cartesian coordinate
     '                  y!         Y part of the Cartesian coordinate
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Magnitude! (x!, y!)
     '
       FUNCTION Magnitude! (x!, y!) STATIC
        Magnitude! = SQR(x! * x! + y! * y!)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Pol2Rec

   Converts a polar notation point (magnitude, angle) to its equivalent (x,
   y) Cartesian coordinates. The conversion assumes that theta! is expressed
   in radians and uses the built-in QuickBASIC functions for finding the sine
   and cosine of this angle.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Pol2rec                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        CARTESIA.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts polar coordinates to Cartesian notation.
     '
     ' EXAMPLE OF USE:  Pol2Rec r!, theta!, x!, y!
     ' PARAMETERS:      r!         Distance of point from the origin
     '                  theta!     Angle of point from the X axis
     '                  x!         X coordinate of the point
     '                  y!         Y coordinate of the point
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Pol2Rec (r!, theta!, x!, y!)
     '
       SUB Pol2Rec (r!, theta!, x!, y!) STATIC
        x! = r! * COS(theta!)
        y! = r! * SIN(theta!)
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Rec2Pol

   Converts a point expressed as a Cartesian coordinate pair (x, y) to the
   equivalent polar notation (magnitude, angle). The Angle! and Magnitude!
   functions within this toolbox perform the calculations for this
   conversion.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Rec2pol                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        CARTESIA.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts Cartesian coordinates to polar notation.
     '
     ' EXAMPLE OF USE:  Rec2Pol x!, y!, r!, theta!
     ' PARAMETERS:      x!         X coordinate of the point
     '                  y!         Y coordinate of the point
     '                  r!         Distance of point from the origin
     '                  theta!     Angle of point from the X axis
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Angle! (x!, y!)
     '                  DECLARE FUNCTION Magnitude! (x!, y!)
     '                  DECLARE SUB Rec2Pol (x!, y!, r!, theta!)
     '
       SUB Rec2Pol (x!, y!, r!, theta!) STATIC
        r! = Magnitude!(x!, y!)
        theta! = Angle!(x!, y!)
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 CIPHER

   The CIPHER program securely ciphers and deciphers any file. You probably
   have some files or data that you'd prefer to keep secret, such as personal
   financial information or proprietary business matters. Several packages on
   the market let you keep your files secure from prying eyes, but they do it
   at some expense. This program does it quickly and simply.

   For each byte in the file to be ciphered, the program generates a
   pseudorandom byte in the range 0 through 255. The pseudorandom byte and
   the file byte are combined using the QuickBASIC XOR function, and the byte
   in the file is replaced with this result. To decipher the file, use the
   CIPHER program to process the file a second time, using exactly the same
   key. XOR then returns the file to its original state.

   The bytes in the ciphered file will appear to be as random as the sequence
   of pseudorandom bytes generated for this process. The RandInteger%
   function generates the bytes, which makes the number of possible
   pseudorandom sequences astronomical. Without knowing the key string used
   to initialize this sequence, a person could probably not break the cipher.
   This points out an important fact about the security of this technique:
   The ciphered file is only as secure as the key you select. Let's see how
   you can choose a secure key.

   First, the "don'ts": Don't use simple, obvious keys such as your name,
   initials, names of family members or pets, addresses, phone numbers, and
   the like. Don't use the same key repeatedly. Don't record the keys in an
   easy-to-find place, such as in a batch file containing CIPHER commands.
   And don't forget to keep track of your key in some safe way. You won't be
   able to get your file back if you forget the key!

   There are several ways to generate your own keys in a safe, secure manner.
   Be creative! For example, you might choose your own private "magic number"
   that you can easily remember and use it to define a key. If your number is
   17, you could use the first 17 characters of line 17, page 17, in your
   favorite novel. Another technique is to create a common phrase that's easy
   to remember yet contains deliberately misspelled words or an odd
   combination of upper- and lowercase characters──3 blined MiSe, for
   example. Don't get too carried away with your creativity, though, and end
   up with something you can't remember. Changing even one character in the
   key will generate an entirely different sequence of pseudorandom bytes.

   The CIPHER program has a unique feature built into it to help generate new
   words that you can use as keys. Instead of typing the filename and key
   string on the command line that invokes the CIPHER program, type CIPHER
   /NEWKEY and press the Enter key. The program will generate nine
   pseudorandom words, created by randomly selecting characters from sets of
   consonants and vowels in a way that makes most of them readable.

   When you use the /NEWKEY command line option, a unique set of new words is
   generated for every possible clock tick in the life of your computer. In
   the module-level code of CIPHER.BAS is the statement RandShuffle DATE$ +
   TIME$ + STR$(TIMER), which initializes the random number generator when
   you give the /NEWKEY option. The key string for the initialization is
   formed by combining the date, time, and timer information into a string of
   about 27 characters.

   Eighteen times each second your computer updates its internal clock. The
   TIMER function returns a different value each time this happens, and the
   date and time are unique for every possible second of each day. As a
   result, the key string that initializes the random number generator will
   always be unique, and it's safe to say you'll never see the same group of
   nine words repeated.

   If you have a large number of files that you'd like to cipher, you can
   automate the process. Create a batch file containing CIPHER command lines,
   complete with filenames and keys. Keep this batch file ciphered at all
   times, except when you want to use it to cipher or decipher the group of
   files listed in the commands. This way, the only key you must remember is
   the one for unlocking the batch command file.

   To try out the CIPHER program, follow these steps. Create a small,
   readable file using the Document mode of the QuickBASIC editor, and save
   it as TEST.TXT. Verify the file contents by typing TYPE TEST.TXT. Now, to
   cipher the file, run CIPHER with the command line TEST.TXT ABC. When
   CIPHER is finished, the file will be unreadable, and entering TYPE
   TEST.TXT will result in strange characters on your screen. To decipher the
   file, once again run CIPHER with the same command line: TEST.TXT ABC. Be
   sure to enter the key string ("ABC" in this case) exactly the same as you
   did when the file was ciphered. Finally, type out the file to verify that
   it was correctly deciphered.

   Name                        Type     Description
   ──────────────────────────────────────────────────────────────────────────
   CIPHER.BAS                          Program module
   NewWord$                   Func     Creates pseudorandom new word
   ProcesX                    Sub      Enciphers string by XORing bytes
   ──────────────────────────────────────────────────────────────────────────


 Program Module: CIPHER

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CIPHER                     **
     ' **  Type:          Program                    **
     ' **  Module:        CIPHER.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:   CIPHER  filename.ext key    or    CIPHER /NEWKEY
     ' .MAK FILE:       CIPHER.BAS
     '                  RANDOMS.BAS
     ' PARAMETERS:      filename      Name of file to be ciphered or deciphere
     '                  key           String of one or more words used as the
     '                                cipher key
     ' VARIABLES:       cmd$          Working copy of COMMAND$
     '                  i%            Loop index
     '                  firstSpace%   Location in command line of first charac
     '                  fileName$     Name of file to be processed
     '                  key$          String to be used as cipher key
     '                  fileLength&   Length of file to be processed
     '                  a$            Workspace for groups of bytes from the f
     '                  count%        Number of groups of bytes to be processe
     '                  j&            Location in file of each group of bytes

     ' Constants
       CONST BYTES = 1000&

     ' Functions
       DECLARE FUNCTION NewWord$ ()
       DECLARE FUNCTION Rand& ()
       DECLARE FUNCTION RandInteger% (a%, b%)

     ' Subprograms
       DECLARE SUB RandShuffle (key$)
       DECLARE SUB ProcesX (a$)

     ' Initialization
       CLS
       PRINT "CIPHER "; COMMAND$
       PRINT

     ' Grab the command line parameters
       cmd$ = COMMAND$

     ' If no command line parameters, then tell user what's needed
       IF cmd$ = "" THEN
           PRINT
           PRINT "Usage:  CIPHER /NEWKEY"
           PRINT "(or)    CIPHER filename key-string"
           PRINT
           SYSTEM
       END IF

     ' If /NEWKEY option, generate a few new words, and then quit
       IF INSTR(cmd$, "/NEWKEY") THEN

         ' Clear the screen and describe the output
           CLS
           PRINT "Randomly created words that can be used as cipher keys..."
           PRINT
           RandShuffle DATE$ + TIME$ + STR$(TIMER)
           FOR i% = 1 TO 9
               PRINT NewWord$; " ";
           NEXT i%
           PRINT
           SYSTEM
       END IF

     ' Get the filename from the command line
       cmd$ = cmd$ + " "
       firstSpace% = INSTR(cmd$, " ")
       fileName$ = LEFT$(cmd$, firstSpace% - 1)

     ' Grab the rest of the command line as the cipher key
       key$ = LTRIM$(MID$(cmd$, firstSpace% + 1))

     ' Prepare the pseudorandom numbers using the key for shuffling
       RandShuffle key$

     ' Open up the file
       OPEN fileName$ FOR BINARY AS #1
       fileLength& = LOF(1)

     ' Process the file in manageable pieces
       a$ = SPACE$(BYTES)
       count% = fileLength& \ BYTES

     ' Loop through the file
       FOR i% = 0 TO count%
           j& = i% * BYTES + 1
           IF i% = count% THEN
               a$ = SPACE$(fileLength& - BYTES * count%)
           END IF
           GET #1, j&, a$
           ProcesX a$
           PUT #1, j&, a$
       NEXT i%

     ' All done
       SYSTEM
   ──────────────────────────────────────────────────────────────────────────


 Function: NewWord$

   Creates a pseudorandom, new "word" by randomly selecting appropriate
   consonants and vowels to form one to three syllables. These words can be
   useful as passwords, cipher keys, or new product names.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          NewWord$                   **
     ' **  Type:          Function                   **
     ' **  Module:        CIPHER.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a pseudorandom word of a possibly
     ' speakable form.
     '
     ' EXAMPLE OF USE: PRINT NewWord$
     ' PARAMETERS:     (none)
     ' VARIABLES:      vowel$     String constant listing the set of vowels
     '                 consonant$ String constant listing the set of consonant
     '                 syllables% Random number of syllables for the new word
     '                 i%         Loop index for creating each syllable
     '                 t$         Temporary work string for forming the new wo
     ' MODULE LEVEL
     '   DECLARATIONS: DECLARE FUNCTION NewWord$ ()
     '
       FUNCTION NewWord$ STATIC
           CONST vowel$ = "aeiou"
           CONST consonant$ = "bcdfghjklmnpqrstvwxyz"
           syllables% = Rand& MOD 3 + 1
           FOR i% = 1 TO syllables%
               t$ = t$ + MID$(consonant$, RandInteger%(1, 21), 1)
               IF i% = 1 THEN
                   t$ = UCASE$(t$)
               END IF
               t$ = t$ + MID$(vowel$, RandInteger%(1, 5), 1)
           NEXT i%
           IF Rand& MOD 2 THEN
               t$ = t$ + MID$(consonant$, RandInteger%(1, 21), 1)
           END IF
           NewWord$ = t$
           t$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ProcesX

   Enciphers a string by XORing the bytes with a sequence of pseudorandom
   bytes. The bytes are generated as pseudorandom integers in the range 0
   through 255 by the RandInteger% function.

   If you initialize the random number generator with the same sequence and
   process the ciphered string a second time with this subprogram, the
   original string will result. The CIPHER program allows deciphering in this
   way by simply requiring that the ciphered file be "ciphered" a second time
   with the same key.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ProcesX                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        CIPHER.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Enciphers a string by XORing with pseudorandom bytes.
     '
     ' EXAMPLE OF USE:  ProcesX a$
     ' PARAMETERS:      a$         String to be ciphered
     ' VARIABLES:       i%         Index into the string
     '                  byte%      Numeric value of each string character
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB ProcesX (a$)
     '
       SUB ProcesX (a$) STATIC
           FOR i% = 1 TO LEN(a$)
               byte% = ASC(MID$(a$, i%, 1)) XOR RandInteger%(0, 255)
               MID$(a$, i%, 1) = CHR$(byte%)
           NEXT i%
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 COLORS

   The COLORS program provides a handy utility for interactively selecting
   colors from the 262,144 available in the VGA and MCGA graphics modes. To
   run this program, you must have a mouse and VGA or MCGA graphics
   capability.

   The program is easy to use. Simply click on any of the three color bars to
   set the intensity of that color. The ellipse on the left side of the
   screen shows the color shade you selected, and the long integer value at
   the top of the screen shows the numeric value to use with the PALETTE
   statement for setting this same color in other programs. When you're ready
   to quit, click on the X at the lower left corner of the screen.

   You can run this program from the QuickBASIC environment, but to make it
   an easily accessible utility, it's probably better to compile it and
   create a stand-alone .EXE program module.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   COLORS.BAS                      Program module
   Shade&                  Func    Color value from given red, green, and
                                    blue
   ──────────────────────────────────────────────────────────────────────────


 Program Module: COLORS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          COLORS                     **
     ' **  Type:          Program                    **
     ' **  Module:        COLORS.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Provides interactive selection of a color shade.
     '
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    VGA or MCGA
     '                  MIXED.QLB/.LIB
     '                  Mouse
     ' .MAK FILE:       COLORS.BAS
     '                  BITS.BAS
     '                  MOUSSUBS.BAS
     ' PARAMETERS:      (none)
     ' VARIABLES:       red!            Intensity of red, from 0 to 1
     '                  green!          Intensity of green, from 0 to 1
     '                  blue!           Intensity of blue, from 0 to 1
     '                  mask$           Mouse graphics cursor definition strin
     '                  xHot%           Mouse cursor hot spot X location
     '                  yHot%           Mouse cursor hot spot Y location
     '                  cursor$         Mouse cursor binary definition string
     '                  fill%           Color bar height calculation
     '                  x%              Color bar horizontal left edge
     '                  x2%             Color bar horizontal right edge
     '                  y%              Color bar vertical top edge
     '                  y2%             Color bar vertical bottom edge
     '                  leftButton%     State of left mouse button
     '                  rightButton%    State of right mouse button
     '                  xMouse%         Horizontal mouse location
     '                  yMouse%         Vertical mouse location
     '                  clickFlag%      Toggle for left mouse button state
     '                  xM%             Modified mouse horizontal location
     '                  quitFlag%       Signal to end program


     ' Logical constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Constants
       CONST REDPAL = 1
       CONST BLUEPAL = 2
       CONST GREENPAL = 3
       CONST TESTPAL = 4
       CONST WHITEPAL = 5
       CONST BARPAL = 6
       CONST DX = 15
       CONST DY = 150
       CONST RX = 180
       CONST RY = 30
       CONST GX = RX + DX + DX
       CONST GY = RY
       CONST BX = GX + DX + DX
       CONST BY = RY

     ' Functions
       DECLARE FUNCTION Shade& (red!, green!, blue!)

     ' Subprograms
       DECLARE SUB MouseHide ()
       DECLARE SUB MouseMaskTranslate (mask$, xHot%, yHot%, cursor$)
       DECLARE SUB MouseSetGcursor (cursor$)
       DECLARE SUB MouseShow ()
       DECLARE SUB Cursleft (mask$, xHot%, yHot%)
       DECLARE SUB MouseNow (leftButton%, rightButton%, xMouse%, yMouse%)

     ' Set 256 color mode
       SCREEN 13

     ' Set first three colors as pure red, green, blue
       PALETTE REDPAL, Shade&(1!, 0!, 0!)
       PALETTE GREENPAL, Shade&(0!, 1!, 0!)
       PALETTE BLUEPAL, Shade&(0!, 0!, 1!)

     ' Set a pure white color choice
       PALETTE WHITEPAL, Shade&(1!, 1!, 1!)

     ' Set bar background color
       PALETTE BARPAL, Shade&(0!, 0!, 0!)

     ' Set background to light gray
       PALETTE 0, Shade&(.4, .4, .4)

     ' Start each intensity at midscale
       red! = .5
       green! = .5
       blue! = .5

     ' Set starting shade
       PALETTE TESTPAL, Shade&(red!, green!, blue!)

     ' Create ellipse of circle to show current shade selected
       CIRCLE (70, 100), 80, TESTPAL, , , 1.4
       PAINT (70, 100), TESTPAL

     ' Create the three color bars
       LINE (RX, RY)-(RX + DX, RY + DY), WHITEPAL, B
       LINE (GX, GY)-(GX + DX, GY + DY), WHITEPAL, B
       LINE (BX, BY)-(BX + DX, BY + DY), WHITEPAL, B

     ' Mark place to quit by clicking
       LOCATE 25, 1
       PRINT "(X) "; CHR$(27); " Quit";

     ' Make the left arrow mouse cursor
       Cursleft mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, cursor$
       MouseSetGcursor cursor$

     ' Main loop
       DO

         ' Put title and current shade number at top
           LOCATE 1, 1
           PRINT "COLOR CHOOSER"; TAB(22);
           PRINT USING "##########"; Shade&(red!, green!, blue!)

         ' Fill in the red color bar
           fill% = red! * (DY - 3) + 1
           x% = RX + 1
           x2% = RX + DX
           y% = RY + 1
           y2% = RY + DY
           LINE (x%, y%)-(x2% - 1, y2% - fill% - 1), BARPAL, BF
           LINE (x%, y2% - fill%)-(x2% - 1, y2% - 1), REDPAL, BF

         ' Fill in the green color bar
           fill% = green! * (DY - 3) + 1
           x% = GX + 1
           x2% = GX + DX
           y% = GY + 1
           y2% = GY + DY
           LINE (x%, y%)-(x2% - 1, y2% - fill% - 1), BARPAL, BF
           LINE (x%, y2% - fill%)-(x2% - 1, y2% - 1), GREENPAL, BF

         ' Fill in the blue color bar
           fill% = blue! * (DY - 3) + 1
           x% = BX + 1
           x2% = BX + DX
           y% = BY + 1
           y2% = BY + DY
           LINE (x%, y%)-(x2% - 1, y2% - fill% - 1), BARPAL, BF
           LINE (x%, y2% - fill%)-(x2% - 1, y2% - 1), BLUEPAL, BF

         ' Change the shade of the ellipse
           PALETTE TESTPAL, Shade&(red!, green!, blue!)

         ' Refresh mouse cursor
           MouseShow

         ' Wait for fresh mouse left button click
           DO
               MouseNow leftButton%, rightButton%, xMouse%, yMouse%
               IF leftButton% = FALSE THEN
                   clickFlag% = FALSE
               END IF
               IF clickFlag% THEN
                   leftButton% = 0
               END IF
           LOOP UNTIL leftButton%

         ' Hide mouse and set parameters
           MouseHide
           clickFlag% = TRUE
           xM% = xMouse% \ 2

         ' Is mouse in the "Quit" area?
           IF xMouse% < 45 AND yMouse% > 190 THEN
               quitFlag% = TRUE
           END IF

         ' Is mouse at the right height to be in a bar?
           IF yMouse% > RY - 2 AND yMouse% < RY + DY + 2 THEN

             ' Is mouse in the red bar?
               IF xM% > RX AND xM% < RX + DX THEN
                   red! = 1! - (yMouse% - RY) / DY
                   IF red! < 0 THEN
                       red! = 0
                   ELSEIF red! > 1 THEN
                       red! = 1
                   END IF
               END IF

             ' Is mouse in the green bar?
               IF xM% > GX AND xM% < GX + DX THEN
                   green! = 1! - (yMouse% - RY) / DY
                   IF green! < 0 THEN
                       green! = 0
                   ELSEIF green! > 1 THEN
                       green! = 1
                   END IF
               END IF

             ' Is mouse in the blue bar?
               IF xM% > BX AND xM% < BX + DX THEN
                   blue! = 1! - (yMouse% - RY) / DY
                   IF blue! < 0 THEN
                       blue! = 0
                   ELSEIF blue! > 1 THEN
                       blue! = 1
                   END IF
               END IF

           END IF

       LOOP UNTIL quitFlag%

       SCREEN 0
       WIDTH 80
       CLS
       END
   ──────────────────────────────────────────────────────────────────────────


 Function: Shade&

   Returns the long integer number for a given shade of color.

   This is the only function the COLORS utility provides, but it's useful
   when programming the VGA and MCGA SCREEN modes 11, 12, and 13. You can use
   the long integer value returned in a PALETTE statement for setting a color
   attribute to one of 262,144 color choices.

   Three single-precision numbers are passed to this routine, representing
   the desired intensities of the red, green, and blue colors. These numbers
   must be in the range 0.0 through 1.0. Shade&(1!, 0!, 0!), for example,
   returns the long integer value for bright red; Shade&(.5, .5, .5) returns
   a number for medium gray.

   The best way to see the results of setting the three colors to various
   intensity levels is by running the COLORS program.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Shade&                     **
     ' **  Type:          Function                   **
     ' **  Module:        COLORS.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the long integer color number given red,
     ' green, and blue intensity numbers in the range
     ' 0 through 1.
     '
     ' EXAMPLE OF USE:  PALETTE 1, Shade&(red!, green!, blue!)
     ' PARAMETERS:      red!       Intensity of red, from 0 to 1
     '                  green!     Intensity of green, from 0 to 1
     '                  blue!      Intensity of blue, from 0 to 1
     ' VARIABLES:       r&         Red amount
     '                  g&         Green amount
     '                  b&         Blue amount
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Shade& (red!, green!, blue!)
     '
       FUNCTION Shade& (red!, green!, blue!) STATIC
           r& = red! * 63!
           g& = green! * 63!
           b& = blue! * 63!
           Shade& = r& + g& * 256& + b& * 65536
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 COMPLEX

   The COMPLEX toolbox provides a collection of subprograms for working with
   complex numbers. The QuickBASIC TYPE definition statement is ideal for
   declaring variables to be of type Complex, as shown. The variables a, b,
   and c each comprise a pair of single-precision numbers representing the
   real and imaginary parts of a complex number. These variables are passed
   to and from the subprograms as easily as if they were simple numeric
   values.

   Complex numbers are expressed as the sum of a real and an imaginary
   number. Usually you show a complex number by writing the real number,
   followed immediately by a plus or minus sign, the imaginary number, and a
   small letter "i" or "j," which represents the square root of -1 and
   indicates the imaginary numeric component of the complex number.

   In this program, complex numbers are entered and displayed in a similar
   format. You use parentheses to surround each complex number. This sample
   run of COMPLEX shows typical input and output complex-number formats:


     Enter first complex number  ? (4-5i)
     (4-5i)

     ComplexExp                     (15.48743+52.35549i)
     ComplexLog                     1.856786-.8960554i)
     ComplexReciprocal              9.756097E-02+.1219512i)
     ComplexSqr                     2.280693-1.096158i)

     Enter second complex number    ? (3+4i)
     (3+4i)

     ComplexAdd                     (7-1i)
     ComplexSub                     (1-9i)
     ComplexMul                     (32+1i)
     ComplexDiv                     (-.32-1.24i)
     ComplexPower                   (251.4394-9454.315i)
     ComplexRoot                    (.9952651-.4262131i)



     Press any key to continue

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   COMPLEX.BAS                     Demo module
   Complex2String          Sub     String representation of a complex number
   ComplexAdd              Sub     Adds two complex numbers
   ComplexDiv              Sub     Divides two complex numbers
   ComplexExp              Sub     Exponential function of a complex number
   ComplexLog              Sub     Natural log of a complex number
   ComplexMul              Sub     Multiplies two complex numbers
   ComplexPower            Sub     Complex number raised to a complex number
   ComplexReciprocal       Sub     Reciprocal of a complex number
   ComplexRoot             Sub     Complex root of a complex number
   ComplexSqr              Sub     Square root of a complex number
   ComplexSub              Sub     Subtracts two complex numbers
   String2Complex          Sub     Converts string to complex variable
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: COMPLEX

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          COMPLEX                    **
     ' **  Type:          Toolbox                    **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates a set of complex number functions and
     ' subprograms.
     '
     ' USAGE:         No command line parameters
     ' .MAK FILE:     COMPLEX.BAS
     '                CARTESIA.BAS
     ' PARAMETERS:    (none)
     ' VARIABLES:     a          Variable of type Complex
     '                b          Variable of type Complex
     '                c          Variable of type Complex
     '                x$         String representation of a complex number
     '                y$         String representation of a complex number
     '                z$         String representation of a complex number

       TYPE Complex
           r AS SINGLE
           i AS SINGLE
       END TYPE

     ' Subprograms
       DECLARE SUB ComplexSub (a AS Complex, b AS Complex, c AS Complex)
       DECLARE SUB ComplexSqr (a AS Complex, c AS Complex)
       DECLARE SUB ComplexRoot (a AS Complex, b AS Complex, c AS Complex)
       DECLARE SUB ComplexReciprocal (a AS Complex, c AS Complex)
       DECLARE SUB ComplexAdd (a AS Complex, b AS Complex, c AS Complex)
       DECLARE SUB ComplexLog (a AS Complex, c AS Complex)
       DECLARE SUB ComplexPower (a AS Complex, b AS Complex, c AS Complex)
       DECLARE SUB Complex2String (a AS Complex, x$)
       DECLARE SUB String2Complex (x$, a AS Complex)
       DECLARE SUB ComplexDiv (a AS Complex, b AS Complex, c AS Complex)
       DECLARE SUB ComplexExp (a AS Complex, c AS Complex)
       DECLARE SUB ComplexMul (a AS Complex, b AS Complex, c AS Complex)
       DECLARE SUB Rec2pol (x!, y!, r!, theta!)

       DIM a AS Complex, b AS Complex, c AS Complex

       CLS
       INPUT "Enter first complex number  "; x$
       String2Complex x$, a
       Complex2String a, x$
       PRINT x$
       PRINT

       ComplexExp a, c
       Complex2String c, z$
       PRINT "ComplexExp", , z$

       ComplexLog a, c
       Complex2String c, z$
       PRINT "ComplexLog", , z$

       ComplexReciprocal a, c
       Complex2String c, z$
       PRINT "ComplexReciprocal", z$

       ComplexSqr a, c
       Complex2String c, z$
       PRINT "ComplexSqr", , z$

       PRINT
       INPUT "Enter second complex number "; y$
       String2Complex y$, b
       Complex2String b, y$
       PRINT y$
       PRINT

       ComplexAdd a, b, c
       Complex2String c, z$
       PRINT "ComplexAdd", , z$

       ComplexSub a, b, c
       Complex2String c, z$
       PRINT "ComplexSub", , z$

       ComplexMul a, b, c
       Complex2String c, z$
       PRINT "ComplexMul", , z$

       ComplexDiv a, b, c
       Complex2String c, z$
       PRINT "ComplexDiv", , z$

       ComplexPower a, b, c
       Complex2String c, z$
       PRINT "ComplexPower", , z$

       ComplexRoot a, b, c
       Complex2String c, z$
       PRINT "ComplexRoot", , z$
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Complex2String

   Creates a string representation of a complex number suitable for printing
   or displaying the results of complex number calculations. The string
   consists of two numbers enclosed in parentheses and separated by either a
   plus or minus sign, with the second number followed by a lowercase "i" to
   indicate the imaginary component. The length of this string result will
   vary, depending on the numeric values of the real and imaginary parts.

   All results displayed by the demonstrations are formatted using this
   subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Complex2String             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Makes a string representation of a complex number.
     '
     ' EXAMPLE OF USE:  Complex2String a, x$
     ' PARAMETERS:      a          Complex number variable (type Complex)
     '                  x$         String representation of the complex number
     ' VARIABLES:       r$         Working string, real part
     '                  i$         Working string, imaginary part
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '                  DECLARE SUB Complex2String (a AS Complex, x$)
     '
       SUB Complex2String (a AS Complex, x$) STATIC

         ' Form the left part of the string
           IF a.r < 0 THEN
               r$ = "(" + STR$(a.r)
           ELSE
               r$ = "(" + MID$(STR$(a.r), 2)
           END IF

         ' Form the right part of the string
           IF a.i < 0 THEN
               i$ = STR$(a.i)
           ELSE
               i$ = "+" + MID$(STR$(a.i), 2)
           END IF

         ' The whole is more complex than the sum of the parts
           x$ = r$ + i$ + "i)"

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexAdd

   Calculates the sum of two complex numbers. Complex number a is added to
   complex number b, and the result is placed in the variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexAdd                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Adds two complex numbers.
     '
     ' EXAMPLE OF USE:  ComplexAdd a, b, c
     ' PARAMETERS:      a          First complex number for the addition
     '                  b          Second complex number for the addition
     '                  c          Result of the complex number addition
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '         DECLARE SUB ComplexAdd (a AS Complex, b AS Complex, c AS Comple
     '
       SUB ComplexAdd (a AS Complex, b AS Complex, c AS Complex) STATIC
           c.r = a.r + b.r
           c.i = a.i + b.i
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexDiv

   Calculates the result of dividing one complex number by another. The
   result of a/b is placed in the variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexDiv                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Divides two complex numbers.
     '
     ' EXAMPLE OF USE:  ComplexDiv a, b, c
     ' PARAMETERS:      a          First complex number for the division
     '                  b          Second complex number for the division
     '                  c          Result of the complex number division a/b
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '        DECLARE SUB ComplexDiv (a AS Complex, b AS Complex, c AS Complex
     '
       SUB ComplexDiv (a AS Complex, b AS Complex, c AS Complex) STATIC
           t! = b.r * b.r + b.i * b.i
           c.r = (a.r * b.r + a.i * b.i) / t!
           c.i = (a.i * b.r - a.r * b.i) / t!
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexExp

   Calculates the exponential function of a complex number a. The result is
   placed in the variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexExp                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calculates the exponential function of a complex number.
     '
     ' EXAMPLE OF USE:  ComplexExp a, c
     ' PARAMETERS:      a          Complex number argument
     '                  c          Complex result of the calculations
     ' VARIABLES:       t!         Temporary working value
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '                  DECLARE SUB ComplexExp (a AS Complex, c AS Complex)
     '
       SUB ComplexExp (a AS Complex, c AS Complex) STATIC
           t! = EXP(a.r)
           c.r = t! * COS(a.i)
           c.i = t! * SIN(a.i)
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexLog

   Calculates the complex logarithm of a complex number a. The result is
   placed in the variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexLog                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calculates the log of a complex number.
     '
     ' EXAMPLE OF USE:  ComplexLog a, c
     ' PARAMETERS:      a          Complex number argument
     '                  c          Complex result of the calculations
     ' VARIABLES:       r!         Magnitude of complex number a
     '                  theta!     Angle of complex number a
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '                  DECLARE SUB ComplexLog (a AS Complex, c AS Complex)
     '                  DECLARE SUB Rec2pol (x!, y!, r!, theta!)
     '
       SUB ComplexLog (a AS Complex, c AS Complex) STATIC
           CALL Rec2pol(a.r, a.i, r!, theta!)
           IF r! <> 0! THEN
               c.r = LOG(r!)
               c.i = theta!
           ELSE
               ERROR 5
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexMul

   Calculates the product of two complex numbers. Complex variables a and b
   are multiplied, and the result is placed in the variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexMul                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Multiplies two complex numbers.
     '
     ' EXAMPLE OF USE:  ComplexMul a, b, c
     ' PARAMETERS:      a          First complex number for the multiplication
     '                  b          Second complex number for the multiplicatio
     '                  c          Result of the complex number multiplication
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '         DECLARE SUB ComplexMul (a AS Complex, b AS Complex, c AS Comple
     '
       SUB ComplexMul (a AS Complex, b AS Complex, c AS Complex) STATIC
           c.r = a.r * b.r - a.i * b.i
           c.i = a.r * b.i + a.i * b.r
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexPower

   Calculates the result of raising one complex number to the power of
   another. The result of raising a to the power of b is then placed in the
   variable c.

   Notice that this subprogram calls several others. If you extract this
   routine for use in another program module, be sure to extract the other
   subprograms as well.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexPower               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calculates a complex number raised to a complex number.
     '
     ' EXAMPLE OF USE:  ComplexPower a, b, c
     ' PARAMETERS:      a          Complex number to be raised to a power
     '                  b          Complex number to raise a to
     '                  c          Result of a raised to the power of b
     ' VARIABLES:       t1         Structure of type Complex
     '                  t2         Structure of type Complex
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '      DECLARE SUB ComplexPower (a AS Complex, b AS Complex, c AS Complex
     '      DECLARE SUB ComplexExp (a AS Complex, c AS Complex)
     '      DECLARE SUB ComplexLog (a AS Complex, c AS Complex)
     '      DECLARE SUB ComplexMul (a AS Complex, b AS Complex, c AS Complex)
     '
       SUB ComplexPower (a AS Complex, b AS Complex, c AS Complex) STATIC
           DIM t1 AS Complex, t2 AS Complex
           IF a.r <> 0! OR a.i <> 0! THEN
               CALL ComplexLog(a, t1)
               CALL ComplexMul(t1, b, t2)
               CALL ComplexExp(t2, c)
           ELSE
               ERROR 5
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexReciprocal

   Calculates the reciprocal of a complex number by dividing the complex
   number (1+0i) by the complex number a. The result is placed in the
   variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexReciprocal          **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calculates the reciprocal of a complex number.
     '
     ' EXAMPLE OF USE:  ComplexReciprocal a, c
     ' PARAMETERS:      a          Complex number to be processed
     '                  c          Result of calculating 1/a
     ' VARIABLES:       t          Structure of type Complex
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '         DECLARE SUB ComplexReciprocal (a AS Complex, c AS Complex)
     '         DECLARE SUB ComplexDiv (a AS Complex, b AS Complex, c AS Comple
     '
       SUB ComplexReciprocal (a AS Complex, c AS Complex) STATIC
           DIM t AS Complex
           t.r = 1!
           t.i = 0
           ComplexDiv t, a, c
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexRoot

   Calculates the complex root of a complex number. The ComplexReciprocal
   and ComplexPower subprograms are called by this subprogram. These
   routines allow the root to be found by raising a to the power of 1/b.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexRoot                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calculates the complex root of a complex number.
     '
     ' EXAMPLE OF USE:  ComplexRoot a, b, c
     ' PARAMETERS:      a          First complex number
     '                  b          Complex number root
     '                  c          Result of finding the bth root of a
     ' VARIABLES:       t          Structure of type Complex
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '       DECLARE SUB ComplexRoot (a AS Complex, b AS Complex, c AS Complex
     '       DECLARE SUB ComplexReciprocal (a AS Complex, c AS Complex)
     '       DECLARE SUB ComplexPower (a AS Complex, b AS Complex, c AS Comple
     '
       SUB ComplexRoot (a AS Complex, b AS Complex, c AS Complex) STATIC
           DIM t AS Complex
           IF b.r <> 0! OR b.i <> 0! THEN
               CALL ComplexReciprocal(b, t)
               CALL ComplexPower(a, t, c)
           ELSE
               ERROR 5
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexSqr

   Calculates the complex square root of a complex number. The square root of
   a is placed in the variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexSqr                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calculates the square root of a complex number.
     '
     ' EXAMPLE OF USE:  ComplexSqr a, c
     ' PARAMETERS:      a          Complex number argument
     '                  c          Result of finding the square root of a
     ' VARIABLES:       r!         Magnitude of complex number a
     '                  theta!     Angle of complex number a
     '                  rs!        Square root of r!
     '                  h!         One half of theta!
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '                  DECLARE SUB ComplexSqr (a AS Complex, c AS Complex)
     '
       SUB ComplexSqr (a AS Complex, c AS Complex) STATIC
           CALL Rec2pol(a.r, a.i, r!, theta!)
           rs! = SQR(r!)
           h! = theta! / 2!
           c.r = rs! * COS(h!)
           c.i = rs! * SIN(h!)
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ComplexSub

   Calculates the difference between two complex numbers. The result of
   subtracting b from a is returned in the variable c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ComplexSub                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Subtracts two complex numbers.
     '
     ' EXAMPLE OF USE:  ComplexSub a, b, c
     ' PARAMETERS:      a          First complex number
     '                  b          Second Complex number
     '                  c          Result of subtracting b from a
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '         DECLARE SUB ComplexSub (a AS Complex, b AS Complex, c AS Comple
     '
       SUB ComplexSub (a AS Complex, b AS Complex, c AS Complex) STATIC
           c.r = a.r - b.r
           c.i = a.i - b.i
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: String2Complex

   Converts a string representation of a complex number to a complex number
   variable of type Complex. This routine is useful for converting user input
   of a complex number to a complex variable.

   In general, the string should be in the same format as that produced by
   the Complex2String function. However, there is some flexibility to allow
   for variations in the way a user might type in complex numbers. For
   example, the "i" character indicates the imaginary part of a complex
   number, but a "j" will also be recognized. Also, parentheses around the
   numbers are optional.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          String2Complex             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        COMPLEX.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts a string representation of a complex
     ' number to a type Complex variable.
     '
     ' EXAMPLE OF USE:  String2Complex x$, a
     ' PARAMETERS:      x$         String representation of a complex number
     '                  a          Complex number structure of type Complex
     ' VARIABLES:       j%         Index to first numerical character
     '                  i%         Pointer to the "i" or "j" character
     '                  k%         Pointer to start of imaginary part
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Complex
     '                     r AS SINGLE
     '                     i AS SINGLE
     '                  END TYPE
     '
     '                  DECLARE SUB Complex2String (a AS Complex, x$)
     '
       SUB String2Complex (x$, a AS Complex) STATIC

         ' Real part starts just after left parenthesis
           j% = INSTR(x$, "(") + 1

         ' Step forward to find start of number
           DO UNTIL INSTR("+-0123456789", MID$(x$, j%, 1)) OR j% > LEN(x$)
               j% = j% + 1
           LOOP

         ' Imaginary part ends at the "i" or "j"
           i% = INSTR(LCASE$(x$), "i")
           IF INSTR(LCASE$(x$), "j") > i% THEN
               i% = INSTR(LCASE$(x$), "j")
           END IF

         ' Step back to find start of imaginary part
           FOR k% = i% TO 1 STEP -1
               IF INSTR("+-", MID$(x$, k%, 1)) THEN
                   EXIT FOR
               END IF
           NEXT k%

         ' Error if pointers don't make sense
           IF j% = 0 OR j% > LEN(x$) THEN
               PRINT "Error: String2Complex - unrecognizable string format"
               SYSTEM
           END IF

         ' Grab the real part
           a.r = VAL(MID$(x$, j%))

         ' Grab the imaginary part
           IF k% > j% THEN
               a.i = VAL(MID$(x$, k%))
           ELSEIF k% = j% THEN
               a.r = 0
               a.i = VAL(MID$(x$, j%))
           ELSE
               a.i = 0
           END IF

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 DOLLARS

   The DOLLARS toolbox contains three functions for working with monetary
   amounts.

   QuickBASIC provides a way for you to put commas between groups of three
   digits in numbers as they're printed or displayed. However, the Comma$
   and DollarString$ functions have the added advantage of allowing you to
   manipulate the string results further before outputting the results.

   The Round# function is presented here as a means of rounding dollar
   amounts to the nearest cent, but you can also use it for scientific and
   engineering calculations when you want to round numbers to a given number
   of decimal places.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   DOLLARS.BAS                     Demo module
   Comma$                  Func    Double-precision with commas inserted
   DollarString$           Func    Dollar representation rounded with commas
   Round#                  Func    Rounding at specified decimal place
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: DOLLARS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DOLLARS                    **
     ' **  Type:          Toolbox                    **
     ' **  Module:        DOLLARS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:         No command line parameters
     ' .MAK FILE:     (none)
     ' PARAMETERS:    (none)
     ' VARIABLES:     n#         Number for demonstration of the functions

       DECLARE FUNCTION Comma$ (n#)
       DECLARE FUNCTION DollarString$ (amount#, length%)
       DECLARE FUNCTION Round# (n#, place%)

       CLS
       n# = 1234567.76543#
       PRINT "Number n#:", , n#
       PRINT "Comma$(n#)", , Comma$(n#)
       PRINT "Comma$(Round#(n#, -2))", Comma$(Round#(n#, -2))
       PRINT
       PRINT "DollarString$(n#, 20)", ":"; DollarString$(n#, 20); ":"
       PRINT , , " 12345678901234567890"
       PRINT

       PRINT "Round#(n#, -3)", Round#(n#, -3)
       PRINT "Round#(n#, -2)", Round#(n#, -2)
       PRINT "Round#(n#, -1)", Round#(n#, -1)
       PRINT "Round#(n#, 0)", , Round#(n#, 0)
       PRINT "Round#(n#, 1)", , Round#(n#, 1)
       PRINT "Round#(n#, 2)", , Round#(n#, 2)
   ──────────────────────────────────────────────────────────────────────────


 Function: Comma$

   Returns a string representation of a given double-precision number, with
   commas separating groups of three digits to the left of the decimal point.
   The returned string is the same as that returned by the QuickBASIC STR$
   function, except for the addition of the commas.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Comma$                     **
     ' **  Type:          Function                   **
     ' **  Module:        DOLLARS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Creates a string representing a double-precision
     ' number, with commas inserted every three digits.
     '
     ' EXAMPLE OF USE:    n$  =  Comma$(n#)
     ' PARAMETERS:        n#     Number to be formatted
     ' VARIABLES:         tn$    Temporary string of the number
     '                    dp%    Position of the decimal point
     '                    i%     Index into tn$
     ' MODULE LEVEL
     '   DECLARATIONS:           DECLARE FUNCTION Comma$ (n#)
     '
       FUNCTION Comma$ (n#) STATIC
           tn$ = STR$(n#)
           dp% = INSTR(tn$, ".")
           IF dp% = 0 THEN
               dp% = LEN(tn$) + 1
           END IF
           IF dp% > 4 THEN
               FOR i% = dp% - 3 TO 3 STEP -3
                   tn$ = LEFT$(tn$, i% - 1) + "," + MID$(tn$, i%)
               NEXT i%
           END IF
           Comma$ = LTRIM$(tn$)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: DollarString$

   Returns a string representation of a dollar amount, as passed in a
   double-precision variable. The Round# function rounds the number to the
   nearest penny, and the Comma$ function separates each group of three
   digits to the left of the decimal point with commas. The string is then
   padded on the left with spaces until the desired string length is
   achieved, and a dollar sign is placed to the left of the spaces. Thus, you
   can conveniently display the dollar amounts in columns.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DollarString$              **
     ' **  Type:          Function                   **
     ' **  Module:        DOLLARS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string representation of a dollar amount,
     ' rounded to the nearest cent, with commas separating
     ' groups of three digits, and with a preceding dollar sign.
     '
     ' EXAMPLE OF USE:    d$ = DollarString$(dollars#)
     ' PARAMETERS:        dollars#   Amount of money
     ' VARIABLES:         tmp$       Temporary working string
     ' MODULE LEVEL
     '   DECLARATIONS:    DECLARE FUNCTION Comma$ (n#)
     '                    DECLARE FUNCTION DollarString$ (amount#, length%)
     '                    DECLARE FUNCTION Round# (n#, place%)
     '
       FUNCTION DollarString$ (amount#, length%) STATIC
           tmp$ = SPACE$(length%) + "$" + Comma$(Round#(amount#, -2))
           DollarString$ = RIGHT$(tmp$, length%)
           tmp$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Round#

   Rounds numbers to any decimal position, as specified by the passed power
   of ten rounding value. For example, to round pi to the nearest integer
   value, you would use Round#(3.1416#, 0); to round 2/3 of ten dollars to
   the nearest cent, Round#(6.6666667#, -2); and finally, to round the
   distance to the moon to the nearest thousand miles, Round#(238857#, 3).

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Round#                     **
     ' **  Type:          Function                   **
     ' **  Module:        DOLLARS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Rounds a number at the power of 10 decimal place.
     '
     ' EXAMPLE OF USE:  x# = Round#(n#, place%)
     ' EXAMPLES:        Round#(12.3456#, -2) = 12.35#
     '                  Round#(12.3456#, -1) = 12.3#
     '                  Round#(12.3456#, 0)  = 12#
     '                  Round#(12.3456#, 1)  = 10#
     ' PARAMETERS:      n#         Number to be rounded
     '                  place%     Power of 10 for rounding the number
     ' VARIABLES:       pTen#      10 raised to the indicated power of 10
     ' MODULE LEVEL
     '   DECLARATIONS:             DECLARE FUNCTION Round# (n#, place%)
     '
       FUNCTION Round# (n#, powerOfTen%) STATIC
           pTen# = 10# ^ powerOfTen%
           Round# = INT(n# / pTen# + .5#) * pTen#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 DOSCALLS

   These routines use the Interrupt and InterruptX subprograms, provided as
   part of the QuickBASIC package, to access the operating system through
   software interrupts. The information returned by these functions and
   subprograms is extensive and useful.

   The DOSCALLS demo module proceeds in this way:

   The BufferedKeyInput$ function prompts you to enter up to nine
   characters. The appearance of the prompt and the input action from the
   keyboard seem very similar to the QuickBASIC INPUT statement, but there
   are some fundamental differences.

   Next, the DOSVersion! function returns the MS-DOS version number.

   The SetDrive subprogram temporarily switches the current drive, and the
   GetDrive$ function displays the results.

   The GetMediaDescriptor subprogram returns several useful pieces of
   information about the current disk drive.

   The Verify state is normally set using the MS-DOS VERIFY command, but with
   the GetVerifyState% function and the SetVerifyState subprogram, your
   programs can now control this setting directly.

   The GetDiskFreeSpace subprogram returns five useful details about the
   structure of the data and free space on any disk drive in your system.

   The GetCountry subprogram returns a data structure filled with details
   that enable you to modify your program outputs for use in other countries.
   Also returned is the address of the MS-DOS character translation
   subroutine called CaseMap, which translates certain characters for some
   foreign languages.

   The TranslateCountry$ function uses the address returned by the
   GetCountry subprogram to translate a string of characters for the
   currently set country.

   The GetDirectory$ function and SetDirectory subprogram let you determine
   or set the current directory-path string.

   The WriteToDevice subprogram is useful for outputting strings directly to
   the indicated device, using the MS-DOS output handler rather than
   QuickBASIC's. One advantage of this approach is in being able to use the
   ANSI.SYS escape-code sequences to control cursor movement, screen mode,
   and color attributes.

   Finally, the GetFileAttributes and SetFileAttributes subprograms let you
   determine or change the file attribute bits as desired. With these
   routines, it's easy to hide or unhide files and to set or clear the
   archive bit for use by the MS-DOS XCOPY command.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   DOSCALLS.BAS                    Demo module
   BufferedKeyInput$       Func    ASCII string of specified length
   DOSVersion!             Func    Version number of MS-DOS returned
   GetCountry              Sub     Current country setting
   GetDirectory$           Func    Path to disk directory specified
   GetDiskFreeSpace        Sub     Disk space format and usage for input
                                    drive
   GetDrive$               Func    Current drive string
   GetFileAttributes       Sub     Attribute bits for given file
   GetMediaDescriptor      Sub     Drive information for system
   GetVerifyState%         Func    Verify setting (state)
   SetDirectory            Sub     Sets current directory
   SetDrive                Sub     Sets current disk drive
   SetFileAttributes       Sub     Sets the attribute bits for a given file
   SetVerifyState          Sub     Sets or clears verify state (writing to
                                    file)
   TranslateCountry$       Func    Translates string──current country
                                    setting
   WriteToDevice           Sub     Outputs a string to a device
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: DOSCALLS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DOSCALLS                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates several interrupt calls to MS-DOS.
     '
     ' USAGE:          No command line parameters
     ' REQUIREMENTS:   MS-DOS 3.0 or later
     '                 MIXED.QLB/.LIB
     '.MAK FILE:       (none)
     ' PARAMETERS:     (none)
     ' VARIABLES:      buffer$    String for buffered input demonstration
     '                 x$         Buffered input string
     '                 drive$     Current disk drive name
     '                 desc       Structure of type MediaDescriptorType
     '                 state%     Current status of the Verify state
     '                 oppositeState%   Opposite state for Verify
     '                 disk       Structure of type DiskFreeSpaceType
     '                 country    Structure of type CountryType
     '                 i%         Loop index for creating translation characte
     '                 a$         Characters to be translated
     '                 path$      Current directory
     '                 result%    Result code from call to SetDirectory
     '                 t$         Temporary copy of TIME$
     '                 attr       Structure of type FileAttributesType
     '                 fileName$  Name of file for determining file attributes


        TYPE RegType
           ax    AS INTEGER
           bx    AS INTEGER
           cx    AS INTEGER
           dx    AS INTEGER
           bp    AS INTEGER
           si    AS INTEGER
           di    AS INTEGER
           flags AS INTEGER
       END TYPE

       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 MediaDescriptorType
           sectorsPerAllocationUnit AS INTEGER
           bytesPerSector AS INTEGER
           FATIdentificationByte AS INTEGER
       END TYPE

       TYPE DiskFreeSpaceType
           sectorsPerCluster AS INTEGER
           bytesPerSector AS INTEGER
           clustersPerDrive AS LONG
           availableClusters AS LONG
           availableBytes AS LONG
       END TYPE

       TYPE CountryType
           dateTimeFormat AS STRING * 11
           currencySymbol AS STRING * 4
           thousandsSeparator AS STRING * 1
           decimalSeparator AS STRING * 1
           dateSeparator AS STRING * 1
           timeSeparator AS STRING * 1
           currencyThenSymbol AS INTEGER
           currencySymbolSpace AS INTEGER
           currencyPlaces AS INTEGER
           hours24 AS INTEGER
           caseMapSegment AS INTEGER
           caseMapOffset AS INTEGER
           dataListSeparator AS STRING * 1
       END TYPE

       TYPE FileAttributesType
           readOnly AS INTEGER
           hidden AS INTEGER
           systemFile AS INTEGER
           archive AS INTEGER
           result AS INTEGER
       END TYPE

     ' Subprograms
       DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegType)
       DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)
       DECLARE SUB SetDrive (drive$)
       DECLARE SUB GetMediaDescriptor (drive$, desc AS MediaDescriptorType)
       DECLARE SUB SetVerifyState (state%)
       DECLARE SUB GetDiskFreeSpace (drive$, disk AS DiskFreeSpaceType)
       DECLARE SUB GetCountry (country AS CountryType)
       DECLARE SUB CaseMap (character%, BYVAL Segment%, BYVAL Offset%)
       DECLARE SUB SetDirectory (path$, result%)
       DECLARE SUB WriteToDevice (handle%, a$, result%)
       DECLARE SUB GetFileAttributes (fileName$, attr AS FileAttributesType)
       DECLARE SUB SetFileAttributes (fileName$, attr AS FileAttributesType)

     ' Functions
       DECLARE FUNCTION DOSVersion! ()
       DECLARE FUNCTION BufferedKeyInput$ (n%)
       DECLARE FUNCTION GetDrive$ ()
       DECLARE FUNCTION GetVerifyState% ()
       DECLARE FUNCTION TranslateCountry$ (a$, country AS CountryType)
       DECLARE FUNCTION GetDirectory$ (drive$)

     ' Try the Buffered Keyboard Input call
       CLS
       PRINT "BufferedKeyInput$:"
       PRINT "Enter a string of up to nine characters...  ";
       x$ = BufferedKeyInput$(9)
       PRINT
       PRINT "Here's the nine-character string result... ";
       PRINT CHR$(34); x$; CHR$(34)

     ' Get the MS-DOS version number
       PRINT
       PRINT "DosVersion!:"
       PRINT "DOS Version number is "; DOSVersion!

     ' Demonstrate the GetDrive and SetDrive routines
       PRINT
       PRINT "GetDrive$ and SetDrive:"
       drive$ = GetDrive$
       PRINT "The current drive is "; drive$
       PRINT "Setting the current drive to A:"
       SetDrive "A:"
       PRINT "Now the current drive is "; GetDrive$
       PRINT "Setting the current drive back to "; drive$
       SetDrive drive$
       PRINT "Now the current drive is "; GetDrive$

     ' Call the MS-DOS "Media Descriptor" function for the current drive
       PRINT
       PRINT "GetMediaDescriptor"
       DIM desc AS MediaDescriptorType
       GetMediaDescriptor drive$, desc
       PRINT "Drive                        "; drive$
       PRINT "Sectors per allocation unit "; desc.sectorsPerAllocationUnit
       PRINT "Bytes per sector            "; desc.bytesPerSector
       PRINT "FAT identification byte      &H"; HEX$(desc.FATIdentificationByt

     ' Wait for user
       PRINT
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""
       CLS

     ' Demonstrate the GetVerifyState and SetVerifyState routines
       PRINT
       PRINT "GetVerifyState% and SetVerifyState:"
       state% = GetVerifyState%
       PRINT "Current verify state is"; state%
       oppositeState% = 1 AND NOT state%
       SetVerifyState oppositeState%
       PRINT "Now the verify state is"; GetVerifyState%
       SetVerifyState state%
       PRINT "Now the verify state is"; GetVerifyState%

     ' Determine free space on the current drive
       PRINT
       PRINT "GetDiskFreeSpace:"
       DIM disk AS DiskFreeSpaceType
       GetDiskFreeSpace drive$, disk
       PRINT "Sectors per cluster     "; disk.sectorsPerCluster
       PRINT "Bytes per sector        "; disk.bytesPerSector
       PRINT "Total clusters on drive "; disk.clustersPerDrive
       PRINT "Available clusters      "; disk.availableClusters
       PRINT "Available bytes         "; disk.availableBytes

     ' Wait for user
       PRINT
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""
       CLS

     ' Get country-dependent information
       PRINT
       PRINT "GetCountry:"
       DIM country AS CountryType
       GetCountry country
       PRINT "Date and time format    "; country.dateTimeFormat
       PRINT "Currency symbol         "; country.currencySymbol
       PRINT "Thousands separator     "; country.thousandsSeparator
       PRINT "Decimal separator       "; country.decimalSeparator
       PRINT "Date separator          "; country.dateSeparator
       PRINT "Time separator          "; country.timeSeparator
       PRINT "Currency before symbol "; country.currencyThenSymbol
       PRINT "Currency symbol space  "; country.currencySymbolSpace
       PRINT "Currency decimal places"; country.currencyPlaces
       PRINT "24-hour time           "; country.hours24
       PRINT "Case map segment       "; country.caseMapSegment
       PRINT "Case map offset        "; country.caseMapOffset
       PRINT "Data list separator     "; country.dataListSeparator

     ' Let's translate lowercase characters for the current country
       PRINT
       PRINT "TranslateCountry$:"
       FOR i% = 128 TO 175
           a$ = a$ + CHR$(i%)
       NEXT i%
       PRINT "Character codes 128 to 175, before and after translation... "
       PRINT a$
       PRINT TranslateCountry$(a$, country)

     ' Wait for user
       PRINT
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""
       CLS

     ' Demonstrate the SetDirectory and GetDirectory routines
       PRINT
       PRINT "GetDirectory$ and SetDirectory:"
       path$ = GetDirectory$(drive$)
       PRINT "Current directory is "; path$
       SetDirectory GetDrive$ + "\", result%
       PRINT "Now the directory is "; GetDirectory$(drive$)
       SetDirectory path$, result%
       PRINT "Now the directory is "; GetDirectory$(drive$)

     ' Write to a file or device
       PRINT
       PRINT "WriteToDevice:"
       PRINT "Writing a 'bell' character to the CRT"
       WriteToDevice 1, CHR$(7), result%
       t$ = TIME$
       DO
       LOOP UNTIL t$ <> TIME$
       PRINT "Writing a 'bell' character to the printer"
       WriteToDevice 4, CHR$(7), result%

     ' Wait for user
       PRINT
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""
       CLS

     ' Demonstrate the GetFileAttributes and SetFileAttributes routines
       PRINT
       PRINT "GetFileAttributes and SetFileAttributes:"
       DIM attr AS FileAttributesType
       fileName$ = "C:\IBMDOS.COM"
       GetFileAttributes fileName$, attr
       PRINT "File attributes for "; fileName$
       PRINT "Result of call "; attr.result
       PRINT "Read only      "; attr.readOnly
       PRINT "Hidden         "; attr.hidden
       PRINT "System         "; attr.systemFile
       PRINT "Archive        "; attr.archive
       PRINT
       attr.hidden = 0
       SetFileAttributes fileName$, attr
       GetFileAttributes fileName$, attr
       PRINT "File attributes for "; fileName$
       PRINT "Result of call "; attr.result
       PRINT "Read only      "; attr.readOnly
       PRINT "Hidden         "; attr.hidden
       PRINT "System         "; attr.systemFile
       PRINT "Archive        "; attr.archive
       PRINT
       attr.hidden = 1
       SetFileAttributes fileName$, attr
       GetFileAttributes fileName$, attr
       PRINT "File attributes for "; fileName$
       PRINT "Result of call "; attr.result
       PRINT "Read only      "; attr.readOnly
       PRINT "Hidden         "; attr.hidden
       PRINT "System         "; attr.systemFile
       PRINT "Archive        "; attr.archive
       PRINT
   ──────────────────────────────────────────────────────────────────────────


 Function: BufferedKeyInput$

   Calls the MS-DOS Buffered Keyboard Input routine, which is similar in
   concept to QuickBASIC's LINE INPUT statement but contains some useful
   differences.

   When you call the BufferedKeyInput$ function, you pass an integer that
   tells the MS-DOS routine the maximum number of characters to be input. If
   extra characters are typed, the computer beeps, and the keystrokes are
   ignored. The Backspace and Left arrow keys allow editing of the input, and
   the screen is constantly updated to display the input buffer at the
   current cursor location.

   The returned string is always n% characters in length, even if the user
   entered fewer than n% characters. If necessary, the string is padded on
   the right with spaces to bring the length up to n%.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BufferedKeyInput$          **
     ' **  Type:          Function                   **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calls the "Buffered Keyboard Input" MS-DOS function
     ' and returns the entered string of characters.
     '
     ' EXAMPLE OF USE:  x$ = BufferedKeyInput$(n%)
     ' PARAMETERS:      buffer$    Buffer for keyboard input
     ' VARIABLES:       regX       Structure of type RegTypeX
     '                  bufSize%   Length of buffer$
     '                  b$         Working copy of buffer$
     '                  count%     Count of characters entered
     ' MODULE LEVEL
     '   DECLARATIONS:  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
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE FUNCTION BufferedKeyInput$ (n%)
     '
       FUNCTION BufferedKeyInput$ (n%) STATIC
           DIM regX AS RegTypeX
           b$ = CHR$(n% + 1) + SPACE$(n% + 1)
           regX.ax = &HA00
           regX.ds = VARSEG(b$)
           regX.dx = SADD(b$)
           InterruptX &H21, regX, regX
           count% = ASC(MID$(b$, 2, 1))
           BufferedKeyInput$ = MID$(b$, 3, count%) + SPACE$(n% - count%)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: DOSVersion!

   Returns the version number of MS-DOS. Sometimes it's necessary to know the
   current version of MS-DOS before proceeding with certain MS-DOS functions.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DOSVersion!                **
     ' **  Type:          Function                   **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the version number of MS-DOS.
     '
     ' EXAMPLE OF USE:  PRINT "MS-DOS Version number is "; DOSVersion!
     ' PARAMETERS:      (none)
     ' VARIABLES:       reg        Structure of type RegType
     '                  major%     Integer part of the MS-DOS version number
     '                  minor%     Fractional part of the MS-DOS version numbe
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE FUNCTION DOSVersion! ()
     '
       FUNCTION DOSVersion! STATIC
           DIM reg AS RegType
           reg.ax = &H3000
           Interrupt &H21, reg, reg
           major% = reg.ax MOD 256
           minor% = reg.ax \ 256
           DOSVersion! = major% + minor% / 100!
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: GetCountry

   Returns information from MS-DOS about the current country settings. This
   information can be invaluable for programs slated to be marketed in more
   than one country. A program's data output can be modified to conform to
   the standards of each country. For example, the date 3-4-88 can refer to
   March 4th or April 3rd, depending on which part of the world you are in.

   The date and time format string indicates the order of the six numeric
   values that make up a given date and time.

   Several variables are returned to indicate the desirable way to format
   monetary values. These determine whether the currency symbol is before or
   after the monetary value, whether a space separates the two, and the
   number of decimal places to use.

   The currency symbol is a four-character string such as "Lira". For
   dollars, the string contains three spaces followed by a $.

   The thousands separator is a one-character string, usually a decimal point
   or a comma.

   The decimal separator is also a one-character string, usually a decimal
   point or a comma.

   The date separator is a one-character string such as "-" or "/".

   The time separator is a one-character string such as ":".

   The hours designation indicates whether a 24-hour format or an A.M. and
   P.M. 12-hour format is more commonly used. The CaseMap address is the
   segment and offset address of the MS-DOS character translation function.
   Refer to the TranslateCountry$ function to see how this address is used.
   (The CaseMap subprogram is discussed in Part III of this book.)

   The data list separator is a one-character string such as ",".

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetCountry                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns country-dependent information as defined
     ' by MS-DOS.
     '
     ' EXAMPLE OF USE:  GetCountry country
     ' PARAMETERS:      country    Structure of type CountryType
     ' VARIABLES:       regX       Structure of type RegTypeX
     '                  c$         Buffer for data returned from interrupt
     ' MODULE LEVEL
     '   DECLARATIONS:  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 CountryType
     '                     DateTimeFormat AS STRING * 11
     '                     CurrencySymbol AS STRING * 4
     '                     ThousandsSeparator AS STRING * 1
     '                     DecimalSeparator AS STRING * 1
     '                     DateSeparator AS STRING * 1
     '                     TimeSeparator AS STRING * 1
     '                     CurrencyThenSymbol AS INTEGER
     '                     CurrencySymbolSpace AS INTEGER
     '                     CurrencyPlaces AS INTEGER
     '                     Hours24 AS INTEGER
     '                     caseMapSegment AS INTEGER
     '                     caseMapOffset AS INTEGER
     '                     DataListSeparator AS STRING * 1
     '                  END TYPE
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB GetCountry (country AS CountryType)
     '
       SUB GetCountry (country AS CountryType)
           DIM regX AS RegTypeX
           regX.ax = &H3800
           c$ = SPACE$(32)
           regX.ds = VARSEG(c$)
           regX.dx = SADD(c$)
           InterruptX &H21, regX, regX
           SELECT CASE CVI(LEFT$(c$, 2))
           CASE 0
               country.dateTimeFormat = "h:m:s m/d/y"
           CASE 1
               country.dateTimeFormat = "h:m:s d/m/y"
           CASE 2
               country.dateTimeFormat = "y/m/d h:m:s"
           CASE ELSE
               country.dateTimeFormat = "h:m:s m/d/y"
           END SELECT
           country.currencySymbol = MID$(c$, 3, 4)
           country.thousandsSeparator = MID$(c$, 8, 1)
           country.decimalSeparator = MID$(c$, 10, 1)
           country.dateSeparator = MID$(c$, 12, 1)
           country.timeSeparator = MID$(c$, 14, 1)
           country.currencyThenSymbol = ASC(MID$(c$, 16)) AND 1
           country.currencySymbolSpace = (ASC(MID$(c$, 16)) AND 2) \ 2
           country.currencyPlaces = ASC(MID$(c$, 17))
           country.hours24 = ASC(MID$(c$, 18))
           country.caseMapSegment = CVI(MID$(c$, 21, 2))
           country.caseMapOffset = CVI(MID$(c$, 19, 2))
           country.dataListSeparator = MID$(c$, 23, 1)
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: GetDirectory$

   Returns the complete path for any drive on your system. The called MS-DOS
   function doesn't return the drive designation or the first slash,
   representing the root directory, but the GetDirectory$ function adds these
   parts to the returned string for you.

   For the current directory of the current, default drive, pass a null
   string. For a specific drive, pass a string containing the letter of the
   drive in the first character position. For example, GetDirectory$("A:")
   might return A:\QB4\SOURCE.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetDirectory$              **
     ' **  Type:          Function                   **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the name of the current directory for any drive.
     '
     ' EXAMPLE OF USE:  path$ = GetDirectory$(drive$)
     ' PARAMETERS:      drive$     Drive of concern, or null string for defaul
     '                             drive
     ' VARIABLES:       regX       Structure of type RegTypeX
     '                  d$         Working copy of drive$
     '                  p$         Buffer space for returned path
     ' MODULE LEVEL
     '   DECLARATIONS:  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
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE FUNCTION GetDirectory$ (drive$)
     '
       FUNCTION GetDirectory$ (drive$) STATIC
           DIM regX AS RegTypeX
           IF drive$ = "" THEN
               d$ = GetDrive$
           ELSE
               d$ = UCASE$(drive$)
           END IF
           drive% = ASC(d$) - 64
           regX.dx = drive%
           regX.ax = &H4700
           p$ = SPACE$(64)
           regX.ds = VARSEG(p$)
           regX.si = SADD(p$)
           InterruptX &H21, regX, regX
           p$ = LEFT$(p$, INSTR(p$, CHR$(0)) - 1)
           GetDirectory$ = LEFT$(d$, 1) + ":\" + p$
           IF regX.flags AND 1 THEN
               GetDirectory$ = ""
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: GetDiskFreeSpace

   Returns information about the current usage and format of a given disk
   drive's contents. The data structure of type DiskFreeSpaceType lists the
   various information returned by this subprogram. Some information, such as
   the sectors per cluster, bytes per sector, and total clusters information,
   is constant in nature, so the subprogram always returns the same value for
   a given drive. The available clusters and available bytes are the variable
   information that this subprogram returns.

   Probably the most important information this subprogram returns is the
   total bytes available. Call this subprogram before creating a large file
   on a disk to prevent the program from being interrupted by a "disk full"
   message. This lets you prompt the user to insert a different disk or take
   other action before any data is lost.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetDiskFreeSpace           **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Get information about a drive's organization, including
     ' total number of bytes available.
     '
     ' EXAMPLE OF USE:  GetDiskFreeSpace drive$, disk
     ' PARAMETERS:      drive$     Disk drive designation
     '                  disk       Structure of type DiskFreeSpaceType
     ' VARIABLES:       reg        Structure of type RegType
     '                  drive%     Numeric drive designation
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '                  TYPE DiskFreeSpaceType
     '                     sectorsPerCluster AS INTEGER
     '                     bytesPerSector AS INTEGER
     '                     clustersPerDrive AS LONG
     '                     availableClusters AS LONG
     '                     availableBytes AS LONG
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB GetDiskFreeSpace (drive$, disk AS DiskFreeSpaceType)
     '
       SUB GetDiskFreeSpace (drive$, disk AS DiskFreeSpaceType)
           DIM reg AS RegType
           IF drive$ <> "" THEN
               drive% = ASC(UCASE$(drive$)) - 64
           ELSE
               drive% = 0
           END IF
           IF drive% >= 0 THEN
               reg.dx = drive%
           ELSE
               reg.dx = 0
           END IF
           reg.ax = &H3600
           Interrupt &H21, reg, reg
           disk.sectorsPerCluster = reg.ax
           disk.bytesPerSector = reg.cx
           IF reg.dx >= 0 THEN
               disk.clustersPerDrive = reg.dx
           ELSE
               disk.clustersPerDrive = reg.dx + 65536
           END IF
           IF reg.bx >= 0 THEN
               disk.availableClusters = reg.bx
           ELSE
               disk.availableClusters = reg.bx + 65536
           END IF
           disk.availableBytes = disk.availableClusters * reg.ax * reg.cx
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: GetDrive$

   Returns a two-character string designation for the current disk drive. The
   first character is always an uppercase letter, and the second character is
   always a colon.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetDrive$                  **
     ' **  Type:          Function                   **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the current disk drive name, such as "A:".
     '
     ' EXAMPLE OF USE:  drive$ = GetDrive$
     ' PARAMETERS:      (none)
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE RegType
     '                     ax    AS INTEGER
     '                     bx    AS INTEGER
     '                     cx    AS INTEGER
     '                     dx    AS INTEGER
     '                     bp    AS INTEGER
     '                     si    AS INTEGER
     '                     di    AS INTEGER
     '                     flags AS INTEGER
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE FUNCTION GetDrive$ ()
     '
       FUNCTION GetDrive$ STATIC
           DIM reg AS RegType
           reg.ax = &H1900
           Interrupt &H21, reg, reg
           GetDrive$ = CHR$((reg.ax AND &HFF) + 65) + ":"
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: GetFileAttributes

   Returns current attribute bits for a given file. Each file has several
   attribute bits that serve useful purposes in MS-DOS. For example, whenever
   a change is made to a file, the "archive" bit is set. The MS-DOS XCOPY
   utility can check the setting of this bit and copy only those files that
   have been modified since the last XCOPY command was given for the same set
   of files. XCOPY clears this bit when a file is copied.

   The "read only" attribute bit protects a file by preventing you from
   changing or deleting its contents. You can read the file, list it, or
   access it in any normal way, but the operating system will generate an
   error if you try to edit or delete it.

   The "hidden" attribute bit makes a file invisible to the user. A good
   example of this bit's action is shown by the module-level code that
   demonstrates this subprogram. The hidden file IBMDOS.COM has its "hidden"
   bit cleared and then reset. If you leave this bit cleared, the IBMDOS.COM
   file will show up in your root directory whenever you give the DIR
   command.

   DOSCALLS

   The "system" attribute bit marks files such as IBMBIO.COM and IBMDOS.COM
   as special system files. These two files are in the root directory of all
   your bootable disks and are necessary for MS-DOS to be able to
   successfully boot from a given disk.

   The variable attr.result returns a 0 if the attempt to read the file
   attribute bits was successful.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetFileAttributes          **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the file attribute settings for a file.
     '
     ' EXAMPLE OF USE:  GetFileAttributes fileName$, attr
     ' PARAMETERS:      fileName$  Name of file
     '                  attr       Structure of type FileAttributesType
     ' VARIABLES:       regX       Structure of type RegTypeX
     '                  f$         Null terminated copy of fileName$
     ' MODULE LEVEL
     '   DECLARATIONS:  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 FileAttributesType
     '                     readOnly AS INTEGER
     '                     hidden AS INTEGER
     '                     systemFile AS INTEGER
     '                     archive AS INTEGER
     '                     result AS INTEGER
     '                  END TYPE
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB GetFileAttributes (fileName$, attr AS FileAttributesType)
     '
       SUB GetFileAttributes (fileName$, attr AS FileAttributesType) STATIC
           DIM regX AS RegTypeX
           regX.ax = &H4300
           f$ = fileName$ + CHR$(0)
           regX.ds = VARSEG(f$)
           regX.dx = SADD(f$)
           InterruptX &H21, regX, regX
           IF regX.flags AND 1 THEN
               attr.result = regX.ax
           ELSE
               attr.result = 0
           END IF
           attr.readOnly = regX.cx AND 1
           attr.hidden = (regX.cx \ 2) AND 1
           attr.systemFile = (regX.cx \ 4) AND 1
           attr.archive = (regX.cx \ 32) AND 1
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: GetMediaDescriptor

   Returns media information about any disk drive currently defined by
   MS-DOS. For any given drive, you can determine the number of sectors per
   allocation unit, the number of bytes per sector, and the FAT
   identification byte MS-DOS uses to determine how to treat the drive. This
   information is returned by the MS-DOS function 21H.

   The GetDiskFreeSpace subprogram returns related information.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetMediaDescriptor         **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calls the MS-DOS "Get Media Descriptor" function for
     ' the indicated drive.  Results are returned in a
     ' structure of type MediaDescriptorType.
     '
     ' EXAMPLE OF USE:  GetMediaDescriptor drive$, desc
     ' PARAMETERS:      drive$     Drive designation, such as "A:"
     '                  desc       Structure of type MediaDescriptorType
     ' VARIABLES:       regX       Structure of type RegTypeX
     '                  drive%     Numeric drive designation
     ' MODULE LEVEL
     '   DECLARATIONS:  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 MediaDescriptorType
     '                     sectorsPerAllocationUnit AS INTEGER
     '                     bytesPerSector AS INTEGER
     '                     FATIdentificationByte AS INTEGER
     '                  END TYPE
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB GetMediaDescriptor (drive$, desc AS MediaDescriptorType)
     '
       SUB GetMediaDescriptor (drive$, desc AS MediaDescriptorType) STATIC
           DIM regX AS RegTypeX
           IF drive$ <> "" THEN
               drive% = ASC(UCASE$(drive$)) - 64
           ELSE
               drive% = 0
           END IF
           IF drive% >= 0 THEN
               regX.dx = drive%
           ELSE
               regX.dx = 0
           END IF
           regX.ax = &H1C00
           InterruptX &H21, regX, regX
           desc.sectorsPerAllocationUnit = regX.ax AND &HFF
           desc.bytesPerSector = regX.cx
           DEF SEG = regX.ds
           desc.FATIdentificationByte = PEEK(regX.bx)
           DEF SEG
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: GetVerifyState%

   Returns the current setting of the MS-DOS Verify flag. If Verify is on,
   this function returns a 1. If Verify is off, a 0 is returned.

   See the SetVerifyState subprogram to see how to set the Verify on or off
   as desired.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetVerifyState%            **
     ' **  Type:          Function                   **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the current state of the MS-DOS "Verify After
     ' Write" flag.
     '
     ' EXAMPLE OF USE:  state% = GetVerifyState%
     ' PARAMETERS:      (none)
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  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
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE FUNCTION GetVerifyState% ()
     '
       FUNCTION GetVerifyState% STATIC
           DIM reg AS RegType
           reg.ax = &H5400
           Interrupt &H21, reg, reg
           GetVerifyState% = reg.ax AND &HFF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SetDirectory

   Sets the current directory for the default drive in the same way as the
   MS-DOS CHDIR command.

   For example, to cause a program to change to the directory C:\TXT, use
   this program statement:


     SetDirectory "C:\TXT", result%

   The returned value of result% indicates whether the attempt to change the
   directory was successful. If result% is 0, the directory change was
   successful.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SetDirectory               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets the current directory.
     '
     ' EXAMPLE OF USE:  SetDirectory path$, result%
     ' PARAMETERS:      path$      The path to the directory
     '                  result%    Returned error code, zero if successful
     ' VARIABLES:       regX       Structure of type RegTypeX
     '                  p$         Null terminated copy of path$
     ' MODULE LEVEL
     '   DECLARATIONS:  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
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB SetDirectory (path$, result%)
     '
       SUB SetDirectory (path$, result%) STATIC
           DIM regX AS RegTypeX
           regX.ax = &H3B00
           p$ = path$ + CHR$(0)
           regX.ds = VARSEG(p$)
           regX.dx = SADD(p$)
           InterruptX &H21, regX, regX
           IF regX.flags AND 1 THEN
               result% = regX.ax
           ELSE
               result% = 0
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SetDrive

   Lets a QuickBASIC program change the current disk drive. Another way of
   doing the same thing would be to use the SHELL statement:


     SHELL "CD " + d$

   However, this subprogram is much more efficient and much faster.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SetDrive                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calls MS-DOS to set the current drive.
     '
     ' EXAMPLE OF USE:  SetDrive d$
     ' PARAMETERS:      d$         Drive designation, such as "A:"
     ' VARIABLES:       reg        Structure of type RegType
     '                  drive%     Numeric value of drive
     ' MODULE LEVEL
     '   DECLARATIONS:  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
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB SetDrive (drive$)
     '
       SUB SetDrive (drive$) STATIC
           DIM reg AS RegType
           IF drive$ <> "" THEN
               drive% = ASC(UCASE$(drive$)) - 65
           ELSE
               drive% = 0
           END IF
           IF drive% >= 0 THEN
               reg.dx = drive%
           ELSE
               reg.dx = 0
           END IF
           reg.ax = &HE00
           Interrupt &H21, reg, reg
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SetFileAttributes

   Sets the file attribute bits for a file as desired. For example, to make a
   file invisible to the user, set the "hidden" attribute bit. To protect a
   file from accidentally being modified or deleted, set the "read only"
   attribute bit.

   The GetFileAttributes subprogram describes these file attribute bits in
   more detail.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SetFileAttributes          **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets attribute bits for a file.
     '
     ' EXAMPLE OF USE:  SetFileAttributes fileName$, attr
     ' PARAMETERS:      fileName$  Name of file
     '                  attr       Structure of type FileAttributesType
     ' VARIABLES:       regX       Structure of type RegTypeX
     '                  f$         Null terminated copy of fileName$
     ' MODULE LEVEL
     '   DECLARATIONS:  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 FileAttributesType
     '                    readOnly AS INTEGER
     '                    hidden AS INTEGER
     '                    systemFile AS INTEGER
     '                    archive AS INTEGER
     '                    result AS INTEGER
     '                 END TYPE
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB SetFileAttributes (fileName$, attr AS FileAttributesType)
     '
       SUB SetFileAttributes (fileName$, attr AS FileAttributesType)
           DIM regX AS RegTypeX
           regX.ax = &H4301
           IF attr.readOnly THEN
               regX.cx = 1
           ELSE
               regX.cx = 0
           END IF
           IF attr.hidden THEN
               regX.cx = regX.cx + 2
           END IF
           IF attr.systemFile THEN
               regX.cx = regX.cx + 4
           END IF
           IF attr.archive THEN
               regX.cx = regX.cx + 32
           END IF
           f$ = fileName$ + CHR$(0)
           regX.ds = VARSEG(f$)
           regX.dx = SADD(f$)
           InterruptX &H21, regX, regX
           IF regX.flags AND 1 THEN
               attr.result = regX.ax
           ELSE
               attr.result = 0
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SetVerifyState

   Sets or clears the write verify flag MS-DOS uses during disk file writing,
   duplicating the actions of the MS-DOS commands VERIFY ON and VERIFY OFF.
   If a parameter (state%) of 0 is passed to the routine, the subprogram sets
   the Verify state to off. If non-zero, it sets it to on.

   To determine the current setting of the Verify flag, use the
   GetVerifyState% function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SetVerifyState             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets or clears the "Verify After Write" MS-DOS flag.
     '
     ' EXAMPLE OF USE:  SetVerifyState state%
     ' PARAMETERS:      state%     If 0, resets Verify;  If non-zero,
     '                             then sets Verify on
     ' VARIABLES:       reg        Structure of type RegType
     ' MODULE LEVEL
     '   DECLARATIONS:  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
     '                  END TYPE
     '
     '      DECLARE SUB Interrupt (intnum%, inreg AS RegType, outreg AS RegTyp
     '      DECLARE SUB SetVerifyState (state%)
     '
       SUB SetVerifyState (state%) STATIC
           DIM reg AS RegType
           IF state% THEN
               reg.ax = &H2E01
           ELSE
               reg.ax = &H2E00
           END IF
           Interrupt &H21, reg, reg
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: TranslateCountry$

   Returns the translated version of the string passed to it, according to
   the current MS-DOS country setting. Only characters with byte values in
   the range 128 through 255 are candidates for translation.

   Before calling this function, you must call the GetCountry subprogram to
   fill in the structure of type GetCountryType with the address of the
   translation routine in the operating system. This housekeeping is all
   taken care of automatically if you only remember to call GetCountry
   before calling TranslateCountry$.

   The TranslateCountry$ function calls an assembly-language subprogram named
   CaseMap to translate each character of the passed string. CaseMap
   demonstrates the powerful DECLARE statement of QuickBASIC. ( CaseMap is
   discussed in Part III of this book.) Notice that the segment% and offset%
   variables representing the address of the MS-DOS translation routine are
   passed by value rather than by address, the default.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          TranslateCountry$          **
     ' **  Type:          Function                   **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string of characters translated according to
     ' the current country setting of MS-DOS.
     '
     ' EXAMPLE OF USE:  b$ = TranslateCountry$(a$, country)
     ' PARAMETERS:      a$         String to be translated
     '                  country    Structure of type CountryType
     ' VARIABLES:       i%         Index to each character of a$
     '                  c%         Byte value of each character in a$
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE CountryType
     '                     DateTimeFormat AS STRING * 11
     '                     CurrencySymbol AS STRING * 4
     '                     ThousandsSeparator AS STRING * 1
     '                     DecimalSeparator AS STRING * 1
     '                     DateSeparator AS STRING * 1
     '                     TimeSeparator AS STRING * 1
     '                     CurrencyThenSymbol AS INTEGER
     '                     CurrencySymbolSpace AS INTEGER
     '                     CurrencyPlaces AS INTEGER
     '                     Hours24 AS INTEGER
     '                     caseMapSegment AS INTEGER
     '                     caseMapOffset AS INTEGER
     '                     DataListSeparator AS STRING * 1
     '                  END TYPE
     '
     '           DECLARE SUB CaseMap (character%, BYVAL Segment%, BYVAL Offset
     '           DECLARE FUNCTION TranslateCountry$ (a$, country AS CountryTyp
     '
       FUNCTION TranslateCountry$ (a$, country AS CountryType) STATIC
           FOR i% = 1 TO LEN(a$)
               c% = ASC(MID$(a$, i%))
               CaseMap c%, country.caseMapSegment, country.caseMapOffset
               MID$(a$, i%, 1) = CHR$(c%)
           NEXT i%
           TranslateCountry$ = a$
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: WriteToDevice

   Outputs a string of bytes or characters to any device or file. QuickBASIC
   provides comprehensive input and output capabilities and should be used
   whenever possible. This routine is for those rare instances when accessing
   the MS-DOS output routines is of benefit. For example, the STDOUT toolbox
   is a good example of the use of the MS-DOS level code for output.
   QuickBASIC PRINT statements bypass the extended screen and keyboard
   control device named ANSI.SYS. Using this WriteToDevice subprogram (or the
   routines in the STDOUT toolbox) lets you use the ANSI.SYS driver's
   capabilities.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          WriteToDevice              **
     ' **  Type:          Subprogram                 **
     ' **  Module:        DOSCALLS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Writes bytes to a file or device.
     '
     ' EXAMPLE OF USE:  WriteToDevice handle%, a$, result%
     ' PARAMETERS:      handle%    File or device handle
     '                  a$         String to be output
     '                  result%    Error code returned from MS-DOS
     ' VARIABLES:       regX       Structure of type RegTypeX
     ' MODULE LEVEL
     '   DECLARATIONS:  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
     '
     '   DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB WriteToDevice (handle%, a$, result%)
     '
       SUB WriteToDevice (handle%, a$, result%) STATIC
           DIM regX AS RegTypeX
           regX.ax = &H4000
           regX.cx = LEN(a$)
           regX.bx = handle%
           regX.ds = VARSEG(a$)
           regX.dx = SADD(a$)
           InterruptX &H21, regX, regX
           IF regX.flags AND 1 THEN
               result% = regX.ax
           ELSEIF regX.ax <> LEN(a$) THEN
               result% = -1
           ELSE
               result% = 0
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 EDIT

   The EDIT toolbox is a collection of subprograms for line and screen input
   of strings. The EditLine subprogram allows full input editing on a single
   line, and the EditBox subprogram allows user input and editing inside a
   rectangular area of the screen. The DrawBox, FormatTwo, and
   InsertCharacter subprograms enhance the capabilities of the EditBox
   routine and provide capabilities that can be useful in themselves.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   EDIT.BAS                        Demo module
   DrawBox                 Sub     Creates a double-lined box on the display
   EditBox                 Sub     Allows editing in a boxed area of the
                                    screen
   EditLine                Sub     Allows editing of string at cursor
                                    position
   FormatTwo               Sub     Splits string into two strings
   InsertCharacter         Sub     Inserts a character
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: EDIT

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          EDIT                       **
     ' **  Type:          Toolbox                    **
     ' **  Module:        EDIT.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:           No command line parameters
     ' .MAK FILE:       EDIT.BAS
     '                  KEYS.BAS
     ' PARAMETERS:      (none)
     ' VARIABLES:       a$         String to be edited by the user

       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Key code numbers
       CONST BACKSPACE = 8
       CONST CTRLLEFTARROW = 29440
       CONST CTRLRIGHTARROW = 29696
       CONST CTRLY = 25
       CONST CTRLQ = 17
       CONST DELETE = 21248
       CONST DOWNARROW = 20480
       CONST ENDKEY = 20224
       CONST ENTER = 13
       CONST ESCAPE = 27
       CONST HOME = 18176
       CONST INSERTKEY = 20992
       CONST LEFTARROW = 19200
       CONST RIGHTARROW = 19712
       CONST TABKEY = 9
       CONST UPARROW = 18432

     ' Functions
       DECLARE FUNCTION KeyCode% ()

     ' Subprograms
       DECLARE SUB EditLine (a$, exitCode%)
       DECLARE SUB DrawBox (row1%, col1%, row2%, col2%)
       DECLARE SUB EditBox (a$, row1%, col1%, row2%, col2%)
       DECLARE SUB FormatTwo (a$, b$, col%)
       DECLARE SUB InsertCharacter (x$(), kee$, cp%, rp%, wide%, high%)

     ' Demonstrate the EditLine subprogram
       a$ = " Edit this line, and then press Up arrow, Down arrow, or Enter "
       CLS
       COLOR 14, 1
       EditLine a$, exitCode%
       COLOR 7, 0
       PRINT
       PRINT
       PRINT "Result of edit ..."
       COLOR 14, 0
       PRINT a$
       COLOR 7, 0
       PRINT
       SELECT CASE exitCode%
       CASE 0
           PRINT "Enter";
       CASE -1
           PRINT "Down arrow";
       CASE 1
           PRINT "Up arrow";
       CASE ELSE
       END SELECT
       PRINT " key pressed."

     ' Demonstrate the EditBox subprogram
       a$ = "Now, edit text inside this box.  Press "
       a$ = a$ + "Esc to end the editing..."
       COLOR 12, 1
       DrawBox 8, 17, 19, 57
       COLOR 11, 1
       EditBox a$, 8, 17, 19, 57
       LOCATE 21, 1
       COLOR 7, 0
       PRINT "Result..."
       COLOR 14, 0
       PRINT a$
       COLOR 7, 0
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: DrawBox

   Draws a rectangular, double-lined box on the screen. No attempt is made to
   save the screen contents under the box area, and no control of the
   character colors is provided. The DrawBox subprogram simply provides a
   fast, flexible way to get a rectangular area of the screen cleared and
   outlined using the current foreground and background color settings. Use
   the COLOR statement before calling this subprogram if you want to change
   the foreground and background colors.

   The WINDOWS.BAS module provides a more comprehensive method of creating
   and removing windows for information and menuing tasks.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DrawBox                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        EDIT.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Draws a double-lined box.
     '
     ' EXAMPLE OF USE:  DrawBox row1%, col1%, row2%, col2%
     ' PARAMETERS:      row1%    Screen text row at upper left corner of the b
     '                  col1%    Screen text column at upper left corner of th
     '                  row2%    Screen text row at lower right corner of the
     '                  col2%    Screen text column at lower right corner of t
     '                           box
     ' VARIABLES:       wide%    Inside width of box
     '                  row3%    Loop row number for creating sides of box
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB DrawBox (row1%, col1%, row2%, col2%)
     '
       SUB DrawBox (row1%, col1%, row2%, col2%) STATIC

         ' Determine inside width of box
           wide% = col2% - col1% - 1

         ' Across the top
           LOCATE row1%, col1%, 0
           PRINT CHR$(201);
           PRINT STRING$(wide%, 205);
           PRINT CHR$(187);

         ' Down the sides
           FOR row3% = row1% + 1 TO row2% - 1
               LOCATE row3%, col1%, 0
               PRINT CHR$(186);
               PRINT SPACE$(wide%);
               PRINT CHR$(186);
           NEXT row3%

         ' Across the bottom
           LOCATE row2%, col1%, 0
           PRINT CHR$(200);
           PRINT STRING$(wide%, 205);
           PRINT CHR$(188);

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: EditBox

   Lets a user input and edit string characters in a rectangular area of the
   screen. This routine doesn't draw a box around the area on the display,
   but you can easily create one by calling the DrawBox subprogram before
   calling EditBox.

   This subprogram is a simple text editor. Features include automatic
   wordwrap and reformatting, line insert and delete, and support of many of
   the same editing keys used in the QuickBASIC editing environment. The keys
   acted upon are Left arrow, Right arrow, Up arrow, Down arrow, Home, End,
   Insert, Backspace, Delete, Ctrl-Y, Ctrl-Q-Y, Ctrl-Right arrow, Ctrl-Left
   arrow, Enter, and Escape.

   You can force a reformat of the entire rectangular area by moving the
   cursor to the upper left corner of the rectangular area and then pressing
   the Backspace key. The cursor won't move anywhere, but all text in the
   area will be reformatted.

   To escape from the editing mode, press the Escape key. The string result
   of the edit is returned in a$ to the calling program. Note that linefeeds
   and all double spaces are removed from a$ and that a$ is trimmed of spaces
   from each end before being returned.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          EditBox                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        EDIT.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Allows the user to edit text inside a rectangular area.
     '
     ' EXAMPLE OF USE:  EditBox a$, row1%, col1%, row2%, col2%
     ' PARAMETERS:      a$     String to be edited
     '                  row1%  Screen text row at upper left corner of the are
     '                  col1%  Screen text column at upper left corner of the
     '                  row2%  Screen text row at lower right corner of the ar
     '                  col2%  Screen text column at lower right corner of the
     ' VARIABLES:       r1%    Upper inside row of rectangular area
     '                  r2%    Lower inside row of rectangular area
     '                  c1%    Left inside column of rectangular area
     '                  c2%    Right inside column of rectangular area
     '                  wide%  Width of area
     '                  high%  Height of area
     '                  rp%    Index to current working row
     '                  cp%    Index to current working column
     '                  insert%  Flag for insert/replace mode
     '                  quit%  Flag for quitting the subprogram
     '                  across%  Saved current cursor column
     '                  down%  Saved current cursor row
     '                  x$()  Workspace string array
     '                  i%  Looping index
     '                  b$  Works with a$ to format a$ into x$()
     '                  keyNumber%  Integer code for any key press
     '                  c$  Temporary string workspace
     '                  ds%  Index to double-space groupings
     '                  sp%  Index to character where split of string is to oc
     '                  ctrlQflag%  Indicates Ctrl-Q has been pressed
     '                  kee$  Character entered from keyboard
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION KeyCode% ()
     '                  DECLARE SUB EditBox ($, row1%, col1%, row2%, col2%)
     '                  DECLARE SUB FormatTwo (a$, b$, col%)
     '                  DECLARE SUB InsertCharacter (x$(), kee$, cp%, rp%,
     '                                               wide%, high%)
     '
       SUB EditBox (a$, row1%, col1%, row2%, col2%) STATIC

         ' Set up some working variables
           r1% = row1% + 1
           r2% = row2% - 1
           c1% = col1% + 2
           c2% = col2% - 2
           wide% = c2% - c1% + 1
           high% = r2% - r1% + 1
           rp% = 1
           cp% = 1
           insert% = TRUE
           quit% = FALSE

         ' Record the current cursor location
           across% = POS(0)
           down% = CSRLIN

         ' Dimension a workspace array
           REDIM x$(1 TO high%)

         ' Format a$ into array space
           FOR i% = 1 TO high%
               FormatTwo a$, b$, wide%
               x$(i%) = a$
               a$ = b$
           NEXT i%

         ' Display the strings
           FOR i% = 1 TO high%
               LOCATE r1% + i% - 1, c1%, 0
               PRINT x$(i%);
           NEXT i%

         ' Process each keystroke
           DO

             ' Update the current line
               LOCATE r1% + rp% - 1, c1%, 0
               PRINT x$(rp%);

             ' Place the cursor
               IF insert% THEN
                   LOCATE r1% + rp% - 1, c1% + cp% - 1, 1, 6, 7
               ELSE
                   LOCATE r1% + rp% - 1, c1% + cp% - 1, 1, 1, 7
               END IF

             ' Grab next keystroke
               keyNumber% = KeyCode%

             ' Process the key
               SELECT CASE keyNumber%

               CASE INSERTKEY
                   IF insert% THEN
                       insert% = FALSE
                   ELSE
                       insert% = TRUE
                   END IF

               CASE BACKSPACE

                 ' Rub out character to the left
                   IF cp% > 1 THEN
                       x$(rp%) = x$(rp%) + " "
                       b$ = LEFT$(x$(rp%), cp% - 2)
                       c$ = MID$(x$(rp%), cp%)
                       x$(rp%) = b$ + c$
                       cp% = cp% - 1

                     ' Upper left corner, so reformat the whole box
                   ELSEIF rp% = 1 THEN

                     ' Pull all the strings together
                       a$ = ""
                       FOR i% = 1 TO high%
                           a$ = a$ + LTRIM$(RTRIM$(x$(i%))) + " "
                       NEXT i%

                     ' Remove double spaces
                       ds% = INSTR(a$, "  ")
                       DO WHILE ds%
                           a$ = LEFT$(a$, ds% - 1) + MID$(a$, ds% + 1)
                           ds% = INSTR(a$, "  ")
                       LOOP

                     ' Format into the array and display lines
                       FOR i% = 1 TO high%
                           FormatTwo a$, b$, wide%
                           x$(i%) = a$
                           a$ = b$
                           LOCATE r1% + i% - 1, c1%, 0
                           PRINT x$(i%);
                       NEXT i%

                     ' Concatenate to the preceding line
                   ELSE

                     ' Use the InsertCharacter sub to insert a space
                       rp% = rp% - 1
                       cp% = wide% + 1
                       InsertCharacter x$(), " ", rp%, cp%, wide%, high%

                     ' Remove the extra spaces introduced
                       IF cp% > 2 THEN
                           b$ = LEFT$(x$(rp%), cp% - 3)
                           c$ = MID$(x$(rp%), cp%)
                       ELSE
                           b$ = ""
                           c$ = MID$(x$(rp%), cp% + 1)
                       END IF

                     ' Pull the line pieces together
                       x$(rp%) = LEFT$(b$ + c$ + SPACE$(3), wide%)

                     ' Adjust the cursor position
                       cp% = cp% - 1

                     ' Display the lines
                       FOR i% = 1 TO high%
                           LOCATE r1% + i% - 1, c1%, 0
                           PRINT x$(i%);
                       NEXT i%
                   END IF

               CASE DELETE
                   x$(rp%) = x$(rp%) + " "
                   b$ = LEFT$(x$(rp%), cp% - 1)
                   c$ = MID$(x$(rp%), cp% + 1)
                   x$(rp%) = b$ + c$

               CASE UPARROW
                   IF rp% > 1 THEN
                       rp% = rp% - 1
                   END IF

               CASE DOWNARROW
                   IF rp% < high% THEN
                       rp% = rp% + 1
                   END IF

               CASE LEFTARROW
                   IF cp% > 1 THEN
                       cp% = cp% - 1
                   END IF

               CASE RIGHTARROW
                   IF cp% < wide% THEN
                       cp% = cp% + 1
                   END IF

               CASE ENTER
                   IF rp% < high% AND x$(high%) = SPACE$(wide%) THEN

                     ' Shuffle lines down
                       FOR i% = high% TO rp% + 1 STEP -1
                           x$(i%) = x$(i% - 1)
                       NEXT i%

                     ' Split current line at cursor
                       sp% = wide% - cp% + 1
                       IF sp% THEN
                           MID$(x$(rp%), cp%, sp%) = SPACE$(sp%)
                       END IF

                     ' Move to next line
                       rp% = rp% + 1
                       x$(rp%) = MID$(x$(rp%), cp%) + SPACE$(cp% - 1)
                       cp% = 1

                     ' Display the modified lines
                       FOR i% = rp% - 1 TO high%
                           LOCATE r1% + i% - 1, c1%, 0
                           PRINT x$(i%);
                       NEXT i%

                   ELSE

                     ' Nowhere to push things down
                       BEEP

                   END IF

               CASE HOME
                   cp% = 1

               CASE ENDKEY
                   cp% = wide% + 1

                 ' Move back to just after last character
                   IF x$(rp%) <> SPACE$(wide%) THEN
                       DO UNTIL MID$(x$(rp%), cp% - 1, 1) <> " "
                           cp% = cp% - 1
                       LOOP
                   ELSE
                       cp% = 1
                   END IF

               CASE CTRLRIGHTARROW

                 ' Find next space
                   DO UNTIL MID$(x$(rp%), cp%, 1) = " " OR cp% = wide%
                       cp% = cp% + 1
                   LOOP

                 ' Find first non-space character
                   DO UNTIL MID$(x$(rp%), cp%, 1) <> " " OR cp% = wide%
                       cp% = cp% + 1
                   LOOP

               CASE CTRLLEFTARROW

                 ' Find first space to the left
                   DO UNTIL MID$(x$(rp%), cp%, 1) = " " OR cp% = 1
                       cp% = cp% - 1
                   LOOP

                 ' Find first non-space character to the left
                   DO UNTIL MID$(x$(rp%), cp%, 1) <> " " OR cp% = 1
                       cp% = cp% - 1
                   LOOP

                 ' Find next space to the left
                   DO UNTIL MID$(x$(rp%), cp%, 1) = " " OR cp% = 1
                       cp% = cp% - 1
                   LOOP

                 ' Adjust cursor position to first non-space character
                   IF cp% > 1 THEN
                       cp% = cp% + 1
                   END IF

               CASE CTRLY
                   IF rp% < high% THEN
                     ' Shuffle lines up, spacing out the last
                       FOR i% = rp% TO high%
                           IF i% < high% THEN
                               x$(i%) = x$(i% + 1)
                           ELSE
                               x$(i%) = SPACE$(wide%)
                           END IF
                           LOCATE r1% + i% - 1, c1%, 0
                           PRINT x$(i%);
                       NEXT i%
                   END IF

                 ' Move cursor to far left
                   cp% = 1

               CASE CTRLQ
                   ctrlQflag% = TRUE

               CASE ESCAPE
                   quit% = TRUE

               CASE IS > 255
                   SOUND 999, 1

               CASE IS < 32
                   SOUND 999, 1

               CASE ELSE
                   kee$ = CHR$(keyNumber%)

                 ' Insert mode
                   IF insert% THEN
                       InsertCharacter x$(), kee$, rp%, cp%, wide%, high%
                       FOR i% = 1 TO high%
                           LOCATE r1% + i% - 1, c1%, 0
                           PRINT x$(i%);
                       NEXT i%

                     ' Must be overstrike mode
                   ELSE
                       MID$(x$(rp%), cp%, 1) = kee$
                       IF cp% < wide% + 1 THEN
                           cp% = cp% + 1
                       ELSE
                           IF rp% < high% THEN
                               LOCATE r1% + rp% - 1, c1%, 0
                               PRINT x$(rp%);
                               rp% = rp% + 1
                               cp% = 1
                           END IF
                       END IF
                   END IF

                 ' Correct for bottom right corner problem
                   IF rp% > high% THEN
                       cp% = wide%
                       rp% = high%
                   END IF

                 ' Check for Ctrl-Q-Y combination (del to end of line)
                   IF kee$ = "y" AND ctrlQflag% THEN
                       cp% = cp% - 1
                       IF cp% = 0 THEN
                           cp% = wide%
                           rp% = rp% - 1
                       END IF
                       sp% = wide% - cp% + 1
                       MID$(x$(rp%), cp%, sp%) = SPACE$(sp%)
                   END IF

                 ' Clear out the possible Ctrl-Q signal
                   ctrlQflag% = FALSE

               END SELECT

           LOOP UNTIL quit%

         ' Concatenate the array strings to form the result
           a$ = ""
           FOR i% = 1 TO high%
               a$ = a$ + " " + LTRIM$(RTRIM$(x$(i%)))
           NEXT i%

         ' Remove double spaces
           ds% = INSTR(a$, "  ")
           DO WHILE ds%
               a$ = LEFT$(a$, ds% - 1) + MID$(a$, ds% + 1)
               ds% = INSTR(a$, "  ")
           LOOP

         ' Trim both ends of spaces
           a$ = LTRIM$(RTRIM$(a$))

         ' Restore original cursor position
           LOCATE down%, across%, 1

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: EditLine

   Allows the user to edit a single line of text. The string is displayed at
   the current cursor location using the current foreground and background
   colors. Many of the same editing keys from the QuickBASIC editing
   environment are supported in the expected manner. For example, pressing
   Ctrl-Right arrow moves the cursor to the start of the next word, and
   pressing Ctrl-Q-Y deletes to the end of the line. Insert and overstrike
   modes are both supported, and you can delete characters by pressing the
   Delete or Backspace key.

   To exit the editing, press the Enter, Up arrow, or Down arrow key. The
   exitCode% value is set to 0, 1, or -1 respectively, allowing your calling
   program to determine which key terminated the editing.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          EditLine                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        EDIT.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Allows the user to edit a string at the current cursor position
     ' on the screen.  Keys acted upon are Ctrl-Y, Ctrl-Q-Y, Right arrow,
     ' Left arrow, Ctrl-Left arrow, Ctrl-Right arrow, Home, End,
     ' Insert, Escape, Backspace, and Delete.
     ' Pressing Enter, Up arrow, or Down arrow terminates
     ' the subprogram and returns exitCode% of 0, +1, or -1.
     '
     ' EXAMPLE OF USE:  EditLine a$, exitCode%
     ' PARAMETERS:      a$         String to be edited
     '                  exitCode%  Returned code indicating the terminating
     '                             key press
     ' VARIABLES:       row%       Saved current cursor row
     '                  col%       Saved current cursor column
     '                  length%    Length of a$
     '                  ptr%       Location of cursor during the editing
     '                  insert%    Insert mode toggle
     '                  quit%      Flag for quitting the editing
     '                  original$  Saved copy of starting a$
     '                  keyNumber% Integer code for any key press
     '                  ctrlQflag% Indicates Ctrl-Q key press
     '                  kee$       Character of key just pressed
     '                  sp%        Length of space string
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION KeyCode% ()
     '                  DECLARE SUB EditLine (a$, exitCode%)
     '
         SUB EditLine (a$, exitCode%) STATIC

         ' Set up some variables
           row% = CSRLIN
           col% = POS(0)
           length% = LEN(a$)
           ptr% = 0
           insert% = TRUE
           quit% = FALSE
           original$ = a$

         ' Main processing loop
           DO

             ' Display the line
               LOCATE row%, col%, 0
               PRINT a$;

             ' Show appropriate cursor type
               IF insert% THEN
                   LOCATE row%, col% + ptr%, 1, 6, 7
               ELSE
                   LOCATE row%, col% + ptr%, 1, 1, 7
               END IF

             ' Get next keystroke
               keyNumber% = KeyCode%

             ' Process the key
               SELECT CASE keyNumber%

               CASE INSERTKEY
                   IF insert% THEN
                       insert% = FALSE
                   ELSE
                       insert% = TRUE
                   END IF

               CASE BACKSPACE
                   IF ptr% THEN
                       a$ = a$ + " "
                       a$ = LEFT$(a$, ptr% - 1) + MID$(a$, ptr% + 1)
                       ptr% = ptr% - 1
                   END IF

               CASE DELETE
                   a$ = a$ + " "
                   a$ = LEFT$(a$, ptr%) + MID$(a$, ptr% + 2)

               CASE UPARROW
                   exitCode% = 1
                   quit% = TRUE

               CASE DOWNARROW
                   exitCode% = -1
                   quit% = TRUE

               CASE LEFTARROW
                   IF ptr% THEN
                       ptr% = ptr% - 1
                   END IF

               CASE RIGHTARROW
                   IF ptr% < length% - 1 THEN
                       ptr% = ptr% + 1
                   END IF

               CASE ENTER
                   exitCode% = 0
                   quit% = TRUE

               CASE HOME
                   ptr% = 0

               CASE ENDKEY
                   ptr% = length% - 1

               CASE CTRLRIGHTARROW
                   DO UNTIL MID$(a$, ptr% + 1, 1) = " " OR ptr% = length% - 1
                       ptr% = ptr% + 1
                   LOOP
                   DO UNTIL MID$(a$, ptr% + 1, 1) <> " " OR ptr% = length% - 1
                       ptr% = ptr% + 1
                   LOOP

               CASE CTRLLEFTARROW
                   DO UNTIL MID$(a$, ptr% + 1, 1) = " " OR ptr% = 0
                       ptr% = ptr% - 1
                   LOOP
                   DO UNTIL MID$(a$, ptr% + 1, 1) <> " " OR ptr% = 0
                       ptr% = ptr% - 1
                   LOOP
                   DO UNTIL MID$(a$, ptr% + 1, 1) = " " OR ptr% = 0
                       ptr% = ptr% - 1
                   LOOP
                   IF ptr% THEN
                       ptr% = ptr% + 1
                   END IF

               CASE CTRLY
                   a$ = SPACE$(length%)
                   ptr% = 0

               CASE CTRLQ
                   ctrlQflag% = TRUE

               CASE ESCAPE
                   a$ = original$
                   ptr% = 0
                   insert% = TRUE

               CASE IS > 255
                   SOUND 999, 1

               CASE IS < 32
                   SOUND 999, 1

               CASE ELSE

                 ' Convert key code to character string
                   kee$ = CHR$(keyNumber%)

                 ' Insert or overstrike
                   IF insert% THEN
                       a$ = LEFT$(a$, ptr%) + kee$ + MID$(a$, ptr% + 1)
                       a$ = LEFT$(a$, length%)
                   ELSE
                       IF ptr% < length% THEN
                           MID$(a$, ptr% + 1, 1) = kee$
                       END IF
                   END IF

                 ' Are we up against the wall?
                   IF ptr% < length% THEN
                       ptr% = ptr% + 1
                   ELSE
                       SOUND 999, 1
                   END IF

                 ' Special check for Ctrl-Q-Y (del to end of line)
                   IF kee$ = "y" AND ctrlQflag% THEN
                       IF ptr% <= length% THEN
                           sp% = length% - ptr% + 1
                           MID$(a$, ptr%, sp%) = SPACE$(sp%)
                           ptr% = ptr% - 1
                       END IF
                   END IF

                 ' Clear out the Ctrl-Q signal
                   ctrlQflag% = FALSE

               END SELECT

           LOOP UNTIL quit%

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FormatTwo

   Formats text lines to a given maximum length. The value of col% is used to
   find a point in a$ where a$ can be split into two strings between words.
   The length of the returned a$ will be less than or equal to col%, and the
   rest of the original a$ will be returned in b$.

   Notice that repeated calls to this subprogram can format an entire
   paragraph of text. An example of this is shown in the subprogram EditBox.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FormatTwo                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        EDIT.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Splits a string into two strings between words,
     ' and with spaces padded to the first string to bring it to
     ' length, col%.
     '
     ' EXAMPLE OF USE:  FormatTwo a$, b$, col%
     ' PARAMETERS:      a$         String to be split
     '                  b$         Returns the tail of the string
     '                  col%       Maximum length of a$ after being split
     ' VARIABLES:       ptr%       Pointer to split point in a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB FormatTwo (a$, b$, col%)
     '
       SUB FormatTwo (a$, b$, col%) STATIC

         ' Be sure string is long enough
           a$ = a$ + SPACE$(col%)

         ' Look for rightmost space
           ptr% = col% + 1
           DO WHILE MID$(a$, ptr%, 1) <> " " AND ptr% > 1
               ptr% = ptr% - 1
           LOOP

         ' Do the split
           IF ptr% = 1 THEN
               b$ = MID$(a$, col% + 1)
               a$ = LEFT$(a$, col%)
           ELSE
               b$ = MID$(a$, ptr% + 1)
               a$ = LEFT$(a$, ptr% - 1)
           END IF

         ' Pad the first string with spaces to length col%
           a$ = LEFT$(a$ + SPACE$(col%), col%)

         ' Trim extra spaces from end of second string
           b$ = RTRIM$(b$)

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: InsertCharacter

   Inserts a character into the array of text being maintained by the
   EditBox subprogram. While in Insert mode, the EditBox subprogram calls
   InsertCharacter. The character insertion is simple enough, but this
   subprogram also handles the chore of performing automatic wordwrap and
   formatting.

   This task of character insertion could have been performed in the
   EditBox subprogram, but breaking the code out into a separate subprogram
   makes it much easier to isolate this task from the others. One great
   advantage of QuickBASIC is the ability to break complex programming tasks
   into smaller, more manageable tasks.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          InsertCharacter            **
     ' **  Type:          Subprogram                 **
     ' **  Module:        EDIT.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Handles the task of inserting a character
     ' for the EditBox subprogram.
     '
     ' EXAMPLE OF USE:  InsertCharacter x$(), kee$, rp%, cp%, wide%, high%
     ' PARAMETERS:      x$()       Array in EditBox where character is to be
     '                             inserted
     '                  kee$       Character to be inserted
     '                  rp%        Row location of insert
     '                  cp%        Column location of insert
     '                  wide%      Width of rectangular area being edited
     '                  high%      Height of rectangular area being edited
     ' VARIABLES:       dum$       Marker character
     '                  b$         String from array at insertion point
     '                  c$         Right part of string at insertion point
     '                  i%         Looping index
     '                  ds%        Position in string of double spaces
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB InsertCharacter (x$(), kee$, cp%, rp%,
     '                                               wide%, high%)
     '
       SUB InsertCharacter (x$(), kee$, rp%, cp%, wide%, high%) STATIC

         ' First, insert a dummy character as a marker
           dum$ = CHR$(255)
           b$ = LEFT$(x$(rp%), cp% - 1)
           c$ = MID$(x$(rp%), cp%)
           b$ = b$ + dum$ + c$

         ' If end of string is a space, then drop it
           IF RIGHT$(b$, 1) = " " THEN
               x$(rp%) = LEFT$(b$, wide%)

             ' Otherwise, need to adjust the lines
           ELSE

             ' If not in the last line, then tack them all together
               IF rp% < high% THEN
                   FOR i% = rp% + 1 TO high%
                       b$ = b$ + " " + x$(i%)
                   NEXT i%
               END IF

             ' Trim both ends
               b$ = LTRIM$(RTRIM$(b$))

             ' Remove all double spaces
               ds% = INSTR(b$, "  ")
               DO WHILE ds%
                   b$ = LEFT$(b$, ds% - 1) + MID$(b$, ds% + 1)
                   ds% = INSTR(b$, "  ")
               LOOP

             ' Reformat the lines
               FOR i% = rp% TO high%
                   FormatTwo b$, c$, wide%
                   x$(i%) = b$
                   b$ = c$
               NEXT i%

           END IF

         ' Find out where that dummy character is now
           FOR rp% = 1 TO high%
               cp% = INSTR(x$(rp%), dum$)
               IF cp% THEN
                   EXIT FOR
               END IF
           NEXT rp%

         ' Replace the dummy character with the keystroke character
           IF cp% THEN
               MID$(x$(rp%), cp%, 1) = kee$
           END IF

         ' Increment the cursor location
           IF cp% < wide% + 1 THEN
               cp% = cp% + 1
           ELSE
               IF rp% < high% THEN
                   cp% = 1
                   rp% = rp% + 1
               END IF
           END IF

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 ERROR

   The ERROR toolbox contains a single subprogram that displays an error
   message in a box. If you have a color monitor, you can make the display
   quite eye-catching. In this example, the message is yellow on a red
   background.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   ERROR.BAS                       Demo module
   ErrorMessage            Sub     Error message display
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: ERROR

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ERROR                      **
     ' **  Type:          Toolbox                    **
     ' **  Module:        ERROR.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)

     ' Subprogram
       DECLARE SUB ErrorMessage (message$)

     ' Demonstrate the subprogram

       ErrorMessage "This is a sample message for ErrorMessage"
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ErrorMessage

   Provides a convenient, noticeable way to display error messages.

   QuickBASIC has a built-in mechanism for terminating a program when a
   serious error occurs. For example, if you try to divide by 0, the program
   immediately halts and displays the message Division by zero.

   In other situations, you might want to terminate a program because of a
   serious error that QuickBASIC would otherwise let pass. One approach in
   such a situation would be to use QuickBASIC's ERROR n% statement. This
   works fine, but unless one of the built-in error messages happens to fit
   the given situation, you're stuck with the default message Unprintable
   error, which sounds ghastly.

   A second approach to terminating a program in a controlled way would be to
   print your own descriptive error message and then follow with the SYSTEM
   statement. In many cases this technique is sufficient, but it's preferable
   to present a more polished, eye-catching display.

   This subprogram lets you systematically display your own error messages in
   a unique error-message window, just before terminating and returning to
   MS-DOS. The display──in this example, a red background and bright yellow
   message──immediately lets you know that a serious error has been detected.

   The table of color-defining constants in this subprogram can be useful in
   any program where you use the COLOR statement. A statement such as COLOR
   YELLOW, RED is much more descriptive than the equivalent COLOR 23, 4. It
   also makes programming easier because you don't have to remember or look
   up the numbers for the various colors.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ErrorMessage               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        ERROR.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Displays an error message and then exits to the system.
     '
     ' EXAMPLE OF USE: ErrorMessage "This is a sample message for ErrorMessage
     ' PARAMETERS:     message$         String to be displayed in the error bo
     ' VARIABLES:      lm%              Length of message$ during processing
     '                 col%             Screen character column for left edge
     '                                  of error box
     ' MODULE LEVEL
     '  DECLARATIONS:  DECLARE SUB ErrorMessage (message$)
     '
       SUB ErrorMessage (message$) STATIC

         ' Define 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 BLINK = 16
           CONST YELLOW = BROWN + BRIGHT

         ' Trim off spaces on each end of message
           message$ = LTRIM$(RTRIM$(message$))

         ' Make message length an odd number
           IF LEN(message$) MOD 2 = 0 THEN
               message$ = message$ + " "
           END IF

         ' Minimum length of message is 9 characters
           DO WHILE LEN(message$) < 9
               message$ = " " + message$ + " "
           LOOP

         ' Maximum length of message is 75
           message$ = LEFT$(message$, 75)

         ' Initialization of display
           SCREEN 0
           WIDTH 80
           CLS

         ' Calculate screen locations
           lm% = LEN(message$)
           col% = 38 - lm% \ 2

         ' Create the error box
           COLOR RED + BRIGHT, RED
           LOCATE 9, col%
           PRINT CHR$(201); STRING$(lm% + 2, 205); CHR$(187)
           LOCATE 10, col%
           PRINT CHR$(186); SPACE$(lm% + 2); CHR$(186)
           LOCATE 11, col%
           PRINT CHR$(186); SPACE$(lm% + 2); CHR$(186)
           LOCATE 12, col%
           PRINT CHR$(200); STRING$(lm% + 2, 205); CHR$(188)

         ' The title
           COLOR CYAN + BRIGHT, RED
           LOCATE 10, 36
           PRINT "* ERROR *";

         ' The message$
           COLOR YELLOW, RED
           LOCATE 11, col% + 2
           PRINT message$;

         ' System will prompt for "any key"
           COLOR WHITE, BLACK
           LOCATE 22, 1
           SYSTEM

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 FIGETPUT

   The FIGETPUT toolbox demonstrates the FileGet$ function and FilePut
   subprogram, routines that allow efficient binary-mode access to files up
   to 32767 bytes in length. Because each of these routines uses binary-file
   mode, an entire file can be read by one GET statement or written by one
   PUT statement. Any type of file containing no more than 32767 bytes can be
   read into or written from a QuickBASIC string variable by these routines.
   When reading an ASCII file, the FileGet$ function returns all lines of
   the file in one string. A carriage return/line feed pair of characters
   marks the separation of each line in the file.

   These routines can be useful for file-processing utility programs, such as
   byte-for-byte file comparisons, text searches, and file ciphering.

   To demonstrate the routines, the module-level code reads a copy of itself
   into a single string, converts all characters to uppercase, counts the
   occurrences of each letter of the alphabet, and saves the resulting string
   in a file named FIGETPUT.TST. For a meaningful character count save
   FIGETPUT.BAS in ASCII format.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   FIGETPUT.BAS                    Demo module
   FileGet$                Func    Returns a string with contents of file
   FilePut                 Sub     Writes contents of string into binary
                                    file
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: FIGETPUT

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FIGETPUT                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        FIGETPUT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reads itself (FIGETPUT.BAS) into a string,
     ' converts characters to uppercase, counts occurrences of
     ' the characters "A" through "Z," and saves the
     ' result in a file named FIGETPUT.TST.
     '
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      filename
     ' VARIABLES:       count%()   Tally array for the 26 alpha characters
     '                  fileName$  Name of file to be processed
     '                  a$         Contents of the file
     '                  i%         Looping index
     '                  c%         ASCII value of each file byte

     ' Functions
       DECLARE FUNCTION FileGet$ (fileName$)

     ' Subprograms
       DECLARE SUB FilePut (fileName$, a$)

     ' Dimension array of counts for each ASCII code "A" to "Z"
       DIM count%(65 TO 90)

     ' Read in the file (must be no greater than 32767 bytes long)
       a$ = FileGet$("FIGETPUT.BAS")

     ' Convert to uppercase
       a$ = UCASE$(a$)

     ' Count the letters
       FOR i% = 1 TO LEN(a$)
           c% = ASC(MID$(a$, i%, 1))
           IF c% >= 65 AND c% <= 90 THEN
               count%(c%) = count%(c%) + 1
           END IF
       NEXT i%

     ' Output the results
       CLS
       PRINT "Alphabetic character count for FIGETPUT.BAS"
       PRINT
       FOR i% = 65 TO 90
           PRINT CHR$(i%); " -"; count%(i%),
       NEXT i%

     ' Write out the new file
       FilePut "FIGETPUT.TST", a$

     ' All done
       END
   ──────────────────────────────────────────────────────────────────────────


 Function: FileGet$

   Uses the binary file mode to read the contents of any MS-DOS file into a
   string variable. The file length must be fewer than 32768 bytes to fit in
   one string. If you try to read a larger file, an error message is
   displayed, and the program halts.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FileGet$                   **
     ' **  Type:          Function                   **
     ' **  Module:        FIGETPUT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string containing the contents of a file.
     ' Maximum file length is 32767 bytes.
     '
     ' EXAMPLE OF USE:  a$ = FileGet$(fileName$)
     ' PARAMETERS:      fileName$     Name of file to be accessed
     ' VARIABLES:       fileNumber    Next available free file number
     '                  length&       Length of file
     '                  a$            String for binary read of file
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION FileGet$ (fileName$)
     '
        FUNCTION FileGet$ (fileName$) STATIC
           fileNumber = FREEFILE
           OPEN fileName$ FOR BINARY AS #fileNumber
           length& = LOF(fileNumber)
           IF length& <= 32767 THEN
               a$ = SPACE$(length&)
               GET #fileNumber, , a$
               FileGet$ = a$
               a$ = ""
           ELSE
               PRINT "FileGet$()... file too large"
               SYSTEM
           END IF
           CLOSE #fileNumber
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FilePut

   Writes the contents of any string variable to a file using binary file
   mode. The biggest file that you can create in this way is 32767 bytes
   because that's the longest string you can build.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FilePut                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FIGETPUT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Writes contents of a$ into a binary file named fileName$.
     '
     ' EXAMPLE OF USE:  FilePut fileName$, a$
     ' PARAMETERS:      fileName$  Name of file to be written
     '                  a$         Bytes to be placed in the file
     ' VARIABLES:       fileNumber Next available free file number
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB FilePut (fileName$, a$)
     '
       SUB FilePut (fileName$, a$) STATIC

         ' Find available file number
           fileNumber = FREEFILE

         ' Truncate any previous contents
           OPEN fileName$ FOR OUTPUT AS #fileNumber
           CLOSE #fileNumber

         ' Write string to file
           OPEN fileName$ FOR BINARY AS #fileNumber
           PUT #fileNumber, , a$

         ' All done
           CLOSE #fileNumber

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 FILEINFO

   The FILEINFO toolbox contains subprograms that obtain directory
   information about files. Basically, this program mimics the MS-DOS DIR
   command or the QuickBASIC FILES command.

   As set up, this program finds normal file entries. You can change the
   FILEATTRIBUTE constant to access other types of files. Refer to the CONST
   statements that define the various file attribute bits.

   The starting path$ for the search is set to the current directory, but you
   can change the path$ assignment to search any desired drive or directory.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   FILEINFO.BAS                    Demo module
   FindFirstFile           Sub     Finds first file that matches parameter
   FindNextFile            Sub     Locates next file that matches parameter
   GetFileData             Sub     Extracts file directory information
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: FILEINFO

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FILEINFO                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        FILEINFO.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Collection of subprograms and functions for accessing
     ' directory information about files.
     '
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    MIXED.QLB/.LIB
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       path$      Path to files for gathering directory
     '                             information; wildcard characters accepted
     '                  dta$       Disk transfer area buffer string
     '                  result%    Code returned as result of directory search
     '                  file       Structure of type FileDataType
     '                  n%         File count

     ' File search attribute bits
       CONST ISNORMAL = 0
       CONST ISREADONLY = 1
       CONST ISHIDDEN = 2
       CONST ISSYSTEM = 4
       CONST ISVOLUMELABEL = 8
       CONST ISSUBDIRECTORY = 16
       CONST ISARCHIVED = 32

     ' Here we'll search for normal files and subdirectories
       CONST FILEATTRIBUTE = ISNORMAL + ISSUBDIRECTORY

       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 FileDataType
           finame    AS STRING * 12
           year      AS INTEGER
           month     AS INTEGER
           day       AS INTEGER
           hour      AS INTEGER
           minute    AS INTEGER
           second    AS INTEGER
           attribute AS INTEGER
           size      AS LONG
       END TYPE

     ' Subprograms
       DECLARE SUB INTERRUPTX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)
       DECLARE SUB FindFirstFile (path$, dta$, result%)
       DECLARE SUB FindNextFile (dta$, result%)
       DECLARE SUB GetFileData (dta$, file AS FileDataType)

     ' Data structures
       DIM file AS FileDataType

     ' For demonstration purposes, list current directory
       CLS
       path$ = "*.*"

     ' Always start by finding the first match
       FindFirstFile path$, dta$, result%

     ' Check that the path$ got us off to a good start
       IF result% THEN
           PRINT "Error: FindFirstFile - found no match for path$"
           SYSTEM
       END IF

     ' List all the files in this directory
       DO
           IF n% MOD 19 = 0 THEN
               CLS
               PRINT TAB(4); "File"; TAB(18); "Date"; TAB(29); "Time";
               PRINT TAB(39); "Size"; TAB(48); "Attributes"
               PRINT
           END IF
           GetFileData dta$, file
           PRINT file.finame;
           PRINT USING "  ##/##/####"; file.month, file.day, file.year;
           PRINT USING "  ##:##:##"; file.hour, file.minute, file.second;
           PRINT USING "  ########"; file.size;
           PRINT USING "  &"; RIGHT$("0" + HEX$(file.attribute), 2)
           PRINT "     &H";
           PRINT USING "&"; RIGHT$("0" + HEX$(file.attribute), 2)
           n% = n% + 1
           FindNextFile dta$, result%
           IF n% MOD 19 = 0 THEN
               PRINT
               PRINT "Press any key to continue"
               DO
               LOOP WHILE INKEY$ = ""
           END IF
       LOOP UNTIL result%
       PRINT
       PRINT n%; "files found"
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FindFirstFile

   Finds the first directory entry that matches a given path$. This
   subprogram is called once before FindNextFile is called numerous times to
   find the rest of the entries.

   The result of this file search is returned in the dta$ variable. Call the
   GetFileData subprogram to extract the information from the string.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FindFirstFile              **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FILEINFO.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Finds first file that matches the path$.
     '
     ' EXAMPLE OF USE:  FindFirstFile path$, dta$, result%
     ' PARAMETERS:      path$      Complete path, including wildcard character
     '                             desired, for the directory search
     '                  dta$       Disk transfer area buffer space
     '                  result%    Returned result code for the search
     ' VARIABLES:       reg        Structure of type RegTypeX
     '                  thePath$   Null terminated version of path$
     '                  sgmt%      Current DTA address segment
     '                  ofst%      Current DTA address offset
     ' MODULE LEVEL
     '   DECLARATIONS:  File search attribute bits
     '                     CONST ISNORMAL = 0
     '                     CONST ISREADONLY = 1
     '                     CONST ISHIDDEN = 2
     '                     CONST ISSYSTEM = 4
     '                     CONST ISVOLUMELABEL = 8
     '                     CONST ISSUBDIRECTORY = 16
     '                     CONST ISARCHIVED = 32
     '
     '                     CONST FILEATTRIBUTE = ISNORMAL + ISSUBDIRECTORY
     '
     '                     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
     '
     '   DECLARE SUB INTERRUPTX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB FindFirstFile (path$, dta$, result%)
     '
       SUB FindFirstFile (path$, dta$, result%) STATIC

         ' Initialization
           DIM reg AS RegTypeX

         ' The path must be a null terminated string
           thePath$ = path$ + CHR$(0)

         ' Get current DTA address
           reg.ax = &H2F00
           INTERRUPTX &H21, reg, reg
           sgmt% = reg.es
           ofst% = reg.bx

         ' Set dta address
           dta$ = SPACE$(43)
           reg.ax = &H1A00
           reg.ds = VARSEG(dta$)
           reg.dx = SADD(dta$)
           INTERRUPTX &H21, reg, reg

         ' Find first file match
           reg.ax = &H4E00
           reg.cx = FILEATTRIBUTE
           reg.ds = VARSEG(thePath$)
           reg.dx = SADD(thePath$)
           INTERRUPTX &H21, reg, reg

         ' The carry flag tells if a file was found or not
           result% = reg.flags AND 1

         ' Reset the original DTA
           reg.ax = &H1A00
           reg.ds = sgmt%
           reg.dx = ofst%
           INTERRUPTX &H21, reg, reg

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FindNextFile

   Continues the search for file directory entries after the FindFirstFile
   subprogram was called once. This subprogram is usually called repeatedly
   until all files that match the original path$ are found. The value of
   result% is 0 until the last file is found.

   The dta$ variable carries the important information about the search from
   call to call of this subprogram. Be careful not to alter its contents
   between calls to this routine. To extract details about each file's
   directory entry, pass dta$ to the subprogram GetFileData.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FindNextFile               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FILEINFO.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Locates next file. FindFirstFile must be called
     ' before this subprogram is called.
     '
     ' EXAMPLE OF USE: FindNextFile dta$, result%
     ' PARAMETERS:      dta$       Previously filled-in Disk Transfer Area
     '                             buffer string
     '                  result%    Result code for the search
     ' VARIABLES:       reg        Structure of type RegTypeX
     '                  thePath$   Null terminated version of path$
     '                  sgmt%      Current DTA address segment
     '                  ofst%      Current DTA address offset
     ' MODULE LEVEL
     '   DECLARATIONS:  CONST ISNORMAL = 0
     '                  CONST ISREADONLY = 1
     '                  CONST ISHIDDEN = 2
     '                  CONST ISSYSTEM = 4
     '                  CONST ISVOLUMELABEL = 8
     '                  CONST ISSUBDIRECTORY = 16
     '                  CONST ISARCHIVED = 32
     '
     '                  CONST FILEATTRIBUTE = ISNORMAL + ISSUBDIRECTORY
     '
     '                     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
     '
     '   DECLARE SUB INTERRUPTX (intnum%, inreg AS RegTypeX, outreg AS RegType
     '   DECLARE SUB FindNextFile (dta$, result%)
     '
       SUB FindNextFile (dta$, result%) STATIC

         ' Initialization
           DIM reg AS RegTypeX

         ' Be sure dta$ was built (FindFirstFile should have been called)
           IF LEN(dta$) <> 43 THEN
               result% = 2
               EXIT SUB
           END IF

         ' Get current DTA address
           reg.ax = &H2F00
           INTERRUPTX &H21, reg, reg
           sgmt% = reg.es
           ofst% = reg.bx

         ' Set dta address
           reg.ax = &H1A00
           reg.ds = VARSEG(dta$)
           reg.dx = SADD(dta$)
           INTERRUPTX &H21, reg, reg

         ' Find next file match
           reg.ax = &H4F00
           reg.cx = FILEATTRIBUTE
           reg.ds = VARSEG(thePath$)
           reg.dx = SADD(thePath$)
           INTERRUPTX &H21, reg, reg

         ' The carry flag tells whether a file was found or not
           result% = reg.flags AND 1

         ' Reset the original DTA
           reg.ax = &H1A00
           reg.ds = sgmt%
           reg.dx = ofst%
           INTERRUPTX &H21, reg, reg

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: GetFileData

   Extracts the information about a file's directory entry from the variable
   dta$ passed back from calls to FindFirstFile and FindNextFile. The
   information is returned in the data structure of type FileDataType and
   includes the date and time of the last file update, the filename, the file
   size, and the file attribute byte.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GetFileData                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FILEINFO.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Extracts the file directory information from a Disk
     ' Transfer Area (dta$) that has been filled in by a
     ' call to either FindFirstFile or FindNextFile.
     '
     ' EXAMPLE OF USE:  GetFileData dta$, file
     ' PARAMETERS:      dta$       Disk Transfer Area buffer string passed bac
     '                             either FindFirstFile or FindNextFile
     ' VARIABLES:       tim&       Time stamp of the file
     '                  dat&       Date stamp of the file
     '                  f$         Filename during extraction
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE FileDataType
     '                     finame    AS STRING * 12
     '                     year      AS INTEGER
     '                     month     AS INTEGER
     '                     day       AS INTEGER
     '                     hour      AS INTEGER
     '                     minute    AS INTEGER
     '                     second    AS INTEGER
     '                     attribute AS INTEGER
     '                     size      AS LONG
     '                  END TYPE
     '
     '                  DECLARE SUB GetFileData (dta$, file AS FileDataType)
     '
       SUB GetFileData (dta$, file AS FileDataType) STATIC

           file.attribute = ASC(MID$(dta$, 22, 1))
           tim& = CVI(MID$(dta$, 23, 2))
           IF tim& < 0 THEN
               tim& = tim& + 65536
           END IF
           file.second = tim& AND &H1F
           file.minute = (tim& \ 32) AND &H3F
           file.hour = (tim& \ 2048) AND &H1F
           dat& = CVI(MID$(dta$, 25, 2))
           file.day = dat& AND &H1F
           file.month = (dat& \ 32) AND &HF
           file.year = ((dat& \ 512) AND &H1F) + 1980
           file.size = CVL(MID$(dta$, 27, 4))
           f$ = MID$(dta$, 31) + CHR$(0)
           file.finame = LEFT$(f$, INSTR(f$, CHR$(0)) - 1)

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 FRACTION

   The FRACTION toolbox is a set of subprograms and functions for working
   with fractions. The fractions are handled as data structures, defined by
   the TYPE statement in the module-level code. This effectively allows
   fractions, comprising a pair of long integer numerator and denominator
   numbers, to be referenced as a new type of variable.

   The demo module displays examples of the LeastComMul& and
   GreatestComDiv& functions and then prompts you to enter fraction problems
   involving the addition, subtraction, multiplication, or division of two
   fractions. Enter the problems using the format displayed on screen. The
   results, reduced to lowest terms, will be displayed.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   FRACTION.BAS                    Demo module
   Fraction2String$        Func    Converts type Fraction variable to a
                                    string
   FractionAdd             Sub     Adds two fractions and reduces
   FractionDiv             Sub     Divides two fractions and reduces
   FractionMul             Sub     Multiplies two fractions and reduces
   FractionReduce          Sub     Reduces fraction to lowest terms
   FractionSub             Sub     Subtracts two fractions and reduces
   GreatestComDiv&         Func    Returns greatest common divisor
   LeastComMul&            Func    Returns least common multiple
   SplitFractions          Sub     Parses fraction problem string
   String2Fraction         Sub     Converts a string to Fraction variable
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: FRACTION

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FRACTION                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates a collection of functions and subprograms
     ' for working with fractions.
     '
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       a          Structure of type Fraction
     '                  b          Structure of type Fraction
     '                  c          Structure of type Fraction
     '                  f$         Input string for fraction problems
     '                  fa$        First fraction in string format
     '                  fb$        Second fraction in string format
     '                  operator$  Function indicator
     '                  fc$        Resultant fraction in string output form

     ' Data structure definitions
       TYPE Fraction
           Num AS LONG
           Den AS LONG
       END TYPE

     ' Subprograms
       DECLARE SUB FractionReduce (a AS Fraction)
       DECLARE SUB String2Fraction (f$, a AS Fraction)
       DECLARE SUB FractionAdd (a AS Fraction, b AS Fraction, c AS Fraction)
       DECLARE SUB FractionDiv (a AS Fraction, b AS Fraction, c AS Fraction)
       DECLARE SUB FractionMul (a AS Fraction, b AS Fraction, c AS Fraction)
       DECLARE SUB FractionSub (a AS Fraction, b AS Fraction, c AS Fraction)
       DECLARE SUB SplitFractions (f$, fa$, operator$, fb$)

     ' Functions
       DECLARE FUNCTION Fraction2String$ (a AS Fraction)
       DECLARE FUNCTION GreatestComDiv& (n1&, n2&)
       DECLARE FUNCTION LeastComMul& (n1&, n2&)

     ' Data structures
       DIM a AS Fraction
       DIM b AS Fraction
       DIM c AS Fraction

     ' Demonstrate the LeastComMul& function
       CLS
       PRINT "LeastComMul&(21&, 49&)    =", LeastComMul&(21&, 49&)
       PRINT

     ' Demonstrate the GreatestComDiv& function
       PRINT "GreatestComDiv&(21&, 49&) =", GreatestComDiv&(21&, 49&)
       PRINT

     ' Demonstrate the fraction routines
       DO
           PRINT
           PRINT "Enter a fraction problem, or simply press Enter"
           PRINT "Example: 2/3 + 4/5"
           PRINT
           LINE INPUT f$
           IF INSTR(f$, "/") = 0 THEN
               EXIT DO
           END IF
           SplitFractions f$, fa$, operator$, fb$
           String2Fraction fa$, a
           String2Fraction fb$, b
           SELECT CASE operator$
           CASE "+"
               FractionAdd a, b, c
           CASE "-"
               FractionSub a, b, c
           CASE "*"
               FractionMul a, b, c
           CASE "/"
               FractionDiv a, b, c
           CASE ELSE
               BEEP
           END SELECT
           fc$ = Fraction2String$(c)
           PRINT "Result (reduced to lowest terms) is "; fc$
       LOOP
   ──────────────────────────────────────────────────────────────────────────


 Function: Fraction2String$

   Returns a string representation of a fraction. The numerator and
   denominator values are converted to strings by the QuickBASIC STR$
   function, and a slash (/) is concatenated between them to form the
   resultant string.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Fraction2String$           **
     ' **  Type:          Function                   **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts a type Fraction variable to a string.
     '
     ' EXAMPLE OF USE:  fa$ = Fraction2String$(a)
     ' PARAMETERS:      a          Structure of type Fraction
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Fraction
     '                     Num AS LONG
     '                     Den AS LONG
     '                  END TYPE
     '
     '                  DECLARE FUNCTION Fraction2String$ (a AS Fraction)
     '
       FUNCTION Fraction2String$ (a AS Fraction) STATIC
           Fraction2String$ = STR$(a.Num) + "/" + STR$(a.Den)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FractionAdd

   Adds fraction a to fraction b, reduces the result to lowest terms, and
   returns the result in fraction c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FractionAdd                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Adds two fractions and reduces the result to lowest terms.
     '
     ' EXAMPLE OF USE:  FractionAdd a, b, c
     ' PARAMETERS:      a          First fraction to add
     '                  b          Second fraction to add
     '                  c          Resulting fraction
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Fraction
     '                     Num AS LONG
     '                     Den AS LONG
     '                  END TYPE
     '
     '     DECLARE SUB FractionReduce (a AS Fraction)
     '     DECLARE SUB FractionAdd (a AS Fraction, b AS Fraction, c AS Fractio
     '     DECLARE FUNCTION GreatestComDiv& (n1&, n2&)
     '
       SUB FractionAdd (a AS Fraction, b AS Fraction, c AS Fraction)
           c.Num = a.Num * b.Den + a.Den * b.Num
           c.Den = a.Den * b.Den
           FractionReduce c
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FractionDiv

   Divides fraction b into fraction a, reduces the result to lowest terms,
   and returns the result in fraction c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FractionDiv                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Divides two fractions and reduces the result to
     ' lowest terms.
     '
     ' EXAMPLE OF USE:  FractionDiv a, b, c
     ' PARAMETERS:      a          First fraction
     '                  b          Fraction to divide into first
     '                  c          Resulting fraction
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Fraction
     '                     Num AS LONG
     '                     Den AS LONG
     '                  END TYPE
     '     DECLARE SUB FractionReduce (a AS Fraction)
     '     DECLARE SUB FractionDiv (a AS Fraction, b AS Fraction, c AS Fractio
     '     DECLARE FUNCTION GreatestComDiv& (n1&, n2&)
     '
       SUB FractionDiv (a AS Fraction, b AS Fraction, c AS Fraction)
           c.Num = a.Num * b.Den
           c.Den = a.Den * b.Num
           FractionReduce c
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FractionMul

   Multiplies fraction a times fraction b, reduces the result to lowest
   terms, and returns the result in fraction c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FractionMul                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Multiplies two fractions and reduces the result to
     ' lowest terms.
     '
     ' EXAMPLE OF USE:  FractionMul a, b, c
     ' PARAMETERS:      a          First fraction to multiply
     '                  b          Second fraction to multiply
     '                  c          Resulting fraction
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Fraction
     '                     Num AS LONG
     '                     Den AS LONG
     '                  END TYPE
     '
     '     DECLARE SUB FractionReduce (a AS Fraction)
     '     DECLARE SUB FractionMul (a AS Fraction, b AS Fraction, c AS Fractio
     '     DECLARE FUNCTION GreatestComDiv& (n1&, n2&)
     '
       SUB FractionMul (a AS Fraction, b AS Fraction, c AS Fraction)
           c.Num = a.Num * b.Num
           c.Den = a.Den * b.Den
           FractionReduce c
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FractionReduce

   Reduces a fraction to its lowest terms by dividing the numerator and
   denominator by their greatest common divisor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FractionReduce             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reduces a fraction to its lowest terms.
     '
     ' EXAMPLE OF USE:  FractionReduce a
     ' PARAMETERS:      a          Fraction to reduce
     ' VARIABLES:       d&         Greatest common divisor of the numerator an
     '                             denominator
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Fraction
     '                     Num AS LONG
     '                     Den AS LONG
     '                  END TYPE
     '
     '                  DECLARE SUB FractionReduce (a AS Fraction)
     '                  DECLARE FUNCTION GreatestComDiv& (n1&, n2&)
     '
       SUB FractionReduce (a AS Fraction)
           d& = GreatestComDiv&(a.Num, a.Den)
           a.Num = a.Num / d&
           a.Den = a.Den / d&
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FractionSub

   Subtracts fraction b from fraction a, reduces the result to lowest terms,
   and returns the result in fraction c.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FractionSub                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Subtracts two fractions and reduces the result to
     ' lowest terms.
     '
     ' EXAMPLE OF USE:  FractionSub a, b, c
     ' PARAMETERS:      a          First fraction
     '                  b          Fraction to subtract from the first
     '                  c          Resulting fraction
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  TYPE Fraction
     '                     Num AS LONG
     '                     Den AS LONG
     '                  END TYPE
     '
     '     DECLARE SUB FractionReduce (a AS Fraction)
     '     DECLARE SUB FractionSub (a AS Fraction, b AS Fraction, c AS Fractio
     '     DECLARE FUNCTION GreatestComDiv& (n1&, n2&)
     '
       SUB FractionSub (a AS Fraction, b AS Fraction, c AS Fraction)
           c.Num = a.Num * b.Den - a.Den * b.Num
           c.Den = a.Den * b.Den
           FractionReduce c
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: GreatestComDiv&

   Returns the greatest common divisor of two long integers.

   The greatest common divisor of the numerator and denominator of a fraction
   is efficient for reducing the fraction to its lowest terms, as
   demonstrated by the FractionReduce subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GreatestComDiv&            **
     ' **  Type:          Function                   **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the greatest common divisor of two long integers.
     '
     ' EXAMPLE OF USE:  gcd& = GreatestComDiv& (n1&, n2&)
     ' PARAMETERS:      n1&        First long integer
     '                  n2&        Second long integer
     ' VARIABLES:       ta&        Working copy of n1&
     '                  tb&        Working copy of n2&
     '                  tc&        Working variable
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION GreatestComDiv& (n1&, n2&)
     '
       FUNCTION GreatestComDiv& (n1&, n2&)
           ta& = n1&
           tb& = n2&
           DO
               tc& = ta& MOD tb&
               ta& = tb&
               tb& = tc&
           LOOP WHILE tc&
           GreatestComDiv& = ta&
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: LeastComMul&

   Returns the least common multiple of two long integers.

   Although this function is not used by any other routine in the
   FRACTION.BAS module, it is included because of its close ties to the
   GreatestComDiv& function. In fact, by using the GreatestComDiv& function
   in the calculations, the LeastComMul& function is shortened to one program
   line, as shown.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          LeastComMul&               **
     ' **  Type:          Function                   **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the least common multiple of two long integers.
     '
     ' EXAMPLE OF USE:  lcm& = LeastComMul& (n1&, n2&)
     ' PARAMETERS:      n1&         First long integer
     '                  n2&         Second long integer
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION LeastComMul& (n1&, n2&)
     '
       FUNCTION LeastComMul& (n1&, n2&)
           LeastComMul& = ABS(n1& * n2& / GreatestComDiv&(n1&, n2&))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SplitFractions

   Splits the input fraction problem string into two fraction strings and one
   operator string.

   This subprogram has a special purpose in the FRACTION.BAS program. After
   you enter a fraction problem, this subprogram splits your input into three
   strings: a string representation of the first fraction, a one-character
   symbol representing the desired mathematical operation, and a string
   representation of the second fraction.

   The results of this subprogram are passed to the String2Fraction
   subprogram before the indicated calculations are performed.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SplitFractions             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Splits an input fraction problem string into
     ' three strings representing each of the two
     ' fractions and a one-character string of the
     ' operation given.
     '
     ' EXAMPLE OF USE: SplitFractions f$, fa$, operator$, fb$
     ' PARAMETERS:     f$         Input string from the FRACTIONS demonstratio
     '                            program
     '                 fa$        First fraction, extracted from f$
     '                 operator$  Mathematical operation symbol, from f$
     '                 fb$        Second fraction, extracted from f$
     ' VARIABLES:      i%         Looping index
     '                 ndx%       Index to mathematical operation symbol
     ' MODULE LEVEL
     '   DECLARATIONS: DECLARE SUB SplitFractions (f$, fa$, operator$, fb$)
     '
       SUB SplitFractions (f$, fa$, operator$, fb$)
           fa$ = ""
           fb$ = ""
           operator$ = ""
           FOR i% = 1 TO 4
               ndx% = INSTR(f$, MID$("+-*/", i%, 1))
               IF ndx% THEN
                   IF i% = 4 THEN
                       ndx% = INSTR(ndx% + 1, f$, "/")
                   END IF
                   fa$ = LEFT$(f$, ndx% - 1)
                   fb$ = MID$(f$, ndx% + 1)
                   operator$ = MID$(f$, ndx%, 1)
                   EXIT FOR
               END IF
           NEXT i%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: String2Fraction

   Converts a string representation of a fraction to a data structure of type
   Fraction. This routine is useful for converting user input of fractional
   values to type Fraction variables.

   This subprogram extracts numerator and denominator values from a string
   representation of a fraction and fills in a data structure of type
   Fraction with the results.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          String2Fraction            **
     ' **  Type:          Subprogram                 **
     ' **  Module:        FRACTION.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts a string to a type Fraction variable.
     '
     ' EXAMPLE OF USE: String2Fraction f$, a
     ' PARAMETERS:     f$         String representation of a fraction
     '                 a          Structure of type Fraction
     ' VARIABLES:      (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB String2Fraction (f$, a AS Fraction)
     '
       SUB String2Fraction (f$, a AS Fraction)
           a.Num = VAL(f$)
           a.Den = VAL(MID$(f$, INSTR(f$, "/") + 1))
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 GAMES

   The GAMES toolbox is a collection of subprograms and functions that
   provide some common tasks for programming games with QuickBASIC.
   QuickBASIC is an ideal language for developing many graphics- and
   text-oriented games, partly because of the interactive nature of the
   development process, and partly because of the excellent set of graphics
   functions and subprograms provided by the language.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   GAMES.BAS                       Demo module
   Card$                   Func    Returns name of card given a number from
                                    1 through 52
   Collision%              Func    Returns TRUE or FALSE collision condition
   Dice%                   Func    Returns total showing for throwing N dice
   FillArray               Sub     Fills an integer array with a sequence of
                                    numbers defined by the bounds
   Shuffle$                Func    Randomizes character bytes in a string
   ShuffleArray            Sub     Randomizes integers in an array
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: GAMES

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GAMES                      **
     ' **  Type:          Toolbox                    **
     ' **  Module:        GAMES.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:          No command line parameters
     ' REQUIREMENTS:   CGA
     ' .MAK FILE:      (none)
     ' PARAMETERS:     (none)
     ' VARIABLES:      a$             String containing the 26 letters of the
     '                                alphabet
     '                 x%             Lower bound for array a%()
     '                 y%             Upper bound for array a%()
     '                 a%()           Array of numbers to be shuffled
     '                 i%             Looping index
     '                 size%          Dimension of bouncing ball array
     '                 object%()      Array for GET and PUT of bouncing ball
     '                 backGround%()  Array for GET and PUT of background
     '                 dx%            X velocity of bouncing ball
     '                 dy%            Y velocity of bouncing ball
     '                 px%            X coordinate of bouncing ball
     '                 py%            Y coordinate of bouncing ball
     '                 testNumber%    One of four bounce direction tests
     '                 test%          Result of the Collision% test

     ' Constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Functions
       DECLARE FUNCTION Shuffle$ (a$)
       DECLARE FUNCTION Dice% (numberOfDice%)
       DECLARE FUNCTION Card$ (cardNumber%)
       DECLARE FUNCTION Collision% (object%(), backGround%())

     ' Subprograms
       DECLARE SUB FillArray (a%())
       DECLARE SUB ShuffleArray (a%())

     ' Demonstration of the Shuffle$ function
       CLS
       RANDOMIZE TIMER
       a$ = "abcdefghijklmnopqrstuvwxyz"
       PRINT "a$           = "; a$
       PRINT "Shuffle$(a$) = "; Shuffle$(a$)
       PRINT

     ' Demonstration of the FillArray subprogram
       x% = -7
       y% = 12
       DIM a%(x% TO y%)
       PRINT "FillArray a%()   where DIM a%( -7 TO 12) ..."
       FillArray a%()
       FOR i% = x% TO y%
           PRINT a%(i%);
       NEXT i%
       PRINT

     ' Demonstration of the ShuffleArray subprogram
       PRINT
       PRINT "ShuffleArray a%() ..."
       ShuffleArray a%()
       FOR i% = x% TO y%
           PRINT a%(i%);
       NEXT i%
       PRINT

     ' Demonstration of the Dice% function
       PRINT
       PRINT "Dice%(2)..."
       FOR i% = 1 TO 20
           PRINT Dice%(2);
       NEXT i%
       PRINT

     ' Deal a hand of seven cards
       PRINT
       PRINT "Seven random cards, without replacement..."
       REDIM a%(1 TO 54)
       FillArray a%()
       ShuffleArray a%()
       FOR i% = 1 TO 7
           PRINT Card$(a%(i%))
       NEXT i%
       PRINT

     ' Wait for user to press a key
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP WHILE INKEY$ = ""

     ' Demonstration of the Collision% function
       size% = 6
       DIM object%(size%), backGround%(size%)

     ' Set medium resolution graphics mode
       SCREEN 1

     ' Create the bouncing ball
       CIRCLE (2, 2), 2, 3
       PAINT (2, 2), 3
       GET (0, 0)-(4, 4), object%

     ' Make solid border around screen
       LINE (14, 18)-(305, 187), 1, B
       PAINT (0, 0), 1

       PRINT " Collision% function... Press any key to quit "

     ' Make three obstacles
       CIRCLE (115, 78), 33, 2, , , .6
       PAINT (115, 78), 2
       CIRCLE (205, 78), 33, 2, , , .6
       PAINT (205, 78), 2
       LINE (90, 145)-(230, 155), 2, BF

     ' Initialize position and velocity of the object
       dx% = 1
       dy% = 1
       px% = 160
       py% = 44
       PUT (px%, py%), object%

     ' Move the object around the screen, avoiding collisions,
     ' until any key is pressed
       DO
           testNumber% = 0
           DO
               PUT (px%, py%), object%
               px% = px% + dx%
               py% = py% + dy%
               GET (px%, py%)-(px% + 4, py% + 4), backGround%
               PUT (px%, py%), object%
               test% = Collision%(object%(), backGround%())
               IF test% THEN
                   testNumber% = testNumber% + 1
                   PUT (px%, py%), object%
                   px% = px% - dx%
                   py% = py% - dy%
                   SELECT CASE testNumber%
                   CASE 1
                       dx% = -dx%
                   CASE 2
                       dx% = -dx%
                       dy% = -dy%
                   CASE 3
                       dy% = -dy%
                   CASE ELSE
                   END SELECT
                   PUT (px%, py%), object%
               END IF
           LOOP UNTIL test% = 0
       LOOP UNTIL INKEY$ <> ""

     ' Clean up a little
       SCREEN 0
       WIDTH 80
       CLS
       SYSTEM
   ──────────────────────────────────────────────────────────────────────────


 Function: Card$

   Returns the name of a card from a standard, 52-card deck, given a number
   from 1 through 52.

   The passed number is first checked to determine the suit. Numbers from 1
   through 13 indicate a Spade, 14 through 26 a Club, and so on. The face
   name or the number of the card is then determined using the MOD function.

   If the number is less than 1 or greater than 52, this function returns
   Joker, making it convenient to deal a 54-card deck if desired.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Card$                      **
     ' **  Type:          Function                   **
     ' **  Module:        GAMES.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the name of a playing card given a number
     ' from 1 to 52.  Any other number returns "Joker."
     '
     ' EXAMPLE OF USE:  PRINT Card$(n%)
     ' PARAMETERS:      n%         Number from 1 to 52 representing a card (an
     '                             other number returns a Joker)
     ' VARIABLES:       suit$      Name of one of the four card suits
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Card$ (cardNumber%)
     '
        FUNCTION Card$ (cardNumber%)

           SELECT CASE (cardNumber% - 1) \ 13      ' Which suit?
           CASE 0
               suit$ = " of Spades"
           CASE 1
               suit$ = " of Clubs"
           CASE 2
               suit$ = " of Hearts"
           CASE 3
               suit$ = " of Diamonds"
           CASE ELSE
               Card$ = "Joker"
               EXIT FUNCTION
           END SELECT

           SELECT CASE (cardNumber% - 1) MOD 13    ' Which card?
           CASE 0
               Card$ = "Ace" + suit$
           CASE 1 TO 9
               Card$ = MID$(STR$(cardNumber% MOD 13), 2) + suit$
           CASE 10
               Card$ = "Jack" + suit$
           CASE 11
               Card$ = "Queen" + suit$
           CASE 12
               Card$ = "King" + suit$
           END SELECT

       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Collision%

   Returns -1 or 0 (TRUE or FALSE), indicating whether a collision or near
   collision has occurred between two graphics objects stored in integer
   arrays.

   The graphics images are copied into the arrays by using the QuickBASIC GET
   statement. If you're not familiar with using the GET and PUT statements to
   create graphics animation, refer to your QuickBASIC documentation. These
   two statements provide a powerful method for quickly moving or duplicating
   graphics objects on your screen.

   To use the Collision function, you must pass two integer arrays of the
   same dimension. Normally, the background is copied into one array (using
   the GET statement) just before the object stored in the second is PUT on
   the screen at that same location. These two arrays are passed to the
   Collision% function, and the returned result determines whether the object
   overlaps (or very nearly overlaps) any pixel already on the screen.

   The check for near collision of pixels proceeds as follows. The first
   three integers in each array are skipped, as these integers contain
   object-dimensioning information and don't represent any pixel. The
   remaining integers from each array are compared to the corresponding
   integers from the other. Pixels having color attribute 0 represent the
   background and are stored in the integer array as one or more 0 bits. If
   an integer is 0, then all the pixels it represents are of the background
   color. If an integer is non-zero, then one or more of the pixels stored in
   it have a non-zero color attribute. To make the collision check fast and
   efficient, this function simply checks for non-zero bits in any
   corresponding integers from the two arrays. The pixels might not actually
   be overlapping, but they'll be very close neighbors. If a near collision
   is detected, the remaining integers are not checked, and the function
   returns a value of TRUE. If all the integers are checked and no collisions
   are detected, the function returns FALSE.

   The demonstration module shows one way to use the collision function to
   allow objects to bounce off each other. The bouncing ball moves around
   quickly in the "square face," bouncing off the mouth, eyes, and screen
   edges. Try experimenting by changing the size of the mouth or eyes or by
   drawing additional objects on the screen. The ball should bounce off any
   non-zero pixel objects.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Collision%                 **
     ' **  Type:          Function                   **
     ' **  Module:        GAMES.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns TRUE if any non-zero pixels occur in the
     ' same byte of video memory, as saved in the object%()
     ' and backGround%() arrays.  The arrays must be the
     ' same size.
     '
     ' EXAMPLE OF USE:  test% = Collision%(object%(), backGround%())
     ' PARAMETERS:      object%()       First array, filled in with the GET
     '                                  statement
     '                  backGround%()   Second array, filled in with the GET
     '                                  statement
     ' VARIABLES:       lo%             Lower bound of first array
     '                  up%             Upper bound of first array
     '                  lb%             Lower bound of second array
     '                  ub%             Upper bound of second array
     '                  i%              Index to integers in each array
     ' MODULE LEVEL
     '   DECLARATIONS:  CONST FALSE = 0
     '                  CONST TRUE = NOT FALSE
     '                  DECLARE FUNCTION Collision% (object%(), backGround%())
     '
       FUNCTION Collision% (object%(), backGround%()) STATIC
           lo% = LBOUND(object%)
           uo% = UBOUND(object%)
           lb% = LBOUND(backGround%)
           ub% = UBOUND(backGround%)
           IF lo% <> lb% OR uo% <> ub% THEN
               PRINT "Error: Collision - The object and background"
               PRINT "graphics arrays have different dimensions."
               SYSTEM
           END IF
           FOR i% = lo% + 2 TO uo%
               IF object%(i%) THEN
                   IF backGround%(i%) THEN
                       Collision% = TRUE
                       EXIT FUNCTION
                   END IF
               END IF
           NEXT i%
           Collision% = FALSE
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Dice%

   Returns a total for all dots that are showing when n% pseudorandom dice
   are thrown.

   The QuickBASIC RND function creates the pseudorandom sequence of
   unpredictable numbers to simulate the dice. Unless you want the same
   scores to show up every time a program is run, you should randomize the
   QuickBASIC random number generator by using the RANDOMIZE statement.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Dice%                      **
     ' **  Type:          Function                   **
     ' **  Module:        GAMES.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the total of the dots showing when any
     ' desired number of dice are rolled.
     '
     ' EXAMPLE OF USE:  total% = Dice%(n%)
     ' PARAMETERS:      n%         Number of dice
     ' VARIABLES:       toss%      Loop index for throwing the n% dice
     '                  total%     Total of the dots showing
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Dice% (numberOfDice%)
     '
       FUNCTION Dice% (numberOfDice%)
           IF numberOfDice% < 1 THEN
               PRINT "Error: Dice%() - Can't throw fewer than one die"
               SYSTEM
           END IF
           FOR toss% = 1 TO numberOfDice%
               total% = total% + INT(RND * 6) + 1
           NEXT toss%
           Dice% = total%
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────

   GAMES


 Subprogram: FillArray

   Fills an integer array with a sequence of numbers defined by the bounds.
   For example, consider these two statements:


     DIM year%(1900 TO 1999)
     FillArray year%

   The array will be filled with year numbers from 1900 through 1999.

   As a second example, consider an array dimensioned from 1 through 52.
   After filling this array with the numbers 1 through 52, the array contents
   can be shuffled efficiently with the ShuffleArray subprogram. The result
   is a freshly shuffled deck of 52 cards. Pulling these random "cards"
   sequentially from the array prevents duplication of a card.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FillArray                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        GAMES.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Initializes an integer array by putting i% into
     ' each i%th element.
     '
     ' EXAMPLE OF USE:  FillArray a%()
     ' PARAMETERS:      a%()       Array to be filled with a sequence of numbe
     ' VARIABLES:       i%         Looping index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB FillArray (a%())
     '
       SUB FillArray (a%()) STATIC
           FOR i% = LBOUND(a%) TO UBOUND(a%)
               a%(i%) = i%
           NEXT i%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: Shuffle$

   Shuffles the contents of a string by randomly swapping bytes throughout
   the string.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Shuffle$                   **
     ' **  Type:          Function                   **
     ' **  Module:        GAMES.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Randomizes the order of the character bytes in a$.
     '
     ' EXAMPLE OF USE:  b$ = Shuffle$(a$)
     ' PARAMETERS:      a$         String to be shuffled
     ' VARIABLES:       x$         Working string space
     '                  lenx%      Number of bytes in the string
     '                  i%         Pointer to each byte
     '                  j%         Pointer to randomly selected byte
     '                  t$         Temporary byte-swapping string
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Shuffle$ (a$)
     '
       FUNCTION Shuffle$ (a$) STATIC
           x$ = a$
           lenx% = LEN(x$)
           FOR i% = 1 TO lenx%
               j% = INT(RND * lenx% + 1)
               t$ = MID$(x$, i%, 1)
               MID$(x$, i%, 1) = MID$(x$, j%, 1)
               MID$(x$, j%, 1) = t$
           NEXT i%
           Shuffle$ = x$
           x$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ShuffleArray

   Shuffles the contents of an integer array. The array dimensions are
   automatically determined, and each integer entry is swapped with a
   randomly selected second entry.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ShuffleArray               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        GAMES.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Randomizes the order of the integers in a%()
     ' by swapping contents in a pseudorandom order.
     '
     ' EXAMPLE OF USE:  ShuffleArray a%()
     ' PARAMETERS:      a%()       Array to be shuffled
     ' VARIABLES:       lb%        Lower bound of the array
     '                  ub%        Upper bound of the array
     '                  range%     Number of array entries
     '                  i%         Looping index
     '
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB ShuffleArray (a%())
     '
       SUB ShuffleArray (a%()) STATIC
           lb% = LBOUND(a%)
           ub% = UBOUND(a%)
           range% = ub% - lb% + 1
           FOR i% = lb% TO ub%
               SWAP a%(i%), a%(INT(RND * range% + lb%))
           NEXT i%
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 HEX2BIN

   The HEX2BIN program reads in a file containing hexadecimal notation and
   creates a file containing the bytes that are indicated. Characters that
   are not in the set of hexadecimal characters are ignored, and each byte is
   assumed to be indicated by a pair of hexadecimal characters.

   This program converts the hexadecimal format files created by the
   BIN2HEX program into the object code files they represent. For example,
   you can create the MOUSE.OBJ file from the MOUSE.HEX file if you don't
   have the Microsoft Macro Assembler. (If you do have the Macro Assembler,
   you should create MOUSE.OBJ directly from the MOUSE.ASM listing.)

   The command line for performing this conversion (assuming you've compiled
   HEX2BIN to an executable program to be run from the MS-DOS prompt) is:


     HEX2BIN MOUSE.HEX MOUSE.OBJ

   Refer to the BIN2HEX program for information about creating this and the
   other .HEX files.


 Program Module: HEX2BIN

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          HEX2BIN                    **
     ' **  Type:          Program                    **
     ' **  Module:        HEX2BIN.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reads in a hexadecimal format file and writes out a binary
     ' file created from the hexadecimal byte numbers.
     '
     ' USAGE:           HEX2BIN inFileName.ext outFileName.ext
     ' .MAK FILE:       HEX2BIN.BAS
     '                  PARSE.BAS
     '                  STRINGS.BAS
     ' PARAMETERS:      inFileName.ext    Name of hexadecimal format file to b
     '                  outFileName.ext   Name of file to be created
     ' VARIABLES:       cmd$       Working copy of the command line
     '                  inFile$    Name of input file
     '                  outFile$   Name of output file
     '                  h$         Pair of hexadecimal characters representing
     '                             each byte
     '                  i%         Index into list of hexadecimal character pa
     '                  byte$      Buffer for binary file access

       DECLARE SUB ParseWord (a$, sep$, word$)
       DECLARE FUNCTION FilterIn$ (a$, set$)

     ' Get the input and output filenames from the command line
       cmd$ = COMMAND$
       ParseWord cmd$, " ,", inFile$
       ParseWord cmd$, " ,", outFile$

     ' Verify both filenames were given
       IF outFile$ = "" THEN
           PRINT
           PRINT "Usage: HEX2BIN inFileName.ext outFileName.ext"
           SYSTEM
       END IF

     ' Open the input file
       OPEN inFile$ FOR INPUT AS #1

     ' Truncate the output file if it already exists
       OPEN outFile$ FOR OUTPUT AS #2
       CLOSE #2

     ' Now open it for binary output
       OPEN outFile$ FOR BINARY AS #2 LEN = 1

     ' Process each line of the hexadecimal file
       DO
           LINE INPUT #1, h$
           h$ = FilterIn$(UCASE$(h$), "0123456789ABCDEF")
           FOR i% = 1 TO LEN(h$) STEP 2
               byte$ = CHR$(VAL("&H" + MID$(h$, i%, 2)))
               PUT #2, , byte$
           NEXT i%
       LOOP WHILE NOT EOF(1)

     ' Clean up and quit
       CLOSE
       END
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 JUSTIFY

   The JUSTIFY toolbox contains the subprogram, Justify, which pads a string
   with spaces between words in a pseudorandom manner until the string is a
   desired number of characters. This sounds simple, but the process is
   surprisingly complicated. For example, the inserted spaces must fall
   randomly between words, but it's desirable to keep the density of spaces
   as even as possible. You wouldn't want five spaces between the first two
   words and two spaces between the next two words.

   The demo module prints a paragraph justified to three different widths. As
   shown in the demo, the FormatTwo subprogram works hand in hand with the
   Justify subprogram to format a long string into several smaller strings.
   By padding the resulting shorter strings with a fixed number of spaces on
   the left, you're able to format paragraphs of text between arbitrary
   margins. Refer to .MAK FILE in the comment lines of the listing to see the
   other modules you must load for this program to run correctly.

   Name               Type     Description
   ──────────────────────────────────────────────────────────────────────────
   JUSTIFY.BAS                Demo module
   Justify           Sub      Adjusts strings to specified widths
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: JUSTIFY

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          JUSTIFY                    **
     ' **  Type:          Toolbox                    **
     ' **  Module:        JUSTIFY.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates the Justify subprogram.
     '
     ' USAGE:           No command line parameters
     ' .MAK FILE:     JUSTIFY.BAS
     '                EDIT.BAS
     '                PARSE.BAS
     '                KEYS.BAS
     ' PARAMETERS:    (none)
     ' VARIABLES:     a$         String to be justified
     '                col%       Number of columns for each example of Justify
     '                x$         Working copy of a$
     '                y$         Working string space

       DECLARE SUB Justify (a$, n%)
       DECLARE SUB ParseLine (x$, sep$, a$())
       DECLARE SUB FormatTwo (a$, b$, col%)

       CLS
       a$ = ""
       a$ = a$ + "This paragraph is used to demonstrate the Justify "
       a$ = a$ + "subprogram.  First, the entire paragraph is "
       a$ = a$ + "placed in a single string variable.  This string "
       a$ = a$ + "is then split between words into shorter strings, "
       a$ = a$ + "and these shorter strings are then justified in "
       a$ = a$ + "order to align both the left and right edges of "
       a$ = a$ + "the text."

       FOR col% = 50 TO 70 STEP 10
           x$ = a$
           DO
               FormatTwo x$, y$, col%
               IF y$ <> "" THEN
                   Justify x$, col%
               END IF
               PRINT x$
               x$ = y$
           LOOP WHILE y$ <> ""
           PRINT
       NEXT col%

       END
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Justify

   Inserts spaces between words until the given string is the desired length.
   Spaces are not added before the first word or after the last word,
   resulting in a string that is left- and right-justified to the length
   indicated.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Justify                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        JUSTIFY.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Spaces words with extra spaces until line
     ' is n% characters long.
     '
     ' EXAMPLE OF USE:  Justify a$, n%
     ' PARAMETERS:      a$         String to be justified
     '                  n%         Desired string length
     ' VARIABLES:       ary$()     Array to store individual words from the st
     '                  cnt%       Count of non-space characters
     '                  i%         Looping index
     '                  j%         Count of words
     '                  each%      Minimum space count to insert between words
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Justify (a$, n%)
     '                  DECLARE SUB ParseLine (x$, sep$, a$())
     '                  DECLARE SUB FormatTwo (a$, b$, col%)
     '
       SUB Justify (a$, n%) STATIC

         ' If string is shorter than n%, don't bother
           IF LEN(a$) < n% THEN
               EXIT SUB
           END IF

         ' Array for list of words from original string
           REDIM ary$(1 TO n%)

         ' Split line up into individual words
           ParseLine a$, " ", ary$()

         ' Count the words and total of non-space characters
           cnt% = 0
           FOR i% = n% TO 1 STEP -1
               cnt% = cnt% + LEN(ary$(i%))
               IF ary$(i%) = "" THEN
                   j% = i% - 1
               END IF
           NEXT i%

         ' If only one or zero words, there's not much we can do
           IF j% < 2 THEN
               a$ = LEFT$(ary$(1) + SPACE$(n%), n%)
               EXIT SUB
           END IF

         ' We want an extra space at the ends of sentences, questions, etc.
           FOR i% = 1 TO j% - 1
               IF INSTR(".!?", RIGHT$(ary$(i%), 1)) THEN
                   ary$(i%) = ary$(i%) + " "
                   cnt% = cnt% + 1
               END IF
           NEXT i%

         ' How many spaces minimum to add to each word?
           each% = (n% - cnt%) \ (j% - 1)

         ' Tack on the minimum spaces to each word
           FOR i% = 1 TO j% - 1
               ary$(i%) = ary$(i%) + SPACE$(each%)
               cnt% = cnt% + each%
           NEXT i%

         ' Which is quicker, adding remaining spaces, or
         ' adding spaces to all and removing a few of them?
           IF (n% - cnt%) < j% \ 2 THEN

             ' We'll add a few spaces at random
               DO UNTIL cnt% = n%
                   DO
                       i% = INT(RND * (j% - 1) + 2)
                   LOOP UNTIL LEFT$(ary$(i%), 1) <> " "
                   ary$(i%) = " " + ary$(i%)
                   cnt% = cnt% + 1
               LOOP

           ELSE

             ' We'll add a space to each, and then remove some at random
               FOR i% = 2 TO j%
                   ary$(i%) = " " + ary$(i%)
                   cnt% = cnt% + 1
               NEXT i%

             ' Now we'll take a few away at random
               DO UNTIL cnt% = n%
                   DO
                       i% = INT(RND * (j% - 1) + 2)
                   LOOP UNTIL LEFT$(ary$(i%), 1) = " "
                   ary$(i%) = MID$(ary$(i%), 2)
                   cnt% = cnt% - 1
               LOOP

           END IF

         ' Glue it all back together
           a$ = ary$(1)
           FOR i% = 2 TO j%
               a$ = a$ + ary$(i%)
           NEXT i%

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 KEYS

   The KEYS toolbox performs two enhanced keyboard input functions. It prints
   the unique integer number returned by the KeyCode% or InKeyCode%
   function for any key pressed. Run the program and press a few keys to see
   the numbers. To try the InKeyCode% function for one second at a time,
   press the Escape key followed immediately by other keys.

   The QuickBASIC INKEY$ function returns a string of zero, one, or two
   characters, depending on whether a key was pressed and whether the key has
   an extended key code. The two functions presented here always return a
   unique integer for any key pressed, even if the key normally returns an
   extended key code. For example, pressing the letter "a" returns 97, F1
   returns 15104, Alt-F1 returns 26624, and the Home key returns 18176. Run
   the program to determine other returned values.

   The EDIT.BAS module uses these functions and presents a table of CONST
   statements that define several common editing keys. Note that most
   standard alphanumeric keys return the expected ASCII code number.

   Name               Type     Description
   ──────────────────────────────────────────────────────────────────────────
   KEYS.BAS                   Demo module
   InKeyCode%        Func     Returns unique integer for any key pressed
   KeyCode%          Func     Waits and returns integer value for key
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: KEYS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          KEYS                       **
     ' **  Type:          Toolbox                    **
     ' **  Module:        KEYS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates keyboard access functions.
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       kee%       Unique integer returned by KeyCode% and
     '                             InKeyCode%


       DECLARE FUNCTION KeyCode% ()
       DECLARE FUNCTION InKeyCode% ()

       CLS
       PRINT "Press any key to see the unique number returned by KeyCode%."
       PRINT "Press Esc to see InKeyCode% results for 1 second."
       PRINT "Press Esc twice in a row to quit."
       PRINT

       DO
           kee% = KeyCode%
           PRINT kee%
           IF kee% = 27 THEN
               t0 = TIMER
               DO
                   kee% = InKeyCode%
                   PRINT kee%;
                   IF kee% THEN
                       PRINT
                   END IF
                   IF kee% = 27 THEN
                       quitFlag% = -1
                       t0 = t0 - 1
                   END IF
               LOOP UNTIL TIMER - t0 > 1
               PRINT
           END IF
       LOOP UNTIL quitFlag%

       END
   ──────────────────────────────────────────────────────────────────────────


 Function: InKeyCode%

   Immediately returns a unique integer for any key pressed or 0 if no key
   was pressed.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          InKeyCode%                 **
     ' **  Type:          Function                   **
     ' **  Module:        KEYS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a unique integer for any key pressed or
     ' a zero if no key was pressed.
     '
     ' EXAMPLE OF USE:  k% = InKeyCode%
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION KeyCode% ()
     '
       FUNCTION InKeyCode% STATIC
           InKeyCode% = CVI(INKEY$ + STRING$(2, 0))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: KeyCode%

   Waits until a key is pressed, and then returns the unique key-code integer
   for each key on the keyboard.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          KeyCode%                   **
     ' **  Type:          Function                   **
     ' **  Module:        KEYS.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a unique integer for any key pressed.
     '
     ' EXAMPLE OF USE:  k% = KeyCode%
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION KeyCode% ()
     '
       FUNCTION KeyCode% STATIC
           DO
               k$ = INKEY$
           LOOP UNTIL k$ <> ""
           KeyCode% = CVI(k$ + CHR$(0))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 LOOK

   The LOOK program is a utility for viewing text-file contents. The program
   displays ASCII text-file contents and provides limited keyboard control to
   allow scrolling or paging through files.

   This program presents the FileRead subprogram for reading ASCII files
   into an array of strings and also demonstrates the VIEW PRINT statement
   for limiting printing and scrolling of text to only those display lines
   desired.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   LOOK.BAS                        Program module
   FileRead                Sub     Reads lines of ASCII files into an array
   ──────────────────────────────────────────────────────────────────────────


 Program Module: LOOK

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          LOOK                       **
     ' **  Type:          Program                    **
     ' **  Module:        LOOK.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:           LOOK filename.ext
     ' .MAK FILE:       LOOK.BAS
     '                  KEYS.BAS
     ' PARAMETERS:      filename.ext  Name of file to view
     ' VARIABLES:       a$()          Array of lines from the file
     '                  fileName$     Name of file, from the command line
     '                  lineCount%    Count of lines read from the file
     '                  linePtr%      First file line currently on the display
     '                  i%            Loop index for printing 24 lines
     '                  quitFlag%     Indicates Escape key press
     '                  updateFlag%   Indicates if update of screen is necessa

     ' Constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Key code numbers
       CONST UPARROW = 18432
       CONST DOWNARROW = 20480
       CONST PGUP = 18688
       CONST PGDN = 20736
       CONST HOME = 18176
       CONST ENDKEY = 20224
       CONST ESCAPE = 27

     ' Functions
       DECLARE FUNCTION KeyCode% ()

     ' Subprograms
       DECLARE SUB FileRead (fileName$, lineCount%, a$())

     ' Dimension string array
     ' NOTE:
     ' Must be dimensioned big enough to read in all lines from the file
       DIM a$(1 TO 2000)

     ' Get the command line parameters
       fileName$ = COMMAND$

     ' Read in the file
       ON ERROR GOTO FileError
       FileRead fileName$, lineCount%, a$()
       ON ERROR GOTO 0

     ' Prepare the screen
       SCREEN 0, 0, 0, 0
       CLS

     ' Set line pointer
       linePtr% = 1

     ' Main loop
       DO

         ' Print information bar at top
           VIEW PRINT 1 TO 1
           COLOR 0, 3
           LOCATE 1, 1
           PRINT " Line:"; LEFT$(STR$(linePtr%) + SPACE$(7), 8);
           PRINT "File: "; LEFT$(fileName$ + SPACE$(19), 19);
           PRINT "Quit: ESC"; SPACE$(3);
           PRINT "Move: "; CHR$(24); " "; CHR$(25); " PGUP PGDN HOME END ";

         ' Update the 24 lines of text
           VIEW PRINT 2 TO 25
           COLOR 7, 1
           FOR i% = 0 TO 23
               LOCATE i% + 2, 1
               PRINT LEFT$(a$(i% + linePtr%) + SPACE$(80), 80);
           NEXT i%

         ' Wait for a meaningful key to be pressed
           SELECT CASE KeyCode%
           CASE UPARROW
               IF linePtr% > 1 THEN
                   linePtr% = linePtr% - 1
               END IF
           CASE DOWNARROW
               IF linePtr% < lineCount% THEN
                   linePtr% = linePtr% + 1
               END IF
           CASE PGUP
               IF linePtr% > 1 THEN
                   linePtr% = linePtr% - 24
                   IF linePtr% < 1 THEN
                       linePtr% = 1
                   END IF
               END IF
           CASE PGDN
               IF linePtr% < lineCount% - 24 THEN
                   linePtr% = linePtr% + 24
                   IF linePtr% > lineCount% THEN
                       linePtr% = lineCount%
                   END IF
               END IF
           CASE HOME
               IF linePtr% > 1 THEN
                   linePtr% = 1
               END IF
           CASE ENDKEY
               IF linePtr% < lineCount% - 24 THEN
                   linePtr% = lineCount% - 24
               END IF
           CASE ESCAPE
               quitFlag% = TRUE
           CASE ELSE
               updateFlag% = FALSE
           END SELECT

       LOOP UNTIL quitFlag%

     ' Set color back to normal
       COLOR 7, 0
       END

   FileError:
       PRINT
       PRINT "Usage: LOOK filename.ext"
       SYSTEM
       RESUME NEXT
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FileRead

   Reads all lines of a text (ASCII) file into a string array and returns the
   array of lines from the file and the count of the read lines.

   The string array must be large enough to hold all the lines from the file.
   The file to read must be readable using the LINE INPUT statement.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FileRead                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        LOOK.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reads lines of an ASCII file into a$().  The
     ' lineCount% is set to the number of lines read
     ' in.  If a$() wasn't dimensioned large enough,
     ' then lineCount% will be set to -1.
     '
     ' EXAMPLE OF USE:  FileRead fileName$, lineCount%, a$()
     ' PARAMETERS:      fileName$     Name of file to be read into the array
     '                  lineCount%    Returned count of lines read from the fi
     '                  a$()          String array of file contents
     ' VARIABLES:       FileNumber%   Next available free file number
     '                  i%            Index for string array
     ' MODULE LEVEL
     '   DECLARATIONS:    DECLARE SUB FileRead (fileName$, lineCount%, a$())
     '
       SUB FileRead (fileName$, lineCount%, a$()) STATIC
           FileNumber% = FREEFILE
           OPEN fileName$ FOR INPUT AS FileNumber%
           FOR i% = LBOUND(a$) TO UBOUND(a$)
               LINE INPUT #FileNumber%, a$(i%)
               lineCount% = i%
               IF EOF(FileNumber%) THEN
                   EXIT FOR
               END IF
           NEXT i%
           IF NOT EOF(FileNumber%) THEN
               lineCount% = -1
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 MONTH

   The MONTH program demonstrates how to use the CALENDAR.BAS toolbox to
   perform calendar-related calculations.

   When MONTH is run, a display of three one-month calendars is created. The
   current system date determines the second month displayed; the previous
   and next month are also shown.

   Included with the display are instructions on how to increment or
   decrement the years or months. Press the lowercase y key to display the
   same three months of the previous year. Press a shifted (uppercase) Y to
   increment the year. In the same way, press M to increment or m to
   decrement the range of months displayed.


 Program Module: MONTH

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MONTH                      **
     ' **  Type:          Program                    **
     ' **  Module:        MONTH.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Creates and displays a three-month calendar.
     ' USAGE:           No command line parameters
     ' .MAK FILE:       MONTH.BAS
     '                  CALENDAR.BAS
     ' PARAMETERS:      (none)
     ' VARIABLES:       year%      Year of concern
     '                  month%     Month of concern
     '                  quitFlag%  Indicates that program is to terminate
     '                  day%       Day near middle of the month
     '                  d2$        Date for second calendar month
     '                  j2&        Julian day number for second calendar month
     '                  d1$        Date for first calendar month
     '                  j1&        Julian day number for first calendar month
     '                  d3$        Date for third calendar month
     '                  j3&        Julian day number for third calendar month
     '                  k$         Key press character

     ' Constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Functions
       DECLARE FUNCTION Date2Julian& (dat$)
       DECLARE FUNCTION MDY2Date$ (month%, day%, year%)
       DECLARE FUNCTION Date2Year% (dat$)
       DECLARE FUNCTION Date2Month% (dat$)
       DECLARE FUNCTION Julian2Date$ (julian&)

     ' Subprograms
       DECLARE SUB OneMonthCalendar (dat$, row%, col%)

     ' Get today's month and year
       year% = Date2Year%(DATE$)
       month% = Date2Month%(DATE$)

     ' Make calendars until the Esc key is pressed
       DO UNTIL quitFlag%

         ' Get Julian day number for about the middle of the month
           day% = 15
           d2$ = MDY2Date$(month%, day%, year%)
           j2& = Date2Julian&(d2$)

         ' Get last month's date
           j1& = j2& - 30
           d1$ = Julian2Date$(j1&)

         ' Get next month's date
           j3& = j2& + 30
           d3$ = Julian2Date$(j3&)

         ' Display the heading
           CLS
           LOCATE 1, 57
           PRINT "THREE-MONTH CALENDAR"
           LOCATE 2, 57
           PRINT "QuickBASIC 4.0"

         ' Create the three calendar sheets
           OneMonthCalendar d1$, 1, 1
           OneMonthCalendar d2$, 8, 25
           OneMonthCalendar d3$, 15, 49

         ' Display the instructions
           LOCATE 17, 1
           PRINT "Press <Y> to increment the year"
           LOCATE 18, 1
           PRINT "Press <y> to decrement the year"
           LOCATE 19, 1
           PRINT "Press <M> to increment the months"
           LOCATE 20, 1
           PRINT "Press <m> to decrement the months"
           LOCATE 22, 1
           PRINT "Press the Esc key to quit"

         ' Wait for a keystroke
           DO
               k$ = INKEY$
           LOOP UNTIL k$ <> ""

         ' Check for appropriate keystroke
           SELECT CASE k$
           CASE "y"
               year% = year% - 1
           CASE "Y"
               year% = year% + 1
           CASE "m"
               month% = month% - 3
           CASE "M"
               month% = month% + 3
           CASE CHR$(27)
               quitFlag% = TRUE
           CASE ELSE
           END SELECT

         ' Adjust month for proper range
           IF month% < 1 THEN
               month% = month% + 12
               year% = year% - 1
           ELSEIF month% > 12 THEN
               month% = month% - 12
               year% = year% + 1
           END IF

       LOOP

     ' All done
       END
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 MOUSGCRS

   The MOUSGCRS program is a utility for designing graphics-mode mouse
   cursors.

   This program lets you create new graphics-mode cursors for programs that
   use the Microsoft Mouse. The program's output is a QuickBASIC subprogram
   file that other programs can load and use. To run MOUSGCRS, your computer
   must have CGA graphics capability and a mouse.

   This module can also be used as a toolbox for choosing any of the
   predefined cursors. For an example of a program using this module as a
   toolbox, see the OBJECT.BAS utility program.

   The MOUSE.ASM subprogram must be assembled and loaded with the QuickBASIC
   environment for this program to run correctly. See the MOUSE.ASM
   subprogram in Part III of this book for more information on loading this
   routine.

   Two masks are displayed while this program is running. The memory-resident
   mouse driver uses the screen mask to define areas of the cursor where the
   background pixels are to be left alone (0s) or blanked out (1s) before the
   cursor mask is displayed. Often, the screen-mask pixels define an area of
   the same shape but slightly larger than the cursor mask, creating an
   outline around the cursor when it's located on a pure white background.

   To edit a cursor, click with either the left or right mouse button on any
   of the small squares that make up the two masks. The left button sets
   pixel locations on, and the right button sets them off. To change the hot
   spot to a new location, press both mouse buttons simultaneously.

   When you're ready to try out your cursor creation, click on the "Try new
   cursor" box. A solid white area at the right side of the screen lets you
   view your new cursor against a white background.

   Click on the "Try standard cursors" box to select one of the predefined
   cursors. Each time you click on this box, the cursor changes to the next
   available predefined cursor type, allowing you to preview them all.

   When you click on the "Create cursor subroutine" box, the currently
   defined cursor masks are written to a QuickBASIC subprogram source file
   named GCURSOR.BAS. This file can be loaded by or merged with any program
   in which you want to use the new cursor. To create more than one cursor,
   be sure to rename the GCURSOR.BAS file after creating each cursor
   subprogram.


 Program Module: MOUSGCRS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MOUSGCRS                   **
     ' **  Type:          Program                    **
     ' **  Module:        MOUSGCRS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Program for the interactive design of graphics-
     ' mode mouse cursor subroutines.
     '
     ' USAGE:          No command line parameters
     ' REQUIREMENTS:   CGA
     '                 MIXED.QLB/.LIB
     '                 Mouse
     ' .MAK FILE:      MOUSGCRS.BAS
     '                 BITS.BAS
     '                 MOUSSUBS.BAS
     ' PARAMETERS:     (none)
     ' VARIABLES:      curs$()       Array of binary cursor string data
     '                 defaultMask$  Pattern mask for the default cursor
     '                 xdef%         Default hot spot X value
     '                 ydef%         Default hot spot Y value
     '                 mask$         Pattern mask for a cursor
     '                 xHot%         Hot spot X value
     '                 yHot%         Hot spot Y value
     '                 maskChr%      Index into the pattern mask
     '                 maskPtr%      Index to the background or foreground mas
     '                               pattern
     '                 y%            Cursor bit pointer, vertical
     '                 x%            Cursor bit pointer, horizontal
     '                 xbox%         X location on screen for cursor bit box
     '                 ybox%         Y location on screen for cursor bit box
     '                 xh%           Screen X location for hot spot
     '                 yh%           Screen Y location for hot spot
     '                 click$        DRAW string for creating the click boxes
     '                 quitFlag%     Indication that user wants to quit
     '                 t$            Copy of TIME$
     '                 toggle%       Once per second toggle for hot spot visib
     '                 pxl%          Pixel value at the hot spot
     '                 leftButton%   Current state of the left mouse button
     '                 rightButton%  Current state of the right mouse button
     '                 resetBox%     Indicates cursor is in the "Try standard
     '                               cursors" box
     '                 tryBox%       Indicates cursor is in the "Try new curso
     '                               box
     '                 subBox%       Indicates cursor is in the "Create cursor
     '                               subroutine" box
     '                 quitBox%      Indicates cursor is in the "Quit" box
     '                 xold%         X location of just-modified pixel box
     '                 yold%         Y location of just-modified pixel box
     '                 ix%           X bit pointer for pixel change
     '                 iy%           Y bit pointer for pixel change
     '                 q$            Double-quote character

     ' Define constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Subprograms
       DECLARE SUB Cursdflt (mask$, xHot%, yHot%)
       DECLARE SUB Curschek (mask$, xHot%, yHot%)
       DECLARE SUB Curshand (mask$, xHot%, yHot%)
       DECLARE SUB Curshour (mask$, xHot%, yHot%)
       DECLARE SUB Cursjet (mask$, xHot%, yHot%)
       DECLARE SUB Cursleft (mask$, xHot%, yHot%)
       DECLARE SUB Cursplus (mask$, xHot%, yHot%)
       DECLARE SUB Cursup (mask$, xHot%, yHot%)
       DECLARE SUB Cursx (mask$, xHot%, yHot%)
       DECLARE SUB MouseShow ()
       DECLARE SUB MouseNow (lbutton%, rbutton%, xMouse%, yMouse%)
       DECLARE SUB MouseHide ()
       DECLARE SUB MouseMaskTranslate (mask$, xHot%, yHot%, cursor$)
       DECLARE SUB MouseSetGcursor (cursor$)

     ' Arrays
       DIM curs$(0 TO 8)

     ' Initialization
       SCREEN 2
       CLS

     ' Create set of cursors
       Cursdflt defaultMask$, xdef%, ydef%
       MouseMaskTranslate defaultMask$, xdef%, ydef%, curs$(0)

       Curschek mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(1)

       Curshand mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(2)

       Curshour mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(3)

       Cursjet mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(4)

       Cursleft mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(5)

       Cursplus mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(6)

       Cursup mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(7)

       Cursx mask$, xHot%, yHot%
       MouseMaskTranslate mask$, xHot%, yHot%, curs$(8)

     ' Set the default cursor
       MouseSetGcursor curs$(0)

     ' Make the default cursor the starting point for editing
       mask$ = defaultMask$
       xHot% = xdef%
       yHot% = ydef%

     ' Place titles above pixel boxes
       LOCATE 2, 22, 0
       PRINT "Screen mask";
       LOCATE 2, 50, 0
       PRINT "Cursor mask";

     ' Outline the pixel boxes, filling the "ones" using the Mask$
       maskChr% = 0
       FOR maskPtr% = 0 TO 1
           FOR y% = 1 TO 16
               FOR x% = 1 TO 16
                   xbox% = x% * 12 + maskPtr% * 222 + 107
                   ybox% = y% * 9 + 10
                   maskChr% = maskChr% + 1
                   LINE (xbox%, ybox%)-(xbox% + 12, ybox% + 9), 1, B
                   IF MID$(mask$, maskChr%, 1) = "1" THEN
                       LINE (xbox% + 3, ybox% + 2)-(xbox% + 9, ybox% + 7), 1,
                   END IF
                   IF maskPtr% = 0 THEN
                       IF x% = xHot% + 1 AND y% = yHot% + 1 THEN
                           xh% = xbox%
                           yh% = ybox%
                       END IF
                   END IF
               NEXT x%
           NEXT y%
       NEXT maskPtr%

     ' Instruction text at bottom of display
       LOCATE 23, 1
       PRINT TAB(16); "Left button       Right button         Both buttons"
       PRINT TAB(16); "to set pixel      to clear pixel       for hot spot";

     ' Print menu items
       LOCATE 3, 2, 0
       PRINT "Try";
       LOCATE 4, 2, 0
       PRINT "standard";
       LOCATE 5, 2, 0
       PRINT "cursors";
       LOCATE 9, 2, 0
       PRINT "Try new";
       LOCATE 10, 2, 0
       PRINT "cursor";
       LOCATE 14, 2, 0
       PRINT "Create"
       LOCATE 15, 2, 0
       PRINT "cursor";
       LOCATE 16, 2, 0
       PRINT "subroutine";
       LOCATE 16, 74, 0
       PRINT "Quit";

     ' Make click box draw string
       click$ = "R20D10L20U10BF5BR1F3E6"

     ' Draw the click boxes
       DRAW "BM20,45" + click$
       DRAW "BM20,85" + click$
       DRAW "BM20,132" + click$
       DRAW "BM592,132" + click$

     ' Make a white cursor testing area
       LOCATE 5, 71
       PRINT "Cursor";
       LOCATE 6, 71
       PRINT "viewing";
       LOCATE 7, 71
       PRINT "area";
       LINE (560, 60)-(610, 100), 1, BF

     ' Turn on the mouse
       MouseShow

     ' Main processing loop control
       DO
           GOSUB MainLoop
       LOOP UNTIL quitFlag%

     ' Exit the loop and end program because Quitflag% has been set
       CLS
       SYSTEM


     ' Main processing loop
   MainLoop:

     ' Toggle the hot spot once per second
       IF t$ <> TIME$ THEN
           t$ = TIME$
           IF toggle% = 1 THEN
               toggle% = 0
           ELSE
               toggle% = 1
           END IF
           pxl% = POINT(xh% + 3, yh% + 2) XOR toggle%
           LINE (xh% + 5, yh% + 3)-(xh% + 7, yh% + 6), pxl%, BF
           pxl% = POINT(xh% + 3 + 222, yh% + 2) XOR toggle%
           LINE (xh% + 5 + 222, yh% + 3)-(xh% + 7 + 222, yh% + 6), pxl%, BF
       END IF

     ' What is the mouse location and button state right now?
       MouseNow leftButton%, rightButton%, x%, y%

     ' Are both buttons being pressed right now?
       IF leftButton% AND rightButton% THEN
           GOSUB WhichBox
           IF xbox% THEN
               GOSUB SetHotSpot
           END IF
       END IF

     ' Are we traversing the "Try standard cursors" click box?
       IF x% > 20 AND x% < 40 AND y% > 45 AND y% < 55 THEN
           IF resetBox% = 0 THEN
               MouseHide
               resetBox% = 1
               LINE (17, 43)-(43, 57), 1, B
               MouseShow
           END IF
       ELSE
           IF resetBox% = 1 THEN
               MouseHide
               resetBox% = 0
               LINE (17, 43)-(43, 57), 0, B
               MouseShow
           END IF
       END IF

     ' Are we traversing the "Try new cursor" click box?
       IF x% > 20 AND x% < 40 AND y% > 85 AND y% < 95 THEN
           IF tryBox% = 0 THEN
               MouseHide
               tryBox% = 1
               LINE (17, 83)-(43, 97), 1, B
               MouseShow
           END IF
       ELSE
           IF tryBox% = 1 THEN
               MouseHide
               tryBox% = 0
               LINE (17, 83)-(43, 97), 0, B
               MouseShow
           END IF
       END IF

     ' Are we traversing the "Create cursor subroutine" click box?
       IF x% > 20 AND x% < 40 AND y% > 132 AND y% < 142 THEN
           IF subBox% = 0 THEN
               MouseHide
               subBox% = 1
               LINE (17, 130)-(43, 144), 1, B
               MouseShow
           END IF
       ELSE
           IF subBox% = 1 THEN
               MouseHide
               subBox% = 0
               LINE (17, 130)-(43, 144), 0, B
               MouseShow
           END IF
       END IF

     ' Are we traversing the "Quit" click box?
       IF x% > 592 AND x% < 612 AND y% > 132 AND y% < 142 THEN
           IF quitBox% = 0 THEN
               MouseHide
               quitBox% = 1
               LINE (589, 130)-(615, 144), 1, B
               MouseShow
           END IF
       ELSE
           IF quitBox% = 1 THEN
               MouseHide
               quitBox% = 0
               LINE (589, 130)-(615, 144), 0, B
               MouseShow
           END IF
       END IF

     ' If just one button or the other is pressed, then check further
       IF leftButton% XOR rightButton% THEN
           GOSUB ButtonWasPressed
       ELSE
           xold% = 0
           yold% = 0
       END IF

     ' End of main loop
       RETURN

     ' Is the mouse currently pointing at a pixel box?
   WhichBox:
       IF x% > 320 THEN
           maskPtr% = 1
           x% = x% - 222
       ELSE
           maskPtr% = 0
       END IF
       ix% = (x% - 107) \ 12
       iy% = (y% - 10) \ 9
       xbox% = 0
       ybox% = 0
       IF ix% >= 1 AND ix% <= 16 THEN
           IF iy% >= 1 AND iy% <= 16 THEN
               xbox% = ix% * 12 + maskPtr% * 222 + 107
               ybox% = iy% * 9 + 10
           END IF
       END IF
       RETURN

     ' Move the hot spot to the current pixel box
   SetHotSpot:
       IF (xbox% <> xh% AND xbox% - 222 <> xh%) OR ybox% <> yh% THEN
           MouseHide
           pxl% = POINT(xh% + 3, yh% + 2)
           LINE (xh% + 5, yh% + 3)-(xh% + 7, yh% + 6), pxl%, BF
           pxl% = POINT(xh% + 3 + 222, yh% + 2)
           LINE (xh% + 5 + 222, yh% + 3)-(xh% + 7 + 222, yh% + 6), pxl%, BF
           MouseShow
           IF xbox% > 320 THEN
               xh% = xbox% - 222
           ELSE
               xh% = xbox%
           END IF
           yh% = ybox%
       END IF
       RETURN

     ' Process the button press depending on mouse location
   ButtonWasPressed:
       IF quitBox% THEN
           GOSUB DoQuitBox
       ELSEIF resetBox% THEN
           GOSUB DoResetCursor
       ELSEIF tryBox% THEN
           GOSUB DoSetNewCursor
       ELSEIF subBox% THEN
           GOSUB DoSetNewCursor
           GOSUB DoCreateSub
       ELSE
           GOSUB DoPixelControl
       END IF
       RETURN

     ' Button was pressed while mouse was in the "Quit" box
   DoQuitBox:
       MouseHide
       quitFlag% = TRUE
       RETURN

     ' Button was pressed while mouse was in the "Try new cursor" box
   DoSetNewCursor:
       MouseHide
       maskChr% = 0
       FOR maskPtr% = 0 TO 1
           FOR y% = 1 TO 16
               FOR x% = 1 TO 16
                   xbox% = x% * 12 + maskPtr% * 222 + 107
                   ybox% = y% * 9 + 10
                   maskChr% = maskChr% + 1
                   IF POINT(xbox% + 3, ybox% + 2) THEN
                       MID$(mask$, maskChr%, 1) = "1"
                   ELSE
                       MID$(mask$, maskChr%, 1) = "0"
                   END IF
                   IF xbox% = xh% AND ybox% = yh% THEN
                       xHot% = x% - 1
                       yHot% = y% - 1
                   END IF
               NEXT x%
           NEXT y%
       NEXT maskPtr%
       MouseMaskTranslate mask$, xHot%, yHot%, cursor$
       MouseSetGcursor cursor$
       MouseShow
       RETURN

     ' Button was pressed while mouse was in the "Try standard cursors" box
   DoResetCursor:
       MouseHide
       cursorIndex% = (cursorIndex% + 1) MOD 9
       MouseSetGcursor curs$(cursorIndex%)
       MouseShow
       DO
           MouseNow leftButton%, rightButton%, xMouse%, yMouse%
       LOOP UNTIL leftButton% = 0 AND rightButton% = 0
       RETURN

     ' Button was pressed while mouse was in the "Create cursor subroutine" bo
   DoCreateSub:
       q$ = CHR$(34)
       OPEN "GCURSOR.BAS" FOR OUTPUT AS #1
       PRINT #1, "   ' ************************************************"
       PRINT #1, "   ' **  Name:          Gcursor                    **"
       PRINT #1, "   ' **  Type:          Subprogram                 **"
       PRINT #1, "   ' **  Module:        GCURSOR.BAS                **"
       PRINT #1, "   ' **  Language:      Microsoft QuickBASIC 4.00  **"
       PRINT #1, "   ' ************************************************"
       PRINT #1, "   '"
       PRINT #1, "   SUB Gcursor (mask$, xHot%, yHot%) STATIC"
       PRINT #1, ""
       PRINT #1, "       mask$ = "; q$; q$
       FOR i% = 0 TO 31
           PRINT #1, "       mask$ = mask$ + ";
           PRINT #1, q$; MID$(mask$, 16 * i% + 1, 16); q$
           IF i% = 15 THEN
               PRINT #1, ""
           END IF
       NEXT i%
       PRINT #1, ""
       PRINT #1, "       xHot% ="; STR$(xHot%)
       PRINT #1, "       yHot% ="; STR$(yHot%)
       PRINT #1, ""
       PRINT #1, "   END SUB"
       RETURN

     ' Set or clear pixel box if mouse is on one
   DoPixelControl:
       GOSUB WhichBox
       IF xbox% THEN
           IF xold% <> xbox% OR yold% <> ybox% THEN
               xold% = xbox%
               yold% = ybox%
               MouseHide
               IF leftButton% THEN
                   LINE (xbox% + 3, ybox% + 2)-(xbox% + 9, ybox% + 7), 1, BF
               ELSE
                   LINE (xbox% + 3, ybox% + 2)-(xbox% + 9, ybox% + 7), 0, BF
               END IF
               MouseShow
           END IF
       END IF
       RETURN
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 MOUSSUBS

   The MOUSSUBS toolbox presents a collection of subprograms for accessing
   and using your mouse. Your computer must have CGA graphics capability and
   a mouse for this program to be useful. If you have a mouse but are limited
   to monochrome text modes, see the MOUSTCRS.BAS module.

   The assembly-language subroutine named MOUSE.ASM must be assembled and
   linked with these routines or included in the user library loaded with
   QuickBASIC. See the MOUSE.ASM subprogram description in Part III of this
   book for more information on doing this.

   To use these subprograms in your own programs, load this module (along
   with the MOUSE.ASM routine), and be sure to declare the subprograms used
   by your main program module. For examples of programs that use this module
   as a toolbox, see the OBJECT.BAS, MOUSGCRS.BAS, MOUSTCRS.BAS, and
   WINDOWS.BAS program modules.

   Each subprogram that creates cursors defines a graphics-mode mouse cursor
   by filling in the pattern mask string and hot spot location variables.
   After this subprogram is called, call MouseMaskTranslate to translate the
   variables to a binary format string, which should then be passed to the
   MouseSetGcursor subprogram to quickly set the indicated cursor.

   You might find it helpful to follow the program listing as the interactive
   demonstration progresses.

╓┌─┌─────────────────────────────┌──────┌────────────────────────────────────╖
   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   MOUSSUBS.BAS                        Demo module
   Curschek                     Sub    Check mark mouse cursor
   Cursdflt                     Sub    Arrow mouse cursor pointing up and
                                        left
   Curshand                     Sub    Pointing hand mouse cursor
   Curshour                     Sub    Hourglass mouse cursor
   Cursjet                      Sub    Jet-shaped mouse cursor
   Cursleft                     Sub    Left arrow mouse cursor
   Cursplus                     Sub    Plus sign mouse cursor
   Cursup                       Sub    Up arrow mouse cursor
   Cursx                        Sub    X-mark mouse cursor
   MouseHide                    Sub    Turns off mouse visibility
   MouseInches                  Sub    Sets mouse-to-cursor motion ratio
   MouseInstall                 Sub    Checks mouse availability; resets
                                        mouse parameters
   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
                                       mouse parameters
   MouseLightPen                Sub    Mouse emulation of a lightpen
   MouseMaskTranslate           Sub    Translates pattern/hot spot to binary
   MouseMickey                  Sub    Returns motion increments since last
                                        call
   MouseNow                     Sub    Current state/location of the mouse
   MousePressLeft               Sub    Location of mouse──left button press
   MousePressRight              Sub    Location of mouse──right button press
   MousePut                     Sub    Moves cursor to the given position
   MouseRange                   Sub    Limits mouse cursor motion to
                                        rectangle
   MouseReleaseLeft             Sub    Location of mouse──left button
                                        release
   MouseReleaseRight            Sub    Location of mouse──right button
                                        release
   MouseSetGcursor              Sub    Sets graphics-mode mouse cursor
   MouseShow                    Sub    Activates and displays mouse cursor
   MouseSoftCursor              Sub    Sets text-mode attributes (mouse
                                        cursor)
   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
                                       cursor)
   MouseWarp                    Sub    Sets mouse double-speed threshold
   ──────────────────────────────────────────────────────────────────────────



 Demo Module: MOUSSUBS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MOUSSUBS                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Collection of subprograms for using the Microsoft Mouse.
     '
     ' Note:         The assembly-language subroutine named MOUSE.ASM
     '               must be assembled and linked with these routines
     '               or included in the user library loaded with
     '               QuickBASIC.
     ' USAGE:        No command line parameters
     ' REQUIREMENTS: CGA
     '               MIXED.QLB/.LIB
     '               Mouse
     ' .MAK FILE:   MOUSSUBS.BAS
     '              BITS.BAS
     ' PARAMETERS:  (none)
     ' VARIABLES:   i%            Looping index
     '              mask$         Pattern mask for each graphics mouse cursor
     '              xHot%         X hot spot location
     '              yHot%         Y hot spot location
     '              curs$         Binary bit pattern for defining mouse cursor
     '              j%            Test for left mouse button press and release
     '              leftButton%   State of left mouse button
     '              rightButton%  State of right mouse button
     '              xMouse%       X location of mouse
     '              yMouse%       Y location of mouse
     '              mflag%        Indicates mouse is available
     '              horizontal%   Horizontal mouse mickies
     '              vertical%     Vertical mouse mickies
     '              xpLeft%       X location of last left button press
     '              ypLeft%       Y location of last left button press
     '              xrLeft%       X location of last left button release
     '              yrLeft%       Y location of last left button release
     '              xpRight%      X location of last right button press
     '              ypRight%      Y location of last right button press
     '              xrRight%      X location of last right button release
     '              yrRight%      Y location of last right button release
     '              t0            Timer value
     '
     ' Functions
       DECLARE FUNCTION BinStr2Bin% (b$)

     ' Subprograms
       DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
       DECLARE SUB MouseRange (x1%, y1%, x2%, y2%)
       DECLARE SUB MousePut (xMouse%, yMouse%)
       DECLARE SUB MouseHide ()
       DECLARE SUB MouseInches (horizontal%, vertical%)
       DECLARE SUB MouseInstall (mflag%)
       DECLARE SUB MouseMickey (horizontal%, vertical%)
       DECLARE SUB MousePressLeft (leftCount%, xMouse%, yMouse%)
       DECLARE SUB MousePressRight (rightCount%, xMouse%, yMouse%)
       DECLARE SUB MouseReleaseLeft (leftCount%, xMouse%, yMouse%)
       DECLARE SUB MouseReleaseRight (rightCount%, xMouse%, yMouse%)
       DECLARE SUB MouseWarp (threshold%)
       DECLARE SUB Cursdflt (mask$, xHot%, yHot%)
       DECLARE SUB Curschek (mask$, xHot%, yHot%)
       DECLARE SUB Curshand (mask$, xHot%, yHot%)
       DECLARE SUB Curshour (mask$, xHot%, yHot%)
       DECLARE SUB Cursjet (mask$, xHot%, yHot%)
       DECLARE SUB Cursleft (mask$, xHot%, yHot%)
       DECLARE SUB Cursplus (mask$, xHot%, yHot%)
       DECLARE SUB Cursup (mask$, xHot%, yHot%)
       DECLARE SUB Cursx (mask$, xHot%, yHot%)
       DECLARE SUB MouseMaskTranslate (mask$, xHot%, yHot%, cursor$)
       DECLARE SUB MouseNow (leftButton%, rightButton%, xMouse%, yMouse%)
       DECLARE SUB MouseSetGcursor (cursor$)
       DECLARE SUB MouseShow ()

     ' Check for mouse
       SCREEN 2
       CLS
       MouseInstall mflag%
       PRINT "MouseInstall ... "; mflag%

     ' Demonstrate the available graphics-mode cursors
       PRINT
       PRINT "Click left mouse button to see the graphics-mode cursors..."
       MouseShow

       FOR i% = 1 TO 9
           SELECT CASE i%
           CASE 1
               Curschek mask$, xHot%, yHot%
           CASE 2
               Curshand mask$, xHot%, yHot%
           CASE 3
               Curshour mask$, xHot%, yHot%
           CASE 4
               Cursjet mask$, xHot%, yHot%
           CASE 5
               Cursleft mask$, xHot%, yHot%
           CASE 6
               Cursplus mask$, xHot%, yHot%
           CASE 7
               Cursup mask$, xHot%, yHot%
           CASE 8
               Cursx mask$, xHot%, yHot%
           CASE ELSE
               Cursdflt mask$, xHot%, yHot%
           END SELECT
           MouseMaskTranslate mask$, xHot%, yHot%, curs$
           FOR j% = -1 TO 0
               DO
                   MouseNow leftButton%, rightButton%, xMouse%, yMouse%
               LOOP UNTIL leftButton% = j%
           NEXT j%
           MouseSetGcursor curs$
       NEXT i%

     ' Mouse hide and show
       PRINT "MouseHide ... (Press any key to continue)"
       MouseHide
       DO
       LOOP UNTIL INKEY$ <> ""
       PRINT "MouseShow ... (Press any key to continue)"
       MouseShow
       DO
       LOOP UNTIL INKEY$ <> ""

     ' Mouse inches per screen
       MouseHide
       PRINT
       PRINT "Setting MouseWarp to 9999 to prevent doubling of speed."
       MouseWarp 9999
       PRINT
       PRINT "Setting MouseInches to 8 by 11. (8 inches of mouse motion"
       PRINT "across desk to move across screen, and 11 inches vertical"
       PRINT "mouse motion from top to bottom of screen) ..."
       PRINT
       PRINT "Press any key to continue"
       MouseInches 8, 11
       MouseShow
       DO
       LOOP UNTIL INKEY$ <> ""

     ' Resetting the mouse
       MouseHide
       PRINT
       PRINT "Resetting the mouse"
       MouseInstall mflag%

     ' Show realtime mouse data
       CLS
       PRINT "Instantaneous mouse information (Press any key to continue)"
       MouseShow
       DO
           MouseMickey horizontal%, vertical%
           MouseNow leftButton%, rightButton%, xMouse%, yMouse%
           MousePressLeft leftCount%, xpLeft%, ypLeft%
           MouseReleaseLeft leftCount%, xrLeft%, yrLeft%
           MousePressRight rightCount%, xpRight%, ypRight%
           MouseReleaseRight rightCount%, xrRight%, yrRight%
           LOCATE 3, 1
           PRINT "Mickies       ";
           PRINT USING "#######, #######"; horizontal%, vertical%
           PRINT "Position      ";
           PRINT USING "#######, #######"; xMouse%, yMouse%
           PRINT
           PRINT "Buttons       ";
           PRINT USING "#######, #######"; leftButton%, rightButton%
           PRINT
           PRINT "Left Press    ";
           PRINT USING "#######, #######"; xpLeft%, ypLeft%
           PRINT "Left Release  ";
           PRINT USING "#######, #######"; xrLeft%, yrLeft%
           PRINT
           PRINT "Right Press   ";
           PRINT USING "#######, #######"; xpRight%, ypRight%
           PRINT "Right Release ";
           PRINT USING "#######, #######"; xrRight%, yrRight%
       LOOP UNTIL INKEY$ <> ""

     ' Mouse placement
       CLS
       MouseHide
       PRINT "MousePut..."
       MouseShow
       FOR i% = 1 TO 20
           xMouse% = RND * 639
           yMouse% = RND * 199
           MousePut xMouse%, yMouse%
           t0 = TIMER
           DO
           LOOP UNTIL TIMER - t0 > .2
       NEXT i%

     ' Range limiting
       CLS
       MouseHide
       PRINT "Range limited to a rectangular area ..."
       PRINT "Press any key to continue"
       MouseShow
       MouseRange 200, 50, 400, 100
       DO
       LOOP UNTIL INKEY$ <> ""

     ' All done
       SCREEN 0
       CLS
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Curschek

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining a check mark cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Curschek                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (check mark).
     '
     ' EXAMPLE OF USE:  Curschek mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Curschek (mask$, xHot%, yHot%)
     '
       SUB Curschek (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "1111111111110000"
           mask$ = mask$ + "1111111111100000"
           mask$ = mask$ + "1111111111000000"
           mask$ = mask$ + "1111111110000001"
           mask$ = mask$ + "1111111100000011"
           mask$ = mask$ + "0000011000000111"
           mask$ = mask$ + "0000000000001111"
           mask$ = mask$ + "0000000000011111"
           mask$ = mask$ + "1100000000111111"
           mask$ = mask$ + "1111000001111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000110"
           mask$ = mask$ + "0000000000001100"
           mask$ = mask$ + "0000000000011000"
           mask$ = mask$ + "0000000000110000"
           mask$ = mask$ + "0000000001100000"
           mask$ = mask$ + "0111000011000000"
           mask$ = mask$ + "0001110110000000"
           mask$ = mask$ + "0000011100000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"

           xHot% = 6
           yHot% = 7

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Cursdflt

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining the default cursor (an arrow pointing up and left).

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Cursdflt                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a default graphics-mode mouse cursor (arrow pointing up and lef
     '
     ' EXAMPLE OF USE:  Cursdflt mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATION:   DECLARE SUB Cursdflt (mask$, xHot%, yHot%)
     '
       SUB Cursdflt (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1001111111111111"
           mask$ = mask$ + "1000111111111111"
           mask$ = mask$ + "1000011111111111"
           mask$ = mask$ + "1000001111111111"
           mask$ = mask$ + "1000000111111111"
           mask$ = mask$ + "1000000011111111"
           mask$ = mask$ + "1000000001111111"
           mask$ = mask$ + "1000000000111111"
           mask$ = mask$ + "1000000000011111"
           mask$ = mask$ + "1000000000001111"
           mask$ = mask$ + "1000000000000111"
           mask$ = mask$ + "1000100001111111"
           mask$ = mask$ + "1001100001111111"
           mask$ = mask$ + "1111110000111111"
           mask$ = mask$ + "1111110000111111"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0010000000000000"
           mask$ = mask$ + "0011000000000000"
           mask$ = mask$ + "0011100000000000"
           mask$ = mask$ + "0011110000000000"
           mask$ = mask$ + "0011111000000000"
           mask$ = mask$ + "0011111100000000"
           mask$ = mask$ + "0011111110000000"
           mask$ = mask$ + "0011111111000000"
           mask$ = mask$ + "0011111111100000"
           mask$ = mask$ + "0011111000000000"
           mask$ = mask$ + "0010001100000000"
   ──────────────────────────────────────────────────────────────────────────

           mask$ = mask$ + "0000001100000000"

           mask$ = mask$ + "0000000110000000"

           mask$ = mask$ + "0000000110000000"



           xHot% = 1

           yHot% = 1



       END SUB


 Subprogram: Curshand

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining a pointing hand cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Curshand                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (pointing hand).
     '
     ' EXAMPLE OF USE:  Curshand mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Curshand (mask$, xHot%, yHot%)
     '
       SUB Curshand (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "1110000111111111"
           mask$ = mask$ + "1110000111111111"
           mask$ = mask$ + "1110000111111111"
           mask$ = mask$ + "1110000111111111"
           mask$ = mask$ + "1110000111111111"
           mask$ = mask$ + "1110000000000000"
           mask$ = mask$ + "1110000000000000"
           mask$ = mask$ + "1110000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"

           mask$ = mask$ + "0001111000000000"
           mask$ = mask$ + "0001001000000000"
           mask$ = mask$ + "0001001000000000"
           mask$ = mask$ + "0001001000000000"
           mask$ = mask$ + "0001001000000000"
           mask$ = mask$ + "0001001111111111"
           mask$ = mask$ + "0001001001001001"
           mask$ = mask$ + "0001001001001001"
           mask$ = mask$ + "1111001001001001"
           mask$ = mask$ + "1001000000000001"
           mask$ = mask$ + "1001000000000001"
           mask$ = mask$ + "1001000000000001"
           mask$ = mask$ + "1000000000000001"
           mask$ = mask$ + "1000000000000001"
           mask$ = mask$ + "1000000000000001"
           mask$ = mask$ + "1111111111111111"

           xHot% = 5
           yHot% = 0

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Curshour

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining an hourglass cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Curshour                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (hourglass).
     '
     ' EXAMPLE OF USE:  Curshour mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:    DECLARE SUB Curshour (mask$, xHot%, yHot%)
     '
       SUB Curshour (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "1000000000000001"
           mask$ = mask$ + "1100000000000011"
           mask$ = mask$ + "1110000000000111"
           mask$ = mask$ + "1111000000001111"
           mask$ = mask$ + "1110000000000111"
           mask$ = mask$ + "1100000000000011"
           mask$ = mask$ + "1000000000000001"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0111111111111110"
           mask$ = mask$ + "0110000000000110"
           mask$ = mask$ + "0011000000001100"
           mask$ = mask$ + "0001100000011000"
           mask$ = mask$ + "0000110000110000"
           mask$ = mask$ + "0000011001100000"
           mask$ = mask$ + "0000001111000000"
           mask$ = mask$ + "0000011001100000"
           mask$ = mask$ + "0000110000110000"
           mask$ = mask$ + "0001100110011000"
           mask$ = mask$ + "0011001111001100"
           mask$ = mask$ + "0110011111100110"
           mask$ = mask$ + "0111111111111110"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"

           xHot% = 7
           yHot% = 7

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Cursjet

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining a jet aircraft cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Cursjet                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (jet aircraft).
     '
     ' EXAMPLE OF USE:  Cursjet mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Cursjet (mask$, xHot%, yHot%)
     '
       SUB Cursjet (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111011111111"
           mask$ = mask$ + "1111110001111111"
           mask$ = mask$ + "1111100000111111"
           mask$ = mask$ + "1111100000111111"
           mask$ = mask$ + "1111100000111111"
           mask$ = mask$ + "1111000000011111"
           mask$ = mask$ + "1110000000001111"
           mask$ = mask$ + "1100000000000111"
           mask$ = mask$ + "1000000000000011"
           mask$ = mask$ + "1000000000000011"
           mask$ = mask$ + "1111100000111111"
           mask$ = mask$ + "1111100000111111"
           mask$ = mask$ + "1111000000011111"
           mask$ = mask$ + "1110000000001111"
           mask$ = mask$ + "1111111111111111"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000100000000"
           mask$ = mask$ + "0000001110000000"
           mask$ = mask$ + "0000001110000000"
           mask$ = mask$ + "0000001110000000"
           mask$ = mask$ + "0000011111000000"
           mask$ = mask$ + "0000111111100000"
           mask$ = mask$ + "0001111111110000"
           mask$ = mask$ + "0011111111111000"
           mask$ = mask$ + "0110001110001100"
           mask$ = mask$ + "0000001110000000"
           mask$ = mask$ + "0000001110000000"
           mask$ = mask$ + "0000011111000000"
           mask$ = mask$ + "0000110001100000"
           mask$ = mask$ + "0000000000000000"

           xHot% = 7
           yHot% = 1

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Cursleft

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining a left arrow cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Cursleft                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (left arrow).
     '
     ' EXAMPLE OF USE:  Cursleft mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:    DECLARE SUB Cursleft (mask$, xHot%, yHot%)
     '
       SUB Cursleft (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "1111111000011111"
           mask$ = mask$ + "1111000000011111"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "1111000000011111"
           mask$ = mask$ + "1111111000011111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000011000000"
           mask$ = mask$ + "0000011111000000"
           mask$ = mask$ + "0111111111111110"
           mask$ = mask$ + "0000011111000000"
           mask$ = mask$ + "0000000011000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"

           xHot% = 0
           yHot% = 3

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Cursplus

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining a plus sign cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Cursplus                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (plus sign).
     '
     ' EXAMPLE OF USE:  Cursplus mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Cursplus (mask$, xHot%, yHot%)
     '
       SUB Cursplus (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "1111110000111111"
           mask$ = mask$ + "1111110000111111"
           mask$ = mask$ + "1111110000111111"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "1111110000111111"
           mask$ = mask$ + "1111110000111111"
           mask$ = mask$ + "1111110000111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0111111111111110"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"

           xHot% = 7
           yHot% = 4

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Cursup

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining an up arrow cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Cursup                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (up arrow).
     '
     ' EXAMPLE OF USE:  Cursup mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Cursup (mask$, xHot%, yHot%)
     '
       SUB Cursup (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "1111100111111111"
           mask$ = mask$ + "1111000011111111"
           mask$ = mask$ + "1110000001111111"
           mask$ = mask$ + "1110000001111111"
           mask$ = mask$ + "1100000000111111"
           mask$ = mask$ + "1100000000111111"
           mask$ = mask$ + "1000000000011111"
           mask$ = mask$ + "1000000000011111"
           mask$ = mask$ + "0000000000001111"
           mask$ = mask$ + "0000000000001111"
           mask$ = mask$ + "1111000011111111"
           mask$ = mask$ + "1111000011111111"
           mask$ = mask$ + "1111000011111111"
           mask$ = mask$ + "1111000011111111"
           mask$ = mask$ + "1111000011111111"
           mask$ = mask$ + "1111000011111111"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000011000000000"
           mask$ = mask$ + "0000111100000000"
           mask$ = mask$ + "0000111100000000"
           mask$ = mask$ + "0001111110000000"
           mask$ = mask$ + "0001111110000000"
           mask$ = mask$ + "0011111111000000"
           mask$ = mask$ + "0011111111000000"
           mask$ = mask$ + "0111111111100000"
           mask$ = mask$ + "0000011000000000"
           mask$ = mask$ + "0000011000000000"
           mask$ = mask$ + "0000011000000000"
           mask$ = mask$ + "0000011000000000"
           mask$ = mask$ + "0000011000000000"
           mask$ = mask$ + "0000011000000000"
           mask$ = mask$ + "0000000000000000"

           xHot% = 5
           yHot% = 0

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Cursx

   Creates a graphics mouse cursor; fills in the pattern mask and hot spot
   values for defining an X-mark cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Cursx                      **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Defines a graphics-mode mouse cursor (X mark).
     '
     ' EXAMPLE OF USE:  Cursx mask$, xHot%, yHot%
     ' PARAMETERS:      mask$      Pattern mask for creating cursor
     '                  xHot%      X location for cursor hot spot
     '                  yHot%      Y location for cursor hot spot
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Cursx (mask$, xHot%, yHot%)
     '
       SUB Cursx (mask$, xHot%, yHot%) STATIC

           mask$ = ""
           mask$ = mask$ + "0000011111100000"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "1100000000000011"
           mask$ = mask$ + "1111000000001111"
           mask$ = mask$ + "1100000000000011"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000110000000"
           mask$ = mask$ + "0000001111000000"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"
           mask$ = mask$ + "1111111111111111"

           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0111000000001110"
           mask$ = mask$ + "0001110000111000"
           mask$ = mask$ + "0000011001100000"
           mask$ = mask$ + "0000001111000000"
           mask$ = mask$ + "0000011001100000"
           mask$ = mask$ + "0001110000111000"
           mask$ = mask$ + "0111000000001110"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"
           mask$ = mask$ + "0000000000000000"

           xHot% = 7
           yHot% = 4

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseHide

   Deactivates the mouse cursor, making it invisible and inaccessible. Use
   the MouseShow subprogram to reactivate the cursor.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseHide                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Hides the mouse cursor.
     '
     ' EXAMPLE OF USE:  MouseHide
     '
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseHide ()
     '
       SUB MouseHide STATIC
           Mouse 2, 0, 0, 0
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseInches

   Sets the ratio of mouse motion to cursor motion. The horizontal% and
   vertical% parameters indicate the number of inches of desktop motion that
   your mouse must move to move the mouse cursor from one edge of the screen
   to the other. Note that the vertical and horizontal values are independent
   of each other.

   Before calling this subprogram, set the double-speed threshold to a large
   value by calling the MouseWarp subprogram. This prevents fast mouse
   motion from doubling the cursor velocity, keeping the motion ratios
   constant.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseInches                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets mouse motion ratio in inches per screen.
     '
     ' EXAMPLE OF USE:  MouseInches horizontal%, vertical%
     ' PARAMETERS:      horizontal%   Inches of horizontal mouse motion per
     '                                screen width
     '                  vertical%     Inches of vertical% mouse motion per
     '                                screen height
     ' VARIABLES:       h%            Calculated value to pass to mouse driver
     '                  v%            Calculated value to pass to mouse driver
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseInches (horizontal%, vertical%)
     '
       SUB MouseInches (horizontal%, vertical%) STATIC
           IF horizontal% > 100 THEN
               horizontal% = 100
           END IF
           IF vertical% > 100 THEN
               vertical% = 100
           END IF
           h% = horizontal% * 5 \ 2
           v% = vertical% * 8
           Mouse 15, 0, h%, v%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseInstall

   Checks the memory-resident mouse driver to determine whether a mouse is
   available. The value of mflag% is returned as 0 if no mouse is available
   and as -1 if one is.

   This subprogram also initializes the mouse driver to the default state.
   The original cursor is set, and the mouse velocity, threshold, and other
   parameters are all set to their original states.

   Normally, this subprogram is called immediately when a program is run.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseInstall               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Determines whether mouse is available and resets all mouse parameters.
     '
     ' EXAMPLE OF USE:  MouseInstall mflag%
     ' PARAMETERS:      mflag%     Returned indication of mouse availability
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseInstall (mflag%)
     '
       SUB MouseInstall (mflag%) STATIC
           mflag% = 0
           Mouse mflag%, 0, 0, 0
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseLightPen

   Activates or deactivates lightpen emulation by the mouse.

   The QuickBASIC PEN function provides ten unique functions for accessing
   information on the lightpen, depending on the parameter you pass to it.
   This complete set of lightpen functions can be emulated using the mouse
   rather than the lightpen. To activate lightpen emulation, call
   MouseLightPen with a non-zero parameter. To deactivate lightpen emulation,
   use a zero parameter.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseLightPen              **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************

     ' Activates and deactivates lightpen emulation mode.
     '
     ' EXAMPLE OF USE:  MouseLightPen switch%
     ' PARAMETERS:      switch%    non-zero to activate lightpen emulation,
     '                             zero to deactivate
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseLightPen (switch%)
     '
       SUB MouseLightPen (switch%) STATIC
           IF switch% THEN
               Mouse 13, 0, 0, 0
           ELSE
               Mouse 14, 0, 0, 0
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseMaskTranslate

   Translates the pattern mask and hot spot values for a given graphics-mode
   mouse cursor to a binary format string suitable for passing to the
   memory-resident mouse driver for setting the cursor.

   This translation process is relatively time-consuming and should normally
   only be performed once, when a program first starts up. To save multiple
   cursors for quick switching between cursor types, save only the cursor$
   result from this subprogram. The call to MouseSetCursor, using this binary
   format cursor$, is very fast.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseMaskTranslate         **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Translates mouse graphics cursor Mask$ to Cursor$.
     '
     ' EXAMPLE OF USE:  MouseMaskTranslate mask$, xHot%, yHot%, cursor$
     ' PARAMETERS:      mask$      Pattern mask that defines a mouse
     '                             graphics-mode cursor
     '                  xHot%      X location of the hot spot
     '                  yHot%      Y location of the hot spot
     '                  cursor$    The returned binary buffer string
     '                             for the cursor
     ' VARIABLES:       i%         Looping index
     '                  b%         Integer formed from string bit representati
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB MouseMaskTranslate (mask$, xHot%, yHot%,
     '                              cursor$)
     '
       SUB MouseMaskTranslate (mask$, xHot%, yHot%, cursor$) STATIC
           cursor$ = CHR$(xHot%) + CHR$(yHot%) + STRING$(64, 0)
           IF LEN(mask$) = 512 THEN
               FOR i% = 1 TO 32
                   b% = BinStr2Bin%(MID$(mask$, i% * 16 - 15, 16))
                   MID$(cursor$, i% + i% + 1, 2) = MKI$(b%)
               NEXT i%
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseMickey

   Returns the mouse "mickies," or relative motion counts, since the last
   call to this routine. If the mouse has not been moved since the last call,
   zeros are returned.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseMickey                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reads mouse mickey counts.
     '
     ' EXAMPLE OF USE:  MouseMickey horizontal%, vertical%
     ' PARAMETERS:      horizontal%   Horizontal motion mickey counts
     '                  vertical%     Vertical motion mickey counts
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseMickey (horizontal, vertical%)
     '
       SUB MouseMickey (horizontal%, vertical%) STATIC
           Mouse 11, 0, horizontal%, vertical%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseNow

   Returns the state of the mouse buttons and the mouse location. This
   subprogram is one of the most useful routines presented. Four parameters
   are passed back: the states of the two mouse buttons and the horizontal
   and vertical location of the mouse.

   The horizontal position is scaled according to the current video mode. In
   most cases, the X position at the right edge of the screen is 639, no
   matter what the screen pixel range is. Check the returned values for the
   mode you want to use.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseNow                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the state of the mouse.
     '
     ' EXAMPLE OF USE:  MouseNow leftButton%, rightButton%, xMouse%, yMouse%
     ' PARAMETERS:      leftButton%   Indicates left mouse button state
     '                  rightButton%  Indicates right mouse button state
     '                  xMouse%       X location of mouse
     '                  yMouse%       Y location of mouse
     ' VARIABLES:       m2%           Mouse driver parameter containing button
     '                                press information
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseNow (leftButton%, rightButton%,
     '                                        xMouse%, yMouse%)
     '
       SUB MouseNow (leftButton%, rightButton%, xMouse%, yMouse%) STATIC
           Mouse 3, m2%, xMouse%, yMouse%
           leftButton% = ((m2% AND 1) <> 0)
           rightButton% = ((m2% AND 2) <> 0)
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MousePressLeft

   Returns the position of the mouse at the time the left button was last
   pressed. Also returned is the number of left button presses since the last
   call to this subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MousePressLeft             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the mouse state at last press of left button.
     '
     ' EXAMPLE OF USE:  MousePressLeft leftCount%, xMouse%, yMouse%
     ' PARAMETERS:      leftCount%    Number of times the left button has been
     '                                pressed since the last call to this
     '                                subprogram
     '                  xMouse%       X location of the mouse at the last pres
     '                                of the left button
     '                  yMouse%       Y location of the mouse at the last pres
     '                                of the left button
     ' VARIABLES:       m1%           Parameter for call to mouse driver
     ' MODULE LEVEL
     '   DECLARATIONS:    DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                    DECLARE SUB MousePressLeft (leftCount%, xMouse%, yMo
     '
       SUB MousePressLeft (leftCount%, xMouse%, yMouse%) STATIC
           m1% = 5
           leftCount% = 0
           Mouse m1%, leftCount%, xMouse%, yMouse%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MousePressRight

   Returns the position of the mouse at the time the right button was last
   pressed. Also returned is the number of right button presses since the
   last call to this subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MousePressRight            **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the mouse state at last press of right button.
     '
       SUB MousePressRight (rightCount%, xMouse%, yMouse%) STATIC
           m1% = 5
           rightCount% = 1
           Mouse m1%, rightCount%, xMouse%, yMouse%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MousePut

   Allows you to move the mouse to any desired location.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MousePut                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets the mouse position.
     '
     ' EXAMPLE OF USE:  MousePut xMouse%, yMouse%
     ' PARAMETERS:      xMouse%    Horizontal location to place cursor
     '                  yMouse%    Vertical location to place cursor
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:   DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                   DECLARE SUB MousePut (xMouse%, yMouse%)
     '
       SUB MousePut (xMouse%, yMouse%) STATIC
           Mouse 4, 0, xMouse%, yMouse%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseRange

   Sets a rectangular area of the screen to which the mouse cursor will be
   limited. The mouse cursor will stay in the bounds defined, no matter which
   way the mouse is moved.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseRange                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets mouse range of motion.
     '
     ' EXAMPLE OF USE:  MouseRange x1%, y1%, x2%, y2%
     ' PARAMETERS:      x1%        Upper left corner X coordinate
     '                  y1%        Upper left corner Y coordinate
     '                  x2%        Lower right corner X coordinate
     '                  y2%        Lower right corner Y coordinate
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:   DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                   DECLARE SUB MouseRange (x1%, y1%, x2%, y2%)
     '
        SUB MouseRange (x1%, y1%, x2%, y2%) STATIC
           Mouse 7, 0, x1%, x2%
           Mouse 8, 0, y1%, y2%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseReleaseLeft

   Returns the position of the mouse at the time the left button was last
   released. Also returned is the number of left button releases since the
   last call to this subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseReleaseLeft           **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the mouse state at last release of left button.
     '
     ' EXAMPLE OF USE:  MouseReleaseLeft leftCount%, xMouse%, yMouse%
     ' PARAMETERS:      leftCount%    Number of times the left button has been
     '                                released since the last call to this
     '                                subprogram
     '                  xMouse%       X location of the mouse at the last
     '                                release of the left button
     '                  yMouse%       Y location of the mouse at the last
     '                                release of the left button
     ' VARIABLES:       m1%           Parameter for call to mouse driver
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseReleaseLeft (leftCount%, xMouse%,
     '                                               yMouse%)
     '
       SUB MouseReleaseLeft (leftCount%, xMouse%, yMouse%) STATIC
           m1% = 6
           leftCount% = 0
           Mouse m1%, leftCount%, xMouse%, yMouse%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseReleaseRight

   Returns the position of the mouse at the time the right button was last
   released. Also returned is the number of right button releases since the
   last call to this subprogram.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseReleaseRight          **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the mouse state at last release of right button.
     '
     ' EXAMPLE OF USE:  MouseReleaseRight rightCount%, xMouse%, yMouse%
     ' PARAMETERS:      rightCount%   Number of times the right button has bee
     '                                released since the last call to this
     '                                subprogram
     '                  xMouse%       X location of the mouse at the last
     '                                release of the right button
     '                  yMouse%       Y location of the mouse at the last
     '                                release of the right button
     ' VARIABLES:       m1%           Parameter for call to mouse driver
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseReleaseRight (rightCount%, xMouse%,
     '                                                 yMouse%)
     '
       SUB MouseReleaseRight (rightCount%, xMouse%, yMouse%) STATIC
           m1% = 6
           rightCount% = 1
           Mouse m1%, rightCount%, xMouse%, yMouse%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseSetGcursor

   Sets the mouse cursor using the binary-format cursor string created by an
   earlier call to the subprogram MouseMaskTranslate.

   To quickly switch among a selection of mouse cursors, keep the
   binary-format cursor strings available, and call this subprogram to change
   cursors.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseSetGcursor            **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets mouse graphics cursor using cursor$.
     '
     ' EXAMPLE OF USE:  MouseSetGcursor cursor$
     ' PARAMETERS:      cursor$    Binary format cursor string
     ' VARIABLES:       xHot%      X hot spot location
     '                  yHot%      Y hot spot location
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseSetGcursor (cursor$)
     '
       SUB MouseSetGcursor (cursor$) STATIC
           xHot% = ASC(LEFT$(cursor$, 1))
           yHot% = ASC(MID$(cursor$, 2, 1))
           Mouse 9, xHot%, yHot%, SADD(cursor$) + 2
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseShow

   Activates the mouse cursor, making it visible and movable by the mouse. To
   turn the cursor off, use the MouseHide subprogram.

   When you are updating the screen, such as when printing text in a graphics
   mode, it's a good idea to hide the mouse just before printing and then
   show it after the printing is done. This helps prevent glitches or blank
   spots from appearing due to overlapping and unsynchronized pixel mapping
   between your program and the mouse driver.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseShow                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Shows the mouse cursor.
     '
     ' EXAMPLE OF USE:  MouseShow
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseShow ()
     '
       SUB MouseShow STATIC
           Mouse 1, 0, 0, 0
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseSoftCursor

   Sets the software mouse cursor for text mode. This cursor changes the
   attributes of screen characters (foreground/background color, intensity,
   or underscoring) when the display adapter is in text mode. The easiest way
   to get a feel for how these masks work is by running the MOUSTCRS.BAS
   program.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseSoftCursor            **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets text-mode software cursor.
     '
     ' EXAMPLE OF USE:  MouseSoftCursor screenMask%, cursorMask%
     ' PARAMETERS:      screenMask%   Integer bit pattern for the screen mask
     '                  cursorMask%   Integer bit pattern for the cursor mask
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB MouseSoftCursor (screenMaks%, cursorMask%)
     '                  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '
       SUB MouseSoftCursor (screenMask%, cursorMask%) STATIC
           Mouse 10, 0, screenMask%, cursorMask%
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MouseWarp

   Sets the double-speed threshold for the mouse in units of mickies per
   second. The default setting is 64 mickies per second.

   Whenever the mouse is moved at a rate greater than the threshold value,
   the cursor motion is doubled. This helps zip the cursor across the screen
   during quick moves but allows slower, more accurate motion at slower
   speeds.

   To use the MouseInches subprogram to approximate the action of an
   absolute-motion pointing device, set the threshold to a large, unreachable
   value. For example, MouseWarp 9999 effectively turns off the threshold
   checking.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MouseWarp                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        MOUSSUBS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************

     ' Sets double-speed threshold.
     '
     ' EXAMPLE OF USE:  MouseWarp threshold%
     ' PARAMETERS:      threshold%    Mickies per second rate of threshold
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
     '                  DECLARE SUB MouseWarp (threshold%)
     '
       SUB MouseWarp (threshold%) STATIC
           Mouse 19, 0, 0, threshold%
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 MOUSTCRS

   The MOUSTCRS program lets you experiment with the screen and cursor masks
   that define the action of the software mouse cursor in text modes.

   Run the program and move the mouse cursor to any of the mask bits
   displayed near the bottom of the screen. Click with the left mouse button
   on any bit to toggle that bit, and move the cursor around the screen to
   see how the cursor's appearance is affected.

   To set any screen and cursor mask combination in your own programs, record
   the hexadecimal numbers for the two masks, and pass these two numbers to
   the MouseSoftCursor subprogram in the MOUSSUBS.BAS toolbox.


 Program Module: MOUSTCRS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          MOUSTCRS                   **
     ' **  Type:          Program                    **
     ' **  Module:        MOUSTCRS.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    MIXED.QLB/.LIB
     '                  Mouse
     ' .MAK FILE:       MOUSTCRS.BAS
     '                  MOUSSUBS.BAS
     '                  BITS.BAS
     '                  ATTRIB.BAS
     ' PARAMETERS:      (none)
     ' VARIABLES:       screenMask%   Integer bit mask for screen mask
     '                  cursorMask%   Integer bit mask for cursor mask
     '                  leftCount%    Count of left mouse button presses
     '                  xm%           Mouse X position at last left button pre
     '                  ym%           Mouse Y position at last left button pre
     '                  row%          Code for which screen bit row was select
     '                  bit%          Bit pattern determined by screen column
     '                                click on
     '                  screenMask$   String of 0s and 1s for bit pattern disp
     '                  cursorMask$   String of 0s and 1s for bit pattern disp
     '                  i%            Looping index
     '                  Shex$         Hexadecimal representation of the screen
     '                  Chex$         Hexadecimal representation of the cursor

     ' Define constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Functions
       DECLARE FUNCTION Bin2BinStr$ (b%)

     ' Subprograms
       DECLARE SUB Attrib ()
       DECLARE SUB MouseHide ()
       DECLARE SUB MouseInstall (mouseFlag%)
       DECLARE SUB MousePressLeft (leftCount%, xMouse%, yMouse%)
       DECLARE SUB MouseShow ()
       DECLARE SUB MouseSoftCursor (screenMask%, cursorMask%)

     ' Is the mouse out there?
       MouseInstall mouseFlag%
       IF mouseFlag% = 0 THEN
           PRINT "Mouse does not appear to be installed.  Check"
           PRINT "your mouse documentation for proper installation."
           PRINT
           SYSTEM
       END IF

     ' Put all attributes on the screen
       Attrib

     ' Set masks to initial state
       screenMask% = &H77FF
       cursorMask% = &H7700

     ' Create the outlined boxes
       COLOR 14, 0
       PRINT "                  +---+-------+---+--------+----------+--------+
       PRINT "                  | b | bckgd | i | foregd |   char   |   =    |
       PRINT "    +-------------+---+-------+---+--------+----------+--------+
       PRINT "    | screen mask | 0 |  111  | 0 |  111   | 11111111 | &H77FF |
       PRINT "    | cursor mask | 0 |  111  | 0 |  111   | 00000000 | &H7700 |
       PRINT "    +-------------+---+-------+---+--------+----------+--------+

     ' Print the instructions
       COLOR 11, 0
       PRINT "Click the mouse on any of the mask bits shown.  Then, try the"
       PRINT "new cursor by moving across the attribute fields above.";

     ' Special indication for quitting
       COLOR 15, 0
       LOCATE 17, 1, 0
       PRINT "Click here";
       LOCATE 18, 1, 0
       PRINT "to Quit - ";
       COLOR 10, 0
       PRINT "X";

     ' Put mask bits into boxes on screen
       GOSUB PrintScreenMask
       GOSUB PrintCursorMask

     ' Activate the mouse
       MouseShow

     ' Do the main processing loop until the quit flag is set
       DO
           GOSUB MainLoop
       LOOP UNTIL quitFlag%

     ' All done
       MouseHide
       CLS
       SYSTEM

     ' Main processing loop
   MainLoop:

     ' Where was mouse when left button was last pressed?
       MousePressLeft leftCount%, xm%, ym%

     ' Was it on one of the two important rows of the screen?
       SELECT CASE ym%
       CASE 152
           row% = 1
       CASE 160
           row% = 2
       CASE ELSE
           row% = 0
       END SELECT

     ' Was it on an important column?
       SELECT CASE xm%
       CASE 80
           IF ym% = 136 THEN
               quitFlag% = TRUE
           END IF
       CASE 160
           bit% = &H8000
       CASE 200
           bit% = &H4000
       CASE 208
           bit% = &H2000
       CASE 216
           bit% = &H1000
       CASE 256
           bit% = &H800
       CASE 296
           bit% = &H400
       CASE 304
           bit% = &H200
       CASE 312
           bit% = &H100
       CASE 360
           bit% = &H80
       CASE 368
           bit% = &H40
       CASE 376
           bit% = &H20
       CASE 384
           bit% = &H10
       CASE 392
           bit% = &H8
       CASE 400
           bit% = &H4
       CASE 408
           bit% = &H2
       CASE 416
           bit% = &H1
       CASE ELSE
           bit% = 0
       END SELECT

     ' Modify the masks and update the cursor
       IF leftCount% THEN
           SELECT CASE row%
           CASE 1
               screenMask% = screenMask% XOR bit%
           CASE 2
               cursorMask% = cursorMask% XOR bit%
           CASE ELSE
           END SELECT
           MouseSoftCursor screenMask%, cursorMask%
           GOSUB PrintScreenMask
           GOSUB PrintCursorMask
       END IF

     ' End of main processing loop
       RETURN

     ' Put screen mask bits on the screen
   PrintScreenMask:
       COLOR 12, 0
       screenMask$ = ""
       screenMask$ = Bin2BinStr$(screenMask%)
       MouseHide
       FOR i% = 0 TO 15
           SELECT CASE i%
           CASE 0 TO 7
               LOCATE 20, 53 - i%, 0
               PRINT MID$(screenMask$, 16 - i%, 1);
           CASE 8 TO 10
               LOCATE 20, 48 - i%, 0
               PRINT MID$(screenMask$, 16 - i%, 1);
           CASE 11
               LOCATE 20, 44 - i%, 0
               PRINT MID$(screenMask$, 16 - i%, 1);
           CASE 12 TO 14
               LOCATE 20, 40 - i%, 0
               PRINT MID$(screenMask$, 16 - i%, 1);
           CASE 15
               LOCATE 20, 36 - i%, 0
               PRINT MID$(screenMask$, 16 - i%, 1);
           CASE ELSE
           END SELECT
       NEXT i%
       shex$ = "&H" + RIGHT$("000" + HEX$(screenMask%), 4)
       LOCATE 20, 57, 0
       COLOR 10, 0
       PRINT shex$;
       MouseShow
       RETURN

     ' Put cursor mask bits on the screen
   PrintCursorMask:
       COLOR 12, 0
       cursorMask$ = ""
       cursorMask$ = Bin2BinStr$(cursorMask%)
       MouseHide
       FOR i% = 0 TO 15
           SELECT CASE i%
           CASE 0 TO 7
               LOCATE 21, 53 - i%, 0
               PRINT MID$(cursorMask$, 16 - i%, 1);
           CASE 8 TO 10
               LOCATE 21, 48 - i%, 0
               PRINT MID$(cursorMask$, 16 - i%, 1);
           CASE 11
               LOCATE 21, 44 - i%, 0
               PRINT MID$(cursorMask$, 16 - i%, 1);
           CASE 12 TO 14
               LOCATE 21, 40 - i%, 0
               PRINT MID$(cursorMask$, 16 - i%, 1);
           CASE 15
               LOCATE 21, 36 - i%, 0
               PRINT MID$(cursorMask$, 16 - i%, 1);
           CASE ELSE
           END SELECT
       NEXT i%
       chex$ = "&H" + RIGHT$("000" + HEX$(cursorMask%), 4)
       LOCATE 21, 57, 0
       COLOR 10, 0
       PRINT chex$;
       MouseShow
       RETURN
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 OBJECT

   The OBJECT program lets you interactively create subprograms that produce
   graphics objects for your programs.

   When a QuickBASIC program uses the GET and PUT statements for graphics
   animation purposes, you'll often notice the objects being created on the
   screen as the program first starts up. The normal procedure is to create
   the graphics objects using the LINE and DRAW statements and then to save
   the objects in integer arrays using the GET statement. The creation of the
   objects the first time is relatively slow, compared with the very fast PUT
   statement.

   The OBJECT program lets you create these objects interactively and
   "off-line" until you're satisfied with their appearance. Then, this
   program automatically writes a subprogram source file that, when loaded or
   merged with your main program, quickly creates the integer arrays by
   simply reading the appropriate integers into the arrays.

   The best way to get a feel for this program is to give it a try. Run it,
   and follow the directions. You can edit a DRAW string, try it to see what
   the new object looks like, and then re-edit the string until you like the
   results. When you select the "Save" option, the program automatically
   determines the smallest integer array that will hold the object you've
   created and writes a source code subprogram file that creates and fills an
   integer array with the bit pattern for your object. Later on, you can load
   this source code file and re-edit the object to make other changes.

   To use the new object source code in your own program, merge the file into
   the program where you want to use the object. The program should run
   through the statements once, but you can use PUT statements repeatedly to
   animate or duplicate the image.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   OBJECT.BAS                      Program module
   SaveObject              Sub     Creates graphics "PUT" file source code
   ──────────────────────────────────────────────────────────────────────────


 Program Module: OBJECT

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          OBJECT                     **
     ' **  Type:          Program                    **
     ' **  Module:        OBJECT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Allows interactive graphics object creation.
     ' Dumps code for another program to be able to create
     ' the graphics object "PUT array" directly.
     '
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    CGA
     ' .MAK FILE:       OBJECT.BAS
     '                  KEYS.BAS
     '                  EDIT.BAS
     ' PARAMETERS:      (none)
     ' VARIABLES:       quitFlag%     Indicates user is ready to quit
     '                  modeFlag%     Indicates a valid graphics mode was sele
     '                  mode%         Graphics mode
     '                  xMax%         Maximum screen X coordinate
     '                  yMax%         Maximum screen Y coordinate
     '                  fileName$     Name of object creation subprogram file
     '                  exitCode%     Return code from EditLine subprogram
     '                  t$            Temporary work string while reading file
     '                                contents
     '                  a$            The DRAW string
     '                  editFlag%     Indicates an edit of the string is desir
     '               drawErrorFlag%   Indicates an error occurred during the D
     '                  keyNumber%    Integer key code returned by KeyCode%
     '                                function
     '                  okayFlag%     Shared flag for determining array dimens

     ' Logical constants
       CONST FALSE = 0
       CONST TRUE = NOT FALSE

     ' Key code constants
       CONST SKEYLC = 115
       CONST SKEYUC = SKEYLC - 32
       CONST QKEYLC = 113
       CONST QKEYUC = QKEYLC - 32
       CONST ESC = 27

     ' 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 BLINK = 16
       CONST YELLOW = BROWN + BRIGHT

     ' Functions
       DECLARE FUNCTION KeyCode% ()

     ' Subprograms
       DECLARE SUB DrawBox (row1%, col1%, row2%, col2%)
       DECLARE SUB EditBox (a$, row1%, col1%, row2%, col2%)
       DECLARE SUB EditLine (a$, exitCode%)
       DECLARE SUB SaveObject (mode%, xMax%, yMax%, fileName$, a$)

     ' Initialization
       SCREEN 0
       CLS
       quitFlag% = FALSE

     ' Title
       PRINT "OBJECT - Interactive graphics object editor"
       PRINT
       PRINT

     ' Display screen mode table
       PRINT "Adapter       SCREEN modes allowed"
       PRINT "----------    --------------------"
       PRINT "Monochrome    (none)"
       PRINT "Hercules      3"
       PRINT "CGA           1,2"
       PRINT "EGA           1,2,7,8,9"
       PRINT "MCGA          1,2,11,13"
       PRINT "VGA           1,2,7,8,9,11,12,13"
       PRINT

     ' Ask user for the graphics screen mode
       DO
           PRINT "Enter a SCREEN mode number, ";
           INPUT "based on your graphics adapter "; mode%
           modeFlag% = TRUE
           SELECT CASE mode%
           CASE 1, 7, 13
               xMax% = 319
               yMax% = 199
           CASE 2, 8
               xMax% = 639
               yMax% = 199
           CASE 9, 10
               xMax% = 639
               yMax% = 349
           CASE 11, 12
               xMax% = 639
               yMax% = 479
           CASE 3
               xMax% = 719
               yMax% = 347
           CASE ELSE
               modeFlag% = FALSE
           END SELECT
       LOOP UNTIL modeFlag% = TRUE

     ' Ask user for the filename
       fileName$ = "IMAGEARY.BAS" + SPACE$(20)
       SCREEN 0
       WIDTH 80
       CLS
       COLOR WHITE, BLACK
       PRINT "Name of the file where source code will be written:"
       PRINT
       PRINT "Edit the default filename IMAGEARY.BAS ";
       PRINT "if desired, and then press Enter..."
       PRINT
       PRINT SPACE$(12);
       COLOR YELLOW, BLUE
       EditLine fileName$, exitCode%
       COLOR WHITE, BLACK

     ' Try to read in previous contents of the file
       ON ERROR GOTO FileError
       OPEN fileName$ FOR INPUT AS #1
       ON ERROR GOTO 0
       DO UNTIL EOF(1)
           LINE INPUT #1, t$
           IF INSTR(t$, "(DRAW$)") THEN
               t$ = MID$(t$, INSTR(t$, CHR$(34)) + 1)
               t$ = LEFT$(t$, INSTR(t$, CHR$(34)) - 1)
               a$ = a$ + t$
           END IF
       LOOP
       CLOSE #1

     ' Main loop
       DO

         ' Prepare for DRAW string editing by the user
           SCREEN 0
           WIDTH 80
           CLS
           editFlag% = FALSE

         ' Display useful information
           PRINT "OBJECT - Screen mode"; mode%
           PRINT
           PRINT "Edit the DRAW string workspace; then press"
           PRINT "the Esc key to try out your creation..."
           PRINT
           PRINT , "                Cn      Color"
           PRINT , " H   U   E      Mx,y    Move absolute"
           PRINT , "   \ | /        M+|/-x,y Move relative"
           PRINT , " L -   - R      An      Angle (1=90,2=180...)"
           PRINT , "   / | \        TAn     Turn angle (-360 to 360)"
           PRINT , " G   D   F      Sn      Scale factor"
           PRINT , "                Pc,b    Paint (color, border)"
       PRINT "(These commands are described in detail in the ";
       PRINT "Microsoft QuickBASIC Language Reference)"

         ' Input DRAW string via EditBox subprogram
           COLOR GREEN + BRIGHT, BLUE
           DrawBox 15, 1, 24, 80
           COLOR YELLOW, BLUE
           EditBox a$, 15, 1, 24, 80

         ' Try out the DRAW string
           SCREEN mode%
           drawErrorFlag% = FALSE
           ON ERROR GOTO DrawError
           DRAW a$
           ON ERROR GOTO 0

         ' Give user idea of what to do
           LOCATE 1, 1
           PRINT "<S>ave, <Esc> to edit, or <Q>uit"

         ' Get next valid keystroke
           DO UNTIL editFlag% OR drawErrorFlag% OR quitFlag%

             ' Grab key code
               keyNumber% = KeyCode%

             ' Process the keystroke
               SELECT CASE keyNumber%

               CASE ESC
                   editFlag% = TRUE

               CASE QKEYLC, QKEYUC
                   quitFlag% = TRUE

               CASE SKEYLC, SKEYUC
                   SaveObject mode%, xMax%, yMax%, fileName$, a$

               CASE ELSE
               END SELECT

           LOOP

       LOOP UNTIL quitFlag%

     ' All done
       CLS
       SCREEN 0
       WIDTH 80
       END

   FileError:
     ' Create the new file
       OPEN fileName$ FOR OUTPUT AS #1
       CLOSE #1
       OPEN fileName$ FOR INPUT AS #1
       RESUME NEXT

   DrawError:
       drawErrorFlag% = TRUE
       SCREEN 0
       CLS
       PRINT "Your DRAW string caused an error"
       PRINT
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""
       RESUME NEXT

   ArrayError:
       okayFlag% = FALSE
       RESUME NEXT
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SaveObject

   Creates a source code subprogram module file for the OBJECT program.

   This subprogram performs the tricky task of finding the boundaries of the
   graphics object, dimensioning an integer array of exactly the right size,
   getting the object from the screen and into the array, and writing a
   source code subprogram file that will recreate the array when merged into
   a different program.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SaveObject                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        OBJECT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Creates source code file for creating graphics mode
     ' objects for efficient "PUT" graphics.
     '
     ' EXAMPLE OF USE:   SaveObject mode%, xMax%, yMax%, fileName$, a$
     ' PARAMETERS:       mode%      Graphics mode
     '                   xMax%      Maximum X screen coordinate for given
     '                              graphics mode
     '                   yMax%      Maximum Y screen coordinate for given
     '                              graphics mode
     '                   fileName$  Name of source code file to edit and/or
     '                              create
     '                   a$         The DRAW string that creates the object
     '                              initially
     ' VARIABLES:        okayFlag%  Shared flag used to determine array size
     '                   size%      Array sizing
     '                   edge%      Array for efficiently finding edges of obj
     '                   stepSize%  Scanning step for search for object edges
     '                   yTop%      Y coordinate at top edge of object
     '                   yBot%      Y coordinate at bottom edge of object
     '                   y1%        Starting edge search Y coordinate
     '                   y2%        Ending edge search Y coordinate
     '                   i%         Looping index
     '                   xLeft%     X coordinate at left edge of object
     '                   xRight%    X coordinate at right edge of object
     '                   x1%        Starting edge search X coordinate
     '                   x2%        Ending edge search X coordinate
     '                   object%()  Array to hold GET object from screen
     '                   objName$   Name of object, derived from filename
     '                   ndx%       Index to any special characters in objName
     '                   ary$       Name of array, derived from filename
     '                   d$         Works string for building lines for file
     ' MODULE LEVEL
     '   DECLARATIONS: DECLARE FUNCTION SaveObject (mode%, xMax%, yMax%,
     '                                              fileName$, a$)
     '
       SUB SaveObject (mode%, xMax%, yMax%, fileName$, a$) STATIC

         ' Shared error trap variable
           SHARED okayFlag%

         ' Select the right array size for the mode
           SELECT CASE mode%
           CASE 1, 2
               size% = 93
           CASE 7, 8
               size% = 367
           CASE 9
               size% = 667
           CASE 10
               size% = 334
           CASE 11
               size% = 233
           CASE 12
               size% = 927
           CASE 13
               size% = 161
           CASE ELSE
           END SELECT

         ' Build the array space
           DIM edge%(size%)

         ' Scan to find top and bottom edges of the object
           stepSize% = 32
           yTop% = yMax%
           yBot% = 0
           y1% = 17
           y2% = yMax%
           DO
               FOR y% = y1% TO y2% STEP stepSize%
                   IF y% < yTop% OR y% > yBot% THEN
                       GET (0, y%)-(xMax%, y%), edge%
                       LINE (0, y%)-(xMax%, y%)
                       FOR i% = 2 TO size%
                           IF edge%(i%) THEN
                               IF y% < yTop% THEN
                                   yTop% = y%
                               END IF
                               IF y% > yBot% THEN
                                   yBot% = y%
                               END IF
                               i% = size%
                           END IF
                       NEXT i%
                       PUT (0, y%), edge%, PSET
                   END IF
               NEXT y%
               IF yTop% <= yBot% THEN
                   y1% = yTop% - stepSize% * 2
                   y2% = yBot% + stepSize% * 2
                   IF y1% < 17 THEN
                       y1% = 17
                   END IF
                   IF y2% > yMax% THEN
                       y2% = yMax%
                   END IF
               END IF
               stepSize% = stepSize% \ 2
           LOOP UNTIL stepSize% = 0

         ' Scan to find left and right edges of the object
           stepSize% = 32
           xLeft% = xMax%
           xRight% = 0
           x1% = 0
           x2% = xMax%
           DO
               FOR x% = x1% TO x2% STEP stepSize%
                   IF x% < xLeft% OR x% > xRight% THEN
                       GET (x%, yTop%)-(x%, yBot%), edge%
                       LINE (x%, yTop%)-(x%, yBot%)
                       FOR i% = 2 TO size%
                           IF edge%(i%) THEN
                               IF x% < xLeft% THEN
                                   xLeft% = x%
                               END IF
                               IF x% > xRight% THEN
                                   xRight% = x%
                               END IF
                               i% = size%
                           END IF
                       NEXT i%
                       PUT (x%, yTop%), edge%, PSET
                   END IF
               NEXT x%
               IF xLeft% <= xRight% THEN
                   x1% = xLeft% - stepSize% * 2
                   x2% = xRight% + stepSize% * 2
                   IF x1% < 0 THEN
                       x1% = 0
                   END IF
                   IF x2% > xMax% THEN
                       x2% = xMax%
                   END IF
               END IF
               stepSize% = stepSize% \ 2
           LOOP UNTIL stepSize% = 0

         ' Draw border around the object
           LINE (xLeft% - 1, yTop% - 1)-(xRight% + 1, yBot% + 1), , B

         ' Build the right size integer array
           stepSize% = 256
           size% = 3
           DO
               DO
                   IF size% < 3 THEN
                       size% = 3
                   END IF
                   REDIM object%(size%)
                   okayFlag% = TRUE
                   ON ERROR GOTO ArrayError
                   GET (xLeft%, yTop%)-(xRight%, yBot%), object%
                   ON ERROR GOTO 0
                   IF okayFlag% = FALSE THEN
                       size% = size% + stepSize%
                   ELSE
                       IF stepSize% > 1 THEN
                           size% = size% - stepSize%
                       END IF
                   END IF
               LOOP UNTIL okayFlag%
               stepSize% = stepSize% \ 2
           LOOP UNTIL stepSize% = 0

         ' Make the name of the object
           objName$ = LTRIM$(RTRIM$(fileName$)) + "."
           ndx% = INSTR(objName$, "\")
           DO WHILE ndx%
               objName$ = MID$(objName$, ndx% + 1)
               ndx% = INSTR(objName$, "\")
           LOOP
           ndx% = INSTR(objName$, ":")
           DO WHILE ndx%
               objName$ = MID$(objName$, ndx% + 1)
               ndx% = INSTR(objName$, ":")
           LOOP
           ndx% = INSTR(objName$, ".")
           objName$ = LCASE$(LEFT$(objName$, ndx% - 1))
           IF objName$ = "" THEN
               objName$ = "xxxxxx"
           END IF

         ' Make array name
           ary$ = objName$ + "%("

         ' Open the file for the new source lines
           OPEN fileName$ FOR OUTPUT AS #1

         ' Print the lines
           PRINT #1, " "
           PRINT #1, "  ' " + objName$
           FOR i% = 1 TO LEN(a$) STEP 50
               PRINT #1, "  ' (DRAW$) "; CHR$(34);
               PRINT #1, MID$(a$, i%, 50); CHR$(34)
           NEXT i%
           PRINT #1, "    DIM " + ary$; "0 TO";
           PRINT #1, STR$(size%) + ")"
           PRINT #1, "    FOR i% = 0 TO"; size%
           PRINT #1, "        READ h$"
           PRINT #1, "        " + ary$ + "i%) = VAL(";
           PRINT #1, CHR$(34) + "&H" + CHR$(34);
           PRINT #1, " + h$)"
           PRINT #1, "    NEXT i%"
           FOR i% = 0 TO size%
               IF d$ = "" THEN
                   d$ = "    DATA "
               ELSE
                   d$ = d$ + ","
               END IF
               d$ = d$ + HEX$(object%(i%))
               IF LEN(d$) > 60 OR i% = size% THEN
                   PRINT #1, d$
                   d$ = ""
               END IF
           NEXT i%
           PRINT #1, " "

         ' Close the file
           CLOSE

         ' Erase the border around the object
           LINE (xLeft% - 1, yTop% - 1)-(xRight% + 1, yBot% + 1), 0, B

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 PARSE

   The PARSE toolbox demonstrates the ParseLine and ParseWord subprograms.
   A sample string of text (x$) is parsed by each of these subprograms, and
   the results are displayed for review.

   The purpose of these subprograms is to split a string into substrings,
   where each substring is delineated by any of a given set of characters
   that you define. For example, a string can be parsed into individual words
   by splitting the string wherever spaces or commas occur.

   A common use for these subprograms would be the processing of a list of
   commands passed to a QuickBASIC program from the MS-DOS command line,
   available in the special variable COMMAND$. The HEX2BIN, BIN2HEX, and
   QBFMT programs use the PARSE toolbox in this way.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   PARSE.BAS                       Demo module
   ParseLine                Sub     Breaks a string into individual words
   ParseWord                Sub     Parses and removes first word from string
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: PARSE

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          PARSE                      **
     ' **  Type:          Toolbox                    **
     ' **  Module:        PARSE.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       a$()       Array of words parsed from x$
     '                  x$         String to be parsed
     '                  sep$       Characters defining word separation
     '                  word$      Each word from the string
     '                  n%         Index to each word in array

       DECLARE SUB ParseLine (x$, sep$, a$())
       DECLARE SUB ParseWord (a$, sep$, word$)

     ' Initialization
       CLS
       DIM a$(1 TO 99)

     ' Demonstrate ParseWord
       x$ = "This is a test line. A,B,C, etc."
       sep$ = " ,"
       PRINT "x$:", x$
       PRINT "sep$:", CHR$(34); sep$; CHR$(34)
       ParseWord x$, sep$, word$
       PRINT "ParseWord x$, sep$, word$"
       PRINT "x$:", x$
       PRINT "word$:", word$

     ' Demonstrate ParseLine
       PRINT
       x$ = "This is a test line. A,B,C, etc."
       sep$ = " ,"
       PRINT "x$:", x$
       PRINT "sep$:", CHR$(34); sep$; CHR$(34)
       ParseLine x$, sep$, a$()
       PRINT "ParseLine x$, sep$, a$()"
       PRINT "a$()..."
       DO
           n% = n% + 1
           PRINT n%, a$(n%)
       LOOP UNTIL a$(n% + 1) = ""

     ' All done
       END
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ParseLine

   Parses a string into individual words, returning the list of words in a
   string array. You can list any characters in sep$ to define the division
   between words, but the most commonly used characters are space, comma, and
   tab. The string array will contain a null string after the last word
   parsed from the string.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ParseLine                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        PARSE.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Breaks a string into an array of words, as defined
     ' by any characters listed in sep$.
     '
     ' EXAMPLE OF USE:  ParseLine x$, sep$, a$()
     ' PARAMETERS:      x$      String to be parsed
     '                  sep$    List of characters defined as word separators
     '                  a$()    Returned array of words
     ' VARIABLES:       t$      Temporary work string
     '                  i%      Index to array entries
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB ParseLine (x$, sep$, a$())
     '
       SUB ParseLine (x$, sep$, a$()) STATIC
           t$ = x$
           FOR i% = LBOUND(a$) TO UBOUND(a$)
               ParseWord t$, sep$, a$(i%)
               IF a$(i%) = "" THEN
                   EXIT FOR
               END IF
           NEXT i%
           t$ = ""
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ParseWord

   Extracts the first word from the front of a string, returning the word and
   the original string minus the leading word. You can call this routine
   repeatedly to parse out each word, one at a time. You set the characters
   that separate words in sep$. For example, to parse words separated by
   either spaces or commas, set as follows:


     sep$ = " ,"

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ParseWord                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        PARSE.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Breaks off the first word in a$, as delimited by
     ' any characters listed in sep$.
     '
     ' EXAMPLE OF USE:  ParseWord a$, sep$, word$
     ' PARAMETERS:      a$         String to be parsed
     '                  sep$       List of characters defined as word separato
     '                  word$      Returned first word parsed from a$
     ' VARIABLES:       lena%      Length of a$
     '                  i%         Looping index
     '                  j%         Looping index
     '                  k%         Looping index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB ParseWord (a$, sep$, word$)
     '
       SUB ParseWord (a$, sep$, word$) STATIC
           word$ = ""
           lena% = LEN(a$)
           IF a$ = "" THEN
               EXIT SUB
           END IF
           FOR i% = 1 TO lena%
               IF INSTR(sep$, MID$(a$, i%, 1)) = 0 THEN
                   EXIT FOR
               END IF
           NEXT i%
           FOR j% = i% TO lena%
               IF INSTR(sep$, MID$(a$, j%, 1)) THEN
                   EXIT FOR
               END IF
           NEXT j%
           FOR k% = j% TO lena%
               IF INSTR(sep$, MID$(a$, k%, 1)) = 0 THEN
                   EXIT FOR
               END IF
           NEXT k%
           IF i% > lena% THEN
               a$ = ""
               EXIT SUB
           END IF
           IF j% > lena% THEN
               word$ = MID$(a$, i%)
               a$ = ""
               EXIT SUB
           END IF
           word$ = MID$(a$, i%, j% - i%)
           IF k% > lena% THEN
               a$ = ""
           ELSE
               a$ = MID$(a$, k%)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 PROBSTAT

   The PROBSTAT toolbox is a collection of functions for probability and
   statistics calculations.

   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   PROBSTAT.BAS                        Demo module
   ArithmeticMean#              Func   Arithmetic mean of an array of
                                        numbers
   Combinations#                Func   Combinations of n items, r at a time
   Factorial#                   Func   Factorial of a number
   GeometricMean#               Func   Geometric mean of an array of numbers
   HarmonicMean#                Func   Harmonic mean of an array of numbers
   Permutations#                Func   Permutations of n items, r at a time
   QuadraticMean#               Func   Quadratic mean of an array of numbers
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: PROBSTAT

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          PROBSTAT                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates several probability- and statistics-
     ' related mathematical functions.
     '
     ' USAGE:          No command line parameters
     ' .MAK FILE:      (none)
     ' PARAMETERS:     (none)
     ' VARIABLES:      a#()       Array of numbers to be processed
     '                 i%         Index into array
     '                 n&         Number of items for combinations and permuta
     '                 r&         Quantity for combinations and permutations
     '
       DECLARE FUNCTION Combinations# (n&, r&)
       DECLARE FUNCTION Factorial# (n&)
       DECLARE FUNCTION Permutations# (n&, r&)
       DECLARE FUNCTION GeometricMean# (a#())
       DECLARE FUNCTION HarmonicMean# (a#())
       DECLARE FUNCTION ArithmeticMean# (a#())
       DECLARE FUNCTION QuadraticMean# (a#())

     ' Demonstrations
       CLS
       PRINT "PROBSTAT"
       PRINT
       PRINT "Array of numbers..."
       DIM a#(-3 TO 6)
       FOR i% = -3 TO 6
           READ a#(i%)
           PRINT a#(i%),
       NEXT i%
       PRINT
       DATA  1.2,3.4,5.6,7.8,9.1,2.3,4.5,6.7,8.9,1.2

       PRINT
       PRINT "Arithmetic mean = "; ArithmeticMean#(a#())
       PRINT "Geometric mean  = "; GeometricMean#(a#())
       PRINT "Harmonic mean   = "; HarmonicMean#(a#())
       PRINT "Quadratic mean  = "; QuadraticMean#(a#())
       PRINT

       n& = 17
       r& = 5
       PRINT "Combinations of"; n&; "objects taken";
       PRINT r&; "at a time = "; Combinations#(n&, r&)

       PRINT "Permutations of"; n&; "objects taken";
       PRINT r&; "at a time = "; Permutations#(n&, r&)

       PRINT
       PRINT "Factorial of 17 = "; Factorial#(17&)

     ' All done
       END
   ──────────────────────────────────────────────────────────────────────────


 Function: ArithmeticMean#

   Returns the arithmetic mean of an array of double-precision numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ArithmeticMean#            **
     ' **  Type:          Function                   **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the arithmetic mean of an array of numbers.
     '
     ' EXAMPLE OF USE:  ArithmeticMean# a#()
     ' PARAMETERS:      a#()       Array of double-precision numbers to be
     '                             processed
     ' VARIABLES:       n%         Count of array entries
     '                  sum#       Sum of the array entries
     '                  i%         Looping index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ArithmeticMean# (a#())
     '
       FUNCTION ArithmeticMean# (a#()) STATIC
           n% = 0
           sum# = 0
           FOR i% = LBOUND(a#) TO UBOUND(a#)
               n% = n% + 1
               sum# = sum# + a#(i%)
           NEXT i%
           ArithmeticMean# = sum# / n%
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Combinations#

   Calculates the number of combinations of n& items taken r& at a time. This
   function returns a double-precision result to allow for larger answers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Combinations#              **
     ' **  Type:          Function                   **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the number of combinations of n& items
     ' taken r& at a time.
     '
     ' EXAMPLE OF USE:  c# = Combinations#(n&, r&)
     ' PARAMETERS:      n&         Number of items
     '                  r&         Taken r& at a time
     ' VARIABLES:       result#    Working result variable
     '                  j&         Working copy of r&
     '                  k&         Difference between n& and r&
     '                  h&         Values from r& through n&
     '                  i&         Values from 1 through j&
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Combinations# (n&, r&)
     '
       FUNCTION Combinations# (n&, r&) STATIC
           result# = 1
           j& = r&
           k& = n& - r&
           h& = n&
           IF j& > k& THEN
               SWAP j&, k&
           END IF
           FOR i& = 1 TO j&
               result# = (result# * h&) / i&
               h& = h& - 1
           NEXT i&
           Combinations# = result#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Factorial#

   Returns the factorial of a long integer. The returned value is
   double-precision, allowing for larger arguments. This is a recursive
   function. If the argument n& is greater than 1, n& is multiplied by the
   result of finding the factorial of n& - 1. The result is that this
   function will call itself n& times.

   Notice that the STATIC keyword is missing from the end of the FUNCTION
   statement because recursive functions must not be defined as STATIC.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Factorial#                 **
     ' **  Type:          Function                   **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the factorial of n& (recursive).
     '
     ' EXAMPLE OF USE:  f# = Factorial#(n&)
     ' PARAMETERS:      n&         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Factorial# (n&)
     '
       FUNCTION Factorial# (n&)
           IF n& > 1 THEN
               Factorial# = n& * Factorial#(n& - 1)
           ELSE
               Factorial# = 1
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: GeometricMean#

   Returns the geometric mean of an array of double-precision numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          GeometricMean#             **
     ' **  Type:          Function                   **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the geometric mean of an array of numbers.
     '
     ' EXAMPLE OF USE:  gm# = GeometricMean#(a#())
     ' PARAMETERS:      a#()       Array of numbers to be processed
     ' VARIABLES:       n%         Count of numbers
     '                  product#   Product of all the numbers
     '                  i%         Index to array entries
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION GeometricMean# (a#())
     '
       FUNCTION GeometricMean# (a#()) STATIC
           n% = 0
           product# = 1
           FOR i% = LBOUND(a#) TO UBOUND(a#)
               n% = n% + 1
               product# = product# * a#(i%)
           NEXT i%
           GeometricMean# = product# ^ (1 / n%)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: HarmonicMean#

   Returns the harmonic mean of an array of double-precision numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          HarmonicMean#              **
     ' **  Type:          Function                   **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the harmonic mean of an array of numbers.
     '
     ' EXAMPLE OF USE:  hm# = HarmonicMean#(a#())
     ' PARAMETERS:      a#()       Array of numbers to be processed
     ' VARIABLES:       n%         Number of array entries
     '                  sum#       Sum of the reciprocal of each number
     '                  i%         Index to each array entry
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION HarmonicMean# (a#())
     '
       FUNCTION HarmonicMean# (a#()) STATIC
           n% = 0
           sum# = 0
           FOR i% = LBOUND(a#) TO UBOUND(a#)
               n% = n% + 1
               sum# = sum# + 1# / a#(i%)
           NEXT i%
           HarmonicMean# = n% / sum#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Permutations#

   Returns the number of permutations of n& items taken r& at a time.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Permutations#              **
     ' **  Type:          Function                   **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the permutations of n& items taken r& at a time.
     '
     ' EXAMPLE OF USE:  perm# = Permutations#(n&, r&)
     ' PARAMETERS:      n&         Number of items
     '                  r&         Taken r& at a time
     ' VARIABLES:       p#         Working variable for permutations
     '                  i&         Loop index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Permutations# (n&, r&)
     '
       FUNCTION Permutations# (n&, r&) STATIC
           p# = 1
           FOR i& = n& - r& + 1 TO n&
               p# = p# * i&
           NEXT i&
           Permutations# = p#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: QuadraticMean#

   Returns the quadratic mean of an array of double-precision numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          QuadraticMean#             **
     ' **  Type:          Function                   **
     ' **  Module:        PROBSTAT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the quadratic mean of an array of numbers.
     '
     ' EXAMPLE OF USE:  qm# = QuadraticMean#(a#())
     ' PARAMETERS:      a#()       Array of numbers to be processed
     ' VARIABLES:       n%         Count of array entries
     '                  sum#       Sum of the square of each number
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION QuadraticMean# (a#())
     '
        FUNCTION QuadraticMean# (a#()) STATIC
           n% = 0
           sum# = 0
           FOR i% = LBOUND(a#) TO UBOUND(a#)
               n% = n% + 1
               sum# = sum# + a#(i%) ^ 2
           NEXT i%
           QuadraticMean# = SQR(sum# / n%)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 QBFMT

   The QBFMT program reformats QuickBASIC modules by indenting the lines
   according to the structure of the statements. For example, all lines found
   between matching DO and LOOP statements are indented four character
   columns more than the DO and LOOP statements. Of course, nested structures
   are indented even farther.

   One advantage of processing a file with this program is that improperly
   matched statements are detected. Improper matching can happen if, for
   example, you forget to type an END IF statement to match an IF. A special
   comment line is placed in the file at the point where each error is
   detected.

   This utility program was an immense help throughout the creation of this
   book. Each module was formatted with this program, resulting in a
   consistent structure, style, and general appearance to the listings.

   Notice that QuickBASIC programs to be processed by the QBFMT program must
   be saved in text format and have the extension .BAS.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   QBFMT.BAS                       Program module
   Indent                  Sub     Performs line indention
   SetCode                 Sub     Determines indention code by keyword
   SplitUp                 Sub     Splits line into major components
   ──────────────────────────────────────────────────────────────────────────


 Program Module: QBFMT

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          QBFMT                      **
     ' **  Type:          Program                    **
     ' **  Module:        QBFMT.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reformats a QuickBASIC program by indenting
     ' lines according to the structure of the statements.  The
     ' default amount is 4 spaces if no indention parameter
     ' is given on the command line.
     '
     ' USAGE:  QBFMT filename [indention]
     '         Command$ = filename [indention]
     ' .MAK FILE:   QBFMT.BAS
     '              PARSE.BAS
     '              STRINGS.BAS
     ' PARAMETERS:  filename(.BAS)   Name of QuickBASIC module to be formatted
     '                               the module must be saved in "Text" format
     ' VARIABLES:   md$              Working copy of COMMAND$ contents
     '              fileName$        Name of QuickBASIC module to be formatted
     '              dpoint%          Position of the decimal point character
     '                               in cmd$
     '              ndent$           Part of cmd$ dealing with optional
     '                               indention amount
     '              indention%       Number of character columns per
     '                               indention level
     '              progline$        Each line of the file being processed
     '              indentLevel%     Keeps track of current indention amount
     '              nest$            Message placed in file if faulty structur
     '                               detected

       DECLARE FUNCTION LtrimSet$ (a$, set$)
       DECLARE FUNCTION RtrimSet$ (a$, set$)
       DECLARE SUB Indent (a$, indention%, indentLevel%)
       DECLARE SUB ParseWord (a$, sep$, word$)
       DECLARE SUB SetCode (a$, keyWord$, code%)
       DECLARE SUB SplitUp (a$, comment$, keyWord$)

     ' Decipher the user command line
       cmd$ = COMMAND$
       IF cmd$ = "" THEN
           PRINT
           PRINT "Usage:  QBFMT filename(.BAS) [indention]"
           SYSTEM
       ELSE
           ParseWord cmd$, " ,", fileName$
           dpoint% = INSTR(fileName$, ".")
           IF dpoint% THEN
               fileName$ = LEFT$(fileName$, dpoint% - 1)
           END IF
           ParseWord cmd$, " ,", ndent$
           indention% = VAL(ndent$)
           IF indention% < 1 THEN
               indention% = 4
           END IF
       END IF

     ' Try to open the indicated files
       PRINT
       ON ERROR GOTO ErrorTrapOne
       OPEN fileName$ + ".BAS" FOR INPUT AS #1
       OPEN fileName$ + ".@$@" FOR OUTPUT AS #2
       ON ERROR GOTO 0

     ' Process each line of the file
       DO
           LINE INPUT #1, progLine$
           Indent progLine$, indention%, indentLevel%
           PRINT progLine$
           PRINT #2, progLine$
           IF indentLevel% < 0 OR (EOF(1) AND indentLevel% <> 0) THEN
               SOUND 555, 5
               SOUND 333, 9
               nest$ = "'<<<<<<<<<<<<<<<<<<<<< Nesting error detected!"
               PRINT nest$
               PRINT #2, nest$
               indentLevel% = 0
           END IF
       LOOP UNTIL EOF(1)

     ' Close all files
       CLOSE

     ' Delete any old .BAK file
       ON ERROR GOTO ErrorTrapTwo
       KILL fileName$ + ".BAK"
       ON ERROR GOTO 0

     ' Rename the files
       NAME fileName$ + ".BAS" AS fileName$ + ".BAK"
       NAME fileName$ + ".@$@" AS fileName$ + ".BAS"

     ' We're done
       END

     '----------- Error trapping routines

   ErrorTrapOne:
       PRINT "Error while opening files"
       SYSTEM

   ErrorTrapTwo:
       RESUME NEXT
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Indent

   Performs the task of indenting each line of a program for the QBFMT
   program. The indention amount is determined by the first word of each
   line, and spaces are added to the front end of each line accordingly.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Indent                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QBFMT.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Determines the indention for each line.
     '
     ' EXAMPLE OF USE:  Indent a$, indention%, indentLevel%
     ' PARAMETERS:      a$             Program line to be indented
     '                  indention%     Spaces to add for each indention level
     '                  indentLevel%   Level of indention
     ' VARIABLES:       comment$       Part of program line that represents a
     '                                 REMARK
     '                  keyWord$       First word of the program line
     '                  code%          Indention control code determined by
     '                                 keyWord$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Indent (a$, indention%, indentLevel%)
     '
     SUB Indent (a$, indention%, indentLevel%) STATIC

         ' Break line into manageable parts
           SplitUp a$, comment$, keyWord$

           IF keyWord$ <> "" THEN

             ' Set indention code according to type of keyword
               SetCode a$, keyWord$, code%

             ' Build a string of spaces for the indicated indention
               SELECT CASE code%
               CASE -2
                   a$ = SPACE$(indention% * indentLevel%) + a$
               CASE -1
                   a$ = SPACE$(indention% * indentLevel%) + a$
                   indentLevel% = indentLevel% - 1
               CASE 0
                   a$ = SPACE$(indention% * (indentLevel% + 1)) + a$
               CASE 1
                   indentLevel% = indentLevel% + 1
                   a$ = SPACE$(indention% * indentLevel%) + a$
               CASE ELSE
               END SELECT
           ELSE
               a$ = SPACE$(indention% * indentLevel% + 2)
           END IF

         ' Round out the position of trailing comments
           IF comment$ <> "" THEN
               IF a$ <> SPACE$(LEN(a$)) AND a$ <> "" THEN
                   a$ = a$ + SPACE$(16 - (LEN(a$) MOD 16))
               END IF
           END IF

         ' Tack the comment back onto the end of the line
           a$ = a$ + comment$

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SetCode

   Determines the indention code for the QBFMT program based on the first
   word of each program line. For example, if the first word of a program
   line is FOR, a code number is returned that signals the QBFMT program to
   indent the following lines one more level. When NEXT is encountered, the
   indention level decreases by one.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SetCode                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QBFMT.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Determines a code number for the type of indention
     ' implied by the various types of keywords that begin
     ' each line of QuickBASIC programs.
     '
     ' EXAMPLE OF USE:   SetCode a$, keyWord$, code%
     ' PARAMETERS:       a$         Program line to indent
     '                   keyWord$   First word of the program line
     '                   code%      Returned code indicating the action to be
     ' VARIABLES:        (none)
     ' MODULE LEVEL
     '   DECLARATIONS:   DECLARE SUB SetCode (a$, keyWord$, code%)
     '
       SUB SetCode (a$, keyWord$, code%) STATIC
           SELECT CASE keyWord$
           CASE "DEF"
               IF INSTR(a$, "=") THEN
                   code% = 0
               ELSE
                   IF INSTR(a$, " SEG") = 0 THEN
                       code% = 1
                   END IF
               END IF
           CASE "ELSE"
               code% = -2
           CASE "ELSEIF"
               code% = -2
           CASE "CASE"
               code% = -2
           CASE "END"
               IF a$ <> "END" THEN
                   code% = -1
               ELSE
                   code% = 0
               END IF
           CASE "FOR"
               code% = 1
           CASE "DO"
               code% = 1
           CASE "SELECT"
               code% = 1
           CASE "IF"
               IF RIGHT$(a$, 4) = "THEN" THEN
                   code% = 1
               ELSE
                   code% = 0
               END IF
           CASE "NEXT"
               code% = -1
           CASE "LOOP"
               code% = -1
           CASE "SUB"
               code% = 1
           CASE "FUNCTION"
               code% = 1
           CASE "TYPE"
               code% = 1
           CASE "WHILE"
               code% = 1
           CASE "WEND"
               code% = -1
           CASE ELSE
               code% = 0
           END SELECT
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SplitUp

   Breaks each program line into its major components for the QBFMT program.
   Leading spaces and tabs are removed, and the first word and any REMARK
   part are returned. Later, after the line is indented the proper amount,
   the parts of the line are patched back together and output to the program
   listing file.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SplitUp                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QBFMT.BAS                  **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Splits the line into statement, comment, and keyword.
     '
     ' EXAMPLE OF USE:  SplitUp a$, comment$, keyWord$
     ' PARAMETERS:      a$         Program line to be split up
     '                  comment$   Part of line following "REM" or "'"
     '                  keyWord$   First word of program line
     ' VARIABLES:       set$       Characters to be trimmed, space and tab
     '                  strFlag%   Indication of a quoted string
     '                  k%         Index to start of REMARK
     '                  i%         Looping index
     '                  m%         Pointer to REMARK
     '                  sptr%      Pointer to first space following the
     '                             first word in a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB SplitUp (a$, comment$, keyWord$)
     '
       SUB SplitUp (a$, comment$, keyWord$) STATIC
           set$ = " " + CHR$(9)
           strFlag% = 0
           k% = 0
           FOR i% = LEN(a$) TO 1 STEP -1
               IF MID$(a$, i%, 1) = CHR$(34) THEN
                   IF strFlag% = 0 THEN
                       strFlag% = 1
                   ELSE
                       strFlag% = 0
                   END IF
               END IF
               IF MID$(a$, i%, 1) = "'" OR MID$(a$, i%, 3) = "REM" THEN
                   IF strFlag% = 0 THEN
                       k% = i%
                   END IF
               END IF
           NEXT i%
           IF k% > 0 THEN
               m% = 0
               FOR j% = k% - 1 TO 1 STEP -1
                   IF INSTR(set$, MID$(a$, j%, 1)) = 0 THEN
                       IF m% = 0 THEN m% = j%
                   END IF
               NEXT j%
               IF m% THEN
                   comment$ = MID$(a$, m% + 1)
                   a$ = LEFT$(a$, m%)
               ELSE
                   comment$ = a$
                   a$ = ""
               END IF
           ELSE
               comment$ = ""
           END IF
           a$ = LtrimSet$(a$, set$)
           a$ = RtrimSet$(a$, set$)
           comment$ = LtrimSet$(comment$, set$)
           comment$ = RtrimSet$(comment$, set$)
           sptr% = INSTR(a$, " ")
           IF sptr% THEN
               keyWord$ = UCASE$(LEFT$(a$, sptr% - 1))
           ELSE
               keyWord$ = UCASE$(a$)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 QBTREE

   The QBTREE program performs a recursive directory search and then displays
   all file entries indented for each level of subdirectory encountered. If a
   command line parameter is given, the search starts at the indicated path.
   If no command line parameter is given, the search begins with the current
   directory.

   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   QBTREE.BAS                          Program module
   FileTreeSearch               Sub    Recursive directory search routine
   ──────────────────────────────────────────────────────────────────────────


 Program Module: QBTREE

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          QBTREE                     **
     ' **  Type:          Program                    **
     ' **  Module:        QBTREE.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' This program creates a list of directories and
     ' subdirectories, and all files in them.  If no
     ' command line path is given, the search
     ' begins with the current directory.
     '
     ' USAGE:          QBTREE [path]
     ' REQUIREMENTS:   MIXED.QLB/.LIB
     ' .MAK FILE:      QBTREE.BAS
     '                 FILEINFO.BAS
     ' PARAMETERS:     path       Path for starting directory search
     ' VARIABLES:      path$      Path string, from the command line, or set
     '                            to "*.*"
     '                 indent%    Indention amount for printing


        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 FileDataType
           finame    AS STRING * 12
           year      AS INTEGER
           month     AS INTEGER
           day       AS INTEGER
           hour      AS INTEGER
           minute    AS INTEGER
           second    AS INTEGER
           attribute AS INTEGER
           size      AS LONG
       END TYPE

     ' Subprograms
       DECLARE SUB Interruptx (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)
       DECLARE SUB FindFirstFile (path$, dta$, result%)
       DECLARE SUB FindNextFile (dta$, result%)
       DECLARE SUB GetFileData (dta$, file AS FileDataType)
       DECLARE SUB FileTreeSearch (path$, indent%)

     ' Create structure for deciphering the DTA file search results
       DIM file AS FileDataType

     ' Get the command line path for starting the file search
       path$ = COMMAND$

     ' If no path was given, then use "*.*" to search the current directory
       IF path$ = "" THEN
           path$ = "*.*"
       END IF

     ' If only a drive was given, then add "*.*"
       IF LEN(path$) = 2 AND RIGHT$(path$, 1) = ":" THEN
           path$ = path$ + "*.*"
       END IF

     ' Adjust the given path if necessary
       IF INSTR(path$, "*") = 0 AND INSTR(path$, "?") = 0 THEN
           FindFirstFile path$, dta$, result%
           IF result% = 0 OR RIGHT$(path$, 1) = "\" THEN
               IF RIGHT$(path$, 1) <> "\" THEN
                   path$ = path$ + "\"
               END IF
               path$ = path$ + "*.*"
           END IF
       END IF

     ' Start with a clean slate
       CLS

     ' Call the recursive search subprogram
       FileTreeSearch path$, indent%

     ' That's all there is to it
       END
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: FileTreeSearch

   Performs a recursive search for filenames in directories. Whenever a
   subdirectory is encountered, the subprogram builds a modified search path
   string (by adding the subdirectory name to the end of the current search
   path) and calls itself again. In this way, all files in all subdirectories
   are located, starting with the initial search path given.

   The filenames are printed with an indention amount that is a function of
   the level of recursion. This means that each subdirectory entry is
   indented four spaces more than its parent directory.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FileTreeSearch             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QBTREE.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Directory searching and listing subprogram for
     ' the QBTREE program.  (recursive)
     '
     ' EXAMPLE OF USE:  FileTreeSearch path$, indent%
     ' PARAMETERS:      path$      Path for search of files
     '                  indent%    Level of indention, function of recursion
     '                             level
     ' VARIABLES:       file       Structure of type FileDataType
     '                  path$      Path for search of files
     '                  dta$       Disk Transfer Area buffer string
     '                  result%    Returned result code from FindFirstFile or
     '                             FindNextFile
     '                  newPath$   Path with added subdirectory for recursive
     '                             search
     ' MODULE LEVEL
     '   DECLARATIONS: TYPE FileDataType
     '                     finame    AS STRING * 12
     '                     year      AS INTEGER
     '                     month     AS INTEGER
     '                     day       AS INTEGER
     '                     hour      AS INTEGER
     '                     minute    AS INTEGER
     '                     second    AS INTEGER
     '                     attribute AS INTEGER
     '                     size      AS LONG
     '                  END TYPE
     '
     '                  DECLARE SUB FindFirstFile (path$, dta$, result%)
     '                  DECLARE SUB FindNextFile (dta$, result%)
     '                  DECLARE SUB GetFileData (dta$, file AS FileDataType)
     '                  DECLARE SUB FileTreeSearch (path$, indent%)
     '
       SUB FileTreeSearch (path$, indent%)

         ' Create structure for deciphering the DTA file search results
           DIM file AS FileDataType

         ' Find the first file given the current search path
           FindFirstFile path$, dta$, result%

         ' Search through the directory for all files
           DO UNTIL result%

             ' Unpack the Disk Transfer Area for file information
               GetFileData dta$, file

             ' Skip the "." and ".." files
               IF LEFT$(file.finame, 1) <> "." THEN

                 ' Print the filename, indented to show tree structure
                   PRINT SPACE$(indent% * 4); file.finame;

                 ' Print any other desired file information here
                   PRINT TAB(50); file.size;
                   PRINT TAB(58); file.attribute

                 ' If we found a directory, then recursively search through it
                   IF file.attribute AND &H10 THEN

                     ' Modify path$ to add this new directory to the search pa
                       newPath$ = path$
                       IF INSTR(newPath$, "\") = 0 THEN
                           newPath$ = "\" + newPath$
                       END IF
                       DO WHILE RIGHT$(newPath$, 1) <> "\"
                           newPath$ = LEFT$(newPath$, LEN(newPath$) - 1)
                       LOOP
                       newPath$ = newPath$ + file.finame + "\*.*"

                     ' Example of recursion here
                       FileTreeSearch newPath$, indent% + 1

                   END IF

               END IF

             ' Try to find the next file in this directory
               FindNextFile dta$, result%

           LOOP

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 QCAL

   The QCAL program provides scientific calculator functions from the MS-DOS
   command line. This program is a modified and expanded version of
   MINICAL.BAS, presented earlier in this book. The original version's goal
   was to demonstrate the methods used to create a small, modular program.
   The functionality of the program wasn't the important issue. Here, the
   program has been enhanced, and several new functions and capabilities make
   this program more useful as a utility. Run the program by typing QCAL
   HELP, QCAL ?, or QCAL, and a list of the available functions will be
   displayed. In addition to the original five functions, several new
   trigonometric, hyperbolic, and logarithmic functions have been added.

   You might want to review the original MINICAL program, which is on pages
   5 through 18. You'll find an explanation of how the numeric values are
   placed on the stack and how the functions operate on those values.

   Because of the modular, structured organization of QuickBASIC programs,
   you can easily modify this program to include other functions. To add a
   new function, modify the Process and QcalHelp subprograms where
   applicable, and follow the same pattern of stack and variable
   manipulations exhibited by the other routines when writing your own.

   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   QCAL.BAS                            Program module
   DisplayStack                  Sub    Displays final results of the program
   NextParameter$                Func   Extracts number or command from
                                        COMMAND$
   Process                       Sub    Controls action for command line
                                        parameters
   QcalHelp                      Sub    Provides a "Help" display for program
   ──────────────────────────────────────────────────────────────────────────


 Program Module: QCAL

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          QCAL                       **
     ' **  Type:          Program                    **
     ' **  Module:        QCAL.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:           QCAL [number] [function] [...]
     ' .MAK FILE:       QCAL.BAS
     '                  QCALMATH.BAS
     ' PARAMETERS:      [number]      Numbers to be placed on the stack
     '                  [function]    Operations to be performed on the stack
     '                                contents
     ' VARIABLES:       cmd$          Working copy of COMMAND$
     '                  stack#()      Array representing the numeric stack
     '                  ptr%          Index into the stack
     '                  parm$         Each number of command extracted from cm

     ' Constants
       CONST PI = 3.141592653589793#

     ' Functions
       DECLARE FUNCTION AbsoluteX# (x#)
       DECLARE FUNCTION Add# (y#, x#)
       DECLARE FUNCTION ArcCosine# (x#)
       DECLARE FUNCTION ArcHypCosine# (x#)
       DECLARE FUNCTION ArcHypSine# (x#)
       DECLARE FUNCTION ArcHypTangent# (x#)
       DECLARE FUNCTION ArcSine# (x#)
       DECLARE FUNCTION ArcTangent# (x#)
       DECLARE FUNCTION Ceil# (x#)
       DECLARE FUNCTION ChangeSign# (x#)
       DECLARE FUNCTION Cosine# (x#)
       DECLARE FUNCTION Divide# (y#, x#)
       DECLARE FUNCTION Exponential# (x#)
       DECLARE FUNCTION FractionalPart# (x#)
       DECLARE FUNCTION HypCosine# (x#)
       DECLARE FUNCTION HypSine# (x#)
       DECLARE FUNCTION HypTangent# (x#)
       DECLARE FUNCTION IntegerPart# (x#)
       DECLARE FUNCTION LogBase10# (x#)
       DECLARE FUNCTION LogBaseN# (y#, x#)
       DECLARE FUNCTION LogE# (x#)
       DECLARE FUNCTION Modulus# (y#, x#)
       DECLARE FUNCTION Multiply# (y#, x#)
       DECLARE FUNCTION NextParameter$ (cmd$)
       DECLARE FUNCTION OneOverX# (x#)
       DECLARE FUNCTION Sign# (x#)
       DECLARE FUNCTION Sine# (x#)
       DECLARE FUNCTION SquareRoot# (x#)
       DECLARE FUNCTION Subtract# (y#, x#)
       DECLARE FUNCTION Tangent# (x#)
       DECLARE FUNCTION Xsquared# (x#)
       DECLARE FUNCTION YRaisedToX# (y#, x#)

     ' Subprograms
       DECLARE SUB QcalHelp ()
       DECLARE SUB Process (parm$, stack#(), ptr%)
       DECLARE SUB DisplayStack (stack#(), ptr%)
       DECLARE SUB SwapXY (stack#(), ptr%)

     ' Get the command line
       cmd$ = COMMAND$

     ' First check if user is asking for help
       IF cmd$ = "" OR cmd$ = "HELP" OR cmd$ = "?" THEN
           QcalHelp
           SYSTEM
       END IF

     ' Create a pseudo stack
       DIM stack#(1 TO 20)
       ptr% = 0

     ' Process each part of the command line
       DO UNTIL cmd$ = ""
           parm$ = NextParameter$(cmd$)
           Process parm$, stack#(), ptr%
           IF ptr% < 1 THEN
               PRINT "Not enough stack values"
               SYSTEM
           END IF
       LOOP

     ' Display results
       DisplayStack stack#(), ptr%

     ' All done
       END
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: DisplayStack

   Displays the final results of the QCAL program. When the QCAL program is
   finished, one or more numeric values are left on the stack, representing
   the final values of the calculations. If the stack has a single value
   remaining on it, this number is displayed with the label Result.... If,
   however, two or more values are left on the stack after QCAL has acted on
   all functions, the values are displayed with the label Stack ...,
   indicating to the user that more than a single result was left on the
   stack.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          DisplayStack               **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QCAL.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Displays the value(s) left on the stack when QCAL
     ' is finished processing the command line.
     '
     ' EXAMPLE OF USE:  DisplayStack stack#(), ptr%
     ' PARAMETERS:      stack#()   Array of numbers representing the stack
     '                  ptr%       Index into the stack
     ' VARIABLES:       i%         Looping index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB DisplayStack (stack#(), ptr%)
     '
       SUB DisplayStack (stack#(), ptr%) STATIC
           PRINT
           IF ptr% > 1 THEN
               PRINT "Stack ... ",
           ELSE
               PRINT "Result... ",
           END IF
           FOR i% = 1 TO ptr%
               PRINT stack#(i%),
           NEXT i%
           PRINT
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: NextParameter$

   Returns the first group of nonspace characters found at the left of the
   passed string. The passed string is then trimmed of these characters,
   along with any extra spaces.

   The PARSE.BAS module contains alternative routines that perform the same
   function in a slightly different way. Take a look at the ParseWord and
   ParseLine routines found there. The NextParameter$ subprogram
   demonstrates how the code from a module can be copied and modified for a
   specific purpose, with any extra code removed. This results in a smaller
   program but has the disadvantage that any future changes to the
   PARSE.BAS module will probably not show up here in the QCAL.BAS module.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          NextParameter$             **
     ' **  Type:          Function                   **
     ' **  Module:        QCAL.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Extracts parameters from the front of the
     ' command line.  Parameters are groups of any
     ' characters separated by spaces.
     '
     ' EXAMPLE OF USE:  parm$ = NextParameter$(cmd$)
     ' PARAMETERS:      cmd$       The working copy of COMMAND$
     ' VARIABLES:       parm$      Each number or command from cmd$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION NextParameter$ (cmd$)
     '
       FUNCTION NextParameter$ (cmd$) STATIC
           parm$ = ""
           DO WHILE LEFT$(cmd$, 1) <> " " AND cmd$ <> ""
               parm$ = parm$ + LEFT$(cmd$, 1)
               cmd$ = MID$(cmd$, 2)
           LOOP
           DO WHILE LEFT$(cmd$, 1) = " " AND cmd$ <> ""
               cmd$ = MID$(cmd$, 2)
           LOOP
           NextParameter$ = parm$
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Process

   Acts upon each command line parameter. If the parameter is a valid
   function, the function is called, and the stack is adjusted appropriately.
   If the parameter isn't a recognizable function, it is assumed to be a
   numeric quantity. The VAL function converts the parameter to its numeric
   equivalent, and the result is pushed on the stack, ready for the next
   operation.

   This subprogram demonstrates a fairly long CASE statement. The same logic
   could be developed using IF THEN, ELSE IF, ELSE, and END IF statements,
   but the CASE statement is ideal for making selections from a large number
   of choices in this way.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Process                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QCAL.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Processes each command parameter for the QCAL
     ' program.
     '
     ' EXAMPLE OF USE:  Process parm$, stack#(), ptr%
     ' PARAMETERS:      parm$      The command line parameter to be processed
     '                  stack#()   Array of numbers representing the stack
     '                  ptr%       Index pointing to last stack entry
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Process (parm$, stack#(), ptr%)
     '
       SUB Process (parm$, stack#(), ptr%) STATIC
           SELECT CASE parm$
           CASE "+"
               ptr% = ptr% - 1
               IF ptr% > 0 THEN
                   stack#(ptr%) = Add#(stack#(ptr%), stack#(ptr% + 1))
               END IF
           CASE "-"
               ptr% = ptr% - 1
               IF ptr% > 0 THEN
                   stack#(ptr%) = Subtract#(stack#(ptr%), stack#(ptr% + 1))
               END IF
           CASE "*"
               ptr% = ptr% - 1
               IF ptr% > 0 THEN
                   stack#(ptr%) = Multiply#(stack#(ptr%), stack#(ptr% + 1))
               END IF
           CASE "/"
               ptr% = ptr% - 1
               IF ptr% > 0 THEN
                   stack#(ptr%) = Divide#(stack#(ptr%), stack#(ptr% + 1))
               END IF
           CASE "CHS"
               IF ptr% > 0 THEN
                   stack#(ptr%) = ChangeSign#(stack#(ptr%))
               END IF
           CASE "ABS"
               IF ptr% > 0 THEN
                   stack#(ptr%) = AbsoluteX#(stack#(ptr%))
               END IF
           CASE "SGN"
               IF ptr% > 0 THEN
                   stack#(ptr%) = Sign#(stack#(ptr%))
               END IF
           CASE "INT"
               IF ptr% > 0 THEN
                   stack#(ptr%) = IntegerPart#(stack#(ptr%))
               END IF
           CASE "MOD"
               ptr% = ptr% - 1
               IF ptr% > 0 THEN
                   stack#(ptr%) = Modulus#(stack#(ptr%), stack#(ptr% + 1))
               END IF
           CASE "FRC"
               IF ptr% > 0 THEN
                   stack#(ptr%) = FractionalPart#(stack#(ptr%))
               END IF
           CASE "1/X"
               IF ptr% > 0 THEN
                   stack#(ptr%) = OneOverX#(stack#(ptr%))
               END IF
           CASE "SQR"
               IF ptr% > 0 THEN
                   stack#(ptr%) = SquareRoot#(stack#(ptr%))
               END IF
           CASE "X2"
               IF ptr% > 0 THEN
                   stack#(ptr%) = Xsquared#(stack#(ptr%))
               END IF
           CASE "SIN"
               IF ptr% > 0 THEN
                   stack#(ptr%) = Sine#(stack#(ptr%))
               END IF
           CASE "COS"
               IF ptr% > 0 THEN
                   stack#(ptr%) = Cosine#(stack#(ptr%))
               END IF
           CASE "TAN"
               IF ptr% > 0 THEN
                   stack#(ptr%) = Tangent#(stack#(ptr%))
               END IF
           CASE "ASN"
               IF ptr% > 0 THEN
                   stack#(ptr%) = ArcSine#(stack#(ptr%))
               END IF
           CASE "ACS"
               IF ptr% > 0 THEN
                   stack#(ptr%) = ArcCosine#(stack#(ptr%))
               END IF
           CASE "ATN"
               IF ptr% > 0 THEN
                   stack#(ptr%) = ArcTangent#(stack#(ptr%))
               END IF
           CASE "HSN"
               IF ptr% > 0 THEN
                   stack#(ptr%) = HypSine#(stack#(ptr%))
               END IF
           CASE "HCS"
               IF ptr% > 0 THEN
                   stack#(ptr%) = HypCosine#(stack#(ptr%))
               END IF
           CASE "HTN"
               IF ptr% > 0 THEN
                   stack#(ptr%) = HypTangent#(stack#(ptr%))
               END IF
           CASE "AHS"
               IF ptr% > 0 THEN
                   stack#(ptr%) = ArcHypSine#(stack#(ptr%))
               END IF
           CASE "AHC"
               IF ptr% > 0 THEN
                   stack#(ptr%) = ArcHypCosine#(stack#(ptr%))
               END IF
           CASE "AHT"
               IF ptr% > 0 THEN
                   stack#(ptr%) = ArcHypTangent#(stack#(ptr%))
               END IF
           CASE "LOG"
               IF ptr% > 0 THEN
                   stack#(ptr%) = LogE#(stack#(ptr%))
               END IF
           CASE "LOG10"
               IF ptr% > 0 THEN
                   stack#(ptr%) = LogBase10#(stack#(ptr%))
               END IF
           CASE "LOGN"
               ptr% = ptr% - 1
               IF ptr% > 0 THEN
                   stack#(ptr%) = LogBaseN#(stack#(ptr%), stack#(ptr% + 1))
               END IF
           CASE "EXP"
               IF ptr% > 0 THEN
                   stack#(ptr%) = Exponential#(stack#(ptr%))
               END IF
           CASE "CEIL"
               IF ptr% > 0 THEN
                   stack#(ptr%) = Ceil#(stack#(ptr%))
               END IF
           CASE "Y^X"
               ptr% = ptr% - 1
               IF ptr% > 0 THEN
                   stack#(ptr%) = YRaisedToX#(stack#(ptr%), stack#(ptr% + 1))
               END IF
           CASE "PI"
               ptr% = ptr% + 1
               stack#(ptr%) = PI
           CASE "SWAP"
               SwapXY stack#(), ptr%
           CASE "DUP"
               IF ptr% > 0 THEN
                   stack#(ptr% + 1) = stack#(ptr%)
                   ptr% = ptr% + 1
               END IF
           CASE ELSE
               ptr% = ptr% + 1
               stack#(ptr%) = VAL(parm$)
           END SELECT
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: QcalHelp

   Provides a Help display for the QCAL program.

   One feature that sets good software apart from mediocre software is the
   ability to provide on-line help for the user. Nothing is more frustrating
   than a program that terminates suddenly, without any explanation of the
   problem or suggestion for solving it.

   The QcalHelp subprogram demonstrates one approach to helping the user with
   a program. Entering any of the following command lines will cause the QCAL
   program to call QcalHelp:


     QCAL HELP
     QCAL ?
     QCAL

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          QcalHelp                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QCAL.BAS                   **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Displays a help screen when QCAL is run with no
     ' parameters or with a parameter of ? or HELP.
     '
     ' EXAMPLE OF USE:  QcalHelp
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB QcalHelp ()
     '
       SUB QcalHelp STATIC
           PRINT
           PRINT "Usage:  QCAL [number] [function] [...] <Enter>"
           PRINT
           PRINT "Numbers are placed on an RPN stack, and functions operate"
           PRINT "on the stacked quantities.  When the program is finished,"
           PRINT "whatever is left on the stack is displayed."
           PRINT
           PRINT "List of available functions..."
           PRINT
           PRINT "Two numbers:     +  -  *  /"
           PRINT "One number:      CHS ABS SGN INT MOD FRC CHS 1/X SQR X2 CEIL
           PRINT "Trigonometric:   SIN COS TAN ASN ACS ATN"
           PRINT "Hyperbolic:      HSN HCS HTN AHS AHC AHT"
           PRINT "Logarithmic:     LOG LOG10 LOGN EXP Y^X"
           PRINT "Constants:       PI"
           PRINT "Stack:           SWAP DUP"
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 QCALMATH

   QCALMATH is a toolbox of scientific functions for the QCAL program.
   Several functions included in QCALMATH are similar to functions provided
   by QuickBASIC. You could shorten QCALMATH by deleting these functions here
   and coding the QuickBASIC routines directly in the Process subprogram,
   located in the QCAL.BAS module. However, there's something to be said for
   keeping the functions as shown here: QCALMATH checks for additional error
   conditions and generates clear messages if errors exist. For example,
   although the SquareRoot# function duplicates a QuickBASIC function,
   SquareRoot# checks for values less than 0 before trying to find the
   square root and prints a clear message if such an attempt is made.

   It's easy to add your own functions to the QCAL program. Simply create
   the function in the same format and style as shown in this module. You'll
   also need to modify the Process subprogram in the QCAL module to let the
   program call the new function. For the final touch, be sure to add the new
   function to the list displayed by the QcalHelp subprogram.

   QCALMATH is the only toolbox in this book that doesn't have any
   module-level code to demonstrate the subprograms and functions. The QCAL
   program loads this toolbox and provides the demonstration code.

╓┌─┌─────────────────────────────┌──────┌────────────────────────────────────╖
   Name                          Type   Description
   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   QCALMATH.BAS                        Toolbox
   AbsoluteX#                   Func   Absolute value of a number
   Add#                         Func   Sum of two numbers
   ArcCosine#                   Func   Arc cosine function of a number
   ArcHypCosine#                Func   Inverse hyperbolic cosine of a number
   ArcHypSine#                  Func   Inverse hyperbolic sine of a number
   ArcHypTangent#               Func   Inverse hyperbolic tangent of a
                                        number
   ArcSine#                     Func   Inverse sine of a number
   ArcTangent#                  Func   Inverse tangent of a number
   Ceil#                        Func   Smallest whole number greater than a
                                        number
   ChangeSign#                  Func   Reverses sign of a number
   Cosine#                      Func   Cosine of a number
   Divide#                      Func   Result of dividing two numbers
   Dup                          Sub    Duplicates top entry on the stack
   Exponential#                 Func   Exponential function of a number
   FractionalPart#              Func   Fractional part of a number
   HypCosine#                   Func   Hyperbolic cosine of a number
   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
  HypCosine#                   Func   Hyperbolic cosine of a number
   HypSine#                     Func   Hyperbolic sine of a number
   HypTangent#                  Func   Hyperbolic tangent of a number
   IntegerPart#                 Func   Integer part of a number
   LogBase10#                   Func   Log base 10 of a number
   LogBaseN#                    Func   Log base N of a number
   LogE#                        Func   Natural logarithm of a number
   Modulus#                     Func   Remainder of the division of two
                                        numbers
   Multiply#                    Func   Product of two numbers
   OneOverX#                    Func   Result of dividing 1 by a number
   Sign#                        Func   Sign of a number
   Sine#                        Func   Sine of a number
   SquareRoot#                  Func   Square root of a number
   Subtract#                    Func   Difference between two numbers
   SwapXY                       Sub    Swaps top two entries on the stack
   Tangent#                     Func   Tangent of a number
   Xsquared#                    Func   Square of a number
   YRaisedToX#                  Func   Number raised to the power of a
   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
  YRaisedToX#                  Func   Number raised to the power of a
                                        second
   ──────────────────────────────────────────────────────────────────────────



 Toolbox: QCALMATH

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          QCALMATH                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Collection of math functions and subprograms for
     ' the QCAL program.
     '
     ' USAGE:         (loaded by the QCAL program)
     '.MAK FILE:      (none)
     ' PARAMETERS:    (none)
     ' VARIABLES:     (none)
     ' Constants
       CONST PI = 3.141592653589793#
       CONST L10 = 2.302585092994046#

     ' Functions
       DECLARE FUNCTION AbsoluteX# (x#)
       DECLARE FUNCTION Add# (y#, x#)
       DECLARE FUNCTION ArcCosine# (x#)
       DECLARE FUNCTION ArcHypCosine# (x#)
       DECLARE FUNCTION ArcHypSine# (x#)
       DECLARE FUNCTION ArcHypTangent# (x#)
       DECLARE FUNCTION ArcSine# (x#)
       DECLARE FUNCTION ArcTangent# (x#)
       DECLARE FUNCTION Ceil# (x#)
       DECLARE FUNCTION ChangeSign# (x#)
       DECLARE FUNCTION Cosine# (x#)
       DECLARE FUNCTION Divide# (y#, x#)
       DECLARE FUNCTION Exponential# (x#)
       DECLARE FUNCTION FractionalPart# (x#)
       DECLARE FUNCTION HypCosine# (x#)
       DECLARE FUNCTION HypSine# (x#)
       DECLARE FUNCTION HypTangent# (x#)
       DECLARE FUNCTION IntegerPart# (x#)
       DECLARE FUNCTION LogBase10# (x#)
       DECLARE FUNCTION LogBaseN# (y#, x#)
       DECLARE FUNCTION LogE# (x#)
       DECLARE FUNCTION Modulus# (y#, x#)
       DECLARE FUNCTION Multiply# (y#, x#)
       DECLARE FUNCTION OneOverX# (x#)
       DECLARE FUNCTION Sign# (x#)
       DECLARE FUNCTION Sine# (x#)
       DECLARE FUNCTION SquareRoot# (x#)
       DECLARE FUNCTION Subtract# (y#, x#)
       DECLARE FUNCTION Tangent# (x#)
       DECLARE FUNCTION Xsquared# (x#)
       DECLARE FUNCTION YRaisedToX# (y#, x#)
   ──────────────────────────────────────────────────────────────────────────


 Function: AbsoluteX#

   Returns the absolute value of the passed value. The absolute value of a
   number is that number's positive value.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          AbsoluteX#                 **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = AbsoluteX#(x#)
     ' PARAMETERS:      x#         Double-precision value to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION AbsoluteX# (x#)
     '
       FUNCTION AbsoluteX# (x#) STATIC
           AbsoluteX# = ABS(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Add#

   Returns the sum of two double-precision numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Add#                       **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  z# = Add#(y#, x#)
     ' PARAMETERS:      y#         First number
     '                  x#         Second number
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Add# (y#, x#)
     '
       FUNCTION Add# (y#, x#) STATIC
           Add# = y# + x#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ArcCosine#

   Returns the arc cosine of a number; the returned angle is expressed in
   radians. If the number passed is less than 1, an error message is
   displayed, and the program terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ArcCosine#                 **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = ArcCosine#(x#)
     ' PARAMETERS:      x#         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ArcCosine# (x#)
     '
       FUNCTION ArcCosine# (x#) STATIC
           x2# = x# * x#
           IF x2# < 1# THEN
               ArcCosine# = PI / 2# - ATN(x# / SQR(1# - x# * x#))
           ELSE
               PRINT "Error: ACS(x#) where x# < 1"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ArcHypCosine#

   Returns the inverse hyperbolic cosine of a number. If the number passed is
   less than or equal to 1, an error message is displayed, and the program
   terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ArcHypCosine#              **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = ArcHypCosine#(x#)
     ' PARAMETERS:      x#         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ArcHypCosine# (x#)
     '
       FUNCTION ArcHypCosine# (x#) STATIC
           IF ABS(x#) > 1# THEN
               ArcHypCosine# = LOG(x# + SQR(x# * x# - 1#))
           ELSE
               PRINT "Error: AHS(x#) where -1 <= x# <= +1"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ArcHypSine#

   Returns the inverse hyperbolic sine of a number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ArcHypSine#                **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = ArcHypSine#(x#)
     ' PARAMETERS:      x#    Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION AryHypSine# (x#)
     '
       FUNCTION ArcHypSine# (x#) STATIC
           ArcHypSine# = LOG(x# + SQR(1# + x# * x#))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ArcHypTangent#

   Returns the inverse hyperbolic tangent of a number. If the number passed
   is less than -1 or greater than 1, an error message is displayed, and the
   program terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ArcHypTangent#             **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = ArcHypTangent#(x#)
     ' PARAMETERS:      x#         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ArcHypTangent# (x#)
     '
       FUNCTION ArcHypTangent# (x#) STATIC
           IF ABS(x#) < 1 THEN
               ArcHypTangent# = LOG((1# + x#) / (1# - x#)) / 2#
           ELSE
               PRINT "Error: AHT(x#) where x# <= -1 or x# >= +1"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ArcSine#

   Returns the inverse sine of a number. If the number passed is greater than
   or equal to 1, the function displays an error message, and the program
   terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ArcSine#                   **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = ArcSine#(x#)
     ' PARAMETERS:      x#         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ArcSine# (x#)
     '
       FUNCTION ArcSine# (x#) STATIC
           x2# = x# * x#
           IF x2# < 1# THEN
               ArcSine# = ATN(x# / SQR(1# - x# * x#))
           ELSE
               PRINT "Error: ASN(x#) where x# >= 1"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ArcTangent#

   Returns the inverse tangent of a number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ArcTangent#                **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = ArcTangent#(x#)
     ' PARAMETERS:      x#         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ArcTangent# (x#)
     '
       FUNCTION ArcTangent# (x#) STATIC
           ArcTangent# = ATN(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Ceil#

   Returns the smallest whole number that is greater than a number. For
   example, Ceil#(3.14) returns 4, Ceil#(-3.14) returns -3, and Ceil#(17)
   returns 17.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Ceil#                      **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Ceil#(x#)
     ' PARAMETERS:      x#         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Ceil# (x#)
     '
       FUNCTION Ceil# (x#) STATIC
           Ceil# = -INT(-x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ChangeSign#

   Returns a number with its sign changed. This function could easily be
   deleted from QCAL by changing the Process subprogram so that it directly
   performs negation in the CASE statement in which the CHS command is acted
   upon. I decided to provide a consistent interface between the functions in
   the QCALMATH module and the Process subprogram, however, making it
   easier to add, delete, or modify functions as desired.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ChangeSign#                **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = ChangeSign#(x#)
     ' PARAMETERS:      x#         Number to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ChangeSign# (x#)
     '
       FUNCTION ChangeSign# (x#) STATIC
           ChangeSign# = -x#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Cosine#

   Returns the cosine of an angle.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Cosine#                    **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Cosine#(x#)
     ' PARAMETERS:      x#         Angle to be evaluated
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Cosine# (x#)
     '
       FUNCTION Cosine# (x#) STATIC
           Cosine# = COS(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Divide#

   Returns the result of dividing two numbers. If a division by 0 is
   attempted, the function displays an error message, and the program
   terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Divide#                    **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Divide#(y#, x#)
     ' PARAMETERS:      y#         Number to be processed
     '                  x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Divide# (y#, x#)
     '
       FUNCTION Divide# (y#, x#) STATIC
           IF x# <> 0 THEN
               Divide# = y# / x#
           ELSE
               PRINT "Error: Division by zero"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Dup

   Duplicates the top entry on the stack for the QCAL program.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Dup                        **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  Dup stack#(), ptr%
     ' PARAMETERS:      stack#()   Numeric stack
     '                  ptr%       Index to last entry on stack
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Dup (Stack#(), ptr%)
     '
       SUB Dup (stack#(), ptr%) STATIC
           IF ptr% THEN
               ptr% = ptr% + 1
               stack#(ptr%) = stack#(ptr% - 1)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: Exponential#

   Returns the exponential function of a number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Exponential#               **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Exponential#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Exponential# (x#)
     '
       FUNCTION Exponential# (x#) STATIC
           Exponential# = EXP(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: FractionalPart#

   Returns the fractional part of a number. For example, the fractional part
   of 3.14 is .14, of -3.14 is -.14, and of 17 is 0.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FractionalPart#            **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = FractionalPart#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION FractionalPart# (x#)
     '
       FUNCTION FractionalPart# (x#) STATIC
           IF x# >= 0 THEN
               FractionalPart# = x# - INT(x#)
           ELSE
               FractionalPart# = x# - INT(x#) - 1#
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: HypCosine#

   Returns the hyperbolic cosine of a number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          HypCosine#                 **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = HypCosine#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION HypCosine# (x#)
     '
       FUNCTION HypCosine# (x#) STATIC
           HypCosine# = (EXP(x#) + EXP(-x#)) / 2#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: HypSine#

   Returns the hyperbolic sine of a number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          HypSine#                   **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = HypSine#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION HypSine# (x#)
     '
       FUNCTION HypSine# (x#) STATIC
           HypSine# = (EXP(x#) - EXP(-x#)) / 2#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: HypTangent#

   Returns the hyperbolic tangent of a number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          HypTangent#                **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = HypTangent#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION HypTangent# (x#)
     '
       FUNCTION HypTangent# (x#) STATIC
           HypTangent# = (EXP(x#) - EXP(-x#)) / (EXP(x#) + EXP(-x#))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: IntegerPart#

   Returns the integer part of a number. For example, the integer part of
   3.14 is 3, of -3.14 is -4, and of 17 is 17.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          IntegerPart#               **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = IntegerPart#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION IntegerPart# (x#)
     '
       FUNCTION IntegerPart# (x#) STATIC
           IntegerPart# = INT(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: LogBase10#

   Returns the logarithm, base 10, of a number. If the number is not greater
   than 0, the function displays an error message, and the program
   terminates.

   Look in the listing at the constant L10, defined in the module-level code
   of QCALMATH. This constant is the double-precision natural logarithm of
   10. The constant can be replaced with LOG(10), its mathematic equivalent,
   but using a constant makes the program faster and the compiled program
   shorter.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          LogBase10#                 **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Log10#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION LogBase10# (x#)
     '
       FUNCTION LogBase10# (x#) STATIC
           IF x# > 0 THEN
               LogBase10# = LOG(x#) / L10
           ELSE
               PRINT "Error: LOG10(x#) where x# <= 0"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: LogBaseN#

   Returns the logarithm, base N, of a number. This function checks for
   several possible error conditions. The number to be processed must be
   greater than 0, and the base for finding the logarithm must be greater
   than 0 and must not be exactly 1. If one of these checks fails, a message
   is displayed, and the program terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          LogBaseN#                  **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = LogBaseN#(y#, x#)
     ' PARAMETERS:      y#         Number to be processed
     '                  x#         The base for finding the logarithm
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION LogBaseN# (y#, x#)
     '
       FUNCTION LogBaseN# (y#, x#) STATIC
           IF x# <= 0 THEN
               PRINT "Error: LOGN(y#, x#) where x# <= 0"
               SYSTEM
           ELSEIF x# = 1# THEN
               PRINT "Error: LOGN(y#, x#) where x# = 1"
               SYSTEM
           ELSEIF y# <= 0 THEN
               PRINT "Error: LOGN(y#, x#) where y# is <= 0"
               SYSTEM
           ELSE
               LogBaseN# = LOG(y#) / LOG(x#)
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: LogE#

   Returns the natural logarithm of a number. The QuickBASIC function LOG()
   is used to calculate the logarithm, but this function first checks that
   the number is greater than 0. If the number is equal to or less than 0, an
   error message is displayed, and the program terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          LogE#                      **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = LogE#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION LogE# (x#)
     '
       FUNCTION LogE# (x#) STATIC
           IF x# > 0 THEN
               LogE# = LOG(x#)
           ELSE
               PRINT "Error: LOGE(x#) where x# <= 0"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Modulus#

   Returns the remainder of the division of two numbers. If a division by 0
   is attempted, the function displays an error message, and the program
   terminates. The function is valid for non-integer quantities.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Modulus#                   **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Modulus#(y#, x#)
     ' PARAMETERS:      y#         Number to be divided
     '                  x#         Number for dividing by
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Modulus# (y#, x#)
     '
       FUNCTION Modulus# (y#, x#) STATIC
           IF x# <> 0 THEN
               Modulus# = y# - INT(y# / x#) * x#
           ELSE
               PRINT "Error: MOD(y#, x#) where x# = 0"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Multiply#

   Returns the product of two numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Multiply#                  **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Multiply#(y#, x#)
     ' PARAMETERS:      y#         First number to be processed
     '                  x#         Second number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Multiply# (y#, x#)
     '
       FUNCTION Multiply# (y#, x#) STATIC
           Multiply# = y# * x#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: OneOverX#

   Returns the result of dividing 1 by a number. If a division by 0 is
   attempted, the function displays an error message, and the program
   terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          OneOverX#                  **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = OneOverX#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION OneOverX# (x#)
     '
       FUNCTION OneOverX# (x#) STATIC
           IF x# <> 0 THEN
               OneOverX# = 1# / x#
           ELSE
               PRINT "Error: 1/x where x = 0"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Sign#

   Returns -1 for all negative numbers, 1 for positive numbers, and 0 for
   zero.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Sign#                      **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Sign#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Sign# (x#)
     '
       FUNCTION Sign# (x#) STATIC
           Sign# = SGN(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Sine#

   Returns the sine of an angle; assumes the angle is expressed in radians.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Sine#                      **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Sine#(x#)
     ' PARAMETERS:      x#         Angle, expressed in radians
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Sine# (x#)
     '
       FUNCTION Sine# (x#) STATIC
           Sine# = SIN(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: SquareRoot#

   Returns the square root of a number. Before the QuickBASIC SQR function is
   used to actually find the square root, the number is checked to be sure it
   isn't negative. If it is, an error message is displayed, and the program
   terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SquareRoot#                **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = SquareRoot#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION SquareRoot# (x#)
     '
       FUNCTION SquareRoot# (x#) STATIC
           IF x# >= 0 THEN
               SquareRoot# = SQR(x#)
           ELSE
               PRINT "Error: SQR(x#) where x# < 0"
               SYSTEM
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Subtract#

   Returns the difference of two numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Subtract#                  **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:   y# = Subtract#(y#, x#)
     ' PARAMETERS:       y#         Number to be processed
     '                   x#         Number to be processed
     ' VARIABLES:        (none)
     ' MODULE LEVEL
     '   DECLARATIONS:   DECLARE FUNCTION Subtract# (y#, x#)
     '
       FUNCTION Subtract# (y#, x#) STATIC
           Subtract# = y# - x#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: SwapXY

   Swaps the top two entries on the stack.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          SwapXY                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  SwapXY stack#(), ptr%
     ' PARAMETERS:      stack#()   Numeric stack
     '                  ptr%       Pointer to top of stack
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB SwapXY (stack#(), ptr%
     '
       SUB SwapXY (stack#(), ptr%) STATIC
           IF ptr% > 1 THEN
               SWAP stack#(ptr%), stack#(ptr% - 1)
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: Tangent#

   Returns the tangent of an angle; assumes the angle is in radians.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Tangent#                   **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Tangent#(x#)
     ' PARAMETERS:      x#         Angle, expressed in radians
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Tangent# (x#)
     '
       FUNCTION Tangent# (x#) STATIC
           Tangent# = TAN(x#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Xsquared#

   Returns the square of a number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Xsquared#                  **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  y# = Xsquared#(x#)
     ' PARAMETERS:      x#         Number to be processed
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Xsquared# (x#)
     '
       FUNCTION Xsquared# (x#) STATIC
           Xsquared# = x# * x#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: YRaisedToX#

   Returns a number raised to the power of a second number.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          YRaisedToX#                **
     ' **  Type:          Function                   **
     ' **  Module:        QCALMATH.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' EXAMPLE OF USE:  z# = YRaisedToX#(y#, x#)
     ' PARAMETERS:      y#         Number to be raised to a power
     '                  x#         Power to raise the other number to
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION YRaisedToX# (y#, x#)
     '
       FUNCTION YRaisedToX# (y#, x#) STATIC
           YRaisedToX# = y# ^ x#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 RANDOMS

   The RANDOMS toolbox provides a collection of random number generators.

   At the heart of these routines are two techniques, which are described in
   The Art of Computer Programming, Vol. 2, Seminumerical Algorithms, by
   Donald Knuth and which are combined to form the method in the Rand&
   function. The Rand& function returns pseudorandom integers in the range 0
   through 999999999. No multiplication or division is used, the algorithm is
   easily translated to any language that supports 32-bit integers, and all
   digits in the returned numbers are equally random. A table-shuffling
   technique further increases the randomness of the sequence.

   Several other functions use the random long integers returned by the
   Rand& function to create other random number distributions. For example,
   the RandReal!(x!, y!) function returns random real numbers in the range x!
   through y!. One common example of this function, RandReal!(0!, 1!),
   returns a pseudorandom, single-precision, floating-point value in the
   range 0 through 1.

   The RandShuffle subprogram and the RandInteger% function are used by
   CIPHER to generate a repeatable but secure sequence of random byte values
   in the range 0 through 255. See the CIPHER program for more information
   on using this file-ciphering technique.

   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   RANDOMS.BAS                          Demo module
   Rand&                        Func   Long integers
   RandExponential!             Func   Real value with exponential
                                        distribution from mean
   RandFrac!                    Func   Single-precision positive value < 1.0
   RandInteger%                 Func   Integers within desired range
   RandNormal!                  Func   Single-precision value from mean
                                        and standard deviation
   RandReal!                    Func   Single-precision value in desired
                                        range
   RandShuffle                  Sub    Initializes random number generator
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: RANDOMS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RANDOMS                    **
     ' **  Type:          Toolbox                    **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       i%      Loop index for generating pseudorandom numbers

       DECLARE FUNCTION Rand& ()
       DECLARE FUNCTION RandExponential! (mean!)
       DECLARE FUNCTION RandFrac! ()
       DECLARE FUNCTION RandInteger% (a%, b%)
       DECLARE FUNCTION RandNormal! (mean!, stddev!)
       DECLARE FUNCTION RandReal! (x!, y!)

       DECLARE SUB RandShuffle (key$)

     ' Array of long integers for generating all randoms
       DIM SHARED r&(1 TO 100)

     ' Clear the screen
       CLS

     ' Shuffle the random number generator, creating a
     ' unique sequence for every possible second
       RandShuffle DATE$ + TIME$

       PRINT "Rand&"
       FOR i% = 1 TO 5
           PRINT Rand&,
       NEXT i%
       PRINT

       PRINT "RandInteger%(0, 9)"
       FOR i% = 1 TO 5
           PRINT RandInteger%(0, 9),
       NEXT i%
       PRINT

       PRINT "RandReal!(-10!, 10!)"
       FOR i% = 1 TO 5
           PRINT RandReal!(-10!, 10!),
       NEXT i%
       PRINT

       PRINT "RandExponential!(100!)"
       FOR i% = 1 TO 5
           PRINT RandExponential!(100!),
       NEXT i%
       PRINT

       PRINT "RandNormal!(100!, 10!)"
       FOR i% = 1 TO 5
           PRINT RandNormal!(100!, 10!),
       NEXT i%
       PRINT

       PRINT "RandFrac!"
       FOR i% = 1 TO 5
           PRINT RandFrac!,
       NEXT i%
       PRINT
   ──────────────────────────────────────────────────────────────────────────


 Function: Rand&

   Returns a pseudorandom long integer in the range 0 through 999999999,
   inclusive. Using the Rand& function provides you several advantages: It is
   fast because a minimal number of mathematical manipulations are performed;
   the sequence length is long, much greater than 2^55; and all digits in the
   returned random integer are equally random.

   The array of long integers, r&(1 TO 100), is shared by this function and
   the RandShuffle subprogram. This array contains a table of 55 random
   integers, a table of 42 values for shuffling the order of the random
   numbers upon output, two index pointers into the first 55 values, and the
   last generated random integer.

   You must call the RandShuffle subprogram once before you use the Rand&
   function. This initializes the tables and presets the two index numbers
   used to access table entries. If you don't call RandShuffle

   first, the Rand& function stops, you receive a Subscript out of range
   error message, and the program halts.

   Here's how Rand& works. The index numbers stored in r&(98) and r&(99) are
   always in the range 1 through 55 and are used to access two numbers stored
   in the first 55 entries of r&(). The first of these values is subtracted
   from the second, and if the result is less than zero, 1000000000 is added
   to bring the result somewhere into the range 0 through 999999999. This
   result replaces the number at the first location accessed. Finally, the
   two index numbers are decremented by 1, adjusted if necessary so that they
   remain in the range 1 through 55, and stored back in r&(98) and r&(99) for
   the next call to this routine.

   This table subtraction algorithm results in a good-quality random long
   integer, but an additional technique is used within Rand& to generate a
   significantly more random sequence of numbers. The generated number is
   used to point to one of the 42 entries in the locations r&(56) through
   r&(97). The previously generated number stored at that location is
   extracted, saved in r&(100), and replaced with the number just generated.
   Finally, the value saved in r&(100) is returned as the result. This
   randomly shuffles the order of the output values and effectively
   obliterates any subtle patterns that the sequence might have.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Rand&                      **
     ' **  Type:          Function                   **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a pseudorandom long integer in the range
     ' 0 through 999999999.
     '
     ' EXAMPLE OF USE:  n& = Rand&
     ' PARAMETERS:      (none)
     ' VARIABLES:       i%         First index into random number table
     '                  j%         Second index into random number table
     '                  t&         Working variable
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Rand& ()
     '                  DIM SHARED r&(1 TO 100)
     '
       FUNCTION Rand& STATIC

         ' Get the pointers into the table
           i% = r&(98)
           j% = r&(99)

         ' Subtract the two table values
           t& = r&(i%) - r&(j%)

         ' Adjust result if less than zero
           IF t& < 0 THEN
               t& = t& + 1000000000
           END IF

         ' Replace table entry with new random number
           r&(i%) = t&

         ' Decrement first index, keeping in range 1 through 55
           IF i% > 1 THEN
               r&(98) = i% - 1
           ELSE
               r&(98) = 55
           END IF

         ' Decrement second index, keeping in range 1 through 55
           IF j% > 1 THEN
               r&(99) = j% - 1
           ELSE
               r&(99) = 55
           END IF

         ' Use last random number to index into shuffle table
           i% = r&(100) MOD 42 + 56

         ' Grab random from table as current random number
           r&(100) = r&(i%)

         ' Put new calculated random into table
           r&(i%) = t&

         ' Return the random number grabbed from the table
           Rand& = r&(100)

       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: RandExponential!

   Returns a pseudorandom real value with an exponential distribution, which
   is defined by the passed value of the mean.

   Be sure to call the RandShuffle subprogram before using this function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RandExponential!           **
     ' **  Type:          Function                   **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns an exponentially distributed pseudorandom,
     ' single-precision number given the mean of the
     ' distribution.
     '
     ' EXAMPLE OF USE:  x! = RandExponential!(mean!)
     ' PARAMETERS:      mean!   The mean of the exponential distribution
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION RandExponential! (mean!)
     '
       FUNCTION RandExponential! (mean!) STATIC
           RandExponential! = -mean! * LOG(RandFrac!)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: RandFrac!

   Returns a pseudorandom real value in the range 0 through 1. This function
   is similar to the QuickBASIC function RND, but has a much longer sequence
   and a more random distribution.

   Be sure to call the RandShuffle subprogram before using this function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RandFrac!                  **
     ' **  Type:          Function                   **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a pseudorandom, single-precision number
     ' in the range 0 through 1.
     '
     ' EXAMPLE OF USE:  x! = RandFrac!
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION RandFrac! ()
     '
       FUNCTION RandFrac! STATIC
           RandFrac! = Rand& / 1E+09
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: RandInteger%

   Returns a pseudorandom integer in the range a% through b%, inclusive. For
   example, RandInteger%(0, 9) returns a random digit from 0 through 9.

   The passed value of a% must be less than b%; if it is not, this function
   generates incorrect random numbers. These parameters must be in the legal
   range of 16-bit signed integers, not less than -32768 nor greater than
   32767.

   Be sure to call the RandShuffle subprogram before using this function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RandInteger%               **
     ' **  Type:          Function                   **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a pseudorandom integer in the range
     ' a% to b% inclusive.
     '
     ' EXAMPLE OF USE:  n% = RandInteger%(a%, b%)
     ' PARAMETERS:      a%    Minimum value for returned integer
     '                  b%    Maximum value for returned integer
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION RandInteger% (a%, b%)
     '
       FUNCTION RandInteger% (a%, b%) STATIC
           RandInteger% = a% + (Rand& MOD (b% - a% + 1))
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: RandNormal!

   Returns pseudorandom real values with a normal distribution, which is
   defined by the passed mean and standard deviation.

   Be sure to call the RandShuffle subprogram before using this function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RandNormal!                **
     ' **  Type:          Function                   **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a normally distributed single-precision,
     ' pseudorandom number given the mean and standard deviation.
     '
     ' EXAMPLE OF USE:  x! = RandNormal!(mean!, stddev!)
     ' PARAMETERS:      mean!    Mean of the distribution of returned
     '                           values
     '                  stddev!  Standard deviation of the distribution
     ' VARIABLES:       u1!      Pseudorandom positive real value
     '                           less than 1
     '                  u2!      Pseudorandom positive real value
     '                           less than 1
     '                  x!       Working value
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION RandNormal! (mean!, stddev!)
     '
       FUNCTION RandNormal! (mean!, stddev!) STATIC
           u1! = RandFrac!
           u2! = RandFrac!
           x! = SQR(-2! * LOG(u1!)) * COS(6.283185 * u2)
           RandNormal! = mean! + stddev! * x!
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: RandReal!

   Returns a pseudorandom real value in the range x! through y! For example,
   RandReal!(-10!, 10!) returns a floating-point, single-precision value in
   the range -10 through +10.

   Be sure to call the RandShuffle subprogram before using this function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RandReal!                  **
     ' **  Type:          Function                   **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a pseudorandom, single-precision real
     ' number in the range x! to y!.
     ' EXAMPLE OF USE:  z! = RandReal!(x!, y!)
     ' PARAMETERS:      x!    Minimum for returned value
     '                  y!    Maximum for returned value
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION RandReal! (x!, y!)
     '
       FUNCTION RandReal! (x!, y!) STATIC
           RandReal! = x! + (y! - x!) * (Rand& / 1E+09)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: RandShuffle

   Initializes the sequence of random numbers that the Rand& function
   returns. The r&() array contains all the values necessary for the Rand&
   function. This subprogram initializes all values in r&() based on the
   characters passed in key$. Refer to the Rand& function for a description
   of the contents of the shared array r&().

   The passed string key$ is first modified to a length of 97 characters.
   Notice that an arbitrary string (in this subprogram, Abra Ca Da Bra) is
   concatenated to the front end of key$. Any string can be used, but at
   least one character must have an odd byte number. This guarantees that at
   least one initial table entry will be odd, a necessity of this
   random-number-generation algorithm.

   Each character of the new key string (k$) is used to generate a
   pseudorandom long integer to be entered in the first 97 entries of r&().
   To "warm up" the sequence, 997 iterations of the Rand& algorithm, slightly
   modified, are performed on the table.

   Finally, starting values for the index values necessary for the Rand&
   function are stored in r&(98) and r&(99), and an initial value for the
   last generated number is stored in r&(100).

   All the other random number generators in this toolbox call the Rand&
   function, which generates an error and quits if RandShuffle isn't run
   first to initialize r&(). Therefore, you must be sure to call RandShuffle
   once during a program run before calling any of these functions.

   To generate the same sequence every time the program is run, pass the same
   key$ each time. To generate a unique sequence each time, pass a unique
   string. For example, to generate a unique sequence for every clock tick of
   your computer's existence, you could enter RandShuffle(DATE$ + TIME$ +
   STR$(TIMER)).

   The key$ can be any reasonable length, but only the first 83 characters
   are used to seed the generator. Because there are 256 possible characters
   for each of the 83, there are 256^83 possible unique sequences. It's safe
   to say you'll never run out!

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RandShuffle                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        RANDOMS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Creates original table of pseudorandom long integers
     ' for use by the function Rand&.  The contents of key$
     ' are used to seed the table.
     '
     ' EXAMPLE OF USE:  RandShuffle(key$)
     ' PARAMETERS:      key$            String used to seed the generator
     '          r&(1 TO 100) (shared)   Array of long integers for
     '                                  generating pseudorandom numbers
     ' VARIABLES:       k$              Modified key string
     '                  i%              Index into k$, index into table
     '                  j%              Index into table
     '                  k%              Loop count for warming up generator
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB RandShuffle (key$)
     '
       SUB RandShuffle (key$) STATIC

         ' Form 97-character string, with key$ as part of it
           k$ = LEFT$("Abra Ca Da Bra" + key$ + SPACE$(83), 97)

         ' Use each character to seed table
           FOR i% = 1 TO 97
               r&(i%) = ASC(MID$(k$, i%, 1)) * 8171717 + i% * 997&
           NEXT i%

         ' Preserve string space
           k$ = ""

         ' Initialize pointers into table
           i% = 97
           j% = 12

         ' Randomize the table to get it warmed up
           FOR k% = 1 TO 997

             ' Subtract entries pointed to by i% and j%
               r&(i%) = r&(i%) - r&(j%)

             ' Adjust result if less than zero
               IF r&(i%) < 0 THEN
                   r&(i%) = r&(i%) + 1000000000
               END IF

             ' Decrement first index, keeping in range of 1 through 97
               IF i% > 1 THEN
                   i% = i% - 1
               ELSE
                   i% = 97
               END IF

             ' Decrement second index, keeping in range of 1 through 97
               IF j% > 1 THEN
                   j% = j% - 1
               ELSE
                   j% = 97
               END IF

           NEXT k%

         ' Initialize pointers for use by Rand& function
           r&(98) = 55
           r&(99) = 24

         ' Initialize pointer for shuffle table lookup by Rand& function
           r&(100) = 77

       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 STDOUT

   The STDOUT toolbox is a collection of subprograms for outputting
   characters through the MS-DOS standard output channel rather than through
   the QuickBASIC PRINT statement.

   QuickBASIC bypasses the ANSI.SYS driver. However, some nice features are
   built into this driver, and this toolbox lets you access them from
   QuickBASIC. For example, the AssignKey subprogram lets you redefine keys
   on the keyboard to any character or string of characters you want.

   Be sure you load the ANSI.SYS driver before trying this program. Several
   of the escape code sequences create meaningless output if the ANSI.SYS
   driver is not resident. In most cases, a statement similar to the
   following in your CONFIG.SYS file will load the ANSI.SYS driver at boot-up
   time:


     DEVICE = \DOS\ANSI.SYS

   When you run the STDOUT demo module, pay close attention to the prompts
   that appear. In one case you are prompted to press the "a" and "b" keys,
   immediately before the program exits to MS-DOS via the SHELL statement. Be
   sure you press "a" and then "b" to prevent the program from getting lost.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   STDOUT.BAS                      Demo module
   AssignKey               Sub     Reassigns a string to a key
   Attribute               Sub     Sets screen color (ANSI driver
                                    definition)
   ClearLine               Sub     Clears current line from cursor to end of
                                    line
   ClearScreen             Sub     Clears screen
   CrLf                    Sub     Sends carriage return and line feed
   CursorDown              Sub     Moves cursor down specified number of
                                    lines
   CursorHome              Sub     Moves cursor to upper left corner of
                                    screen
   CursorLeft              Sub     Moves cursor left specified number of
                                    spaces
   CursorPosition          Sub     Moves cursor to specified row and column
   CursorRight             Sub     Moves cursor right specified number of
                                    spaces
   CursorUp                Sub     Moves cursor up specified number of lines
   StdOut                  Sub     Sends a string to standard output channel
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: STDOUT

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          STDOUT                     **
     ' **  Type:          Toolbox                    **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:            No command line parameters
     ' REQUIREMENTS:     MIXED.QLB/.LIB
     '                   ANSI.SYS
     ' .MAK FILE:        (none)
     ' PARAMETERS:       (none)
     ' VARIABLES:        t0         Timer variable
     '                   bell$      ASCII character 7 (bell)

     ' Attribute definitions
       CONST NORMAL = 0
       CONST BRIGHT = 1
       CONST UNDERSCORE = 4
       CONST BLINK = 5
       CONST REVERSE = 7
       CONST INVISIBLE = 8
       CONST BLACKFOREGROUND = 30
       CONST REDFOREGROUND = 31
       CONST GREENFOREGROUND = 32
       CONST YELLOWFOREGROUND = 33
       CONST BLUEFOREGROUND = 34
       CONST MAGENTAFOREGROUND = 35
       CONST CYANFOREGROUND = 36
       CONST WHITEFOREGROUND = 37
       CONST BLACKBACKGROUND = 40
       CONST REDBACKGROUND = 41
       CONST GREENBACKGROUND = 42
       CONST YELLOWBACKGROUND = 43
       CONST BLUEBACKGROUND = 44
       CONST MAGENTABACKGROUND = 45
       CONST CYANBACKGROUND = 46
       CONST WHITEBACKGROUND = 47

       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

     ' Subprograms
       DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX)
       DECLARE SUB ClearLine ()
       DECLARE SUB ClearScreen ()
       DECLARE SUB StdOut (a$)
       DECLARE SUB CrLf ()
       DECLARE SUB CursorPosition (row%, col%)
       DECLARE SUB CursorDown (n%)
       DECLARE SUB CursorLeft (n%)
       DECLARE SUB CursorRight (n%)
       DECLARE SUB CursorUp (n%)
       DECLARE SUB AssignKey (keyCode%, assign$)
       DECLARE SUB Attribute (attr%)

     ' Demonstrate the ClearLine and ClearScreen routines
       CLS
       PRINT "This will be erased quickly, in two steps..."
       t0 = TIMER
       DO
       LOOP UNTIL TIMER - t0 > 2
       LOCATE 1, 27
       ClearLine
       t0 = TIMER
       DO
       LOOP UNTIL TIMER - t0 > 2
       LOCATE 15, 1
       ClearScreen

     ' Demonstrate the StdOut routine
       bell$ = CHR$(7)
       StdOut "Sending a 'Bell' to StdOut" + bell$
       CrLf

     ' Set cursor position
       CursorPosition 3, 20
       StdOut "* CursorPosition 3, 20"
       CrLf

     ' Move the cursor around the screen
       StdOut "Cursor movements..."
       CrLf
       CursorDown 1
       StdOut "Down 1"
       CursorRight 12
       StdOut "Right 12"
       CursorDown 2
       StdOut "Down 2"
       CursorLeft 99
       StdOut "Left 99"
       CrLf

     ' Character attributes
       CrLf
       Attribute YELLOWFOREGROUND
       Attribute BRIGHT
       Attribute BLUEBACKGROUND
       StdOut "Bright yellow on blue"
       CrLf
       Attribute NORMAL
       StdOut "Back to normal attributes"
       CrLf
     '
     ' Key reassignment
       AssignKey 97, "REM The 'a' and 'b' keys have been redefined" + CHR$(13)
       AssignKey 98, "EXIT" + CHR$(13)
       CursorDown 1
       Attribute BRIGHT
       Attribute YELLOWFOREGROUND
       StdOut "NOTE:"
       CrLf
       StdOut "Press the 'a' key and then the 'b' key ... "
       CrLf
       StdOut "The program will then continue ........ "
       Attribute NORMAL
       CrLf
       SHELL
       AssignKey 97, ""
       AssignKey 98, ""
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: AssignKey

   Assigns a string to any key on the keyboard. The first parameter is the
   key code number returned by the ASC(INKEY$) statement for a given key
   press. The second parameter is a string of characters assigned to the
   indicated key. The string can be a maximum of 63 characters in length. If
   the string is null, the original key definition is returned to the key.

   One complication arises if the key normally returns an extended key code.
   Recall that such keys return CHR$(0), followed by a second character that
   identifies the key. The AssignKey subprogram recognizes negative key
   numbers as extended key codes. Pass the negative of the second byte of an
   extended key code to indicate the key.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          AssignKey                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Assigns a string to any key using ANSI.SYS driver.
     '
     ' EXAMPLE OF USE:  AssignKey keyCode%, assign$
     ' PARAMETERS:      keyCode%   ASCII number for key to be reassigned
     '                  assign$    String to assign to key
     ' VARIABLES:       k$         Command string for ANSI.SYS driver
     '                  i%         Index to each character of assign$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB AssignKey (keyCode%, assign$)
     '
       SUB AssignKey (keyCode%, assign$) STATIC
           IF keyCode% <= 0 THEN
               k$ = "[0;"
           ELSE
               k$ = "["
           END IF
           k$ = k$ + MID$(STR$(keyCode%), 2)
           IF assign$ <> "" THEN
               FOR i% = 1 TO LEN(assign$)
                   k$ = k$ + ";" + MID$(STR$(ASC(MID$(assign$, i%))), 2)
               NEXT i%
           END IF
           StdOut CHR$(27) + k$ + "p"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Attribute

   Sets screen color attributes as defined by the ANSI.SYS driver.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Attribute                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sets the foreground, background, and other color
     ' attributes.
     '
     ' EXAMPLE OF USE:  Attribute attr%
     ' PARAMETERS:      attr%      Number for attribute to be set
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB StdOut (a$)
     '                  DECLARE SUB Attribute (attr%)
     '
       SUB Attribute (attr%) STATIC
           StdOut CHR$(27) + "[" + MID$(STR$(attr%), 2) + "m"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ClearLine

   Sends to standard output the ANSI.SYS escape-code sequence that erases the
   current line from the cursor to the end of the line. The current cursor
   position is maintained.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ClearLine                  **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Clears the display line from the current cursor
     ' position to the end of the line.
     '
     ' EXAMPLE OF USE:  ClearLine
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB ClearLine ()
     '                  DECLARE SUB StdOut (a$)
     '
       SUB ClearLine STATIC
           StdOut CHR$(27) + "[K"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: ClearScreen

   Sends to standard output the ANSI.SYS escape-code sequence that clears the
   screen; positions the cursor at the top left of the screen.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ClearScreen                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Clears the screen and moves the cursor to the
     ' home position.
     '
     ' EXAMPLE OF USE:  ClearScreen
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB ClearScreen ()
     '                  DECLARE SUB StdOut (a$)
     '
         SUB ClearScreen STATIC
           StdOut CHR$(27) + "[2J"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: CrLf

   Sends carriage return and line feed to a standard output.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CrLf                       **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Sends line feed and carriage return characters
     ' to standard output.
     '
     ' EXAMPLE OF USE:  CrLf
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB StdOut (a$)
     '                  DECLARE SUB CrLf ()
     '
       SUB CrLf STATIC
           StdOut CHR$(13) + CHR$(10)
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: CursorDown

   Sends to standard output the ANSI.SYS escape-code sequence that moves the
   cursor down the screen n% lines. The cursor stays in the same column and
   stops at the bottom line of the screen.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CursorDown                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Moves the cursor n% lines down the screen.
     '
     ' EXAMPLE OF USE:   CursorDown n%
     ' PARAMETERS:       n%         Number of lines to move the cursor down
     ' VARIABLES:        (none)
     ' MODULE LEVEL
     '   DECLARATIONS:   DECLARE SUB StdOut (a$)
     '                   DECLARE SUB CursorDown (n%)
     '
       SUB CursorDown (n%) STATIC
           StdOut CHR$(27) + "[" + MID$(STR$(n%), 2) + "B"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: CursorHome

   Sends to standard output the ANSI.SYS escape-code sequence that moves the
   cursor to the home position; does not erase the display.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CursorHome                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Moves the cursor to the top left of the
     ' screen.
     '
     ' EXAMPLE OF USE:  CursorHome
     ' PARAMETERS:      (none)
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB CursorHome
     '
       SUB CursorHome STATIC
           StdOut CHR$(27) + "[H"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: CursorLeft

   Sends to standard output the ANSI.SYS escape-code sequence that moves the
   cursor to the left n% columns. The cursor stays in the same row and stops
   at the left column of the screen.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CursorLeft                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Moves the cursor n% columns left on the screen.
     '
     ' EXAMPLE OF USE:  CursorLeft n%
     ' PARAMETERS:      n%      Number of columns to move the cursor left
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB CursorLeft (n%)
     '
       SUB CursorLeft (n%) STATIC
           StdOut CHR$(27) + "[" + MID$(STR$(n%), 2) + "D"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: CursorPosition

   Sends to standard output the ANSI.SYS escape-code sequence that moves the
   cursor to a given row and column.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CursorPosition             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Moves the cursor to the indicated row and column.
     '
     ' EXAMPLE OF USE:  CursorPosition row%, col%
     ' PARAMETERS:      row%       Row to move the cursor to
     '                  col%       Column to move the cursor to
     ' VARIABLES:       row$       String representation of row%
     '                  col$       String representation of col%
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB CursorPosition (row%, col%)
     '
       SUB CursorPosition (row%, col%) STATIC
           row$ = MID$(STR$(row%), 2)
           col$ = MID$(STR$(col%), 2)
           StdOut CHR$(27) + "[" + row$ + ";" + col$ + "H"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: CursorRight

   Sends to standard output the ANSI.SYS escape-code sequence that moves the
   cursor to the right n% columns. The cursor stays in the same row and stops
   at the right column of the screen.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CursorRight                **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Moves the cursor n% columns right on the screen.
     '
     ' EXAMPLE OF USE:  CursorRight n%
     ' PARAMETERS:      n%     Number of columns to move the cursor right
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB CursorRight (n%)
     '
       SUB CursorRight (n%) STATIC
           StdOut CHR$(27) + "[" + MID$(STR$(n%), 2) + "C"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: CursorUp

   Sends to standard output the ANSI.SYS escape-code sequence that moves the
   cursor up the screen n% lines. The cursor stays in the same column and
   stops at the top line of the screen.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CursorUp                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Moves the cursor n% lines up the screen.
     '
     ' EXAMPLE OF USE:  CursorUp n%
     ' PARAMETERS:      n%         Number of lines to move the cursor up
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB CursorUp (n%)
     '
       SUB CursorUp (n%) STATIC
           StdOut CHR$(27) + "[" + MID$(STR$(n%), 2) + "A"
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: StdOut

   Sends a string of bytes to the standard output device. The string is
   output through the MS-DOS function for string output, bypassing the
   QuickBASIC PRINT statement.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          StdOut                     **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STDOUT.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Writes string to the MS-DOS standard output.
     '
     ' EXAMPLE OF USE:  StdOut a$
     ' PARAMETERS:      a$         String to be output
     ' VARIABLES:       regX       Structure of type RegTypeX
     ' MODULE LEVEL
     '   DECLARATIONS:    DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX,
     '                                          outreg AS RegTypeX)
     '                  DECLARE SUB StdOut (a$)
     '
       SUB StdOut (a$) STATIC
           DIM regX AS RegTypeX
           regX.ax = &H4000
           regX.cx = LEN(a$)
           regX.bx = 1
           regX.ds = VARSEG(a$)
           regX.dx = SADD(a$)
           InterruptX &H21, regX, regX
           IF regX.flags AND 1 THEN
               PRINT "Error while calling StdOut:"; regX.ax
               SYSTEM
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 STRINGS

   The STRINGS toolbox provides several common (and not so common)
   string-manipulation functions and subprograms.

╓┌─┌────────────────────────┌───────┌────────────────────────────────────────╖
   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   STRINGS.BAS                     Demo module
   Ascii2Ebcdic$           Func    Converts string from ASCII to EBCDIC
   BestMatch$              Func    Returns best match to input string
   BuildAEStrings          Sub     Builds ASCII and EBCDIC character
                                    translation tables
   Center$                 Func    Centers string by padding with spaces
   Detab$                  Func    Replaces tab characters with spaces
   Ebcdic2Ascii$           Func    Converts a string from EBCDIC to ASCII
   Entab$                  Func    Replaces spaces with tab characters
   FilterIn$               Func    Retains only specified characters in
                                    string
   FilterOut$              Func    Deletes specified characters from string
   Lpad$                   Func    Returns left-justified input string
   LtrimSet$               Func    Deletes specified characters from left
   Ord%                    Func    Returns byte number for ANSI mnemonic
   Repeat$                 Func    Combines multiple copies into one string
   Replace$                Func    Replaces specified characters in string
   Reverse$                Func    Reverses order of characters in a string
   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
  Reverse$                Func    Reverses order of characters in a string
   ReverseCase$            Func    Reverses case for each character in a
                                    string
   Rpad$                   Func    Returns right-justified input string
   RtrimSet$               Func    Deletes specified characters from right
   Translate$              Func    Exchanges characters in string from table
   ──────────────────────────────────────────────────────────────────────────



 Demo Module: STRINGS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          STRINGS                    **
     ' **  Type:          Toolbox                    **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     ' USAGE:           No command line parameters
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       a$       Working string for demonstrations
     '                  b$       Working string for demonstrations
     '                  c$       Working string for demonstrations
     '                  x$       Working string for demonstrations
     '                  y$       Working string for demonstrations
     '                  set$     Set of characters that define word separation

       DECLARE FUNCTION Ascii2Ebcdic$ (a$)
       DECLARE FUNCTION BestMatch$ (a$, x$, y$)
       DECLARE FUNCTION Center$ (a$, n%)
       DECLARE FUNCTION Detab$ (a$, tabs%)
       DECLARE FUNCTION Ebcdic2Ascii$ (e$)
       DECLARE FUNCTION Entab$ (a$, tabs%)
       DECLARE FUNCTION FilterIn$ (a$, set$)
       DECLARE FUNCTION FilterOut$ (a$, set$)
       DECLARE FUNCTION Lpad$ (a$, n%)
       DECLARE FUNCTION LtrimSet$ (a$, set$)
       DECLARE FUNCTION Ord% (a$)
       DECLARE FUNCTION Repeat$ (a$, n%)
       DECLARE FUNCTION Replace$ (a$, find$, substitute$)
       DECLARE FUNCTION Reverse$ (a$)
       DECLARE FUNCTION ReverseCase$ (a$)
       DECLARE FUNCTION Rpad$ (a$, n%)
       DECLARE FUNCTION RtrimSet$ (a$, set$)
       DECLARE FUNCTION Translate$ (a$, f$, t$)

     ' Subprograms
       DECLARE SUB BuildAEStrings ()

     ' Quick demonstrations
       CLS
       a$ = "This is a test"
       PRINT "a$", , a$
       PRINT "ReverseCase$(a$)", ReverseCase$(a$)
       PRINT "Reverse$(a$)", , Reverse$(a$)
       PRINT "Repeat$(a$, 3)", Repeat$(a$, 3)
       PRINT

       set$ = "T this"
       PRINT "set$", , set$
       PRINT "LtrimSet$(a$, set$)", LtrimSet$(a$, set$)
       PRINT "RtrimSet$(a$, set$)", RtrimSet$(a$, set$)
       PRINT "FilterOut$(a$, set$)", FilterOut$(a$, set$)
       PRINT "FilterIn$(a$, set$)", FilterIn$(a$, set$)
       PRINT

       a$ = "elephant"
       x$ = "alpha"
       y$ = "omega"
       PRINT "a$", , a$
       PRINT "x$", , x$
       PRINT "y$", , y$
       PRINT "BestMatch$(a$, x$, y$)", BestMatch$(a$, x$, y$)
       PRINT

       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""

       CLS
       a$ = "BEL"
       PRINT "a$", , a$
       PRINT "Ord%(a$)", , Ord%(a$)
       PRINT

       a$ = "This is a test"
       find$ = "s"
       substitute$ = "<s>"
       PRINT "a$", , , a$
       PRINT "find$", , , find$
       PRINT "substitute$", , , substitute$
       PRINT "Replace$(a$, find$, substitute$)", Replace$(a$, find$, substitut
       PRINT

       PRINT "a$", , a$
       PRINT "Lpad$(a$, 40)", , ":"; Lpad$(a$, 40); ":"
       PRINT "Rpad$(a$, 40)", , ":"; Rpad$(a$, 40); ":"
       PRINT "Center$(a$, 40)", ":"; Center$(a$, 40); ":"
       PRINT

       a$ = "a$ character" + STRING$(2, 9) + "count" + CHR$(9) + "is"
       PRINT a$; LEN(a$)
       PRINT "a$ = Detab$(a$, 8)"
       a$ = Detab$(a$, 8)
       PRINT a$; LEN(a$)
       PRINT "a$ = Entab$(a$, 8)"
       a$ = Entab$(a$, 8)
       PRINT a$; LEN(a$)
       PRINT

       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""

       CLS
       a$ = "You know this test string has vowels."
       x$ = "aeiou"
       y$ = "eioua"
       PRINT "a$", , a$
       PRINT "x$", , x$
       PRINT "y$", , y$
       PRINT "Translate$(a$, x$, y$)", Translate$(a$, x$, y$)
       PRINT

       a$ = "This is a test."
       b$ = Ascii2Ebcdic$(a$)
       c$ = Ebcdic2Ascii$(b$)
       PRINT "a$", , a$
       PRINT "b$ = Ascii2Ebcdic$(a$)", b$
       PRINT "c$ = Ebcdic2Ascii$(b$)", c$
       PRINT

       END
   ──────────────────────────────────────────────────────────────────────────


 Function: Ascii2Ebcdic$

   Converts a string of ASCII characters to EBCDIC equivalents.

   Almost all computers use the ASCII character set to define which byte
   represents which character. This standard makes it possible for computers,
   printers, plotters, and other equipment to communicate effectively.
   However, IBM's larger computers have long used the EBCDIC character set,
   an alternative way for computers and peripherals to communicate. If files
   are to be transferred to or from an IBM mainframe, it's necessary to
   translate character bytes between the two methods. This function, along
   with its counterpart Ebcdic2Ascii$, translates strings of characters
   between the ASCII character set and the EBCDIC character set.

   These functions and the BuildAEStrings subprogram share a pair of string
   variables, ascii$ and ebcdic$. The SHARED statement lets these two strings
   be accessed by each of these three routines while remaining invisible and
   unalterable to all other parts of a program.

   The BuildAEStrings subprogram is called only once, to build both the
   ascii$ and ebcdic$ translation strings the first time that the
   Ascii2Ebcdic$ or Ebcdic2Ascii$ function is called. All subsequent calls
   to these functions use these strings immediately, as the contents of the
   strings are preserved between calls.

   Refer to the BuildAEStrings subprogram for more information about how
   these two strings are built. Refer to the Translate$ function for more
   information about the character-by-character translation.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Ascii2Ebcdic$              **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a$ with each character translated from ASCII to EBCDIC.
     '
     ' EXAMPLE OF USE:  e$ = Ascii2Ebcdic$(a$)
     ' PARAMETERS:      a$         String of ASCII characters to be
     '                             converted
     ' VARIABLES:       ebcdic$    Table of translation characters
     '                  ascii$     Table of translation characters
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Ascii2Ebcdic$ (a$)
     '
       FUNCTION Ascii2Ebcdic$ (a$) STATIC
           SHARED ebcdic$, ascii$
           IF ebcdic$ = "" THEN
               BuildAEStrings
           END IF
           Ascii2Ebcdic$ = Translate$(a$, ascii$, ebcdic$)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: BestMatch$

   Compares two strings with a third and returns the string that most closely
   matches the third.

   Everybody's talking "artificial intelligence" these days. Programs capable
   of making decisions based on "fuzzy" facts are already being used for
   voice analysis, pattern matching, and other similar tasks. This function
   provides a way to make an educated guess as to the best pattern match when
   comparing two strings.

   The method of comparison used here scans substrings of the target string
   and checks for occurrences of these substrings in each of the other two
   strings. A score is kept for the number of substring matches found for
   each string. The score is weighted heavier for longer substring matches.
   For example, finding an occurrence of the substring "ABC" is worth 6
   points, while finding separate occurrences of "E," "F," and "G" is worth a
   total of only 3 points.

   When all substrings of the target string have been checked, the points are
   compared for each test string. The highest score wins, and that string is
   returned as the result.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BestMatch$                 **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns either x$ or y$, whichever is a best match to a$.
     '
     ' EXAMPLE OF USE:  b$ = BestMatch$(a$, x$, y$)
     ' PARAMETERS:      a$          The string to be matched
     '                  x$          The first string to compare with a$
     '                  y$          The second string to compare with a$
     ' VARIABLES:       ua$         Uppercase working copy of a$
     '                  ux$         Uppercase working copy of x$
     '                  uy$         Uppercase working copy of y$
     '                  lena%       Length of a$
     '                  i%          Length of substrings of ua$
     '                  j%          Index into ua$
     '                  t$          Substrings of ua$
     '                  xscore%     Accumulated score for substring matches
     '                              found in ux$
     '                  yscore%     Accumulated score for substring matches
     '                              found in uy$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION BestMatch$ (a$, x$, y$)
     '
       FUNCTION BestMatch$ (a$, x$, y$) STATIC
           ua$ = UCASE$(a$)
           ux$ = UCASE$(x$)
           uy$ = UCASE$(y$)
           lena% = LEN(ua$)
           FOR i% = 1 TO lena%
               FOR j% = 1 TO lena% - i% + 1
                   t$ = MID$(ua$, j%, i%)
                   IF INSTR(ux$, t$) THEN
                       xscore% = xscore% + i% + i%
                   END IF
                   IF INSTR(uy$, t$) THEN
                       yscore% = yscore% + i% + i%
                   END IF
               NEXT j%
           NEXT i%
           IF xscore% > yscore% THEN
               BestMatch$ = x$
           ELSE
               BestMatch$ = y$
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: BuildAEStrings

   Initializes the ASCII-EBCDIC translation table strings. This subprogram is
   called once per program run, by either the Ascii2Ebcdic$ or
   Ebcdic2Ascii$ function, when one is called first. Each function checks to
   see whether the shared strings, ascii$ and ebcdic$, are filled in or
   whether they are still null (empty) strings. If they are null, this
   subprogram is called to fill them in before they are used as character
   translation tables.

   The method used to fill in the strings can easily create strings
   containing any binary bytes. First, ebcdic$ is created as a string of
   hexadecimal characters, each pair of which represents a single byte. At
   this point, ebcdic$ is twice the desired length. The processing loop near
   the end of the function converts each pair of hexadecimal characters to
   the byte it represents and replaces the hexadecimal characters with these
   bytes. After all hexadecimal character pairs are converted, the STRINGS

   first half of ebcdic$ contains the desired string of bytes. The second
   half of ebcdic$ is deleted.

   The string variable ascii$ is filled in with binary byte values 0 through
   127. This string is built to be passed to the Translate$ function, which
   requires a string table for both lookup as well as replacement.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          BuildAEStrings             **
     ' **  Type:          Subprogram                 **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Called by the Ascii2Ebcdic$ and Ebcdic2Ascii$
     ' functions to build the translation strings.
     ' This subprogram is called only once.
     '
     ' EXAMPLE OF USE:  Called automatically by either the Ascii2Ebcdic$ or
     '                  Ebcdic2Ascii$ function
     ' PARAMETERS:      ascii$     Shared by Ascii2Ebcdic$, Ebcdic2Ascii$, and
     '                             BuildAEStrings
     '                  ebcdic$    Shared by Ascii2Ebcdic$, Ebcdic2Ascii$, and
     '                             BuildAEStrings
     ' VARIABLES:       i%         Index into strings
     '                  byte%      Binary value of character byte
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB BuildAEStrings ()
     '
       SUB BuildAEStrings STATIC
           SHARED ebcdic$, ascii$
           ascii$ = SPACE$(128)
           ebcdic$ = ebcdic$ + "00010203372D2E2F1605250B0C0D0E0F"
           ebcdic$ = ebcdic$ + "101112133C3D322618193F271C1D1E1F"
           ebcdic$ = ebcdic$ + "404F7F7B5B6C507D4D5D5C4E6B604B61"
           ebcdic$ = ebcdic$ + "F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F"
           ebcdic$ = ebcdic$ + "7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6"
           ebcdic$ = ebcdic$ + "D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D"
           ebcdic$ = ebcdic$ + "79818283848586878889919293949596"
           ebcdic$ = ebcdic$ + "979899A2A3A4A5A6A7A8A9C06AD0A107"
           FOR i% = 0 TO 127
               MID$(ascii$, i% + 1, 1) = CHR$(i%)
               byte% = VAL("&H" + MID$(ebcdic$, i% + i% + 1, 2))
               MID$(ebcdic$, i% + 1, 1) = CHR$(byte%)
           NEXT i%
           ebcdic$ = LEFT$(ebcdic$, 128)
       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: Center$

   Returns a string of length n% by padding a$ with spaces on both ends.

   The original string is centered in the new string. If n% is less than the
   length of a$ (after any spaces are stripped from the ends), the string is
   returned with no spaces tacked on and with a length greater than n%.

   One obvious use for this function is centering titles and labels on a
   printed or displayed page.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Center$                    **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Pads a$ with spaces on both ends until text is
     ' centered and the string length is n%.
     '
     ' EXAMPLE OF USE:  b$ = Center$(a$, n%)
     ' PARAMETERS:      a$         String of characters to be padded with spac
     '                  n%         Desired length of resulting string
     ' VARIABLES:       pad%       Number of spaces to pad at ends of string
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Center$ (a$, n%)
     '
       FUNCTION Center$ (a$, n%) STATIC
           a$ = LTRIM$(RTRIM$(a$))
           pad% = n% - LEN(a$)
           IF pad% > 0 THEN
               Center$ = SPACE$(pad% \ 2) + a$ + SPACE$(pad% - pad% \ 2)
           ELSE
               Center$ = a$
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Detab$

   Replaces tab characters with the appropriate number of spaces.

   Tab characters are useful for forcing text alignment into predictable
   columns and for conserving space in text files. If you then need to
   exchange the tab characters for the equivalent number of spaces, this
   function lets you do so.

   Your computer display and (probably) your printer use a tab spacing
   constant of 8. For this reason, the most common value passed to this
   function for tabs% is 8. Spaces are inserted in a$ in place of tab
   characters to align the following characters into columns that are
   multiples of 8. Displaying or printing the string before and after it's
   processed by this function should result in exactly the same output.

   Also see Entab$, which performs exactly the opposite function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name           Detab$                     **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Replaces all tab characters with spaces, using
     ' tabs% to determine proper alignment.
     '
     ' EXAMPLE OF USE:  b$ = Detab$(a$, tabs%)
     ' PARAMETERS:      a$           String with possible tab characters
     '                  tabs%        Tab spacing
     ' VARIABLES:       t$           Working copy of a$
     '                  tb$          Tab character
     '                  tp%          Pointer to position in t$ of a tab charac
     '                  sp$          Spaces to replace a given tab character
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Detab$ (a$, tabs%)
     '
       FUNCTION Detab$ (a$, tabs%) STATIC
           t$ = a$
           tb$ = CHR$(9)
           DO
               tp% = INSTR(t$, tb$)
               IF tp% THEN
                   Sp$ = SPACE$(tabs% - ((tp% - 1) MOD tabs%))
                   t$ = LEFT$(t$, tp% - 1) + Sp$ + MID$(t$, tp% + 1)
               END IF
           LOOP UNTIL tp% = 0
           Detab$ = t$
           t$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Ebcdic2Ascii$

   Converts a string of EBCDIC characters to ASCII equivalents. This function
   performs the exact opposite of the Ascii2Ebcdic$ function.

   Refer to the Ascii2Ebcdic$ function for more information.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Ebcdic2Ascii$              **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a$ with each character translated from
     ' EBCDIC to ASCII.
     '
     ' EXAMPLE OF USE:  b$ = Ascii2Ebcdic$(a$)
     ' PARAMETERS:      a$          String of EBCDIC characters to be converte
     ' VARIABLES:       ebcdic$     Table of translation characters
     '                  ascii$      Table of translation characters
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Ebcdic2Ascii$ (e$)
     '
       FUNCTION Ebcdic2Ascii$ (e$) STATIC
           SHARED ebcdic$, ascii$
           IF ebcdic$ = "" THEN
               BuildAEStrings
           END IF
           Ebcdic2Ascii$ = Translate$(e$, ebcdic$, ascii$)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Entab$

   Replaces spaces with tab characters wherever possible, providing a way to
   compress the size of a text file.

   For the opposite function, replacing tabs with appropriate numbers of
   spaces, see Detab$.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Entab$                     **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Replaces groups of spaces, where possible, with
     ' tab characters, keeping the alignment indicated
     ' by the value of tabs%.
     '
     ' EXAMPLE OF USE:  b$ = Entab$(a$, tabs%)
     ' PARAMETERS:      a$            String with possible tab characters
     '                  tabs%         Tab spacing
     ' VARIABLES:       t$            Working copy of a$
     '                  tb$           Tab character
     '                  i%            Index into t$
     '                  k%            Count of spaces being replaced
     '                  j%            Index into t$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Entab$ (a$, tabs%)
     '
       FUNCTION Entab$ (a$, tabs%) STATIC
           t$ = a$
           tb$ = CHR$(9)
           FOR i% = (LEN(t$) \ tabs%) * tabs% + 1 TO tabs% STEP -tabs%
               IF MID$(t$, i% - 1, 1) = " " THEN
                   k% = 0
                   FOR j% = 1 TO tabs%
                       IF MID$(t$, i% - j%, 1) <> " " THEN
                           k% = i% - j%
                           EXIT FOR
                       END IF
                   NEXT j%
                   IF k% = 0 THEN
                       k% = i% - tabs% - 1
                   END IF
                   t$ = LEFT$(t$, k%) + tb$ + MID$(t$, i%)
               END IF
           NEXT i%
           Entab$ = t$
           t$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: FilterIn$

   Filters a string, character by character, and removes any characters that
   are not in the designated set. FilterIn$("EXAMPLE", "AEIOU"), for example,
   returns the string EAE, because all characters, except uppercase vowels,
   are removed from EXAMPLE.

   To filter a string by removing characters listed in set$ (as opposed to
   removing all characters not in set$), see the FilterOut$ function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FilterIn$                  **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a$ with all occurrences of any characters
     ' that are not in set$ deleted.
     '
     ' EXAMPLE OF USE:  b$ = FilterIn$(a$, set$)
     ' PARAMETERS:      a$          String to be processed
     '                  set$        Set of characters to be retained
     ' VARIABLES:       i%          Index into a$
     '                  j%          Count of characters retained
     '                  lena%       Length of a$
     '                  t$          Working string space
     '                  c$          Each character of a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION FilterIn$ (a$, set$)
     '
       FUNCTION FilterIn$ (a$, set$) STATIC
           i% = 1
           j% = 0
           lena% = LEN(a$)
           t$ = a$
           DO UNTIL i% > lena%
               c$ = MID$(a$, i%, 1)
               IF INSTR(set$, c$) THEN
                   j% = j% + 1
                   MID$(t$, j%, 1) = c$
               END IF
               i% = i% + 1
           LOOP
           FilterIn$ = LEFT$(t$, j%)
           t$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: FilterOut$

   Filters a string, character by character, and removes any characters that
   are listed in the designated set. FilterOut$("EXAMPLE", "AEIOU"),
   STRINGSfor example, returns the string XMPL, because all uppercase vowels
   are removed from EXAMPLE.

   To filter a string by removing characters not listed in set$ (as opposed
   to removing all characters found in set$), see the FilterIn$ function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          FilterOut$                 **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a$ with all occurrences of any characters
     ' from set$ deleted.
     '
     ' EXAMPLE OF USE:  b$ = FilterOut$(a$, set$)
     ' PARAMETERS:      a$           String to be processed
     '                  set$         Set of characters to be retained
     ' VARIABLES:       i%           Index into a$
     '                  j%           Count of characters retained
     '                  lena%        Length of a$
     '                  t$           Working string space
     '                  c$           Each character of a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION FilterOut$ (a$, set$)
     '
       FUNCTION FilterOut$ (a$, set$) STATIC
           i% = 1
           j% = 0
           lena% = LEN(a$)
           t$ = a$
           DO UNTIL i% > lena%
               c$ = MID$(a$, i%, 1)
               IF INSTR(set$, c$) = 0 THEN
                   j% = j% + 1
                   MID$(t$, j%, 1) = c$
               END IF
               i% = i% + 1
           LOOP
           FilterOut$ = LEFT$(t$, j%)
           t$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Lpad$

   Returns a left-justified string of n% characters by shifting a$ to the
   left and adding space characters on the right.

   This function actually does an amazing amount of work for only one program
   line. First, the string passed as parameter a$ has all spaces removed from
   its left, the final goal being to left justify the string.

   The desired string length is n%. To guarantee that you have at least n%
   characters to work with, n% space characters are added to the right of the
   string. Most likely, the string is now longer than desired. So, the LEFT$
   function returns the first n% characters from the string, finishing the
   desired processing of a$ and assigning the result to Lpad$, the name of
   the function.

   See Rpad$ for a similar function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Lpad$                      **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string of length n%, with a$ left justified
     ' and padded on the right with spaces.
     '
     ' EXAMPLE OF USE:  b$ = Lpad$(a$, n%)
     ' PARAMETERS:      a$          String to be left justified and padded
     '                  n%          Length of string result
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Lpad$ (a$, n%)
     '
       FUNCTION Lpad$ (a$, n%) STATIC
           Lpad$ = LEFT$(LTRIM$(a$) + SPACE$(n%), n%)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: LtrimSet$

   Trims characters in set$ from the left of a$ until a character is found
   that is not in set$.

   STRINGS

   The QuickBASIC LTRIM$() function removes space characters from the end of
   a string. This function goes a step further and lets you remove any of
   several characters from the left of a string. For example,
   LtrimSet$("EXAMPLE", "AXE") returns MPLE.

   One use for this function is to remove tabs and spaces from the left of a
   string.

   See RtrimSet$ for a similar function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          LtrimSet$                  **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Trims occurrences of any characters in set$
     ' from the left of a$.
     '
     ' EXAMPLE OF USE:  b$ = LtrimSet$(a$, set$)
     ' PARAMETERS:      a$           String to be trimmed
     '                  set$         Set of characters to be trimmed
     ' VARIABLES:       i%           Index into a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION LtrimSet$ (a$, set$)
     '
       FUNCTION LtrimSet$ (a$, set$) STATIC
           IF a$ <> "" THEN
               FOR i% = 1 TO LEN(a$)
                   IF INSTR(set$, MID$(a$, i%, 1)) = 0 THEN
                       LtrimSet$ = MID$(a$, i%)
                       EXIT FUNCTION
                   END IF
               NEXT i%
           END IF
           LtrimSet$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Ord%

   Returns the byte number defined by ANSI standard mnemonics.

   This function interprets ANSI standard mnemonics for control characters
   and returns the numeric value of the byte the mnemonics represent (the
   ordinal of the mnemonic). Ord%("BEL"), for example, returns 7, the byte
   number for the bell character. (Recall that PRINT CHR$(7) causes your
   computer to beep.)

   Other common control-character mnemonics include CR (carriage return), LF
   (line feed), FF (form feed), and NUL (the zero byte value). Many others
   are available, however, including mnemonics for the lowercase alphabetic
   characters.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Ord%                       **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Similar to ASC() function; returns
     ' numeric byte values for the ANSI standard
     ' mnemonics for control characters.
     '
     ' EXAMPLE OF USE:  byte% = Ord%(a$)
     ' PARAMETERS:      a$          ANSI standard character mnemonic string
     ' VARIABLES:      (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Ord% (a$)
     '
       FUNCTION Ord% (a$) STATIC
           SELECT CASE UCASE$(a$)
           CASE "NUL"              'Null
               Ord% = 0
           CASE "SOH"              'Start of heading
               Ord% = 1
           CASE "STX"              'Start of text
               Ord% = 2
           CASE "ETX"              'End of text
               Ord% = 3
           CASE "EOT"              'End of transmission
               Ord% = 4
           CASE "ENQ"              'Enquiry
               Ord% = 5
           CASE "ACK"              'Acknowledge
               Ord% = 6
           CASE "BEL"              'Bell
               Ord% = 7
           CASE "BS"               'Backspace
               Ord% = 8
           CASE "HT"               'Horizontal tab
               Ord% = 9
           CASE "LF"               'Line feed
               Ord% = 10
           CASE "VT"               'Vertical tab
               Ord% = 11
           CASE "FF"               'Form feed
               Ord% = 12
           CASE "CR"               'Carriage return
               Ord% = 13
           CASE "SO"               'Shift out
               Ord% = 14
           CASE "SI"               'Shift in
               Ord% = 15
           CASE "DLE"              'Data link escape
               Ord% = 16
           CASE "DC1"              'Device control 1
               Ord% = 17
           CASE "DC2"              'Device control 2
               Ord% = 18
           CASE "DC3"              'Device control 3
               Ord% = 19
           CASE "DC4"              'Device control 4
               Ord% = 20
           CASE "NAK"              'Negative acknowledge
               Ord% = 21
           CASE "SYN"              'Synchronous idle
               Ord% = 22
           CASE "ETB"              'End of transmission block
               Ord% = 23
           CASE "CAN"              'Cancel
               Ord% = 24
           CASE "EM"               'End of medium
               Ord% = 25
           CASE "SUB"              'Substitute
               Ord% = 26
           CASE "ESC"              'Escape
               Ord% = 27
           CASE "FS"               'File separator
               Ord% = 28
           CASE "GS"               'Group separator
               Ord% = 29
           CASE "RS"               'Record separator
               Ord% = 30
           CASE "US"               'Unit separator
               Ord% = 31
           CASE "SP"               'Space
               Ord% = 32
           CASE "UND"              'Underline
               Ord% = 95
           CASE "GRA"              'Grave accent
               Ord% = 96
           CASE "LCA"              'Lowercase a
               Ord% = 97
           CASE "LCB"              'Lowercase b
               Ord% = 98
           CASE "LCC"              'Lowercase c
               Ord% = 99
           CASE "LCD"              'Lowercase d
               Ord% = 100
           CASE "LCE"              'Lowercase e
               Ord% = 101
           CASE "LCF"              'Lowercase f
               Ord% = 102
           CASE "LCG"              'Lowercase g
               Ord% = 103
           CASE "LCH"              'Lowercase h
               Ord% = 104
           CASE "LCI"              'Lowercase i
               Ord% = 105
           CASE "LCJ"              'Lowercase j
               Ord% = 106
           CASE "LCK"              'Lowercase k
               Ord% = 107
           CASE "LCL"              'Lowercase l
               Ord% = 108
           CASE "LCM"              'Lowercase m
               Ord% = 109
           CASE "LCN"              'Lowercase n
               Ord% = 110
           CASE "LCO"              'Lowercase o
               Ord% = 111
           CASE "LCP"              'Lowercase p
               Ord% = 112
           CASE "LCQ"              'Lowercase q
               Ord% = 113
           CASE "LCR"              'Lowercase r
               Ord% = 114
           CASE "LCS"              'Lowercase s
               Ord% = 115
           CASE "LCT"              'Lowercase t
               Ord% = 116
           CASE "LCU"              'Lowercase u
               Ord% = 117
           CASE "LCV"              'Lowercase v
               Ord% = 118
           CASE "LCW"              'Lowercase w
               Ord% = 119
           CASE "LCX"              'Lowercase x
               Ord% = 120
           CASE "LCY"              'Lowercase y
               Ord% = 121
           CASE "LCZ"              'Lowercase z
               Ord% = 122
           CASE "LBR"              'Left brace
               Ord% = 123
           CASE "VLN"              'Vertical line
               Ord% = 124
           CASE "RBR"              'Right brace
               Ord% = 125
           CASE "TIL"              'Tilde
               Ord% = 126
           CASE "DEL"              'Delete
               Ord% = 127
           CASE ELSE               'Not ANSI Standard ORD mnemonic
               Ord% = -1
           END SELECT
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Repeat$

   Returns the string result of concatenating n% copies of a$. If the length
   of the result is less than 0 or greater than 32767, an error message is
   displayed, and the program terminates.

   To create a string of 80 spaces, you can use the QuickBASIC function
   SPACE$(80). To create a string of 80 equal signs, you can use STRING$(80,
   "="). But how can you create an 80-character string made up of 40
   repetitions of "+-"? The Repeat$ function lets you do so. Repeat$("+-",
   40) would do the trick.

   At first glance, this function looks like more code than is needed.
   Consider the short function on the following page that returns the same
   result.


     FUNCTION SlowRepeat$ (a$, n%) STATIC
         x$ = ""
         FOR i% = 1 to n%
            x$ = x$ + a$
         NEXT i%
         SlowRepeat$ = x$
     END FUNCTION

   In tests of operating speed, this shorter function often ran about 10
   times slower than did the Repeat$ function! The difference is in how the
   string space is handled.

   SlowRepeat$ performs much string-manipulation overhead for each n%
   repetition of a$. In particular, the statement x$ = x$ + a$ creates
   working copies of x$ and a$ in the string workspace for each iteration. As
   x$ becomes larger, this shuffling of strings begins to bog down the
   function, even though QuickBASIC performs these functions efficiently.

   The Repeat$ function avoids much of this string-manipulation overhead by
   assigning string results to the MID$ of a large string (t$) that was
   created only once. First, t$ is created as a string of spaces long enough
   to hold all n% copies of a$. Each copy of a$ is then assigned to the
   appropriate substring location in t$ by use of the MID$ statement.

   This technique can often be used to speed up other string manipulations.
   The difference in speed is often insignificant, except in cases where a
   large number of string operations are performed.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Repeat$                    **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a string formed by concatenating n%
     ' copies of a$ together.
     '
     ' EXAMPLE OF USE:  b$ = Repeat$(a$, n%)
     ' PARAMETERS:      a$           String to be repeated
     '                  n%           Number of copies of a$ to concatenate
     ' VARIABLES:       lena%        Length of a$
     '                  lent&        Length of result
     '                  t$           Work space for building result
     '                  ndx%         Index into t$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Repeat$ (a$, n%)
     '
       FUNCTION Repeat$ (a$, n%) STATIC
           lena% = LEN(a$)
           lent& = n% * lena%
           IF lent& < 0 OR lent& > 32767 THEN
               PRINT "ERROR: Repeat$ - Negative repetition, or result too long
               SYSTEM
           ELSEIF lent& = 0 THEN
               Repeat$ = ""
           ELSE
               t$ = SPACE$(lent&)
               ndx% = 1
               DO
                   MID$(t$, ndx%, lena%) = a$
                   ndx% = ndx% + lena%
               LOOP UNTIL ndx% > lent&
               Repeat$ = t$
               t$ = ""
           END IF
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Replace$

   Replaces all occurrences of find$ in a$ with substitute$.

   One common function provided by text editors and word processors is the
   ability to globally replace occurrences of character strings with other
   character strings. This function performs such a global replacement in a
   single string. By using this function repeatedly, you can globally edit
   entire files of strings.

   For example, Replace$ ("This is a test", "i", "ii") returns the string
   Thiis iis a test.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Replace$                   **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Replaces all occurrences of find$ in a$ with substitute$.
     '
     ' EXAMPLE OF USE:  b$ = Replace$(a$, find$, substitute$)
     ' PARAMETERS:      a$            String to make substring replacements in
     '                  find$         Substring to be searched for
     '                  substitutes$  String for replacing the found
     '                                substrings
     ' VARIABLES:       t$            Working copy of a$
     '                  lenf%         Length of find$
     '                  lens%         Length of substitute$
     '                  i%            Index into a$, pointing at substrings
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Replace$ (a$, find$, substitute$)
     '
       FUNCTION Replace$ (a$, find$, substitute$) STATIC
           t$ = a$
           lenf% = LEN(find$)
           lens% = LEN(substitute$)
           i% = 1
           DO
               i% = INSTR(i%, t$, find$)
               IF i% = 0 THEN
                   EXIT DO
               END IF
               t$ = LEFT$(t$, i% - 1) + substitute$ + MID$(t$, i% + lenf%)
               i% = i% + lens%
           LOOP
           Replace$ = t$
           t$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Reverse$

   Quickly reverses the order of all characters in a string. For example,
   Reverse$("QuickBASIC") returns CISABkciuQ.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Reverse$                   **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Reverses the order of all characters in a$.
     '
     ' EXAMPLE OF USE:  b$ = Reverse$(a$)
     ' PARAMETERS:      a$         String to be processed
     ' VARIABLES:       n%         Length of the string
     '                  r$         Working string space
     '                  i%         Index into the string
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Reverse$ (a$)
     '
       FUNCTION Reverse$ (a$) STATIC
           n% = LEN(a$)
           r$ = a$
           FOR i% = 1 TO n%
               MID$(r$, i%, 1) = MID$(a$, n% - i% + 1, 1)
           NEXT i%
           Reverse$ = r$
           r$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: ReverseCase$

   Changes the case of all alphabetical characters in a passed string.
   Nonalphabetic characters are left undisturbed.

   Some text editors can change the case of characters from the current
   cursor location to the end of the line. This function was designed with
   that concept in mind. ReverseCase$("Testing 1,2,3"), for example, returns
   tESTING 1,2,3.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          ReverseCase$               **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Changes all lowercase characters to uppercase
     ' and all uppercase characters to lowercase.
     '
     ' EXAMPLE OF USE:  b$ = ReverseCase$(a$)
     ' PARAMETERS:      a$         String to be processed
     ' VARIABLES:       r$         Working copy of a$
     '                  i%         Index into r$
     '                  t$         Character from middle of a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION ReverseCase$ (a$)
     '
       FUNCTION ReverseCase$ (a$) STATIC
           r$ = a$
           FOR i% = 1 TO LEN(a$)
               t$ = MID$(a$, i%, 1)
               IF LCASE$(t$) <> t$ THEN
                   MID$(r$, i%, 1) = LCASE$(t$)
               ELSE
                   MID$(r$, i%, 1) = UCASE$(t$)
               END IF
           NEXT i%
           ReverseCase$ = r$
           r$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Rpad$

   Returns a right-justified string of n% characters by shifting a$ to the
   right as far as possible and adding space characters on the left.

   See Lpad$ for a similar function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Rpad$                      **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns string of length n%, with a$ right justified
     ' and padded on the left with spaces.
     '
     ' EXAMPLE OF USE:  b$ = Rpad$(a$, n%)
     ' PARAMETERS:      a$           String to be right justified and padded
     '                  n%           Length of string result
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Rpad$ (a$, n%)
     '
       FUNCTION Rpad$ (a$, n%) STATIC
           Rpad$ = RIGHT$(SPACE$(n%) + RTRIM$(a$), n%)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: RtrimSet$

   Trims characters in set$ from the right of a$ until a character is found
   that is not in set$.

   The QuickBASIC RTRIM$() function removes space characters from the right
   of a string. This function goes a step further and lets you remove any of
   several characters from the right of a string. For example,
   RtrimSet$("EXAMPLE", "LEAVE") returns EXAMP.

   One use for this function is to remove tabs and spaces from the right of a
   string.

   See LtrimSet$ for a similar function.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          RtrimSet$                  **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Trims occurrences of any characters in set$
     ' from the right of a$.
     '
     ' EXAMPLE OF USE:  b$ = LtrimSet$(a$, set$)
     ' PARAMETERS:      a$           String to be trimmed
     '                  set$         Set of characters to be trimmed
     ' VARIABLES:       i%           Index into a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION RtrimSet$ (a$, set$)
     '
       FUNCTION RtrimSet$ (a$, set$) STATIC
           IF a$ <> "" THEN
               FOR i% = LEN(a$) TO 1 STEP -1
                   IF INSTR(set$, MID$(a$, i%, 1)) = 0 THEN
                       RtrimSet$ = LEFT$(a$, i%)
                       EXIT FUNCTION
                   END IF
               NEXT i%
           END IF
           RtrimSet$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Translate$

   Performs a table-lookup translation of the characters in a$. Each
   character in a$ is searched for in f$. If found, the character is replaced
   by the character located in the same position in t$. Take a look at a
   simple example to help clarify the explanation.

   Translate$("EXAMPLE", "ABCDE", "vwxyz") returns zXvMPLz. The first
   character of "EXAMPLE" is found in the fifth character position of
   "ABCDE," so it is replaced with the fifth character of "vwxyz." (The "E"
   is replaced with a "z.") Then each remaining character in "EXAMPLE" is
   searched for and replaced in the same way.

   The Ascii2Ebcdic$ and Ebcdic2Ascii$ functions call this function to
   translate characters from one standard set to the other.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Translate$                 **
     ' **  Type:          Function                   **
     ' **  Module:        STRINGS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns a$ with each character translated from
     ' f$ to t$.  If a character from a$ is found in f$,
     ' it is replaced with the character located
     ' in the same position in t$.
     '
     ' EXAMPLE OF USE:  b$ = Translate$ (a$, f$, t$)
     ' PARAMETERS:      a$         String to be translated
     '                  f$         Table of lookup characters
     '                  t$         Table of replacement characters
     ' VARIABLES:       ta$        Working copy of a$
     '                  lena%      Length of a$
     '                  lenf%      Length of f$
     '                  lent%      Length of t$
     '                  i%         Index into ta$
     '                  ptr%       Pointer into f$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Translate$ (a$, f$, t$)
     '
       FUNCTION Translate$ (a$, f$, t$) STATIC
           ta$ = a$
           lena% = LEN(ta$)
           lenf% = LEN(f$)
           lent% = LEN(t$)
           IF lena% > 0 AND lenf% > 0 AND lent% > 0 THEN
               FOR i% = 1 TO lena%
                   ptr% = INSTR(f$, MID$(ta$, i%, 1))
                   IF ptr% THEN
                       MID$(ta$, i%, 1) = MID$(t$, ptr%, 1)
                   END IF
               NEXT i%
           END IF
           Translate$ = ta$
           ta$ = ""
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 TRIANGLE

   The TRIANGLE toolbox is a collection of analytical geometry functions and
   subprograms for calculating parts of triangles.

   The demonstration module-level code of this toolbox provides a useful
   triangle calculator utility.

   Run the program, and enter the known sides and/or angles of a triangle
   when prompted. If it's possible to calculate the remaining sides and
   angles, the program does so and then displays the results.

   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   TRIANGLE.BAS                        Demo module
   Deg2Rad#                     Func   Converts degree angular units to
                                        radians
   Rad2Deg#                     Func   Converts radian angular units to
                                        degrees
   Triangle                     Sub    Calculates sides and angles of
                                        triangle
   TriangleArea#                Func   Calculates area of triangle from 3
                                        sides
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: TRIANGLE

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          TRIANGLE                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        TRIANGLE.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:          No command line parameters
     ' REQUIREMENTS:   CGA
     ' .MAK FILE:      TRIANGLE.BAS
     '                 QCALMATH.BAS
     ' PARAMETERS:     (none)
     ' VARIABLES:      sA$        User input of side a
     '                 sB$        User input of side b
     '                 sC$        User input of side c
     '                 aA$        User input of angle A
     '                 aB$        User input of angle B
     '                 aC$        User input of angle C
     '                 sA#        Side A
     '                 sB#        Side B
     '                 sC#        Side C
     '                 aA#        Angle A
     '                 aB#        Angle B
     '                 aC#        Angle C

     ' Functions
       DECLARE FUNCTION Deg2Rad# (deg#)
       DECLARE FUNCTION Rad2Deg# (rad#)
       DECLARE FUNCTION ArcCosine# (x#)
       DECLARE FUNCTION ArcSine# (x#)
       DECLARE FUNCTION TriangleArea# (sA#, sB#, sC#)

     ' Subprograms
       DECLARE SUB Triangle (sA#, sB#, sC#, aA#, aB#, aC#)

     ' Initialization
       SCREEN 2
       CLS
       PRINT "TRIANGLE"

     ' Draw a representative triangle
       WINDOW (0, 0)-(1, 1)
       LINE (.3, .7)-(.8, .7)
       LINE -(.4, 1)
       LINE -(.3, .7)

     ' Label the triangle sides
       LOCATE 4, 26
       PRINT "a"
       LOCATE 3, 48
       PRINT "b"
       LOCATE 9, 42
       PRINT "c"

     ' Label the triangle angles
       LOCATE 7, 55
       PRINT "A"
       LOCATE 7, 28
       PRINT "B"
       LOCATE 2, 33
       PRINT "C"

     ' Ask user for the known data
       LOCATE 12, 1
       PRINT "Enter known sides and angles (deg),"
       PRINT "and press Enter for unknowns..."
       LOCATE 16, 1
       LINE INPUT "Side  a  "; sA$
       LINE INPUT "Side  b  "; sB$
       LINE INPUT "Side  c  "; sC$
       PRINT
       LINE INPUT "Angle A  "; aA$
       LINE INPUT "Angle B  "; aB$
       LINE INPUT "Angle C  "; aC$
       PRINT

     ' Convert to numeric values
       sA# = VAL(sA$)
       sB# = VAL(sB$)
       sC# = VAL(sC$)
       aA# = Deg2Rad#(VAL(aA$))
       aB# = Deg2Rad#(VAL(aB$))
       aC# = Deg2Rad#(VAL(aC$))

     ' Solve for the unknowns
       Triangle sA#, sB#, sC#, aA#, aB#, aC#

     ' Output the results
       LOCATE 16, 1
       PRINT "Side  a  "; sA#
       PRINT "Side  b  "; sB#
       PRINT "Side  c  "; sC#
       PRINT
       PRINT "Angle A  "; Rad2Deg#(aA#); "Deg"
       PRINT "Angle B  "; Rad2Deg#(aB#); "Deg"
       PRINT "Angle C  "; Rad2Deg#(aC#); "Deg"
       LOCATE 20, 40
       PRINT "Area = "; TriangleArea#(sA#, sB#, sC#)

     ' All done
       LOCATE 24, 1
       PRINT "Press any key to continue";
       DO
       LOOP WHILE INKEY = ""
       SCREEN 0
       END
   ──────────────────────────────────────────────────────────────────────────


 Function: Deg2Rad#

   Converts degrees to radians.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Deg2Rad#                   **
     ' **  Type:          Function                   **
     ' **  Module:        TRIANGLE.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts degree angular units to radians.
     '
     ' EXAMPLE OF USE:  r# = Deg2Rad#(deg#)
     ' PARAMETERS:      deg#       Degrees
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Deg2Rad# (deg#)
     '
       FUNCTION Deg2Rad# (deg#) STATIC
           Deg2Rad# = deg# / 57.29577951308232#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Function: Rad2Deg#

   Converts radians to degrees.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Rad2Deg#                   **
     ' **  Type:          Function                   **
     ' **  Module:        TRIANGLE.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Converts radian angular units to degrees.
     '
     ' EXAMPLE OF USE:  d# = Rad2Deg#(rad#)
     ' PARAMETERS:      rad#       Radians
     ' VARIABLES:       (none)
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION Rad2Deg# (rad#)
     '
       FUNCTION Rad2Deg# (rad#) STATIC
           Rad2Deg# = rad# * 57.29577951308232#
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Triangle

   Calculates sides and angles of a triangle if enough sides and/or angles
   are given to be able to deduce the rest. Any combination of sides and
   angles can be given, although illegal combinations will produce
   unpredictable results.

   Double-precision numbers are used throughout this subprogram to maintain
   high accuracy. Change all the pound signs to exclamation points if you
   prefer to work with single-precision numbers.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Triangle                   **
     ' **  Type:          Subprogram                 **
     ' **  Module:        TRIANGLE.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Calculates all sides and angles of a triangle,
     ' assuming enough sides and angles are given.
     '
     ' EXAMPLE OF USE:  Triangle sA#, sB#, sC#, aA#, aB#, aC#
     ' PARAMETERS:      sA#        Side A
     '                  sB#        Side B
     '                  sC#        Side C
     '                  aA#        Angle A
     '                  aB#        Angle B
     '                  aC#        Angle C
     ' VARIABLES:       i%         Looping index
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB Triangle (sA#, sB#, sC#, aA#, aB#, aC#)
     '
       SUB Triangle (sA#, sB#, sC#, aA#, aB#, aC#) STATIC

           FOR i% = 1 TO 18

               IF aA# = 0# THEN
                   IF sA# <> 0# AND sB# <> 0# AND sC# <> 0# THEN
                       t# = sB# * sB# + sC# * sC# - sA# * sA#
                       aA# = ArcCosine#(t# / 2# / sB# / sC#)
                   END IF
               END IF

               IF aB# = 0# THEN
                   IF sA# <> 0# AND sB# <> 0# AND aA# <> 0# THEN
                       aB# = ArcSine#(sB# * SIN(aA#) / sA#)
                   END IF
               END IF

               IF aC# = 0# THEN
                   IF aA# <> 0# AND aB# <> 0# THEN
                       aC# = 3.141592653589793# - aA# - aB#
                   END IF
               END IF

               IF sB# = 0# THEN
                   IF sA# <> 0# AND aB# <> 0# AND aA# <> 0# THEN
                       sB# = sA# * SIN(aB#) / SIN(aA#)
                   END IF
               END IF

               IF sC# = 0# THEN
                   IF sA# <> 0# AND sB# <> 0# AND aC# <> 0# THEN
                       t# = sA# * sA# + sB# * sB#
                       sC# = SQR(t# - 2# * sA# * sB# * COS(aC#))
                   END IF
               END IF

               IF i% MOD 2 THEN
                   SWAP sB#, sC#
                   SWAP aB#, aC#
               ELSE
                   SWAP sA#, sB#
                   SWAP aA#, aB#
               END IF

           NEXT i%

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Function: TriangleArea#

   Calculates the area of a triangle given the three sides of the triangle.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          TriangleArea#              **
     ' **  Type:          Function                   **
     ' **  Module:        TRIANGLE.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the area of a triangle given the three sides.
     '
     ' EXAMPLE OF USE:  TriangleArea# sA#, sB#, sC#
     ' PARAMETERS:      sA#        Side A
     '                  sB#        Side B
     '                  sC#        Side C
     ' VARIABLES:       s#         Sum of the three sides of the triangle
     '                             divided by two
     '                  t1#        Temporary variable
     '                  t2#        Temporary variable
     '                  t3#        Temporary variable
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION TriangleArea# (sA#, sB#, sC#)
     '
       FUNCTION TriangleArea# (sA#, sB#, sC#) STATIC
           s# = (sA# + sB# + sC#) / 2#
           t1# = s# - sA#
           t2# = s# - sB#
           t3# = s# - sC#
           TriangleArea# = SQR(s# * t1# * t2# * t3#)
       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 WINDOWS

   The WINDOWS demo module demonstrates the windows subprograms. One lets
   you create several types of windows for displaying information and menu
   selections. A second subprogram removes the most recently created window.

   The WindowsType data structure completely defines the action and
   appearance of the windows that you can create. Although the list of
   variables in this structure is fairly long, you have the advantage of
   complete control over the windows.

   Set the action code to 0, 1, or 2. An action code of 0 indicates a return
   to the calling program immediately after the window is created, leaving
   the window on the screen. You could use this type of window for simply
   displaying information.

   An action code of 1 creates the window and then waits for the user to
   press any key before continuing. The code for the key pressed is returned
   to the calling program, making it possible to use a type 1 window to ask
   yes-or-no, multiple choice, or other questions.

   An action code of 2 creates the most sophisticated type of window. In this
   case, a menu window is created, providing several methods for the user to
   select from among the available menu choices. One line of the menu window
   is highlighted to indicate the currently selected choice. You can use the
   up and down arrow keys or the mouse to move this highlight to the desired
   line. Clicking with the mouse or pressing the Enter key selects the
   currently highlighted line. You can also press the key for the first
   unique character of a line, which immediately selects that line. The
   Windows subprogram then returns the line number for a type 2 action code
   menu.

   The edgeLine variable in the WindowsType data structure should also be set
   to 0, 1, or 2. This parameter tells the Windows subprogram to draw a
   border around the window with 0-, 1-, or 2-line graphics characters.

   You can select and control the foreground and background colors for each
   part of a window individually. The color definition constants used in the
   demonstration program can be very useful for setting these parameters.

   The row and column variables define the placement of the upper left corner
   of the window. The Windows subprogram automatically sizes the window for
   both the number of lines and the length of the longest line. Be sure to
   place the window where it won't hit the edges of the screen.

   The title string appears in the center of the top border of the window,
   and the prompt string appears in the center of the bottom border of the
   display. If these strings are null, nothing is displayed in the window
   borders.

   The PCOPY statement copies screen pages for saving and restoring the
   background information under the windows. This technique results in very
   quick window appearance and disappearance without using complicated
   assembly-language routines. In 40-column SCREEN mode 0, you can display up
   to seven windows at once, one for each available screen page. Depending on
   the graphics adapter you have, other video modes let you display two to
   four windows simultaneously.

   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   WINDOWS.BAS                         Demo module
   Windows                      Sub    Creates a pop-up window
   WindowsPop                   Sub    Removes last displayed window
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: WINDOWS

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          WINDOWS                    **
     ' **  Type:          Toolbox                    **
     ' **  Module:        WINDOWS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    MIXED.QLB/.LIB
     '                  Mouse (optional)
     ' .MAK FILE:       WINDOWS.BAS
     '                  BITS.BAS
     '                  BIOSCALL.BAS
     '                  MOUSSUBS.BAS
     '                  KEYS.BAS
     ' PARAMETERS:      (none)
     ' VARIABLES:       w1         Structure of type WindowsType
     '                  w2         Structure of type WindowsType
     '                  w3         Structure of type WindowsType
     '                  w1Text$()  Strings to display in first window
     '                  w2Text$()  Strings to display in second window
     '                  w3Text$()  Strings to display in third window
     '                  w1Title$   Title string for first window
     '                  w1Prompt$  Prompt string for first window
     '                  w2Title$   Title string for second window
     '                  w2Prompt$  Prompt string for second window
     '                  w3Title$   Title string for third window
     '                  arrow$     String showing up and down arrows
     '                  entSymbol$ String showing the Enter key symbol
     '                  w3Prompt$  Prompt string for third window
     '                  i%         Looping index
     '                  t0         Timer value


     ' Define 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 BLINK = 16
       CONST YELLOW = BROWN + BRIGHT

       TYPE WindowsType
           action       AS INTEGER
           edgeLine     AS INTEGER
           row          AS INTEGER
           col          AS INTEGER
           fgdEdge      AS INTEGER
           bgdEdge      AS INTEGER
           fgdBody      AS INTEGER
           bgdBody      AS INTEGER
           fgdHighlight AS INTEGER
           bgdHighlight AS INTEGER
           fgdTitle     AS INTEGER
           bgdTitle     AS INTEGER
           fgdPrompt    AS INTEGER
           bgdPrompt    AS INTEGER
           returnCode   AS INTEGER
       END TYPE

     ' Functions
       DECLARE FUNCTION InKeyCode% ()

     ' Subprograms
       DECLARE SUB Windows (w AS WindowsType, wText$(), wTitle$, wPrompt$)
       DECLARE SUB WindowsPop ()
       DECLARE SUB VideoState (mode%, columns%, page%)
       DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
       DECLARE SUB MouseMickey (horizontal%, vertical%)
       DECLARE SUB MouseNow (leftButton%, rightButton%, xMouse%, yMouse%)

     ' Data structures
       DIM w1 AS WindowsType
       DIM w2 AS WindowsType
       DIM w3 AS WindowsType

     ' Arrays
       DIM w1Text$(1 TO 5)
       DIM w2Text$(1 TO 3)
       DIM w3Text$(1 TO 9)

     ' Define first window
       w1.action = 0
       w1.edgeLine = 1
       w1.row = 2
       w1.col = 3
       w1.fgdEdge = YELLOW
       w1.bgdEdge = BLUE
       w1.fgdBody = BRIGHT + WHITE
       w1.bgdBody = BLUE
       w1.fgdHighlight = 0
       w1.bgdHighlight = 0
       w1.fgdTitle = YELLOW
       w1.bgdTitle = BLUE
       w1.fgdPrompt = YELLOW
       w1.bgdPrompt = BLUE
       w1Title$ = " First Window "
       w1Text$(1) = "This window demonstrates how information"
       w1Text$(2) = "can be displayed without requesting any"
       w1Text$(3) = "response from the user.  The action code"
       w1Text$(4) = "is 0, causing an immediate return to the"
       w1Text$(5) = "program after the window is displayed."
       w1Prompt$ = ""

     ' Define second window
       w2.action = 1
       w2.edgeLine = 2
       w2.row = 10
       w2.col = 12
       w2.fgdEdge = CYAN + BRIGHT
       w2.bgdEdge = BLACK
       w2.fgdBody = YELLOW
       w2.bgdBody = BLACK
       w2.fgdHighlight = 0
       w2.bgdHighlight = 0
       w2.fgdTitle = CYAN + BRIGHT
       w2.bgdTitle = BLUE
       w2.fgdPrompt = CYAN + BRIGHT
       w2.bgdPrompt = BLUE
       w2Title$ = " Second window, action code is 1 "
       w2Text$(1) = "This window waits for the user to press"
       w2Text$(2) = "any key before continuing.  The key code"
       w2Text$(3) = "is passed back to the calling program."
       w2Prompt$ = " Press any key to continue. "

     ' Define third window
       w3.action = 2
       w3.edgeLine = 2
       w3.row = 7
       w3.col = 15
       w3.fgdEdge = YELLOW
       w3.bgdEdge = WHITE
       w3.fgdBody = BLACK
       w3.bgdBody = WHITE
       w3.fgdHighlight = WHITE + BRIGHT
       w3.bgdHighlight = BLACK
       w3.fgdTitle = YELLOW
       w3.bgdTitle = WHITE
       w3.fgdPrompt = YELLOW
       w3.bgdPrompt = WHITE
       w3Title$ = " Third window, action is 2 (menu selection) "
       arrows$ = CHR$(24) + " " + CHR$(25) + " "
       entSymbol$ = CHR$(17) + CHR$(196) + CHR$(217)
       w3Prompt$ = " <Character> " + arrows$ + entSymbol$ + " or use mouse "
       w3Text$(1) = "1. This is the first line in the window."
       w3Text$(2) = "2. This is the second."
       w3Text$(3) = "3. This is the third line."
       w3Text$(4) = "4. The fourth."
       w3Text$(5) = "5. The fifth."
       w3Text$(6) = "A. You can press <A> or <a> to select this line."
       w3Text$(7) = "B. You can press <1> to <5> for one of the first 5 lines.
       w3Text$(8) = "C. Try moving the cursor up or down and pressing Enter."
       w3Text$(9) = "D. Also, try the mouse. Click with left button."

     ' Initialize the display
       SCREEN 0, , 0, 0
       WIDTH 80
       CLS
       FOR i% = 1 TO 20
           PRINT STRING$(80, 178)
       NEXT i%
       LOCATE 6, 24
       PRINT " * Windows toolbox demonstration * "

     ' Wait for any key to be pressed
       LOCATE 22, 1
       PRINT "Press any key to continue"
       DO
       LOOP UNTIL INKEY$ <> ""

     ' Clear the "press any key" prompt
       LOCATE 22, 1
       PRINT SPACE$(25)

     ' Create the three windows
       Windows w1, w1Text$(), w1Title$, w1Prompt$
       Windows w2, w2Text$(), w2Title$, w2Prompt$
       Windows w3, w3Text$(), w3Title$, w3Prompt$

     ' Display the result codes, and erase each window
       FOR i% = 1 TO 4
           LOCATE 21, 1
           COLOR WHITE, BLACK
           PRINT "The three return codes...";
           PRINT w1.returnCode; w2.returnCode; w3.returnCode
           COLOR YELLOW
           PRINT "Every five seconds another window will disappear..."
           COLOR WHITE, BLACK
           t0 = TIMER
           DO
           LOOP UNTIL TIMER - t0 > 5
           WindowsPop
       NEXT i%

     ' All done
       CLS
       END
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: Windows

   Creates a pop-up window for displaying string data or menu selections. The
   data structure of type WindowsType defines the action, colors, borders,
   and other attributes of the windows. If you provide invalid parameters,
   you receive an appropriate error message, and the program terminates.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Windows                    **
     ' **  Type:          Subprogram                 **
     ' **  Module:        WINDOWS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Displays a rectangular window for information display
     ' or menu selection.
     '
     ' EXAMPLE OF USE:  Windows w1, wText$(), wTitle$, wPrompt$
     ' PARAMETERS:      w1            Structure of type WindowsType
     '                  wTest$()      Array of strings to be displayed
     '                  wTitle$       Title string
     '                  wPrompt$      Prompt string
     ' VARIABLES:       mode%         Current video mode
     '                  columns%      Current number of character columns
     '                  page%         Current video page
     '                  cursorRow%    Saved cursor row position
     '                  cursorCol%    Saved cursor column position
     '                  newpage%      Next video page
     '                  lbText%       Lower boundary of array of text lines
     '                  ubText%       Upper boundary of array of text lines
     '                  i%            Looping index
     '                  maxlen%       Length of longest string to display
     '                  length%       Length of each array string
     '                  row2%         Row number at bottom right corner of win
     '                  col2%         Column number at bottom right corner of
     '                                window
     '                  ul%           Upper left corner border character code
     '                  ur%           Upper right corner border character code
     '                  ll%           Lower left corner border character code
     '                  lr%           Lower right corner border character code
     '                  vl%           Vertical border character code
     '                  hl%           Horizontal border character code
     '                  r%            Index to each line of text
     '                  ptr%          Highlighted line pointer
     '                  lastPtr%      Last highlighted line
     '                  horizontal%   Horizontal mouse mickies
     '                  vertical%     Vertical mouse mickies
     '                  mickies       Accumulated vertical mickies
     '                  choice$       Set of unique characters for each menu l
     '                  tmp$          Work string
     '                  kee%          Key code returned by InKeyCode% function
     '                  leftButton%   Mouse left button state
     '                  rightButton%  Mouse right button state
     '                  xMouse%       Mouse X position
     '                  yMouse%       Mouse Y position
     ' MODULE LEVEL
     '   DECLARATIONS:  SUB Windows (w AS WindowsType, wText$(), wTitle$,
     '                               wPrompt$) STATIC
     '
       SUB Windows (w AS WindowsType, wText$(), wTitle$, wPrompt$) STATIC
         ' Key code numbers
           CONST DOWNARROW = 20480
           CONST ENTER = 13
           CONST ESCAPE = 27
           CONST UPARROW = 18432

         ' Determine current video page
           VideoState mode%, columns%, page%

         ' Record current cursor location
           cursorRow% = CSRLIN
           cursorCol% = POS(0)

         ' Window will be on the next page, if available
           newpage% = page% + 1
           IF newpage% > 7 THEN
               SCREEN , , 0, 0
               PRINT "Error: Windows - not enough video pages"
               SYSTEM
           END IF

         ' Copy current page to new page
           PCOPY page%, newpage%

         ' Show the current page while building window on new page
           SCREEN , , newpage%, page%

         ' Determine array bounds
           lbText% = LBOUND(wText$)
           ubText% = UBOUND(wText$)

         ' Check the text array bounds, lower always 1, upper > 0
           IF lbText% <> 1 OR ubText% < 1 THEN
               SCREEN , , 0, 0
               PRINT "Error: Windows - text array dimensioned incorrectly"
               SYSTEM
           END IF

         ' Determine longest string in the text array
           maxLen% = 0
           FOR i% = lbText% TO ubText%
               length% = LEN(wText$(i%))
               IF length% > maxLen% THEN
                   maxLen% = length%
               END IF
           NEXT i%

         ' Determine the bottom right corner of window
           row2% = w.row + ubText% + 1
           col2% = w.col + maxLen% + 3

         ' Check that window is on screen
           IF w.row < 1 OR w.col < 1 OR row2% > 25 OR col2% > columns% THEN
               SCREEN , , 0, 0
               PRINT "Error: Windows - part of window is off screen"
               SYSTEM
           END IF

         ' Set the edge characters
           SELECT CASE w.edgeLine
           CASE 0
               ul% = 32
               ur% = 32
               ll% = 32
               lr% = 32
               vl% = 32
               hl% = 32
           CASE 1
               ul% = 218
               ur% = 191
               ll% = 192
               lr% = 217
               vl% = 179
               hl% = 196
           CASE 2
               ul% = 201
               ur% = 187
               ll% = 200
               lr% = 188
               vl% = 186
               hl% = 205
           CASE ELSE
               SCREEN , , 0, 0
               PRINT "Error: Windows - Edge line type incorrect"
               SYSTEM
           END SELECT

         ' Draw top edge of the box
           LOCATE w.row, w.col, 0
           COLOR w.fgdEdge, w.bgdEdge
           PRINT CHR$(ul%); STRING$(maxLen% + 2, hl%); CHR$(ur%);

         ' Draw the body of the window
           FOR r% = w.row + 1 TO row2% - 1
               LOCATE r%, w.col, 0
               COLOR w.fgdEdge, w.bgdEdge
               PRINT CHR$(vl%);
               COLOR w.fgdBody, w.bgdBody
               tmp$ = LEFT$(wText$(r% - w.row) + SPACE$(maxLen%), maxLen%)
               PRINT " "; tmp$; " ";
               COLOR w.fgdEdge, w.bgdEdge
               PRINT CHR$(vl%);
           NEXT r%

         ' Draw bottom edge of the box
           LOCATE row2%, w.col, 0
           COLOR w.fgdEdge, w.bgdEdge
           PRINT CHR$(ll%); STRING$(maxLen% + 2, hl%); CHR$(lr%);

         ' Center and print top title if present
           IF wTitle$ <> "" THEN
               LOCATE w.row, (w.col + col2% - LEN(wTitle$) + 1) \ 2, 0
               COLOR w.fgdTitle, w.bgdTitle
               PRINT wTitle$;
           END IF

         ' Center and print prompt if present
           IF wPrompt$ <> "" THEN
               LOCATE row2%, (w.col + col2% - LEN(wPrompt$) + 1) \ 2, 0
               COLOR w.fgdPrompt, w.bgdPrompt
               PRINT wPrompt$;
           END IF

         ' Now make the new page visible and active
           SCREEN , , newpage%, newpage%

         ' Take next action based on action code
           SELECT CASE w.action
           CASE 1

             ' Get a key code number and return it
               DO
                   w.returnCode = InKeyCode%
               LOOP UNTIL w.returnCode

           CASE 2

             ' Set choice pointer to last selection if known
               IF w.returnCode > 0 AND w.returnCode < ubText% THEN
                   ptr% = w.returnCode
               ELSE
                   ptr% = 1
               END IF

             ' Start with last pointer different, to update highlighting
               IF ptr% > 1 THEN
                   lastPtr% = 1
               ELSE
                   lastPtr% = 2
               END IF

             ' Clear any mouse mickey counts
               MouseMickey horizontal%, vertical%
               mickies% = 0

             ' Create unique key selection string
               choice$ = ""
               FOR i% = 1 TO ubText%
                   tmp$ = UCASE$(LTRIM$(wText$(i%)))
                   DO
                       IF tmp$ <> "" THEN
                           t$ = LEFT$(tmp$, 1)
                           tmp$ = MID$(tmp$, 2)
                           IF INSTR(choice$, t$) = 0 THEN
                               choice$ = choice$ + t$
                           END IF
                       ELSE
                           SCREEN 0, , 0
                           PRINT "Error: Windows - No unique character"
                           SYSTEM
                       END IF
                   LOOP UNTIL LEN(choice$) = i%
               NEXT i%

             ' Main loop, monitor mouse and keyboard
               DO

                 ' Add the mouse mickies
                   MouseMickey horizontal%, vertical%
                   mickies% = mickies% + vertical%

                 ' Check for enough mickies
                   IF mickies% < -17 THEN
                       mickies% = 0
                       IF ptr% > 1 THEN
                           ptr% = ptr% - 1
                       END IF
                   ELSEIF mickies% > 17 THEN
                       mickies% = 0
                       IF ptr% < ubText% THEN
                           ptr% = ptr% + 1
                       END IF
                   END IF

                 ' Check keyboard
                   kee% = InKeyCode%
                   IF kee% >= ASC("a") AND kee% <= ASC("z") THEN
                       kee% = ASC(UCASE$(CHR$(kee%)))
                   END IF
                   SELECT CASE kee%
                   CASE UPARROW
                       IF ptr% > 1 THEN
                           ptr% = ptr% - 1
                       END IF
                   CASE DOWNARROW
                       IF ptr% < ubText% THEN
                           ptr% = ptr% + 1
                       END IF
                   CASE ENTER
                       w.returnCode = ptr%
                   CASE ESCAPE
                       w.returnCode = -1
                   CASE ELSE
                       w.returnCode = INSTR(choice$, CHR$(kee%))
                       IF w.returnCode THEN
                           ptr% = w.returnCode
                       END IF
                   END SELECT

                 ' Check the left mouse button
                   MouseNow leftButton%, rightButton%, xMouse%, yMouse%
                   IF leftButton% THEN
                       w.returnCode = ptr%
                   END IF

                 ' Update the highlight if line has changed
                   IF ptr% <> lastPtr% THEN
                       LOCATE lastPtr% + w.row, w.col + 2, 0
                       COLOR w.fgdBody, w.bgdBody
                       tmp$ = LEFT$(wText$(lastPtr%) + SPACE$(maxLen%), maxLen
                       PRINT tmp$;
                       LOCATE ptr% + w.row, w.col + 2, 0
                       COLOR w.fgdHighlight, w.bgdHighlight
                       tmp$ = LEFT$(wText$(ptr%) + SPACE$(maxLen%), maxLen%)
                       PRINT tmp$;
                       lastPtr% = ptr%
                   END IF

               LOOP WHILE w.returnCode = 0

           CASE ELSE
               w.returnCode = 0
           END SELECT

         ' Reset the cursor position
           LOCATE cursorRow%, cursorCol%

       END SUB
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: WindowsPop

   Removes the most recently created window from the screen. The SCREEN
   statement is used to change the apage and vpage parameters simultaneously,
   resulting in nearly instant removal of the window.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          WindowsPop                 **
     ' **  Type:          Subprogram                 **
     ' **  Module:        WINDOWS.BAS                **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Removes last displayed window.
     '
     ' EXAMPLE OF USE:  WindowsPop
     ' PARAMETERS:      (none)
     ' VARIABLES:       mode%      Current video mode
     '                  columns%   Current number of display columns
     '                  page%      Current display page
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE SUB WindowsPop ()
     '
       SUB WindowsPop STATIC
           VideoState mode%, columns%, page%
           IF page% THEN
               SCREEN 0, , page% - 1, page% - 1
           END IF
       END SUB
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 WORDCOUN

   The WORDCOUN toolbox counts words in a file and contains a function that
   counts words in a string. Enter a filename on the command line when you
   run this program.

   Name                          Type   Description
   ──────────────────────────────────────────────────────────────────────────
   WORDCOUN.BAS                        Demo module
   WordCount%                   Func   Returns number of words in a string
   ──────────────────────────────────────────────────────────────────────────


 Demo Module: WORDCOUN

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          WORDCOUN                   **
     ' **  Type:          Toolbox                    **
     ' **  Module:        WORDCOUN.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:           WORDCOUN filename
     ' .MAK FILE:       (none)
     ' PARAMETERS:      filename      Name of file to be processed
     ' VARIABLES:       fileName$     Name of file from the command line
     '                  sep$          List of characters defined as word separ
     '                  a$            Each line from the file
     '                  totalCount&   Total count of words

       DECLARE FUNCTION WordCount% (a$, sep$)

     ' Assume a filename has been given on the command line
       fileName$ = COMMAND$

     ' Open the file
       OPEN fileName$ FOR INPUT AS #1

     ' Define the word-separating characters as space, tab, and comma
       sep$ = " " + CHR$(9) + ","

     ' Read in and process each line
       DO
           LINE INPUT #1, a$
           totalCount& = totalCount& + WordCount%(a$, sep$)
       LOOP UNTIL EOF(1)

     ' Print the results
       PRINT "There are"; totalCount&; "words in "; fileName$

     ' That's all
       END
   ──────────────────────────────────────────────────────────────────────────


 Function: WordCount%

   Returns the number of words in a string. Words are defined as groups of
   characters separated by one or more of the characters in sep$. The
   WORDCOUN toolbox passes sep$ with a space, a tab, and a comma in it, but
   you can place any characters in sep$ that you want to use to define the
   separation of words.

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          Wordcount%                 **
     ' **  Type:          Function                   **
     ' **  Module:        WORDCOUN.BAS               **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Returns the number of words in a string.
     '
     ' EXAMPLE OF USE:  WordCount% a$, sep$
     ' PARAMETERS:      a$         String containing words to be counted
     '                  sep$       List of word separation characters
     ' VARIABLES:       count%     Count of words
     '                  flag%      Indicates if scanning is currently inside o
     '                             word
     '                  la%        length of a$
     '                  i%         Index to each character of a$
     ' MODULE LEVEL
     '   DECLARATIONS:  DECLARE FUNCTION WordCount% (a$, sep$)
     '
         FUNCTION WordCount% (a$, sep$) STATIC
           count% = 0
           flag% = 0
           la% = LEN(a$)
           IF la% > 0 AND sep$ <> "" THEN
               FOR i% = 1 TO la%
                   IF INSTR(sep$, MID$(a$, i%, 1)) THEN
                       IF flag% THEN
                           flag% = 0
                           count% = count% + 1
                       END IF
                   ELSE
                       flag% = 1
                   END IF
               NEXT i%
           END IF
           WordCount% = count% + flag%

       END FUNCTION
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 PART 3  MIXED-LANGUAGE TOOLBOXES
 ────────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 Chapter Four  Using Mixed-Language Toolboxes

   Although Microsoft QuickBASIC is a sophisticated and powerful
   software-development tool, other languages, such as C, FORTRAN, Pascal,
   and assembly language, have unique strengths. The ability to mix
   subprograms and functions written in any of these languages lets you use
   the best features of each. FORTRAN, for example, has extensive mathematics
   and engineering libraries, and C is a powerful development language. For
   the fastest running programs, assembly language can't be beat. Once you
   understand a few concepts, you'll be able to easily combine routines from
   these languages.


 Near and Far Addressing

   MS-DOS runs on the 8088, 8086, 80286, and 80386 family of microprocessors
   found at the heart of IBM Personal Computers and compatibles. These chips
   use special hardware registers that allow quicker access and shorter
   instruction when referring to data or procedures located in the same block
   of 65536 (64 KB) bytes of memory.

   From a software point of view, microprocessor instructions can address
   memory locations by referring to either locations in a currently defined,
   single block of 64 KB memory addresses or to any possible locations in
   memory space. These references are called "near" and "far," respectively.
   Near references require one word, and far references require two words.
   Normally, high-level languages such as QuickBASIC take care of all these
   details for you, but when you link subprograms from other languages with
   QuickBASIC, you need to be sure that references to variables and calls to
   subprograms and functions all use the same type of near or far addressing.

   You can adjust Microsoft QuickC and Microsoft Macro Assembler 5.0 to
   create programs using a variety of memory models that indicate whether
   memory locations are referred to by near or far addressing. To be
   compatible with QuickBASIC's method, you should use Medium Model settings
   for both compilers. In fact, this is the default setting for QuickC,
   making it easy for you to write QuickC routines to be called from
   QuickBASIC.


 Passing Variables

   Most programming languages, including QuickBASIC and QuickC, let you pass
   variables to called subprograms, functions, and subroutines by listing
   them in parentheses as part of the calling statement. This list matches
   one for one the parameters defined and used in the called routine.

   You can pass these parameters to and from a subprogram or function by
   reference or by value. Some languages pass the address of the referenced
   variable, and changes made to the variable by the routine modify the
   contents of memory that this address points to. Other languages pass
   copies of the values of the variables. Changes to the passed variables
   don't affect the originals because the changes are made only to the
   copies.

   The important concept is that both the calling routine and the called
   routine must agree as to how they pass parameters back and forth. For
   example, QuickBASIC usually passes parameters by reference, and QuickC by
   value. Fortunately, both languages let you control whether parameters are
   passed by value or by reference. See the CDECL modifier of the QuickBASIC
   DECLARE statement for an example of how you can control parameter passing.

   Parameter passing can also vary from language to language in the order in
   which the parameters are pushed onto the stack as well as in the method
   used to remove these parameters from the stack when the called routine is
   finished. For example, consider a QuickBASIC program that passes
   parameters (A, B, C) to a QuickC subprogram. The QuickC routine processes
   the parameters as (C, B, A). The CDECL modifier in the QuickBASIC DECLARE
   statement can tell QuickBASIC to reverse the normal order of parameter
   pushing to be compatible with QuickC.

   In most languages, when a subprogram or function is finished, the
   parameters are removed from the stack before the routine returns to the
   calling program. QuickC routines expect the calling program to clean up
   the stack after the return. (This allows passing a variable number of
   parameters in C.) The CDECL modifier instructs QuickBASIC to clean up the
   stack after calling a subprogram or function.

   By using standard parameter-passing techniques and by following the
   examples in this book and in your Microsoft QuickBASIC and Microsoft Macro
   Assembler manuals, you'll find mixed-language programming easy and
   convenient.

   The routines in Part III of this book demonstrate passing integers, arrays
   of integers, and string variables. The Microsoft Macro Assembler was used
   to develop the mouse interface subprogram, and Microsoft QuickC was used
   to create some bit manipulation and byte-movement routines.


 Creating Mixed-Language Toolboxes

   In the section "Using QuickBASIC Toolboxes," you will find the steps to
   follow for using the QuickC and Macro Assembler routines presented in Part
   III of this book. Please see "Creating MIXED.QLB," beginning on page 22.

   In addition to compiling from the system prompt, you can also compile each
   QuickC toolbox, CTOOLS1.C and CTOOLS2.C, from within the QuickC
   environment. Run QuickC by typing QC, and notice that the environment is
   very similar in appearance and feel to that of QuickBASIC. Pull down the
   Files menu and choose Open. Select CTOOLS1.C to load the first toolbox
   into QuickC. Then pull down the Run menu and choose Compile. A dialog box
   opens, providing several compiling options. In the Output Options section,
   select Obj, rather than the default Memory, and then select Compile File,
   rather than the default Build Program option. You can experiment with the
   options listed under Miscellaneous, but selecting Optimizations and
   deselecting the Stack Checking and Debug options generally results in a
   smaller .OBJ file. QuickC then compiles the CTOOLS1.C source code
   currently in memory and writes the resulting CTOOLS1.OBJ file to disk.
   Repeat the process for the CTOOLS2.C file.

   Once you have created the object-code files and the MIXED.QLB Quick
   Library and have loaded MIXED.QLB with QuickBASIC, you can then call any
   or all of the QuickC and Macro Assembler functions and subprograms from
   within programs running in the QuickBASIC environment. Be sure to declare
   the subprogram or function in the module-level code, and then call the
   routines freely, as though they were part of the standard set of
   QuickBASIC functions and commands.

   Once a program is running as desired in the QuickBASIC environment you may
   want to compile it into a stand-alone .EXE format file. Simply compile the
   program from within QuickBASIC and the appropriate .LIB file will be
   searched. The MIXED.LIB file will automatically pull in the necessary code
   during the LINK process.

   NOTE: You must have QuickC installed to compile CDEMO1 and CDEMO2 into
   executable files.

 Assembly Source-Code Files

   The CASEMAP.ASM and MOUSE.ASM source-code files are listed here for your
   convenience in building both the MIXED.QLB and MIXED.LIB libraries.

   The CASEMAP.ASM subprogram is called by TranslateCountry$, a function
   found in the DOSCALLS module, to translate each character, one at a time.

   This routine demonstrates how you can use QuickBASIC's DECLARE statement
   to pass parameters by value rather than by reference. In this case, the
   segment- and offset-address parameters for the MS-DOS translation routine
   are passed by value, resulting in a very efficient branch to the MS-DOS
   character-translation routine from CaseMap.

   ──────────────────────────────────────────────────────────────────────────
    ; **********************************************
    ; **  CASEMAP.ASM                   MASM 5.0  **
    ; **                                          **
    ; **  Assembly subprogram for translating     **
    ; **  some characters according to the        **
    ; **  currently loaded MS-DOS country-        **
    ; **  dependent information.                  **
    ; **                                          **
    ; **  Use:  CALL CASEMAP (CHAR%, SEG%, OFS%)  **
    ; **  Note: CHAR% is passed by reference      **
    ; **        SEG% and OFS% are passed by value **
    ; **********************************************
    ;
    ; EXAMPLE OF USE:  CALL CaseMap (char%, seg%, ofs%)
    ; PARAMETERS:      char%      Character byte to be translated
    ;                  seg%       Segment of address of MS-DOS translate routi
    ;                  ofs%       Offset of address of MS-DOS translate routin
    ; VARIABLES:       (none)
    ; MODULE LEVEL
    ;   DECLARATIONS:  DECLARE SUB GetCountry (country AS CountryType)
    ;                  DECLARE SUB CaseMap (character%, BYVAL Segment%,
    ;                                       BYVAL Offset%)
    ;                  DECLARE FUNCTION TranslateCountry$ (a$, country AS Coun


   .MODEL  MEDIUM
   .CODE
           public  casemap

   casemap proc

   ; Standard entry
           push    bp
           mov     bp,sp

   ; Get CHAR% into AX register
           mov     bx,[bp+10]
           mov     ax,[bx]

   ; Call the translate function in MS-DOS
           call    dword ptr [bp+6]

   ; Return translated character to CHAR%
           mov     bx,[bp+10]
           mov     [bx],ax

   ; Standard exit, assumes three variables passed
           pop     bp
           ret     6

   ; End of the procedure
   casemap endp
           end
   ──────────────────────────────────────────────────────────────────────────

   The MOUSE.ASM subprogram provides a fast and efficient method of
   interfacing QuickBASIC with the memory-resident mouse-driver software.
   (See your mouse documentation for information on loading this driver into
   memory.)

   ──────────────────────────────────────────────────────────────────────────
    ; **********************************************
    ; **  MOUSE.ASM              Macro Assembler  **
    ; **                                          **
    ; **  Assembly subprogram for accessing the   **
    ; **  Microsoft Mouse from QuickBASIC 4.00    **
    ; **                                          **
    ; **  Use:  CALL MOUSE (M1%, M2%, M3%, M4%)   **
    ; **********************************************
     ;
    ; EXAMPLE OF USE:  CALL Mouse (m1%, m2%, m3%, m4%)
    ; PARAMETERS:      m1%        Passed in AX to the mouse driver
    ;                  m2%        Passed in BX to the mouse driver
    ;                  m3%        Passed in CX to the mouse driver
    ;                  m4%        Passed in DX to the mouse driver
    ; VARIABLES:       (none)
    ; MODULE LEVEL
    ;   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)

   .MODEL  MEDIUM
   .CODE
           public  mouse

   mouse   proc

   ; Standard entry
           push    bp
           mov     bp,sp

   ; Get M1% and store it on the stack
           mov     bx,[bp+12]
           mov     ax,[bx]
           push    ax

   ; Get M2% and store it on the stack
           mov     bx,[bp+10]
           mov     ax,[bx]
           push    ax

   ; Get M3% into CX register
           mov     bx,[bp+8]
           mov     cx,[bx]

   ; Get M4% into DX register
           mov     bx,[bp+6]
           mov     dx,[bx]

   ; Move M2% from stack into BX register
           pop     bx

   ; Move M1% from stack into AX register
           pop     ax

   ; Set ES to same as DS (for mouse function 9)
           push    ds
           pop     es

   ; Do the mouse interrupt
           int     33h

   ; Save BX (M2%) on stack to free register
           push    bx

   ; Return M1% from AX
           mov     bx,[bp+12]
           mov     [bx],ax

   ; Return M2% from stack (was BX)
           pop     ax
           mov     bx,[bp+10]
           mov     [bx],ax

   ; Return M3% from CX
           mov     bx,[bp+8]
           mov     [bx],cx

   ; Return M4% from DX
           mov     bx,[bp+6]
           mov     [bx],dx

   ; Standard exit, assumes four variables passed
           pop     bp
           ret     8

   ; End of this procedure
   mouse   endp
           end
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 CDEMO1.BAS AND CTOOLS1.C

   The CDEMO1.BAS program is a QuickBASIC program that demonstrates the
   proper declaration and calling of the QuickC routines presented in the
   CTOOLS1.C toolbox.

   The IsIt[Type]% functions can efficiently determine the classification of
   any character, given its ASCII numeric value. For example, given c% =
   ASC("A"), the IsItAlnum%, IsItAlpha%, IsItAscii%, IsItGraph%,
   IsItPrint%, IsItUpper%, and IsItXDigit% functions all return a true
   (non-zero) value, and all other functions return zero.

   The MovBytes and MovWords subprograms allow movement of bytes or words
   from any location in memory to any other, using the QuickC movedata
   function. You can use these subprograms to copy the contents of variables
   into variables of a different type. The eight bytes of a double-precision
   number, for example, can be easily extracted from an eight-character
   string after the data has been moved from the number into the string.
   Large arrays of data can efficiently be moved into arrays of a different
   type, and video memory can be stored in a string, as demonstrated by the
   module-level code of CDEMO1.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   CDEMO1.BAS                      QuickBASIC program module
   CTOOLS1.C                       C-language toolbox containing
                                    functions/subprograms
   IsItAlnum%              Func    Alphanumeric character determination
   IsItAlpha%              Func    Alphabetic character determination
   IsItAscii%              Func    Standard ASCII character determination
   IsItCntrl%              Func    Control character determination
   IsItDigit%              Func    Decimal digit (0─9) determination
   IsItGraph%              Func    Graphics character determination
   IsItLower%              Func    Lowercase character determination
   IsItPrint%              Func    Printable character determination
   IsItPunct%              Func    Punctuation character determination
   IsItSpace%              Func    Space character determination
   IsItUpper%              Func    Uppercase character determination
   IsItXDigit%             Func    Hexadecimal character determination
   MovBytes                Sub     Moves bytes from one location to another
   MovWords                Sub     Moves blocks of words in memory
   ──────────────────────────────────────────────────────────────────────────


 Program Module: CDEMO1

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CDEMO1                     **
     ' **  Type:          Program                    **
     ' **  Module:        CDEMO1.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' Demonstrates the QuickC routines presented in
     ' the file CTOOLS1.C.
     '
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    CGA
     '                  MIXED.QLB/.LIB
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       a%(0 TO 1999) Storage space for first text screen
     '                  b%(0 TO 1999) Storage space for second text screen
     '                  i%            Looping index
     '                  sseg%         Word and byte move source segment
     '                                part of address
     '                  soff%         Word and byte move source offset
     '                                part of address
     '                  dseg%         Word and byte move destination segment
     '                                part of address
     '                  doff%         Word and byte move destination offset
     '                                part of address
     '                  nwords%       Number of words to move
     '                  nbytes%       Number of bytes to move
     '                  t$            Copy of TIME$
     '                  quitflag%     Signal to end first demonstration

     ' Functions
       DECLARE FUNCTION IsItAlnum% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItAlpha% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItAscii% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItCntrl% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItDigit% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItGraph% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItLower% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItPrint% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItPunct% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItSpace% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItUpper% CDECL (BYVAL c AS INTEGER)
       DECLARE FUNCTION IsItXDigit% CDECL (BYVAL c AS INTEGER)

     ' Subprograms
       DECLARE SUB MovBytes CDECL (sseg%, soff%, dseg%, doff%, nbytes%)
       DECLARE SUB MovWords CDECL (sseg%, soff%, dseg%, doff%, nwords%)

     ' Make two buffers for the first page of video memory
       DIM a%(0 TO 1999), b%(0 TO 1999)

     ' Prevent scrolling when printing in row 25, column 80
       VIEW PRINT 1 TO 25

     ' Create the first page of text
       CLS
       COLOR 14, 4
       FOR i% = 1 TO 25
           PRINT STRING$(80, 179);
       NEXT i%
       COLOR 15, 1
       LOCATE 11, 25
       PRINT STRING$(30, 32);
       LOCATE 12, 25
       PRINT "    -  Calling MovWords  -    "
       LOCATE 13, 25
       PRINT STRING$(30, 32);

     ' Move the screen memory into the first array
       sseg% = &HB800
       soff% = 0
       dseg% = VARSEG(a%(0))
       doff% = VARPTR(a%(0))
       nwords% = 2000
       MovWords sseg%, soff%, dseg%, doff%, nwords%

     ' Create the second page of text
       CLS
       COLOR 14, 4
       FOR i% = 1 TO 25
           PRINT STRING$(80, 196);
       NEXT i%
       COLOR 15, 1
       LOCATE 11, 25
       PRINT STRING$(30, 32);
       LOCATE 12, 25
       PRINT "    -  Calling MovBytes  -    "
       LOCATE 13, 25
       PRINT STRING$(30, 32);

     ' Move the screen memory into the second array
       sseg% = &HB800
       soff% = 0
       dseg% = VARSEG(b%(0))
       doff% = VARPTR(b%(0))
       nwords% = 2000
       MovWords sseg%, soff%, dseg%, doff%, nwords%

     ' Set destination to the video screen memory
       dseg% = &HB800
       doff% = 0

     ' Do the following until a key is pressed
       DO

         ' Move 2000 words from first array to screen memory
           sseg% = VARSEG(a%(0))
           soff% = VARPTR(a%(0))
           nwords% = 2000
           MovWords sseg%, soff%, dseg%, doff%, nwords%

         ' Wait one second
           t$ = TIME$
           DO
               IF INKEY$ <> "" THEN
                   t$ = ""
                   quitFlag% = 1
               END IF
           LOOP UNTIL TIME$ <> t$

         ' Move 4000 bytes from second array to screen memory
           sseg% = VARSEG(b%(0))
           soff% = VARPTR(b%(0))
           nbytes% = 4000
           MovBytes sseg%, soff%, dseg%, doff%, nbytes%

         ' Wait one second
           t$ = TIME$
           DO
               IF INKEY$ <> "" THEN
                   t$ = ""
                   quitFlag% = 1
               END IF
           LOOP UNTIL TIME$ <> t$

       LOOP UNTIL quitFlag%

     ' Create a table of all 256 characters and their type designations
       FOR i% = 0 TO 255

         ' After each screenful, display a heading
           IF i% MOD 19 = 0 THEN

             ' If not the first heading, prompt user before continuing
               IF i% THEN
                   PRINT
                   PRINT "Press any key to continue"
                   DO WHILE INKEY$ = ""
                   LOOP
               END IF

             ' Print the heading
               CLS
               PRINT "Char   Alnum Alpha Ascii Cntrl Digit Graph ";
               PRINT "Lower Print Punct Space Upper XDigit"
               PRINT
           END IF

         ' Some characters we don't want to display
           SELECT CASE i%
           CASE 7, 8, 9, 10, 11, 12, 13, 29, 30, 31
               PRINT USING "###    "; i%;
           CASE ELSE
               PRINT USING "### \ \"; i%, CHR$(i%);
           END SELECT

         ' Display "1" if test is true, "0" otherwise
           PRINT USING "  #   "; 1 + (0 = IsItAlnum%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItAlpha%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItAscii%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItCntrl%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItDigit%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItGraph%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItLower%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItPrint%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItPunct%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItSpace%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItUpper%(i%));
           PRINT USING "  #   "; 1 + (0 = IsItXDigit%(i%))

       NEXT i%
       END
   ──────────────────────────────────────────────────────────────────────────


 Toolbox: CTOOLS1.C

   The CTOOLS1.C toolbox provides access to the efficient QuickC functions
   for classifying characters and to QuickC's fast memory move functions for
   copying blocks of bytes or words from any location in memory to any other.

   You can determine character types using QuickBASIC code, but the QuickC
   routines are optimized for speed. Also, adhering to the definitions
   provided by QuickC guarantees that character classifications will be the
   same for both languages.

   You must add both of the following #include statements at the top of the
   CTOOLS1.C source-code file, before the function definitions are given.
   These two statements pull in the contents of header files necessary for
   correct compilation by QuickC:


     #include <ctype.h>
     #include <memory.h>


 Function: IsItAlnum%

   Determines whether a character is alphanumeric. This function returns a
   non-zero value if the integer value represents an alphanumeric ASCII
   character or a zero if the value does not. Alphanumeric characters are in
   the ranges A through Z, a through z, and 0 through 9.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItAlnum%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:   result% = IsItAlnum%(c%)
   * PARAMETERS:       c%         ASCII character code
   * VARIABLES:        (none)
   * MODULE LEVEL
   *   DECLARATIONS:   #include <ctype.h>        */


   int isitalnum (c)
   int c;
       {
       return (isalnum(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItAlpha%

   Determines whether a character is alphabetic. This function returns a
   non-zero value if the integer value represents an alphabetic ASCII
   character or a zero if the value does not. The alphabetic characters are
   in the ranges A through Z and a through z.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItAlpha%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:   result% = IsItAlpha%(c%)
   * PARAMETERS:       c%         ASCII character code
   * VARIABLES:        (none)
   * MODULE LEVEL
   *   DECLARATIONS:   #include <ctype.h>        */


   int isitalpha (c)
   int c;
       {
       return (isalpha(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItAscii%

   Determines whether a character is standard ASCII. This function returns a
   non-zero value if the integer value represents an ASCII character or a
   zero if the value does not. The ASCII character values are in the range 0
   through 127.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItAscii%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:  result% = IsItAscii%(c%)
   * PARAMETERS:      c%         ASCII character code
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <ctype.h>         */


   int isitascii (c)
   int c;
       {
       return (isascii(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItCntrl%

   Determines whether a character is a control character. This function
   returns a non-zero value if the integer value represents a control
   character or a zero if the value does not. The control characters are in
   the range 0 through 31, and 127.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItCntrl%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:   result% = IsItCntrl%(c%)
   * PARAMETERS:       c%         ASCII character code
   * VARIABLES:        (none)
   * MODULE LEVEL
   *   DECLARATIONS:   #include <ctype.h>        */


   int isitcntrl (c)
   int c;
       {
       return (iscntrl(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItDigit%

   Determines whether a character is a numeric digit. This function returns a
   non-zero value if the integer value represents a decimal digit or a zero
   if the value does not. The digit characters are in the range 0 through 9.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItDigit%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   ──────────────────────────────────────────────────────────────────────────

   * EXAMPLE OF USE:  result% = IsItDigit%(c%)

   * PARAMETERS:      c%         ASCII character code

   * VARIABLES:       (none)

   * MODULE LEVEL

   *   DECLARATIONS:  #include <ctype.h>         */





   int isitdigit (c)

   int c;

       {

       return (isdigit(c));

       }


 Function: IsItGraph%

   Determines whether a character is graphic. This function returns a
   non-zero value if the integer value represents a printable character, not
   including the space character. These character values are in the range 33
   through 126.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItGraph%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:  result% = IsItGraph%(c%)
   * PARAMETERS:      c%         ASCII character code
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <ctype.h>         */


   int isitgraph (c)
   int c;
       {
       return (isgraph(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItLower%

   Determines whether a character is lowercase. This function returns a
   non-zero value if the integer value represents a lowercase character or a
   zero if the value does not. The lowercase characters are in the range a
   through z.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItLower%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:  result% = IsItLower%(c%)
   * PARAMETERS:      c%         ASCII character code
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <ctype.h>         */


   int isitlower (c)
   int c;
       {
       return (islower(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItPrint%

   Determines whether a character is printable. This function returns a
   non-zero value if the integer value represents a printable character or a
   zero if the value does not. The printable characters are in the range 32
   through 126.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItPrint%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:  result% = IsItPrint%(c%)
   * PARAMETERS:      c%         ASCII character code
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <ctype.h>         */


   int isitprint (c)
   int c;
       {
       return (isprint(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItPunct%

   Determines whether a character is punctuation. This function returns a
   non-zero value if the integer value represents a punctuation character or
   a zero if the value does not. The punctuation characters are in the ranges
   33 through 47, 59 through 64, 91 through 96, or 123 through 126.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItPunct%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:  result% = IsItPunct%(c%)
   * PARAMETERS:      c%         ASCII character code
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <ctype.h>         */


   int isitpunct (c)
   int c;
       {
       return (ispunct(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItSpace%

   Determines whether a character is white space. This function returns a
   non-zero value if the integer value represents a white-space character or
   a zero if the value does not. The white-space character values are in the
   range 9 through 13, and 32.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItSpace%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:  result% = IsItSpace%(c%)
   * PARAMETERS:      c%         ASCII character code
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <ctype.h>         */


   int isitspace (c)
   int c;
       {
       return (isspace(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItUpper%

   Determines whether a character is uppercase. This function returns a
   non-zero value if the integer value represents an uppercase character or a
   zero if the value does not. The uppercase characters are in the range A
   through Z.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItUpper%                  **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:   result% = IsItUpper%(c%)
   * PARAMETERS:       c%         ASCII character code
   * VARIABLES:        (none)
   * MODULE LEVEL
   *   DECLARATIONS:   #include <ctype.h>         */

   int isitupper (c)
   int c;
       {
       return (isupper(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: IsItXDigit%

   Determines whether a character is a hexadecimal digit. This function
   returns a non-zero value if the integer value represents a hexadecimal
   character or a zero if the value does not. The hexadecimal characters are
   in the ranges 0 through 9, a through f, or A through F.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         IsItXDigit%                 **
   **  Type:         Function                    **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * EXAMPLE OF USE:  result% = IsItXDigit%(c%)
   * PARAMETERS:      c%         ASCII character code
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <ctype.h>         */


   int isitxdigit (c)
   int c;
       {
       return (isxdigit(c));
       }
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MovBytes

   Calls the QuickC movedata function to quickly copy a block of bytes from
   any address in memory to any other.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         MovBytes                    **
   **  Type:         Subprogram                  **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   *  Moves bytes from a source segment and offset
   *  location in memory to a destination segment and
   *  offset location.
   *
   *  EXAMPLE OF USE:  MovBytes sseg%, soff%, dseg%, doff%, nbytes%
   *  PARAMETERS:      sseg%      Source segment address of bytes to be moved
   *                   soff%      Source offset address of bytes to be moved
   *                   dseg%      Destination segment address of bytes to be m
   *                   doff%      Destination offset address of bytes to be mo
   *                   nbytes%    Number of bytes to be moved
   * VARIABLES:        (none)
   * MODULE LEVEL
   *   DECLARATIONS:   #include <memory.h>     */


   void movbytes (srcseg, srcoff, destseg, destoff, nbytes)
   unsigned int *srcseg, *srcoff, *destseg, *destoff, *nbytes;
       {
       movedata(*srcseg, *srcoff, *destseg, *destoff, *nbytes);
       }
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: MovWords

   Moves a block of words from any memory location to any other. This
   subprogram calls the QuickC movedata function to quickly copy a block of
   words from any address in memory to any other.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         MovWords                    **
   **  Type:         Subprogram                  **
   **  Module:       CTOOLS1.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   *  Moves words from a source segment and offset
   *  location in memory to a destination segment and
   *  offset location.
   *
   * EXAMPLE OF USE:  MovWords sseg%, soff%, dseg%, doff%, nbytes%
   * PARAMETERS:      sseg%      Source segment address of words to be moved
   *                  soff%      Source offset address of words to be moved
   *                  dseg%      Destination segment address of words to be mo
   *                  doff%      Destination offset address of words to be mov
   *                  nwords%    Number of words to be moved
   * VARIABLES:       (none)
   * MODULE LEVEL
   *   DECLARATIONS:  #include <memory.h>        */


   void movwords (srcseg, srcoff, destseg, destoff, nwords)
   unsigned int *srcseg, *srcoff, *destseg, *destoff, *nwords;
       {
       unsigned int nbytes;

       nbytes = *nwords + *nwords;
       movedata(*srcseg, *srcoff, *destseg, *destoff, nbytes);
       }
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 CDEMO2.BAS AND CTOOLS2.C

   The CDEMO2.BAS program is a QuickBASIC program that demonstrates the
   proper declaration and calling of the QuickC routines presented in the
   CTOOLS2.C toolbox.

   The MenuString% function creates a horizontal bar menu, similar to the
   menu line at the top of the display in the QuickBASIC environment. The
   function call returns the number of the word selected. You can place the
   menu bar anywhere on the screen, and it can contain any number of one-word
   choices. The first letter of each word must be uppercase, and no more than
   two words can have the same first letter.

   The BitShiftLeft% and BitShiftRight% functions let you shift all the
   bits in a string of bytes one position to the left or right. Each function
   returns the bit shifted off the end of the string and shifts in a zero at
   the other end.

   The NumberOfBits& function returns the number of bits in all the bytes of
   a string. You could do this by using the bit-shifting functions and adding
   up the returned values, but the NumberOfBits& function is much faster.
   The string contents are unchanged by the function.

   The PackWord and UnPackWord subprograms let you pack and unpack two byte
   values (integers in the range 0 through 255) into an integer variable.
   This can be accomplished using the QuickBASIC math functions (although it
   gets complicated when dealing with negative numbers), but QuickC has
   features ideal for performing these types of data manipulations. By
   declaring a union of a two-byte structure with an integer, the bytes can
   simply be moved into place instead of calculated.

   The TextGet and TextPut subprograms let you quickly save and restore
   rectangular areas of the text-mode screen. These routines are similar in
   concept to the QuickBASIC GET and PUT statements that save and restore
   rectangular areas of graphics-mode screens. Unlike the GET and PUT
   statements, though, the rectangular area restored can be of a different
   shape than the area that was saved. The total number of bytes must be
   identical, but the width and height of the area can differ. The program
   module first prints a line of text that is saved into a string using
   TextGet and is then restored in a vertical (one column wide) rectangular
   area.

   Name                     Type    Description
   ──────────────────────────────────────────────────────────────────────────
   CDEMO2.BAS                      QuickBASIC program module
   CTOOLS2.C                       C-language toolbox containing
                                    functions/subprograms
   BitShiftLeft%           Func    Shifts all bits in a string left one bit
   BitShiftRight%          Func    Shifts all bits in a string right one bit
   MenuString%             Func    Bar menu and user response function
   NumberOfBits&           Func    Determines number of 1 bits in a string
   PackWord                Sub     Packs two bytes into an integer value
   TextGet                 Sub     Saves characters and attributes from area
                                    of screen
   TextPut                 Sub     Restores text from TextGet to screen
   UnPackWord              Sub     Unpacks values from high and low bytes
   ──────────────────────────────────────────────────────────────────────────


 Program Module: CDEMO2

   ──────────────────────────────────────────────────────────────────────────
     ' ************************************************
     ' **  Name:          CDEMO2                     **
     ' **  Type:          Program                    **
     ' **  Module:        CDEMO2.BAS                 **
     ' **  Language:      Microsoft QuickBASIC 4.00  **
     ' ************************************************
     '
     ' USAGE:           No command line parameters
     ' REQUIREMENTS:    CGA
     '                  MIXED.QLB/.LIB
     ' .MAK FILE:       (none)
     ' PARAMETERS:      (none)
     ' VARIABLES:       m$            Menu string
     '                  word%         Integer to be packed with two bytes
     '                  hi%           Most significant byte unpacked from an
     '                                integer
     '                  lo%           Least significant byte unpacked from an
     '                                integer
     '                  a$            Workspace for TextGet and TextPut
     '                  b$            Workspace for TextGet and TextPut
     '                  n%            Timing constant for TextPut demonstratio
     '                  row%          Row location to put small "window" using
     '                                TextPut
     '                  col%          Column location to put small "window" us
     '                                TextPut
     '                  t0            Timer variable
     '                  x$            String variable for bit shifting
     '                  i%            Looping index

     ' Functions
       DECLARE FUNCTION MenuString% CDECL (row%, col%, a$)
       DECLARE FUNCTION BitShiftleft% CDECL (a$)
       DECLARE FUNCTION BitShiftRight% CDECL (a$)
       DECLARE FUNCTION NumberOfBits& CDECL (a$)

     ' Subprograms
       DECLARE SUB PackWord CDECL (word%, hi%, lo%)
       DECLARE SUB UnPackWord CDECL (word%, hi%, lo%)
       DECLARE SUB TextGet CDECL (r1%, c1%, r2%, c2%, a$)
       DECLARE SUB TextPut CDECL (r1%, c1%, r2%, c2%, a$)

     ' Build menu string
       m$ = "Packword Unpackword Textget Textput "
       m$ = m$ + "Bitshiftleft Bitshiftright Numberofbits Quit"

     ' Let user repeatedly select the demonstrations
       DO
           COLOR 15, 1
           CLS
           PRINT
           PRINT
           PRINT "MenuString function..."
           PRINT
           PRINT "Select one of the CTOOLS2 demonstrations by ";
           PRINT "pressing the Left arrow,"
           PRINT "Right arrow, first letter of the choice, or Enter keys."

         ' Use MenuString to choose demonstrations
           SELECT CASE MenuString%(1, 1, m$)

         ' PackWord demonstration
           CASE 1

               CLS
               PRINT "PackWord word%, 255, 255  ...  word% = ";
               PackWord word%, 255, 255
               PRINT word%
               PRINT "PackWord word%,   0,   1  ...  word% = ";
               PackWord word%, 0, 1
               PRINT word%
               PRINT "PackWord word%,   1,   0  ...  word% = ";
               PackWord word%, 1, 0
               PRINT word%

               PRINT
               PRINT "Press any key to continue..."

               DO
               LOOP UNTIL INKEY$ <> ""

         ' UnPackWord demonstration
           CASE 2

               CLS
               PRINT "UnPackWord  -1, hi%, lo%  ...  hi%, lo% =";
               UnPackWord -1, hi%, lo%
               PRINT hi%; lo%
               PRINT "UnPackWord   1, hi%, lo%  ...  hi%, lo% =";
               UnPackWord 1, hi%, lo%
               PRINT hi%; lo%
               PRINT "UnPackWord 256, hi%, lo%  ...  hi%, lo% =";
               UnPackWord 256, hi%, lo%
               PRINT hi%; lo%

               PRINT
               PRINT "Press any key to continue..."

               DO
               LOOP UNTIL INKEY$ <> ""

         ' TextGet and TextPut demonstration
           CASE 3, 4

             ' TextGet a line of text
               CLS
               PRINT "A Vertical Message"
               a$ = SPACE$(36)
               TextGet 1, 1, 1, 18, a$

             ' TextPut it back, but stretch it vertically
               TextPut 6, 1, 23, 1, a$

             ' Now just a normal line of text at top
               LOCATE 1, 1
               PRINT "TextGet and TextPut - Press any key to stop"

             ' Create first of two colorful text patterns
               COLOR 14, 4
               LOCATE 13, 13, 0
               PRINT CHR$(201); CHR$(205); CHR$(209); CHR$(205); CHR$(187)
               LOCATE 14, 13, 0
               PRINT CHR$(199); CHR$(196); CHR$(197); CHR$(196); CHR$(182)
               LOCATE 15, 13, 0
               PRINT CHR$(200); CHR$(205); CHR$(207); CHR$(205); CHR$(188)
               a$ = SPACE$(30)
               TextGet 13, 13, 15, 17, a$

             ' Create second of two colorful text patterns
               COLOR 10, 1
               LOCATE 13, 13, 0
               PRINT CHR$(218); CHR$(196); CHR$(210); CHR$(196); CHR$(191)
               LOCATE 14, 13, 0
               PRINT CHR$(198); CHR$(205); CHR$(206); CHR$(205); CHR$(181)
               LOCATE 15, 13, 0
               PRINT CHR$(192); CHR$(196); CHR$(208); CHR$(196); CHR$(217)
               b$ = SPACE$(30)
               TextGet 13, 13, 15, 17, b$

             ' Randomly pop up little "windows"
               n% = 0
               DO
                   row% = INT(RND * 21 + 3)
                   col% = INT(RND * 73 + 4)
                   TextPut row%, col%, row% + 2, col% + 4, a$
                   row% = INT(RND * 21 + 3)
                   col% = INT(RND * 73 + 4)
                   TextPut row%, col%, row% + 2, col% + 4, b$
                   IF n% < 10 THEN
                       n% = n% + 1
                       t0 = TIMER
                       DO
                       LOOP UNTIL TIMER > t0 + (10 - n%) / 10
                   END IF
               LOOP UNTIL INKEY$ <> ""

         ' BitShiftLeft demonstration
           CASE 5

               CLS
               x$ = "This string will be shifted left 8 bits"
               PRINT x$
               FOR i% = 1 TO 8
                   PRINT "bit ="; BitShiftleft%(x$)
               NEXT i%
               PRINT x$

               PRINT
               PRINT "Press any key to continue..."

               DO
               LOOP UNTIL INKEY$ <> ""

         ' BitShiftRight demonstration
           CASE 6

               CLS
               x$ = "This string will be shifted right 8 bits"
               PRINT x$
               FOR i% = 1 TO 8
                   PRINT "bit ="; BitShiftRight%(x$)
               NEXT i%
               PRINT x$

               PRINT
               PRINT "Press any key to continue..."

               DO
               LOOP UNTIL INKEY$ <> ""

         ' BitShiftRight demonstration
           CASE 7

               CLS
               x$ = "The number of bits in this string is ..."
               PRINT x$
               PRINT NumberOfBits&(x$)

               PRINT
               PRINT "Press any key to continue..."

               DO
               LOOP UNTIL INKEY$ <> ""

         ' Must be time to quit
           CASE ELSE
               COLOR 7, 0
               CLS
               END
           END SELECT
       LOOP
   ──────────────────────────────────────────────────────────────────────────


 Toolbox: CTOOLS2.C

   The CTOOLS2.C toolbox provides a collection of functions and subprograms
   that perform tasks that QuickC is well suited for.

   You must enter the following block of lines into the first lines of the
   CTOOLS2.C source-code file, immediately before the functions and
   subprograms. Note that the definition for VIDEO_START should be changed to
   0xb0000000 for monochrome operation.


     #include <ctype.h>
     #include <conio.h>

     #define VIDEO_START         0xb8000000

     #define BLACK_ON_CYAN       48
     #define RED_ON_CYAN         52
     #define BRIGHT_WHITE_ON_RED 79

     #define ENTER               13
     #define RIGHT_ARROW         77
     #define LEFT_ARROW          75

     /* Definition of the QuickBASIC string descriptor structure */
     struct bas_str
         {
         int  sd_len;
         char *sd_addr;
         };


 Function: BitShiftLeft%

   Shifts all bits in a QuickBASIC string variable to the left one bit
   position. The number of bits in a string is eight times the length of the
   string. The function returns the leftmost bit of the first character of
   the string.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         BitShiftLeft%               **
   **  Type:         Function                    **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * Shifts all bits in a QuickBASIC string one bit
   * to the left.  The leftmost bit is returned, and
   * the rightmost bit is set to zero.
   *
   * EXAMPLE OF USE:  bit% = BitShiftLeft%(bit$)
   * PARAMETERS:      bit$       String containing a bit pattern
   * VARIABLES:       len        Length of the string (number of bytes)
   *                  str        Pointer to string contents
   *                  i          Looping index to each byte of the string
   *                  carry      Bit carried over from byte to byte
   *                  the_byte   Working copy of each byte of the string
   *
   * Definition of the QuickBASIC string descriptor structure
   *    struct bas_str
   *        {
   *        int  sd_len;
   *        char *sd_addr;
   *        };                                    */


   int bitshiftleft (basic_string)
   struct bas_str *basic_string;
       {
       int len = basic_string->sd_len;
       unsigned char *str = basic_string->sd_addr;
       int i, carry;
       unsigned int the_byte;

       for (i=len-1, carry=0; i>=0; i--)
           {
           the_byte = *(str + i);
           *(str + i) = (the_byte << 1) + carry;
           carry = the_byte >> 7;
           }

       return (carry);
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: BitShiftRight%

   Shifts all bits in a QuickBASIC string variable to the right one bit
   position. The number of bits in a string is eight times the length of the
   string. The function returns the rightmost bit of the last character of
   the string.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         BitShiftRight%              **
   **  Type:         Function                    **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * Shifts all bits in a QuickBASIC string one bit to
   * the right.  The rightmost bit is returned, and the
   * leftmost bit is set to zero.
   *
   * EXAMPLE OF USE:  bit% = BitShiftRight%(bit$)
   * PARAMETERS:      bit$       String containing a bit pattern
   * VARIABLES:       len        Length of the string (number of bytes)
   *                  str        Pointer to string contents
   *                  i          Looping index to each byte of the string
   *                  carry      Bit carried over from byte to byte
   *                  the_byte   Working copy of each byte of the string
   *
   * Definition of the QuickBASIC string descriptor structure
   *    struct bas_str
   *        {
   *        int  sd_len;
   *        char *sd_addr;
   *        };                                             */

   int bitshiftright (basic_string)
   struct bas_str *basic_string;
       {
       int len = basic_string->sd_len;
       unsigned char *str = basic_string->sd_addr;
       int i, carry;
       unsigned int the_byte;

       for (i=0, carry=0; i<len; i++)
           {
           the_byte = *(str + i);
           *(str + i) = (the_byte >> 1) + carry;
           carry = (the_byte & 1) << 7;
           }

       if (carry)
           return(1);
       else
           return(0);
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: MenuString%

   Creates a horizontal menu bar, highlights the one-word choices, and
   returns the number of the choice selected when the Enter key is pressed.
   The menu is highlighted using the same color scheme as the main pull-down
   menu bars of both the QuickBASIC and QuickC environments.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         MenuString%                 **
   **  Type:         Function                    **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   *  Displays a horizontal bar menu and waits for a
   *  response from the user.  Returns the number of
   *  the word selected from the string.
   * EXAMPLE OF USE:  choice% = MenuString%(row%, col%, menu$)
   * PARAMETERS:      row%       Row location to display the menu string
   *                  col%       Column location to display the menu string
   *                  menu$      String containing list of words representing
   *                             choices
   * VARIABLES:       len        Length of the menu string
   *                  str        Pointer to string contents
   *                  vidptr     Pointer to video memory
   *                  attribute  Index into string
   *                  character  Character from keyboard press
   *                  both       Combination of a character and its attribute
   *                  i          Looping index
   *                  j          Looping index
   *                  k          Looping index
   *                  c          Looping index
   *                  choice     Menu selection number
   *                  wordnum    Sequential count of each word in the menu str
   *                  refresh    Signals to redraw the menu string
   * #include <ctype.h>
   * #include <conio.h>
   * #define VIDEO_START         0xb8000000
   * #define BLACK_ON_CYAN       48
   * #define RED_ON_CYAN         52
   * #define BRIGHT_WHITE_ON_RED 79
   * #define ENTER               13
   * #define RIGHT_ARROW         77
   * #define LEFT_ARROW          75
   *
   * Definition of the QuickBASIC string descriptor structure
   *    struct bas_str
   *        {
   *        int  sd_len;
   *        char *sd_addr;
   *        };                                        */


   int menustring (row, col, basic_string)
   int *row, *col;
   struct bas_str *basic_string;
       {
       int len;
       char * str;
       int far * vidptr;
       int attribute, character, both;
       int i, j, k, c;
       int choice, wordnum;
       int refresh;
       void packword();

       /* Initialize variables */
       len = basic_string->sd_len;
       str = basic_string->sd_addr;
       vidptr = (int far *) VIDEO_START + (*row - 1) * 80 + (*col - 1);
       choice = 1;
       refresh = 1;

       /* Loop until return() statement */
       while (1)
           {

           /* Display the string only if refresh is non-zero */
           if (refresh)
               {
               refresh = 0;

               /* Loop through each character of the string */
               for (wordnum = 0, i=0; i<len; i++)
                   {

                   /* Set the character and default attribute */
                   character = str[i];
                   attribute = BLACK_ON_CYAN;

                   /* Uppercase? */
                   if (isupper(character))
                       {
                       wordnum++;
                       attribute = RED_ON_CYAN;
                       }

                   /* In the middle of the current selection? */
                   if (wordnum == choice && character != ' ')
                       attribute = BRIGHT_WHITE_ON_RED;

                   /* Move data to video */
                   packword(&both, &attribute, &character);
                   vidptr[i] = both;
                   }
               }

           /* Check for any key presses */
           if (kbhit())
               {

               /* Get the key code and process it */
               switch (c = getch())
                   {

                   /* Return the choice when Enter is pressed */
                   case ENTER:
                       return (choice);

                   /* Highlight next choice if Right arrow is pressed */
                   case RIGHT_ARROW:
                       if (choice < wordnum)
                           {
                           choice++;
                           refresh = 1;
                           }
                       break;

                   /* Highlight previous choice if Left arrow is pressed */
                   case LEFT_ARROW:
                       if (choice > 1)
                           {
                           choice--;
                           refresh = 1;
                           }
                       break;

                   /* Check for match on first character of each word */
                   default:
                       c = _toupper(c);
                       for (k=0, j=0; j<len; j++)
                           {

                           /* Each choice starts at an uppercase char */
                           if (isupper(str[j]))
                               k++;

                           /* Match if same char and not current choice */
                           if (str[j] == c && k != choice)
                               {
                               choice = k;
                               refresh = 1;
                               break;
                               }
                           }
                       break;
                   }
               }
           }
       }
   ──────────────────────────────────────────────────────────────────────────


 Function: NumberOfBits&

   Returns the number of bits in a string without altering its contents.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         NumberOfBits&               **
   **  Type:         Function                    **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * Counts the 1 bits in a QuickBASIC string.
   *
   * EXAMPLE OF USE:  count& = NumberOfBits&(a$)
   * PARAMETERS:      a$         String containing bits to be counted
   * VARIABLES:       len        Length of the string
   *                  str        Pointer to string contents
   *                  i          Looping index to each byte
   *                  the_byte   Working copy of each byte of the string
   *                  count      Count of the bits
   *
   * Definition of the QuickBASIC string descriptor structure
   *    struct bas_str
   *        {
   *        int  sd_len;
   *        char *sd_addr;
   *        };                                           */


   long numberofbits (basic_string)
   struct bas_str *basic_string;
       {
       int len = basic_string->sd_len;
       unsigned char *str = basic_string->sd_addr;
       int i,the_byte;
       long count = 0;

       for (i=0; i<len; i++)
           {
           the_byte = *(str+i);
           while (the_byte)
               {
               count += (the_byte & 1);
               the_byte >>= 1;
               }
           }
       return (count);
       }
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: PackWord

   Packs two bytes into an integer value. For example, the high and low (most
   significant and least significant) bytes of the integer value 258 are 1
   and 2. QuickBASIC can pack two values into an integer by multiplying the
   first value by 256 and adding the second. This works well for small byte
   values but becomes awkward when the high byte is 128 or greater. In such
   cases, the resulting integer is a negative number.

   PackWord uses the QuickC union and structure data definition features to
   pack the byte values using simple data moves in memory.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         PackWord                    **
   **  Type:         Subprogram                  **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   *  Packs two byte values into the high and low
   *  bytes of an integer (word).
   *
   * EXAMPLE OF USE:  PackWord hiloword%, hibyte%, lobyte%
   * PARAMETERS:      hiloword%  Integer word to pack the two bytes into
   *                  hibyte%    Integer value of the most significant byte
   *                  lobyte%    Integer value of the least significant byte
   * VARIABLES:       both       A union of a two-byte structure and an intege
   *                             variable                                */


   void packword (hiloword, hibyte, lobyte)
   int *hiloword, *hibyte, *lobyte;
       {
       union
           {
           struct
               {
               unsigned char lo;
               unsigned char hi;
               } bytes;
           int hilo;
           } both;

       both.bytes.hi = *hibyte;
       both.bytes.lo = *lobyte;
       *hiloword = both.hilo;
       }
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: TextGet

   Copies a rectangular area of the text screen into a string variable. This
   is similar in concept to the graphics-oriented GET statement, except that
   this subprogram copies text-mode screen data. To redisplay the text
   anywhere on the screen, use the TextPut subprogram.

   The string variable must be exactly the right length for the amount of
   data to be copied, or the call will be ignored. There are two bytes of
   screen memory for each character displayed (the character and its color
   attribute), so the string must contain width * height * 2 bytes. For
   example, to save the area from row 3, column 4, to row 5, column 9, the
   string length must be 3 * 6 * 2, or 36 characters. The SPACE$ statement is
   ideal for preparing strings for this call. For example, a$ = SPACE$(36)
   makes the previous string the correct length.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         TextGet                     **
   **  Type:         Subprogram                  **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * Saves characters and attributes from a rectangular
   * area of the screen.
   *
   * EXAMPLE OF USE:  TextGet r1%, c1%, r2%, c2%, a$
   * PARAMETERS:      r1%        Pointer to row at upper left corner
   *                  c1%        Pointer to column at upper left corner
   *                  r2%        Pointer to row at lower right corner
   *                  c2%        Pointer to column at lower right corner
   *                  a$         String descriptor, where screen contents
   *                             will be stored
   * VARIABLES:       len        Length of string
   *                  str        Pointer to string contents
   *                  video      Pointer to video memory
   *                  i          Index into string
   *                  row        Looping index
   *                  col        Looping index
   * #define VIDEO_START         0xb8000000
   *
   * Definition of the QuickBASIC string descriptor structure
   *
   *  struct bas_str
   *      {
   *      int  sd_len;
   *      char *sd_addr;
   *      };                                           */


   void textget (r1,c1,r2,c2,basic_string)
   int *r1,*c1,*r2,*c2;
   struct bas_str *basic_string;
       {
       int len;
       int * str;
       int far * video;
       int i,row,col;

       len = basic_string->sd_len;
       str = (int *) basic_string->sd_addr;
       video = (int far *) VIDEO_START;

       if (len == (*r2 - *r1 + 1) * (*c2 - *c1 + 1) * 2)
           for (row = *r1 - 1, i = 0; row < *r2; row++)
               for (col = *c1 - 1; col < *c2; col++)
                   str[i++] = video[row * 80 + col];
       }
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: TextPut

   Restores a rectangular area of a text screen from a string variable
   previously used to copy screen contents via the TextGet subprogram. This
   is similar to the graphics-oriented PUT statement, except that this
   subprogram copies text-mode screen data.

   The string variable must be exactly the right length for the amount of
   data to be copied onto the screen, or the call will be ignored. There are
   two bytes of screen memory for each character displayed (the character and
   its color attribute), so the string must contain width * height * 2 bytes.
   See the TextGet subprogram for more details on string length
   requirements.

   The shape of the restored area can differ from the original area as long
   as the total number of bytes is the same. For example, an area three
   characters wide by four characters high can be copied using TextGet and
   then placed back on the screen in an area two wide by six high. As long as
   the width times the height remains constant, TextPut will move the data
   onto the screen.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         TextPut                     **
   **  Type:         Subprogram                  **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   * Restores characters and attributes to a rectangular
   * area of the screen.
   *
   * EXAMPLE OF USE:  TextPut r1%, c1%, r2%, c2%, a$
   * PARAMETERS:      r1%        Pointer to row at upper left corner
   *                  c1%        Pointer to column at upper left corner
   *                  r2%        Pointer to row at lower right corner
   *                  c2%        Pointer to column at lower right corner
   *                  a$         String descriptor where screen contents are s
   * VARIABLES:       len        Length of string
   *                  str        Pointer to string contents
   *                  video      Pointer to video memory
   *                  i          Index into string
   *                  row        Looping index
   *                  col        Looping index
   * #define VIDEO_START         0xb8000000
   *
   * Definition of the QuickBASIC string descriptor structure
   *    struct bas_str
   *        {
   *        int  sd_len;
   *        char *sd_addr;
   *        };                                        */


   void textput (r1,c1,r2,c2,basic_string)
   int *r1,*c1,*r2,*c2;
   struct bas_str *basic_string;
       {
       int len;
       int * str;
       int far * video;
       int i,row,col;

       len = basic_string->sd_len;
       str = (int *) basic_string->sd_addr;
       video = (int far *) VIDEO_START;

       if (len == (*r2 - *r1 + 1) * (*c2 - *c1 + 1) * 2)
           for (row = *r1 - 1, i = 0; row < *r2; row++)
               for (col = *c1 - 1; col < *c2; col++)
                   video[row * 80 + col] = str[i++];
       }
   ──────────────────────────────────────────────────────────────────────────


 Subprogram: UnPackWord

   Extracts two bytes from a QuickBASIC integer value. For example, the high
   and low (most significant and least significant) bytes of the integer
   value 258 are 1 and 2, and the two bytes of -1 are 255 and 255.

   CDEMO2.BAS AND CTOOLS2.C

   This subprogram uses the QuickC union and structure data definition
   features to unpack the byte values using simple data moves in memory.

   ──────────────────────────────────────────────────────────────────────────
   /***********************************************
   **  Name:         UnPackWord                  **
   **  Type:         Subprogram                  **
   **  Module:       CTOOLS2.C                   **
   **  Language:     Microsoft QuickC/QuickBASIC **
   ************************************************
   *
   *  Unpacks two byte values from the high and low
   *  bytes of an integer (word).
   *
   * EXAMPLE OF USE:  UnPackWord hiloword%, hibyte%, lobyte%
   * PARAMETERS:      hiloword%  Integer word containing the two bytes
   *                  hibyte%    Integer value of the most significant byte
   *                  lobyte%    Integer value of the least significant byte
   * VARIABLES:       both       A union of a two-byte structure and an intege
   *                             variable                               */


   void unpackword (hiloword, hibyte, lobyte)
   int *hiloword, *hibyte, *lobyte;
       {
       union
           {
           struct
               {
               unsigned char lo;
               unsigned char hi;
               } bytes;
           int hilo;
           } both;

       both.hilo = *hiloword;
       *hibyte = both.bytes.hi;
       *lobyte = both.bytes.lo;
       }
   ──────────────────────────────────────────────────────────────────────────



 ────────────────────────────────────────────────────────────────────────────
 PART 4  APPENDIXES



 ────────────────────────────────────────────────────────────────────────────
 Appendix A  Requirements for Running Toolboxes/Programs

   In the following table, the Usage line assumes execution from the system
   prompt after you compile the .BAS program. From QuickBASIC, modify
   COMMAND$ and enter any parameters before selecting Run and Start.

   CGA─Color Graphics Adapter/Monitor

   EGA─Enhanced Graphics Adapter/Monitor

   VGA─Video Graphics Adapter/Monitor

   Sub─Subprogram

   Func─Function

╓┌─┌────────────────────┌────────────────────────────────────────────────────╖
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
   ATTRIB.BAS          Screen/Text Attribute Display
                        Utility Program: 1 Sub
                        Usage: ATTRIB
                        Requirements: CGA
   BIN2HEX.BAS         Binary-to-Hex Conversion
                        Utility Program
                        Usage: BIN2HEX inFileName.ext outFileName.ext
                        .MAK File: BIN2HEX.BAS
                                   PARSE.BAS
   BIOSCALL.BAS        ROM BIOS Interrupt Calls
                        Toolbox: 6 Sub with Demo Module
                        Usage: BIOSCALL
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       Usage: BIOSCALL
                        Requirements: MIXED.QLB/.LIB
   BITS.BAS            Bit Manipulation
                        Toolbox: 2 Func/2 Sub with Demo Module
                        Usage: BITS
   CALENDAR.BAS        Calendar and Time Routines
                        Toolbox: 19 Func/1 Sub with Demo Module
                        Usage: CALENDAR
   CARTESIA.BAS        Cartesian Coordinate Routines
                        Toolbox: 2 Func/2 Sub with Demo Module
                        Usage: CARTESIA
   CDEMO1.BAS          Demo 1 of C-Language Routines
                        Program
                        Usage: CDEMO1
                        Requirements: CGA
                                      MIXED.QLB/.LIB
                                      Microsoft QuickC
   CDEMO2.BAS          Demo 2 of C-Language Routines
                        Program
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       Program
                        Usage: CDEMO2
                        Requirements: CGA
                                      MIXED.QLB/.LIB
                                      Microsoft QuickC
   CIPHER.BAS          Cipher File Security
                        Utility Program: 1 Func/1 Sub
                        Usage: CIPHER filename.ext key or CIPHER /NEWKEY
                        .MAK File: CIPHER.BAS
                                   RANDOMS.BAS
   COLORS.BAS          VGA Color Selection
                        Utility Program: 1 Func
                        Usage: COLORS
                        Requirements: VGA or MCGA
                                      MIXED.QLB/.LIB
                                      Mouse
                        .MAK File: COLORS.BAS
                                   BITS.BAS
                                   MOUSSUBS.BAS
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                                  MOUSSUBS.BAS
   COMPLEX.BAS         Complex Numbers
                        Toolbox: 12 Sub with Demo Module
                        Usage: COMPLEX
                        .MAK File: COMPLEX.BAS
                                   CARTESIA.BAS
   CTOOLS1.C           C Functions──Characters
                        C-Language Toolbox: 12 Func/2 Sub
                        Usage: Place in MIXED.QLB and MIXED.LIB
                               after compiling into object files and then run
                               CDEMO1.BAS from QuickBASIC
   CTOOLS2.C           C Functions──Text
                        C-Language Toolbox: 4 Func/4 Sub
                        Usage: Place in MIXED.QLB and MIXED.LIB
                               after compiling into object files and then run
                               CDEMO2.BAS from QuickBASIC
   DOLLARS.BAS         Dollar Formatting
                        Toolbox: 3 Func with Demo Module
                        Usage: DOLLARS
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       Usage: DOLLARS
   DOSCALLS.BAS        MS-DOS System Calls
                        Toolbox: 6 Func/9 Sub with Demo Module
                        Usage: DOSCALLS
                        Requirements: MIXED.QLB/.LIB
                                      MS-DOS 3.3 or later
   EDIT.BAS            Editing
                        Toolbox: 5 Sub with Demo Module
                        Usage: EDIT
                        .MAK File: EDIT.BAS
                                   KEYS.BAS
   ERROR.BAS           Error Message
                        Toolbox: 1 Sub with Demo Module
                        Usage: ERROR
   FIGETPUT.BAS        FILEGET and FILEPUT Routines
                        Toolbox: 1 Func/1 Sub with Demo Module
                        Usage: FIGETPUT
   FILEINFO.BAS        Directory/File Listing Information
                        Toolbox: 3 Sub with Demo Module
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       Toolbox: 3 Sub with Demo Module
                        Usage: FILEINFO
                        Requirements: MIXED.QLB/.LIB
   FRACTION.BAS        Fractions
                        Toolbox: 3 Func/7 Sub with Demo Module
                        Usage: FRACTION
   GAMES.BAS           Games
                        Toolbox: 4 Func/2 Sub with Demo Module
                        Usage: GAMES
                        Requirements: CGA
   HEX2BIN.BAS         Hex-to-Binary Conversion
                        Utility Program
                        Usage: HEX2BIN inFileName.ext outFileName.ext
                        .MAK File: HEX2BIN.BAS
                                   PARSE.BAS
                                   STRINGS.BAS
   JUSTIFY.BAS         Paragraph Justification
                        Toolbox: 1 Sub with Demo Module
                        Usage: JUSTIFY
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       Usage: JUSTIFY
                        .MAK File: JUSTIFY.BAS
                                   EDIT.BAS
                                   KEYS.BAS
                                   PARSE.BAS
   KEYS.BAS            Enhanced Keyboard Input Functions
                        Toolbox: 2 Func with Demo Module
                        Usage: KEYS
   LOOK.BAS            Text File Display Utility
                        Utility Program
                        Usage: LOOK filename.ext
                        .MAK File: LOOK.BAS
                                   KEYS.BAS
   MONTH.BAS           Three-Month Calendar
                        Utility Program
                        Usage: MONTH
                        .MAK File: MONTH.BAS
                                   CALENDAR.BAS
   MOUSGCRS.BAS        Custom Graphics Mouse Cursors
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
  MOUSGCRS.BAS        Custom Graphics Mouse Cursors
                        Utility Program
                        Usage: MOUSGCRS
                        Requirements: CGA
                                      MIXED.QLB/.LIB
                                      Mouse
                        .MAK File: MOUSGCRS.BAS
                                   BITS.BAS
                                   MOUSSUBS.BAS
   MOUSSUBS.BAS        Mouse Subroutines
                        Toolbox: 26 Subs with Demo Module
                        Usage: MOUSSUBS
                        Requirements: CGA
                                      MIXED.QLB/.LIB
                                      Mouse
                        .MAK File: MOUSSUBS.BAS
                                   BITS.BAS
   MOUSTCRS.BAS        Text-Mode Mouse Cursor
                        Utility Program
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       Utility Program
                        Usage: MOUSTCRS
                        Requirements: MIXED.QLB/.LIB
                                      Mouse
                        .MAK File: MOUSTCRS.BAS
                                   MOUSSUBS.BAS
                                   BITS.BAS
                                   ATTRIB.BAS
   OBJECT.BAS          Interactive Graphics Creation
                        Toolbox and Utility Program: 1 Sub
                        Usage: OBJECT
                        Requirements: CGA
                        .MAK File: OBJECT.BAS
                                   KEYS.BAS
                                   EDIT.BAS
   PARSE.BAS           Command Line Parsing
                        Toolbox: 2 Subs with Demo Module
                        Usage: PARSE
   PROBSTAT.BAS        Probability and Statistical Routines
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
  PROBSTAT.BAS        Probability and Statistical Routines
                        Toolbox: 7 Func with Demo Module
                        Usage: PROBSTAT
   QBFMT.BAS           Formatting Utility
                        Utility Program: 3 Subs
                        Usage: QBFMT filename [indention]
                        .MAK File: QBFMT.BAS
                                   PARSE.BAS
                                   STRINGS.BAS
   QBTREE.BAS          Directory/Subdirectory/Files Listing
                        Utility Program
                        Usage: QBTREE [path]
                        Requirements: MIXED.QLB/.LIB
                        .MAK File: QBTREE.BAS
                                   FILEINFO.BAS
   QCAL.BAS            Command Line Scientific Calculator
                        Utility Program: 1 Func/3 Subs
                        Usage: QCAL [number] [function] [...]
                        .MAK File: QCAL.BAS
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       .MAK File: QCAL.BAS
                                   QCALMATH.BAS
   QCALMATH.BAS        Math Functions
                        Toolbox: 31 Func/2 Sub
                        Usage: loaded by the QCAL program
   RANDOMS.BAS         Pseudorandom Numbers
                        Toolbox: 6 Func/1 Sub with Demo Module
                        Usage: RANDOMS
   STDOUT.BAS          MS-DOS Standard (ANSI) Output
                        Toolbox: 12 Sub with Demo Module
                        Usage: STDOUT
                        Requirements: MIXED.QLB/.LIB
                                      ANSI.SYS
   STRINGS.BAS         String Manipulation
                        Toolbox: 18 Func/1 Sub with Demo Module
                        Usage: STRINGS
   TRIANGLE.BAS        Triangles
                        Toolbox: 3 Func/1 Sub with Demo Module
                        Usage: TRIANGLE
   Name                 Description
   ──────────────────────────────────────────────────────────────────────────
                       Usage: TRIANGLE
                        Requirements: CGA
                        .MAK File: TRIANGLE.BAS
                                   QCALMATH.BAS
   WINDOWS.BAS         Windows
                        Toolbox: 2 Sub with Demo Module
                        Usage: WINDOWS
                        Requirements: MIXED.QLB/.LIB
                                      Mouse (optional)
                        .MAK File: WINDOWS.BAS
                                   BIOSCALL.BAS
                                   BITS.BAS
                                   KEYS.BAS
                                   MOUSSUBS.BAS
   WORDCOUN.BAS        Word Counting
                        Toolbox: 1 Func with Demo Module
                        Usage: WORDCOUN filename
   ──────────────────────────────────────────────────────────────────────────

   Name                 Description
   ──────────────────────────────────────────────────────────────────────────





 ────────────────────────────────────────────────────────────────────────────
 Appendix B  Functions-to-Modules Cross Reference

╓┌─┌───────────────────┌─────────────┌───────────────────────────────────────╖
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
   AbsoluteX#         QCALMATH      Absolute value of a number
   Add#               QCALMATH      Sum of two numbers
   Angle!             CARTESIA      Angle between X axis and line to x, y
                                     point
   ArcCosine#         QCALMATH      Arc cosine function of a number
   ArcHypCosine#      QCALMATH      Inverse hyperbolic cosine of a number
   ArcHypSine#        QCALMATH      Inverse hyperbolic sine of a number
   ArcHypTangent#     QCALMATH      Inverse hyperbolic tangent of a number
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
  ArcHypTangent#     QCALMATH      Inverse hyperbolic tangent of a number
   ArcSine#           QCALMATH      Inverse sine of a number
   ArcTangent#        QCALMATH      Inverse tangent of a number
   ArithmeticMean#    PROBSTAT      Arithmetic mean of an array of numbers
   Ascii2Ebcdic$      STRINGS       Converts string from ASCII to EBCDIC
   BestMatch$         STRINGS       Returns best match to input string
   Bin2BinStr$        BITS          Integer to 16-character binary string
   BinStr2Bin%        BITS          16-character binary string to integer
   BitShiftLeft%      CTOOLS2       Shifts all bits in a string left one bit
   BitShiftRight%     CTOOLS2       Shifts all bits in a string right one
                                     1 through 52
   BufferedKeyInput$  DOSCALLS      numberstring of specified length
   Card$              GAMES         Returns name of card given a number from
   Ceil#              QCALMATH      Smallest whole number greater than a
   Center$            STRINGS       Centers string by padding with spaces
   ChangeSign#        QCALMATH      Reverses sign of a number
   CheckDate%         CALENDAR      Validates date with return of TRUE/FALSE
   Collision%         GAMES         Returns TRUE or FALSE collision
                                     condition
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
                                    condition
   Combinations#      PROBSTAT      Combinations of n items, r at a time
   Comma$             DOLLARS       Double-precision with commas inserted
   Cosine#            QCALMATH      Cosine of a number
   Date2Day%          CALENDAR      Day of month number from date string
   Date2Julian&       CALENDAR      Julian day number for a given date
   Date2Month%        CALENDAR      Month number from date string
   Date2Year%         CALENDAR      Year number from date string
   DayOfTheCentury&   CALENDAR      Day of the given century
   DayOfTheWeek$      CALENDAR      Name of day of the week for given date
   DayOfTheYear%      CALENDAR      Day of the year (1 through 366) for
                                     given date
   DaysBetweenDates&  CALENDAR      Number of days between two dates
   Deg2Rad#           TRIANGLE      Converts degree angular units to radians
   Detab$             STRINGS       Replaces tab characters with spaces
   Dice%              GAMES         Returns total showing for throwing n
                                     dice
   Divide#            QCALMATH      Result of dividing two numbers
   DollarString$      DOLLARS       Dollar representation rounded with
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
  DollarString$      DOLLARS       Dollar representation rounded with
                                     commas
   DOSVersion!        DOSCALLS      Version number of MS-DOS returned
   Ebcdic2Ascii$      STRINGS       Converts a string from EBCDIC to ASCII
   Entab$             STRINGS       Replaces spaces with tab characters
   Exponential#       QCALMATH      Exponential function of a number
   Factorial#         PROBSTAT      Factorial of a number
   FileGet$           FIGETPUT      Returns a string with contents of file
   FilterIn$          STRINGS       Retains only specified characters in
                                     string
   FilterOut$         STRINGS       Deletes specified characters from string
   Fraction2String$   FRACTION      Converts type Fraction variable to a
                                     string
   FractionalPart#    QCALMATH      Fractional part of a number
   GeometricMean#     PROBSTAT      Geometric mean of an array of numbers
   GetDirectory$      DOSCALLS      Path to disk directory specified
   GetDrive$          DOSCALLS      Current drive string
   GetVerifyState%    DOSCALLS      Verify setting (state)
   GreatestComDiv&    FRACTION      seconds greatest common divisor
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
  GreatestComDiv&    FRACTION      seconds greatest common divisor
   HarmonicMean#      PROBSTAT      Harmonic mean of an array of numbers
   HMS2Time$          CALENDAR      Time string for given hour, minute, and
   HypCosine#         QCALMATH      Hyperbolic cosine of a number
   HypSine#           QCALMATH      Hyperbolic sine of a number
   HypTangent#        QCALMATH      Hyperbolic tangent of a number
   InKeyCode%         KEYS          Returns unique integer for any key
                                     pressed
   IntegerPart#       QCALMATH      Integer part of a number
   IsItAlnum%         CTOOLS1       Alphanumeric character determination
   IsItAlpha%         CTOOLS1       Alphabetic character determination
   IsItAscii%         CTOOLS1       Standard ASCII character determination
   IsItCntrl%         CTOOLS1       Control character determination
   IsItDigit%         CTOOLS1       Decimal digit (0─9) determination
   IsItGraph%         CTOOLS1       Graphics character determination
   IsItLower%         CTOOLS1       Lowercase character determination
   IsItPrint%         CTOOLS1       Printable character determination
   IsItPunct%         CTOOLS1       Punctuation character determination
   IsItSpace%         CTOOLS1       Space character determination
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
  IsItSpace%         CTOOLS1       Space character determination
   IsItUpper%         CTOOLS1       Uppercase character determination
   IsItXDigit%        CTOOLS1       Hexadecimal character determination
   Julian2Date$       CALENDAR      Date string from given Julian day number
   KeyCode%           KEYS          Waits and returns integer value for key
   LeastComMul&       FRACTION      Returns least common multiple
   LogBase10#         QCALMATH      Log base 10 of a number
   LogBaseN#          QCALMATH      Log base N of a number
   LogE#              QCALMATH      Natural logarithm of a number
   Lpad$              STRINGS       Returns left-justified input string
   LtrimSet$          STRINGS       Deletes specified characters from left
   Magnitude!         CARTESIA      Distance from origin to x, y point
   MDY2Date$          CALENDAR      Date string from given month, day, and
                                     year
   MenuString%        CTOOLS2       Bar menu and user response function
   Modulus#           QCALMATH      Remainder of the division of two numbers
   MonthName$         CALENDAR      Name of month for a given date
   Multiply#          QCALMATH      COMMAND$of two numbers
   NewWord$           CIPHER        Creates pseudorandom new word
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
  NewWord$           CIPHER        Creates pseudorandom new word
   NextParameter$     QCAL          Extracts number or command from
   NumberOfBits&      CTOOLS2       Determines number of 1 bits in a string
   OneOverX#          QCALMATH      Result of dividing 1 by a number
   Ord%               STRINGS       Returns byte number for ANSI mnemonic
   Permutations#      PROBSTAT      Permutations of n items, r at a time
   QuadraticMean#     PROBSTAT      Quadratic mean of an array of numbers
   Rad2Deg#           TRIANGLE      from meanradian angular units to degrees
   Rand&              RANDOMS       Long integers
   RandExponential!   RANDOMS       Real value with exponential distribution
   RandFrac!          RANDOMS       deviationecision positive value < 1.0
   RandInteger%       RANDOMS       Integers within desired range
   RandNormal!        RANDOMS       Single-precision from mean and standard
   RandReal!          RANDOMS       Single-precision value in desired range
   Repeat$            STRINGS       Combines multiple copies into one string
   Replace$           STRINGS       Replaces specified characters in string
   Reverse$           STRINGS       Reverses order of characters in a string
   ReverseCase$       STRINGS       Reverses case for each charater in a
                                     string
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
                                    string
   Round#             DOLLARS       Rounding at specified decimal place
   Rpad$              STRINGS       Returns right-justified input string
   RtrimSet$          STRINGS       Deletes specified characters from right
   Second2Date$       CALENDAR      Seconds from last of 1979 to date given
   Second2Time$       CALENDAR      Time of day from seconds since last of
                                     1979
   Shade&             COLORS        Color value from given red, green, and
                                     blue
   Shuffle$           GAMES         Randomizes character bytes in string
   Sign#              QCALMATH      Sign of a number
   Sine#              QCALMATH      Sine of a number
   SquareRoot#        QCALMATH      Square root of a number
   Subtract#          QCALMATH      Difference between two numbers
   Tangent#           QCALMATH      Tangent of a number
   Time2Hour%         CALENDAR      Hour number from time string
   Time2Minute%       CALENDAR      Minute number from time string
   Time2Second%       CALENDAR      Seconds number from time string
   TimeDate2Second&   CALENDAR      Seconds from last of 1979 from date/time
   Function            Module        Description
   ──────────────────────────────────────────────────────────────────────────
  TimeDate2Second&   CALENDAR      Seconds from last of 1979 from date/time
   Translate$         STRINGS       Exchanges characters in string from
                                     table
   TranslateCountry$  DOSCALLS      Translates string──current country
                                     setting
   TriangleArea#      TRIANGLE      Calculates area of triangle from three
                                     sides
   WordCount%         WORDCOUN      Returns number of words in a string
   Xsquared#          QCALMATH      Square of a number
   YRaisedToX#        QCALMATH      Number raised to the power of a second
   ──────────────────────────────────────────────────────────────────────────





 ────────────────────────────────────────────────────────────────────────────
 Appendix C  Subprograms-to-Modules Cross Reference

╓┌─┌────────────────────────┌───────────┌────────────────────────────────────╖
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
   AssignKey               STDOUT      Reassigns a string to a key
   Attrib                  ATTRIB      Table of color attributes (text mode)
   Attribute               STDOUT      Sets screen color (ANSI driver
                                        definition)
   BitGet                  BITS        Value from any bit position in a
                                        string
   BitPut                  BITS        translation tables at location in a
                                        string
   BuildAEStrings          STRINGS     Builds ASCII and EBCDIC character
   ClearLine               STDOUT      Clears line from cursor to end of
                                        line
   ClearScreen             STDOUT      Clears screen
   Complex2String          COMPLEX     String representation of a complex
                                        number
   ComplexAdd              COMPLEX     Adds two complex numbers
   ComplexDiv              COMPLEX     Divides two complex numbers
   ComplexExp              COMPLEX     Exponential function of a complex
                                        number
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
                                       number
   ComplexLog              COMPLEX     numberl log of a complex number
   ComplexMul              COMPLEX     Multiplies two complex numbers
   ComplexPower            COMPLEX     Complex number raised to a complex
   ComplexReciprocal       COMPLEX     Reciprocal of a complex number
   ComplexRoot             COMPLEX     Complex root of a complex number
   ComplexSqr              COMPLEX     Square root of a complex number
   ComplexSub              COMPLEX     Subtracts two complex numbers
   CrLf                    STDOUT      Sends carriage return and line feed
   Curschek                MOUSSUBS    Check-mark mouse cursor pattern mask
   Cursdflt                MOUSSUBS    Arrow mouse cursor pointing up and
                                        left
   Curshand                MOUSSUBS    Pointing hand mouse cursor
   Curshour                MOUSSUBS    Hourglass mouse cursor
   Cursjet                 MOUSSUBS    Jet-shaped mouse cursor
   Cursleft                MOUSSUBS    Left arrow mouse cursor
   CursorDown              STDOUT      Moves cursor down specified number of
                                        lines
   CursorHome              STDOUT      Moves cursor to upper left corner of
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
  CursorHome              STDOUT      Moves cursor to upper left corner of
                                        screen
   CursorLeft              STDOUT      Moves cursor left specified number of
                                        spaces
   CursorPosition          STDOUT      Moves cursor to specified row and
                                        column
   CursorRight             STDOUT      Moves cursor right specified number
                                        of spaces
   CursorUp                STDOUT      Moves cursor up specified number of
                                        lines
   Cursplus                MOUSSUBS    Plus sign mouse cursor
   Cursup                  MOUSSUBS    Up arrow mouse cursor
   Cursx                   MOUSSUBS    X-mark mouse cursor
   DisplayStack            QCAL        Displays final results of the program
   DrawBox                 EDIT        Creates a double-lined box on the
                                        display
   Dup                     QCALMATH    Duplicates top entry on the stack
   EditBox                 EDIT        Allows editing in a boxed area of the
                                        screen
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
                                       screen
   EditLine                EDIT        Allows editing of string at cursor
                                        position
   Equipment               BIOSCALL    Equipment/hardware information
   ErrorMessage            ERROR       Error message display
   FilePut                 FIGETPUT    Writes contents of string into binary
                                        file
   FileRead                LOOK        Reads lines of ASCII files into an
                                        array
   FileTreeSearch          QBTREE      numbers defined by the boundsutine
   FillArray               GAMES       Fills an integer array with a
   FindFirstFile           FILEINFO    Finds first file that matches
                                        parameter
   FindNextFile            FILEINFO    Finds next file that matches
                                        parameter
   FormatTwo               EDIT        Splits string into two strings
   FractionAdd             FRACTION    Adds two fractions and reduces
   FractionDiv             FRACTION    Divides two fractions and reduces
   FractionMul             FRACTION    Multiplies two fractions and reduces
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
  FractionMul             FRACTION    Multiplies two fractions and reduces
   FractionReduce          FRACTION    Reduces fraction to lowest terms
   FractionSub             FRACTION    Subtracts two fractions and reduces
   GetCountry              DOSCALLS    Current country setting
   GetDiskFreeSpace        DOSCALLS    Disk space format and usage for input
                                        drive
   GetFileAttributes       DOSCALLS    Attribute bits for given file
   GetFileData             FILEINFO    Extracts file directory information
   GetMediaDescriptor      DOSCALLS    Drive information for system
   GetShiftStates          BIOSCALL    Shift key states
   Indent                  QBFMT       Performs line indention
   InsertCharacter         EDIT        Inserts a character
   Justify                 JUSTIFY     Adjusts strings to specified widths
   MouseHide               MOUSSUBS    Turns off mouse visibility
   MouseInches             MOUSSUBS    parameters-to-cursor motion ratio
   MouseInstall            MOUSSUBS    Checks mouse availability; resets
   MouseLightPen           MOUSSUBS    Mouse emulation of a lightpen
   MouseMaskTranslate      MOUSSUBS    Translates pattern/hot spot to binary
   MouseMickey             MOUSSUBS    Returns motion increments since last
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
  MouseMickey             MOUSSUBS    Returns motion increments since last
                                        call
   MouseNow                MOUSSUBS    Current state/location of the mouse
   MousePressLeft          MOUSSUBS    Location of mouse──left button press
   MousePressRight         MOUSSUBS    Location of mouse──right button press
   MousePut                MOUSSUBS    Moves cursor to the given position
   MouseRange              MOUSSUBS    Limits mouse cursor motion to
                                        rectangle
   MouseReleaseLeft        MOUSSUBS    Location of mouse──left button
                                        release
   MouseReleaseRight       MOUSSUBS    Location of mouse──right button
                                        release
   MouseSetGcursor         MOUSSUBS    Sets graphics-mode mouse cursor
   MouseShow               MOUSSUBS    Activates and displays mouse cursor
   MouseSoftCursor         MOUSSUBS    Sets text-mode attributes (mouse
                                        cursor)
   MouseWarp               MOUSSUBS    Sets mouse double-speed threshold
   MovBytes                CTOOLS1     Moves bytes from one location to
                                        another
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
                                       another
   MovWords                CTOOLS1     Moves blocks of words in memory
   OneMonthCalendar        CALENDAR    One-month calendar for given date
   PackWord                CTOOLS2     Packs two bytes into an integer value
   ParseLine               PARSE       Breaks a string into individual words
   ParseWord               PARSE       Parses and removes first word from
                                        string
   Pol2Rec                 CARTESIA    Polar to Cartesian conversion
   PrintScreen             BIOSCALL    Screen dump
   Process                 QCAL        Controls action for command line
                                        parameters
   ProcesX                 CIPHER      Enciphers string by XORing bytes
   QcalHelp                QCAL        Provides a "Help" display for program
   RandShuffle             RANDOMS     Initializes random number generator
   ReBoot                  BIOSCALL    System reboot
   Rec2Pol                 CARTESIA    Cartesian to polar conversion
   SaveObject              OBJECT      Creates graphics "PUT" file source
                                        code
   Scroll                  BIOSCALL    Moves text in designated area of
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
  Scroll                  BIOSCALL    Moves text in designated area of
                                        screen
   SetCode                 QBFMT       Determines indention code by keyword
   SetDirectory            DOSCALLS    Sets current directory
   SetDrive                DOSCALLS    Sets current disk drive
   SetFileAttributes       DOSCALLS    Sets the attribute bits for a given
                                        file
   SetVerifyState          DOSCALLS    Sets or clears verify state (writing
                                        to file)
   ShuffleArray            GAMES       Randomizes integers in an array
   SplitFractions          FRACTION    Parses fraction problem string
   SplitUp                 QBFMT       Splits line into major components
   StdOut                  STDOUT      Sends a string to standard output
                                        channel
   String2Complex          COMPLEX     Converts string to complex variable
   String2Fraction         FRACTION    Converts a string to Fraction
                                        variable
   SwapXY                  QCALMATH    of screen two entries on the stack
   TextGet                 CTOOLS2     Saves characters and attributes from
   Subprogram               Module      Description
   ──────────────────────────────────────────────────────────────────────────
  TextGet                 CTOOLS2     Saves characters and attributes from
   TextPut                 CTOOLS2     Restores text from TextGet to screen
   Triangle                TRIANGLE    Calculates sides and angles of
                                        triangle
   UnPackWord              CTOOLS2     Unpacks values from high and low
                                        state
   VideoState              BIOSCALL    Mode, column, and page display of
   Windows                 WINDOWS     Creates a pop-up window
   WindowsPop              WINDOWS     Removes last displayed window
   WriteToDevice           DOSCALLS    Outputs a string to a device
   ──────────────────────────────────────────────────────────────────────────





 ────────────────────────────────────────────────────────────────────────────
 Appendix D  Hexadecimal Format (.obj) Files

   Three assembly-language modules are discussed in this book. The suggested
   method for creating object-code files is to use the Microsoft Macro
   Assembler 5.0 on the source-code files. If necessary, however, you can
   process these files using the HEX2BIN.BAS program to create the desired
   object-code files. (See the HEX2BIN.BAS program for information about how
   to make the conversions.)


     MOUSE.HEX (MOUSE.OBJ)
     80 0B 00 09 4D 4F 55 53 - 45 2E 41 53 4D D4 96 24
     00 00 06 44 47 52 4F 55 - 50 04 44 41 54 41 04 43
     4F 44 45 0A 4D 4F 55 53 - 45 5F 54 45 58 54 05 5F
     44 41 54 41 7D 98 07 00 - 48 39 00 05 04 01 D6 98
     07 00 48 00 00 06 03 01 - 0F 9A 04 00 02 FF 02 5F
     90 0C 00 00 01 05 4D 4F - 55 53 45 00 00 00 D5 88
     04 00 00 A2 01 D1 A0 3D - 00 01 00 00 55 8B EC 8B
     5E 0C 8B 07 50 8B 5E 0A - 8B 07 50 8B 5E 08 8B 0F
     8B 5E 06 8B 17 5B 58 1E - 07 CD 33 53 8B 5E 0C 89
     07 58 8B 5E 0A 89 07 8B - 5E 08 89 0F 8B 5E 06 89
     17 5D CA 08 00 BC 8A 02 - 00 00 74

     INTRPT.HEX (INTRPT.OBJ)
     80 0C 00 0A 49 4E 54 52 - 50 54 2E 41 53 4D 7A 88
     03 00 80 9E 57 96 25 00 - 00 06 44 47 52 4F 55 50
     04 44 41 54 41 04 43 4F - 44 45 05 5F 44 41 54 41
     0B 49 4E 54 52 50 54 5F - 54 45 58 54 23 98 07 00
     48 07 01 06 04 01 06 98 - 07 00 48 00 00 05 03 01
     10 9A 04 00 02 FF 02 5F - 90 1E 00 00 01 09 49 4E
     54 45 52 52 55 50 54 00 - 00 00 0A 49 4E 54 45 52
     52 55 50 54 58 0D 00 00 - 3F 88 04 00 00 A2 01 D1
     A0 0B 01 01 00 00 55 8B - EC 83 C4 E2 C7 46 FA 08
     00 EB 0B 55 8B EC 83 C4 - E2 C7 46 FA 0A 00 89 76
     E4 89 7E E2 8C 5E FC 9C - 8F 46 FE 8B 76 08 8D 7E
     E6 8B 4E FA FC 16 07 F3 - A5 55 8B 76 0A 8B 1C 0A
     FF 74 03 E9 00 00 80 FB - 25 74 05 80 FB 26 75 0E
     B8 08 00 50 B8 02 CA 50 - B8 83 C4 50 EB 07 33 C0
     50 B8 CA 06 50 8A E3 B0 - CD 50 0E B8 00 00 50 16
     8B C4 05 06 00 50 8B 46 - F4 25 D5 0F 50 8B 46 E6
     8B 5E E8 8B 4E EA 8B 56 - EC 8B 76 F0 8B 7E E2 83
     7E FA 08 74 14 81 7E F6 - FF FF 74 03 8E 5E F6 81
     7E F8 FF FF 74 03 8E 46 - F8 8B 6E EE 9D CB 55 8B
     EC 8B 6E 02 9C 8F 46 F4 - FF 76 FE 9D 89 46 E6 89
     5E E8 89 4E EA 89 56 EC - 8B 46 DE 89 46 EE 89 76
     F0 89 7E E2 8C 5E F6 8C - 46 F8 8E 5E FC 8D 76 E6
     1E 07 8B 7E 06 8B 4E FA - FC F3 A5 8B 76 E4 8B 7E
     E2 8B E5 5D CA 06 00 8B - 76 0A C7 04 FF FF 8B 76
     E4 8B 7E E2 8E 5E FC 8B - E5 5D CA 06 00 0B 9C 0F
     00 84 3E 00 01 01 F1 00 - C4 66 00 01 01 A8 00 CC
     8A 02 00 00 74

     CASEMAP.HEX (CASEMAP.OBJ)
     80 0D 00 0B 43 41 53 45 - 4D 41 50 2E 41 53 4D 5F
     96 26 00 00 06 44 47 52 - 4F 55 50 0C 43 41 53 45
     4D 41 50 5F 54 45 58 54 - 04 44 41 54 41 04 43 4F
     44 45 05 5F 44 41 54 41 - 08 98 07 00 48 14 00 03
     05 01 FC 98 07 00 48 00 - 00 06 04 01 0E 9A 04 00
     02 FF 02 5F 90 0E 00 00 - 01 07 43 41 53 45 4D 41
     50 00 00 00 60 88 04 00 - 00 A2 01 D1 A0 18 00 01
     00 00 55 8B EC 8B 5E 0A - 8B 07 FF 5E 06 8B 5E 0A
     89 07 5D CA 06 00 E3 8A - 02 00 00 74



 ────────────────────────────────────────────────────────────────────────────
 Appendix E  Line-Drawing Characters

   You can enter line-drawing characters into QuickBASIC programs by pressing
   and holding the Alt key while typing up to three decimal digits on the
   numeric keypad. You can then use QuickBASIC strings to outline screen
   areas or to draw boxes around text. This chart organizes the line-drawing
   characters by type rather than by ASCII value.

         201  203  187                   218  194  191
         ╔     ╦     ╗                   ┌     ┬     ┐

     204 ╠           ╣ 185           195 ├           ┤ 180

         ╚     ╩     ╝                   └     ┴     ┘
         200  202  188                   192  193  217


                         206  205  197
                         ╬     ═     ┼

                     186 ║           │ 179

                         ╪     ─     ╫
                         216  196  215


         213  209  184                   214  210  183
         ╒     ╤     ╕                   ╓     ╥     ╖

     198 ╞           ╡ 181           199 ╟           ╢ 182

         ╘     ╧     ╛                   ╙     ╨     ╜
         212  207  190                   211  208  189





   John Clark Craig has written several books on computer programming since
   1980, including True BASIC Programs and Subroutines. He lives with his
   family in Eagle River, Alaska, where he is a programmer for ARCO Alaska,
   Inc.