'------------------------------------------------------------------------
' fInput% function for PowerBASIC Console Compiler
'    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
'----------------------------------------------------------------------
' fInput%(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&
'--------------------------------------------------------------------------

%Esc_key   = &h001B             ' key codes returned by fGetKey%
%Enter_key = &h000D
%BkSpc_key = &h0008
%Del_key   = &h5300
%Up_key    = &h4800
%Down_key  = &h5000
%Ins_key   = &h5200
%Left_key  = &h4B00
%Right_key = &h4D00
%Ctrl_Del  = &h9300
%F10_key   = &h4400
%Home_key  = &h4700
%End_key   = &h4F00

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

DECLARE FUNCTION fInput(SEG D AS STRING,BYVAL Row AS LONG,BYVAL Col AS LONG,BYVAL VisLen AS LONG,BYVAL MaxLen AS LONG,BYVAL ExitKeys AS STRING) AS INTEGER
DECLARE FUNCTION fGetKey() AS INTEGER

FUNCTION PBmain ()

  DIM C        AS LOCAL LONG
  DIM Col      AS LOCAL LONG
  DIM D(5)     AS LOCAL STRING
  DIM ExitKeys AS LOCAL STRING
  DIM F(2,5)   AS LOCAL LONG
  DIM Fld      AS LOCAL LONG
  DIM G        AS LOCAL INTEGER
  DIM Prompt   AS LOCAL STRING
  DIM X        AS LOCAL LONG

  COLOR 0, 15
  CLS
  D(0) = "Mary had a little lamb, its fleece was white as snow."
  G = fInput(D(0), 2, 10, 20, 70, "")
  LOCATE 2, 1: PRINT D(0);

  FOR X = 1 TO 5
    INCR C : Prompt = READ$(C)
    INCR C : D(X)   = READ$(C)
    INCR C : F(0,X) = VAL(READ$(C))
    INCR C : F(1,X) = VAL(READ$(C))
    INCR C : F(2,X) = VAL(READ$(C))
    Col = F(1,X) - LEN(Prompt) - 1
    COLOR 8, 15
    LOCATE F(0,X), Col
    PRINT Prompt;
    COLOR 1, 15
    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$(%F10_key) + MKI$(%Up_Key) + MKI$(%Down_Key)

  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 %F10_key : EXIT LOOP
      CASE %Esc_Key : EXIT LOOP
      CASE %Up_Key  : DECR Fld
      CASE ELSE     : INCR Fld
    END SELECT
  LOOP
  FOR X = 1 TO 5
    LOCATE X + 10, 1
    PRINT D(X)
  NEXT
  WAITKEY$

  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

END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fGetKey () EXPORT AS INTEGER

  DIM G AS LOCAL STRING

  G = WAITKEY$

  IF LEN(G) = 1 THEN
      FUNCTION = ASC(G)
    ELSE
      FUNCTION = CVI(G)
  END IF

END FUNCTION
'
'-------------------------------------------------------------------------------
'
FUNCTION fInput (  SEG Datum    AS STRING, _
                 BYVAL Row      AS LONG  , _
                 BYVAL Col      AS LONG  , _
                 BYVAL VisLen   AS LONG  , _
                 BYVAL MaxLen   AS LONG  , _
                 BYVAL ExitKeys AS STRING  ) EXPORT AS INTEGER

  DIM Bgrnd  AS LOCAL LONG          ' original background color
  DIM Cpos   AS LOCAL LONG          ' current cursor position within string
  DIM E      AS LOCAL LONG          ' temp variable
  DIM Fgrnd  AS LOCAL LONG          ' original foreground color
  DIM Inzert AS LOCAL LONG          ' insert state
  DIM KeyVal AS LOCAL LONG          ' incoming key-press value
  DIM MaxOff AS LOCAL LONG          ' maximum offset position
  DIM Offset AS LOCAL LONG          ' 1st character shown in field
  DIM Temp   AS LOCAL STRING * 256  ' working data string

  Temp     = LTRIM$(Datum)
  Inzert   = 10
  ExitKeys = MKI$(%ESC_key) & MKI$(%Enter_Key) & ExitKeys$
  Bgrnd    = SCREENATTR(Row, Col)
  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
  CURSOR ON, Inzert

  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 = MIN(MaxOff,(Cpos - VisLen + 1))
    END IF
    GOSUB fInputPrint
    LOCATE Row, (Col + Cpos - Offset)
    KeyVal = fGetKey
    E = INSTR(ExitKeys, MKI$(KeyVal))
    IF (E AND 1) = 1 THEN EXIT LOOP
    SELECT CASE KeyVal
      CASE 32 TO 255   : IF (Inzert > 10) OR (Cpos = MaxLen) THEN
                             ASC(Temp,Cpos) = KeyVal
                           ELSE
                             Temp = STRINSERT$(Temp,CHR$(KeyVal),Cpos)
                         END IF
                         INCR Cpos
      CASE %BkSpc_Key  : IF Cpos > 1 THEN
                          DECR Cpos
                          Temp = STRDELETE$(Temp,Cpos,1)
                         END IF
      CASE %Del_Key    : Temp = STRDELETE$(Temp,Cpos,1)
      CASE %Home_Key   : Cpos = 1
      CASE %End_Key    : GOSUB fInputEOL
      CASE %Left_Key   : DECR Cpos
      CASE %Right_Key  : INCR Cpos
      CASE %Ins_Key    : IF Inzert = 10 THEN Inzert = 50 ELSE Inzert = 10
                         CURSOR ON, Inzert
    END SELECT
  LOOP

  Offset = 1
  IF KeyVal <> %Esc_Key THEN Datum = TRIM$(Temp)
  Temp = Datum
  COLOR Fgrnd, Bgrnd
  GOSUB fInputPrint

  FUNCTION = KeyVal
  EXIT FUNCTION
  '-----------------------------------------------------------------
  '------------- local routines
  '-----------------------------------------------------------------
  fInputPrint:
    LOCATE Row, Col
    PRINT MID$(Temp, Offset, VisLen);
  RETURN
  '-----------------------------------------------------------------
  fInputEOL:
    FOR Cpos = MaxLen TO 1 STEP -1
      IF ASC(Temp, Cpos) <> 32 THEN EXIT FOR
    NEXT
    INCR Cpos
  RETURN

END FUNCTION