'===========================================================================
' Subject: FINPUT FOR FIRSTBASIC             Date: 03-17-00 (16:37)       
' Author:  Don Schullian                     Code: FB                     
' Origin:  d83@DASoftVSS.com               Packet: PB.ABC
'===========================================================================
'------------------------------------------------------------------------
' fInput% function for FirstBASIC
'    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 CONSTANTS 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%
'--------------------------------------------------------------------------

%EscKey   = &h001B             ' key codes returned by fGetKey%
%EnterKey = &h000D
%BkSpcKey = &h0008
%DelKey   = &h5300
%UpKey    = &h4800
%DownKey  = &h5000
%InsKey   = &h5200
%LeftKey  = &h4B00
%RightKey = &h4D00
%CtrlDel  = &h9300
%F10key   = &h4400
%HomeKey  = &h4700
%EndKey   = &h4F00

%Fgrnd    = 15                 ' editing foreground
%Bgrnd    =  1                 ' editing background

'---------------------------------------------------------------
'-------------------- start of test code
'---------------------------------------------------------------
COLOR 0, 7
CLS
' ================================================
' ======= this demonstrates the use for one field
' ================================================
D$ = "Mary had a little lamb, its fleece was white as snow."
G% = fInput%(D$, 2, 10, 20, 70, "")
LOCATE 2, 1: PRINT D$;
' ==================================================
' ====== the following uses an array for 5 fields
' ==================================================
DIM D$(5)
DIM F%(2,5)

RESTORE TestData
FOR X% = 1 TO 5
  READ Prompt$
  READ D$(X%), F%(0,X%), F%(1,X%), F%(2,X%)
  Col% = F%(1,X%) - LEN(Prompt$) - 1
  COLOR 8, 7
  LOCATE F%(0,X%), Col%
  PRINT Prompt$;
  COLOR 1, 7
  LOCATE F%(0,X%), F%(1,X%)
  PRINT LEFT$(D$(X%), F%(2,X%))
NEXT

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

ExitKeys$ = MKI$(%F10key) + MKI$(%UpKey) + MKI$(%DownKey)

Fld% = 1
DO
  IF Fld% < 1 THEN
      Fld% = 5
    ELSEIF Fld% > 5 THEN
      Fld% = 1
  END IF
  G% = fInput%( D$(Fld%), F%(0,Fld%), F%(1,Fld%), 0, F%(2,Fld%), ExitKeys$)
  SELECT CASE G%
    CASE %F10key : EXIT LOOP
    CASE %EscKey : EXIT LOOP
    CASE %UpKey  : DECR Fld%
    CASE ELSE    : INCR Fld%
  END SELECT
LOOP
FOR X% = 1 TO 5
  LOCATE X% + 10, 1
  PRINT D$(X%)
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%

  LOCAL G$
  LOCAL L%

  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$ )

  LOCAL Bgrnd%                ' original background color
  LOCAL Cpos%                 ' current cursor position within string
  LOCAL E%                    ' temp variable
  LOCAL Exet$                 ' string vals of all exit keys
  LOCAL Fgrnd%                ' original foreground color
  LOCAL Inzert%               ' insert state
  LOCAL KeyVal%               ' incoming key-press value
  LOCAL MaxOff%               ' maximum offset position
  LOCAL Offset%               ' 1st character shown in field
  LOCAL Temp$$                ' working data string

  MAP Temp$$ * MaxLen%

  Temp$$  = LTRIM$(Datum$)
  Inzert% = 31
  Exet$   = MKI$(%EscKey) + MKI$(%EnterKey) + 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 %Fgrnd, %Bgrnd
  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%
    E% = INSTR(Exet$, MKI$(KeyVal%))
    IF (E% AND 1) = 1 THEN EXIT LOOP
    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
                       INCR Cpos%
      CASE %BkSpcKey : IF Cpos% > 1 THEN
                         DECR Cpos%
                         GOSUB fInputStrip
                       END IF
      CASE %DelKey   : GOSUB fInputStrip
      CASE %HomeKey  : Cpos% = 1
      CASE %EndKey   : GOSUB fInputEOL
      CASE %LeftKey  : DECR Cpos%
      CASE %RightKey : INCR Cpos%
      CASE %InsKey   : Inzert% = ( Inzert% XOR 31 )
                       LOCATE , , , Inzert%, 31
    END SELECT
  LOOP

  Offset% = 1
  IF KeyVal% <> %EscKey THEN
      Temp$$ = LTRIM$(Temp$$)
      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 ASCii(MID$(Temp$$, Cpos%)) <> 32 THEN EXIT FOR
  NEXT
  INCR Cpos%
RETURN

END FUNCTION