'===========================================================================
' Subject: FINPUT FOR QBASIC                 Date: 03-17-00 (16:37)       
' Author:  Don Schullian                     Code: QB, QBasic, PDS        
' Origin:  d83@DASoftVSS.com               Packet: KEYBOARD.ABC
'===========================================================================
'------------------------------------------------------------------------
' fInput% function for Qbasic
'    coded by: Don Schullian  d83@DASoftVSS.com
'    public domain
'
' Welcome,
'
'   This code is offered as an (better?) alternative to INPUT$. It
' allows for cursoring around a field, deletion, insertion, overwrite,
' scrolling, and bail out without saving the/any changes.
'
'   Its use is demonstrated below using an array to allow for editing
' a screen full of data in one loop. This code could, very easily be
' placed into it's own function and called several times in a single
' program.
'
'   There are a series of CONSTant variables set that are used by the
' function. You may, of course, put their values into the function or,
' in some cases, send the values to the function to allow for more
' control by varied other functions.
'
'   This offering is just a starting point for those of you who are
' more adventurous. Over the years I've developed 10 different
' variations of this function that control and guide the users' input.
' One of them works only for numerical input and looks & feels like
' a calculator; another allows input of only specific characters;
' while others handle hexadecimal input, masked fields, multiple lines
' and other varied field types. A bit of imagination goes a LONG way!
'
'   fGetKey% is my basic keyboard input function and I never leave
' home without it. There is a full discussion on how and why on
' either of my web pages. www.basicguru.com/scullian or
' www.DASoftVSS.com along with some other goodies.
'
'   If you have any questions, give me a shout.
'
' Don
'----------------------------------------------------------------------
' fGetKey%(Datum$,Row%,Col%,VisCols%,MaxLen%,ExitKeys$)
'
' PURPOSE: Allow user input in an editable, friendly environment
'  PARAMS: Datum$     incoming the data already found in the field
'                     returning the edited data
'          Row%, Col% the left most screen position of the field
'          VisCols%   the number of visable characters on screen      
'          MaxLen%    the maximum number of characters in the field
'          ExitKeys$  the MKI$(keyvalue%) of all the keys OTHER THAN
'                       <ESC> and <ENTER> that will return from the
'                       function
'    NOTE: If VisCols% =< MaxLen% then the value will be set to match
'          that of MaxLen%
'--------------------------------------------------------------------------
DECLARE FUNCTION fGetKey% ()
DECLARE FUNCTION fInput% (Datum$, Row%, Col%, VisCols%, MaxLen%, ExitKeys$)

CONST cEscKey% = &H1B
CONST cEnterKey% = &HD
CONST cBkSpcKey% = &H8
CONST cDelKey% = &H5300
CONST cUpKey% = &H4800
CONST cDownKey% = &H5000
CONST cInsKey% = &H5200
CONST cLeftKey% = &H4B00
CONST cRightKey% = &H4D00
CONST cF10key% = &H4400
CONST cHomeKey% = &H4700
CONST cEndKey% = &H4F00
CONST cFgrnd% = 15          ' editing foreground
CONST cBgrnd% = 1           ' editing background
CONST cMaxLen% = 80         ' maximum length used by fInput%

TYPE InputTYPE              ' used to store a screen full of data
  Dat AS STRING * cMaxLen   ' the field of data
  Row AS INTEGER            ' screen position
  Col AS INTEGER            '
  MaxLen AS INTEGER         ' maximum data length for this field
END TYPE
'---------------------------------------------------------------
'-------------------- start of test code
'---------------------------------------------------------------
CLS
' ================================================
' ======= this demonstrates the use for one field
' ================================================
D$ = "Mary had a little lamb, its fleece was white as snow."
G% = fInput%(D$, 1, 10, 20, 70, "")
LOCATE 2, 1: PRINT D$;
' ==================================================
' ====== the following uses an array for 5 fields
' ==================================================
DIM tI(5) AS InputTYPE

RESTORE TestData
FOR X% = 1 TO 5
  READ Prompt$
  READ tI(X%).Dat, tI(X%).Row, tI(X%).Col, tI(X%).MaxLen
  Col% = tI(X%).Col - LEN(Prompt$) - 1
  COLOR 7, 0
  LOCATE tI(X%).Row, Col%
  PRINT Prompt$;
  COLOR 15, 0
  LOCATE tI(X%).Row, tI(X%).Col
  PRINT LEFT$(tI(X%).Dat, tI(X%).MaxLen)
NEXT

LOCATE 25, 1: PRINT "Use Arrows to move - F-10 to save & exit - <ESC> to quit";

ExitKeys$ = MKI$(cF10key%) + MKI$(cUpKey%) + MKI$(cDownKey%)

Fld% = 1
DO
  IF Fld% < 1 THEN
      Fld% = 5
    ELSEIF Fld% > 5 THEN
      Fld% = 1
  END IF
  G% = fInput%(tI(Fld%).Dat, tI(Fld%).Row, tI(Fld%).Col, 0, tI(Fld%).MaxLen, ExitKeys$)
  SELECT CASE G%
    CASE cF10key: EXIT DO
    CASE cEscKey: EXIT DO
    CASE cUpKey: Fld% = Fld% - 1
    CASE ELSE: Fld% = Fld% + 1
  END SELECT
LOOP
FOR X% = 1 TO 5
  LOCATE X% + 10, 1
  PRINT tI(X%).Dat
NEXT

TestData:
  DATA "Last Name:", "Schullian", 6, 20, 17
  DATA "Frst Name:", "Don", 7, 20, 17
  DATA "Street:", "My Street 27", 8, 20, 30
  DATA "City:", "Hometown", 9, 20, 30
  DATA "Zip:", "12345-2433", 9, 56, 10

'
FUNCTION fGetKey%
 
  DO
    G$ = INKEY$
    L% = LEN(G$)
  LOOP UNTIL L% > 0
 
  IF L% = 1 THEN
      fGetKey% = ASC(G$)
    ELSE
      fGetKey% = CVI(G$)
  END IF

END FUNCTION

FUNCTION fInput% (Datum$, Row%, Col%, VisLen%, MaxLen%, ExitKeys$)

  DIM Bgrnd  AS INTEGER              ' original background color
  DIM Cpos   AS INTEGER              ' current cursor position within string
  DIM Exet   AS STRING               ' string vals of all exit keys
  DIM Fgrnd  AS INTEGER              ' original foreground color
  DIM Inzert AS INTEGER              ' insert state
  DIM KeyVal AS INTEGER              ' incoming key-press value
  DIM MaxOff AS INTEGER              ' maximum offset position
  DIM Offset AS INTEGER              ' 1st character shown in field
  DIM Temp   AS STRING * cMaxLen     ' working data string

  Temp$ = LTRIM$(LEFT$(Datum$, MaxLen%))
  Inzert% = 31
  Exet$ = MKI$(cEscKey%) + MKI$(cEnterKey%) + ExitKeys$
  Bgrnd% = SCREEN(Row%, Col%, 1)
  Fgrnd% = (Bgrnd% AND 15)
  Bgrnd% = (Bgrnd% \ 16)
  Offset% = 1
 
  IF (VisLen% = 0) OR (VisLen% > MaxLen%) THEN VisLen% = MaxLen%
  MaxOff% = (MaxLen% - VisLen% + 1)

  GOSUB fInputEOL
  COLOR cFgrnd%, cBgrnd%
  LOCATE , , , Inzert%, 31
 
  DO
    IF Cpos% < 1 THEN
        Cpos% = 1
      ELSEIF Cpos% > MaxLen% THEN
        Cpos% = MaxLen%
    END IF
    IF Cpos% < Offset% THEN
        Offset% = Cpos%
      ELSEIF (Cpos% - Offset% + 2) > VisLen% THEN
        Offset% = (Cpos% - VisLen% + 1)
        IF Offset% > MaxOff% THEN Offset% = MaxOff%
    END IF
    GOSUB fInputPrint
    LOCATE Row%, (Col% + Cpos% - Offset%), 1
    KeyVal% = fGetKey%
    IF (INSTR(Exet$, MKI$(KeyVal%)) AND 1) THEN EXIT DO
    SELECT CASE KeyVal%
      CASE 32 TO 255
        IF (Inzert% = 0) OR (Cpos% = MaxLen%) THEN
            MID$(Temp$, Cpos%, 1) = CHR$(KeyVal%)
          ELSE
            Temp$ = LEFT$(Temp$, Cpos% - 1) + CHR$(KeyVal%) + MID$(Temp$, Cpos%)
        END IF
        Cpos% = Cpos% + 1
      CASE cBkSpcKey%
        IF Cpos% > 1 THEN
          Cpos% = Cpos% - 1
          GOSUB fInputStrip
        END IF
      CASE cDelKey%
        GOSUB fInputStrip
      CASE cHomeKey%
        Cpos% = 1
      CASE cEndKey%
        GOSUB fInputEOL
      CASE cLeftKey%
        Cpos% = Cpos% - 1
      CASE cRightKey%
        Cpos% = Cpos% + 1
      CASE cInsKey%
        Inzert% = (Inzert% XOR 31)
        LOCATE , , , Inzert%, 31
    END SELECT
  LOOP

  Offset% = 1
  Temp$ = LTRIM$(Temp$)
  IF KeyVal% <> cEscKey% THEN
      Datum$ = LEFT$(Temp$, MaxLen%)
      Datum$ = RTRIM$(Temp$)
    ELSE
      Temp$ = Datum$
  END IF
  COLOR Fgrnd%, Bgrnd%
  GOSUB fInputPrint
 
  fInput% = KeyVal%
  EXIT FUNCTION
  '-----------------------------------------------------------------
  '------------- local routines
  '-----------------------------------------------------------------
fInputPrint:
  LOCATE Row%, Col%, 0
  PRINT MID$(Temp$, Offset%, VisLen%);
RETURN
  '-----------------------------------------------------------------
fInputStrip:
  Temp$ = LEFT$(Temp$, Cpos% - 1) + MID$(Temp$, Cpos% + 1)
RETURN
  '-----------------------------------------------------------------
fInputEOL:
  FOR Cpos% = MaxLen% TO 1 STEP -1
    IF ASC(MID$(Temp$, Cpos%)) <> 32 THEN EXIT FOR
  NEXT
  Cpos% = Cpos% + 1
RETURN

END FUNCTION