'===========================================================================
' Subject: TEXT USER INTERFACE               Date: 02-11-96 (18:35)       
' Author:  Dave Gjessing                     Code: QB, QBasic, PDS        
' Origin:  dgjess@freenet.columbus.oh.us   Packet: TEXT.ABC
'===========================================================================
DECLARE SUB CommandPointer (firstline%, Col%, BotLimit%, Fgc%, Bgc%, DoLine%)
DECLARE SUB DLBox (TLine%, LCol%, BLine%, RCol%, FieldNo%, border%, Fgc%, Bgc%, shadow%)
DECLARE SUB MenuBar (message%, Fgc%, Bgc%)

DEFINT A-Z

'IFACE_06.BAS - a text user interface - Dave Gjessing 1996
'Copy IFACE_06.BAS to [yourprog].BAS, erase the demonstration below,
'and put in your own code instead.
'The demonstration is all black and white, and seems to work fine
'on Hercules, MCGA, and color VGA.

'demonstration
top:
DLBox 2, 1, 23, 80, 0, 2, 7, 0, 0
MenuBar 1, 7, 0
CommandPointer 3, 3, 22, 7, 0, DoLine%

SELECT CASE DoLine%
   CASE IS < 100
   LOCATE DoLine%, 5
   PRINT "the pointer is on line "; DoLine%
   SLEEP 2: GOTO top
   CASE 100
   DLBox 10, 25, 14, 55, 0, 1, 7, 0, 1    'single border, shadow
   LOCATE 12, 32: PRINT "page down pressed"
   SLEEP 2: GOTO top
   CASE 200
   DLBox 10, 25, 14, 55, 0, 2, 7, 0, 0    'double border, no shadow
   LOCATE 12, 33: PRINT "page up pressed"
   SLEEP 2: GOTO top
   CASE 601 TO 609
   DLBox 10, 25, 14, 55, 0, 1, 7, 0, 1    'single border, shadow
   LOCATE 12, 33
   DoLineStr$ = STR$(DoLine%)
   PRINT "F"; RIGHT$(DoLineStr$, 1); " key pressed"
   SLEEP 2: GOTO top
   CASE 610
   DLBox 10, 25, 14, 55, 0, 2, 7, 0, 1    'double border, shadow
   LOCATE 12, 33: PRINT "F10 key pressed"
   SLEEP 2: GOTO top
   CASE 900
   CLS : END
   CASE ELSE
   GOTO top

END SELECT

SUB CommandPointer (firstline%, Col%, BotLimit%, Fgc%, Bgc%, DoLine%)
'this is where the user reacts to menu choices...

COLOR Fgc%, Bgc%
DoLine% = firstline%    'set aside the first line (sent with the sub call)
                        'as the upper limit to the list. (Work with DoLine%)
LOCATE firstline%, Col% 'go to the line and column called for in the
                        'subroutine call
PRINT CHR$(16)          'and print the line pointer on the screen

DO                      'run around in circles awaiting instructions
selection$ = INKEY$
selection$ = UCASE$(selection$)

'the next two IF's move the pointer up and down...
IF selection$ = CHR$(0) + "H" THEN           'UpArrow
   LOCATE DoLine%, Col%: PRINT CHR$(0)       'first blank out old pointer
   DoLine% = DoLine% - 1                     'move up one line
   IF DoLine% < firstline% THEN DoLine% = BotLimit% 'jump to bottom if at top
   LOCATE DoLine%, Col%                      'go to where directed
   PRINT CHR$(16)                            'print new pointer on screen
   END IF
IF selection$ = CHR$(0) + "P" THEN           'DnArrow
   LOCATE DoLine%, Col%: PRINT CHR$(0)       'cover the last pointer
   DoLine% = DoLine% + 1                     'move down one line
   IF DoLine% > BotLimit% THEN DoLine% = firstline% 'jump to top if at bottom
   LOCATE DoLine%, Col%                      'go to where directed
   PRINT CHR$(16)                            'new pointer
   END IF

'this IF reacts to the user pressing the ENTER key. The sub ends with a new
'value for DoLine%, equal to the line that the pointer was on.
IF selection$ = CHR$(13) THEN
    DoLine% = DoLine%
    EXIT SUB
    END IF

'these other IF's return a value for DoLine% which is not a valid screen
'coordinate. It is up to the SELECT CASE statements that follow the line
'that called CommandPointer to determine what to do with the returned value

IF selection$ = CHR$(0) + CHR$(81) THEN      'page down key
   DoLine% = 100
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(73) THEN      'page up key
   DoLine% = 200
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(59) THEN      'F1 key
   DoLine% = 601
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(60) THEN      'F2 key
   DoLine% = 602
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(61) THEN      'F3 key
   DoLine% = 603
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(62) THEN      'F4 key
   DoLine% = 604
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(63) THEN      'F5 key
   DoLine% = 605
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(64) THEN      'F6 key
   DoLine% = 606
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(65) THEN      'F7 key
   DoLine% = 607
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(66) THEN      'F8 key
   DoLine% = 608
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(67) THEN      'F9 key
   DoLine% = 609
   EXIT SUB
   END IF
IF selection$ = CHR$(0) + CHR$(68) THEN      'F10 key
   DoLine% = 610
   EXIT SUB
   END IF
IF selection$ = CHR$(27) THEN                'escape key
   DoLine% = 900
   EXIT SUB
   END IF
LOOP
'break out of the loop and return to the calling module with a new variable
'called DoLine%, equal to the line number on screen where the selected item
'was being displayed, or else with a number beyond the screen size (100, 200,
'etc.), which will be used to convey special instructions
END SUB

SUB DLBox (TLine, LCol, BLine, RCol, FieldNo, border, Fgc, Bgc, shadow)
'DLBOX (DeLuxe Box) is a fancy box sub-routine that includes
'a user-defined background character parameter, single or double-
'line border (or no border), and foreground and background color parameters,
'plus shadow or no shadow option.
'
'The no-border option makes this "box" routine able to replace "background"
'routines.
COLOR Fgc, Bgc
   IF border = 0 THEN    'no border at all
      ULC = FieldNo
      URC = FieldNo
      LLC = FieldNo
      LRC = FieldNo
      HORIZ = FieldNo
      VERT = FieldNo
         END IF
   IF border = 1 THEN   'single line border
      ULC = 218         'upper left corner
      URC = 191         'upper right corner
      LLC = 192         'lower left corner
      LRC = 217         'lower right corner
      HORIZ = 196       'horizontal lines
      VERT = 179        'vertical lines
         END IF
   IF border = 2 THEN   'double line border
      ULC = 201         'ditto all above
      URC = 187
      LLC = 200
      LRC = 188
      HORIZ = 205
      VERT = 186
         END IF

LOCATE TLine, LCol
PRINT CHR$(ULC) + STRING$(((RCol - LCol) - 1), CHR$(HORIZ)) + CHR$(URC)
FOR x = 1 TO (BLine - TLine) - 1
LOCATE ((TLine + 1) + NextLine), LCol
   NextLine = NextLine + 1
PRINT CHR$(VERT) + STRING$(((RCol - LCol) - 1), CHR$(FieldNo)) + CHR$(VERT);
NEXT x
LOCATE BLine, LCol
PRINT CHR$(LLC) + STRING$(((RCol - LCol) - 1), CHR$(HORIZ)) + CHR$(LRC);
 

IF shadow = 1 THEN   'for consistancy, use 1 for shadows, 0 for no shadow
   IF BLine > 24 OR RCol > 79 THEN GOTO badshadow
COLOR 7, 0           'shadows are dark

LOCATE BLine + 1, LCol + 1                 'across the
PRINT STRING$((RCol - LCol), CHR$(176));  'bottom...
 
FOR I = TLine + 1 TO BLine + 1              'on the
LOCATE I, RCol + 1: PRINT CHR$(176);         'right side
NEXT

END IF
COLOR Fgc, Bgc       'restore original colors
badshadow:

END SUB

SUB MenuBar (message, Fgc, Bgc)
COLOR Bgc%, Bgc%                             'nothing but background
LOCATE 1, 1: PRINT STRING$(80, 219);           'color bar 1 at top
LOCATE 24, 1: PRINT STRING$(80, 219);          'color bar 2 at bottom
LOCATE 25, 1: PRINT STRING$(80, 219);          'color bar 3 at very bottom
COLOR Fgc%, Bgc%                             'activate foreground color
progname$ = "IFACE_06.BAS - a text user interface for QBasic, etc."
title1$ = "title for MenuBar 1"
LOCATE 25, (40 - (LEN(progname$) / 2)): PRINT progname$;   'prog name

IF message% = 1 THEN
    LOCATE 1, 1: PRINT " <ESC> QUIT "; CHR$(4); " arrows & enter to select "; CHR$(4); " <F> keys as needed";
    LOCATE 24, (40 - (LEN(title1$) / 2)): PRINT title1$;
END IF

IF message% = 2 THEN
END IF

IF message% = 3 THEN
END IF

IF message% = 4 THEN
END IF

IF message% = 5 THEN
END IF

IF message% = 6 THEN
END IF

IF message% = 7 THEN
END IF

IF message% = 8 THEN
END IF

IF message% = 9 THEN
END IF

IF message% = 10 THEN
END IF

END SUB