'===========================================================================
' Subject: FIELD EDITOR                      Date: 03-02-88 (00:00)       
' Author:  Wayne Robinson                    Code: QB, QBasic, PDS        
' Origin:  harryst@castel.nl               Packet: TEXT.ABC
'===========================================================================

'  FldEdit()
'  by Wayne Robinson, Under the Sun Software
'  Data (201) 666-0519, The Covered Bridge, Phoenix 807/10
'
'  Field Editor for taking keyboard input from a specific
'  screen location of maximum length. Returns one string (FTemp$)
'  and one integer value (FRKey%).
'  Display this code with a TAB stop of 3 spaces for best result.
'  Version 2.0, 3/2/88
'
'  In order to trap function keys the variable FRKey% must be initialized
'  with a non-zero value for the call. This will enable the page, cursor,
'  function keys, and others to be trapped. If FRKey% is 0 coming into
'  FldEdit then only Escape and Carriage Return are trapped. In order to
'  parse for the occurance of one of these keys I suggest a test of FRKey%
'  at the return from FldEdit via a select case such as this one. FldEdit
'  will strip the leading 0's from extended keys and return only the second
'  value in FRKey%
'
'     SELECT CASE FRKey%
'        CASE 13  'CR note FldEdit v1.0 returned 0
'        CASE 27  'ESC
'        CASE 9   'TAB
'        CASE 59  'F1
'        CASE 60  'F2
'        .
'        .
'        .
'        .
'        CASE 71  'HOME
'        CASE 79  'END
'        CASE ELSE
'     END SELECT
'
'  The keys trapped with FRKey% are:
'           F1 - F10             0, 59 to 0, 68
'           Carriage Return      13
'           Escape               27
'           Tab                  9
'           Home                 0, 71
'           End                  0, 79
'           PgUp                 0, 73
'           PgDn                 0, 81
'           Cursor Up            0, 72
'           Cursor Down          0, 80
'
'  Parameters:
'  FRow% = ROW of first character of field
'  FCol% = Column of first character of field
'  FLength% = maximum length of field
'  FFore% = foreground color of text in field
'  FBack% = background color of text in field
'  FRKey% if 0 in then function keys are not parsed
'         if > 0 in then function keys are parsed and value returned
'  FTemp$ = String to edit. If not "" then this string will be placed
'           in the field by FldEdit with the correct attribute.
'           The edited string is returned in this variable.

	SUB FldEdit (FRow%, FCol%, FLength%, FFore%, FBack%, FRKey%, FTemp$) STATIC

'  Set boolean values
		CONST TRUE = -1
		CONST FALSE = 0

'  Set color, ephasize field, insert string, and set cursor
		FSet% = FCol% - 1
		COLOR FFore%, FBack%
		LOCATE FRow%, FCol%, 0
		PRINT FTemp$; SPACE$(FLength% - LEN(FTemp$));
		LOCATE FRow%, FCol%, 1

'  Check FRKey% and set page key functions
		IF FRKey% THEN
			PageSet% = TRUE
		ELSE
			PageSet% = FALSE
		END IF

'  Initialize return key code, stop, reset insert mode
		FRKey% = FALSE
		FStop% = FALSE
		FInsert% = FALSE

'  Set Editor Output string to new Input string
		FOut$ = FTemp$

'  Start Parsing
		DO UNTIL FStop%

'  Sound alarm if called for
			IF Alarm% THEN
				SOUND 1000, 1
				SOUND 1500, 2
				SOUND 500, 1
				Alarm% = FALSE
			END IF

'  Get a key to parse
			FIn$ = ""
			DO
			FIn$ = INKEY$
			LOOP WHILE FIn$ = ""

'  Start by parsing length of key string
			SELECT CASE LEN(FIn$)

'  Check for extended key, strip leading zero
				CASE 2
				FIn$ = RIGHT$(FIn$, 1)

'  Use ASCII value to select
					SELECT CASE ASC(FIn$)

'  Cursor Right
						CASE 77
							IF POS(0) < FSet% + (LEN(FOut$) + 1) THEN
								LOCATE , POS(0) + 1
							ELSE
								Alarm% = TRUE
							END IF

'  Cursor Left
						CASE 75
							IF POS(0) > FSet% + 1 THEN
								LOCATE , POS(0) - 1
							ELSE
								Alarm% = TRUE
							END IF

'  Delete
						CASE 83
							IF POS(0) - FSet% <= LEN(FOut$) THEN
								Shift$ = MID$(FOut$, (POS(0) - FSet%) + 1)
								FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 1)) + Shift$
								FTempPos% = POS(0)
								LOCATE , , 0
								PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
								LOCATE , FTempPos%, 1
							ELSE
								Alarm% = TRUE
							END IF

'  Insert
						CASE 82
							IF FInsert% = FALSE THEN
								FInsert% = TRUE
								LOCATE , , , 0, 7
							ELSEIF FInsert% = TRUE THEN
								FInsert% = FALSE
								LOCATE , , , 7, 7
							END IF

'  Up, Down, PgUp, PgDn, Home, End
						CASE 59 to 68, 71, 72, 73, 79, 80, 81
							IF PageSet% THEN
								FRKey% = ASC(FIn$)
								FStop% = TRUE
							ELSE
								Alarm% = TRUE
							END IF

'  Any other key is illegal so set alarm and loop
						CASE ELSE
							Alarm% = TRUE

					END SELECT

'  Check for non-extended keys
				CASE 1

'  Use ASCII value to select
					SELECT CASE ASC(FIn$)

'  Backspace
						CASE 8
							IF POS(0) - FSet% > 1 THEN
								IF POS(0) - FSet% > LEN(FOut$) THEN
									FOut$ = LEFT$(FOut$, LEN(FOut$) - 1)
									FTempPos% = POS(0)
									LOCATE , POS(0) - 1, 0
									PRINT CHR$(32);
									LOCATE , FTempPos% - 1, 1
								ELSEIF POS(0) - FSet% <= LEN(FOut$) THEN
									Shift$ = MID$(FOut$, POS(0) - FSet%)
									FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 2)) + Shift$
									FTempPos% = POS(0)
									LOCATE , POS(0) - 1, 0
									PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
									LOCATE , FTempPos% - 1, 1
								END IF
							ELSE
								Alarm% = TRUE
							END IF

'  Tab
						CASE 9
							IF PageSet% THEN
								FRKey% = ASC(FIn$)
								FStop% = TRUE
							ELSE
								Alarm% = TRUE
							END IF

'  Carriage Return
						CASE 13
							FRKey% = ASC(FIn$)
							FStop% = TRUE

'  Escape
						CASE 27
							FRKey% = ASC(FIn$)
							FStop% = TRUE

'  Check for additional uprintable input
						CASE IS < 32, IS > 125
							Alarm% = TRUE

'  Found printable key
						CASE 32 TO 125

'  If not past end of maximum length take input.
							IF POS(0) <= FSet% + FLength% THEN

'  If position is less than current string length then check for insert
'  mode on and overwrite character if insert off or insert character if on.
								IF POS(0) - FSet% <= LEN(FOut$) THEN

'  Insert mode off?
									IF FInsert% = FALSE THEN
										MID$(FOut$, POS(0) - FSet%, 1) = FIn$
										PRINT FIn$;

'  Insert mode on?
									ELSEIF FInsert% = TRUE THEN

'  Check length of string plus input and take input if less than max lenth.
										IF LEN(FOut$) < FLength% THEN
											Shift$ = MID$(FOut$, POS(0) - FSet%)
											FOut$ = LEFT$(FOut$, (POS(0) - FSet%) - 1) + FIn$ + Shift$
											FTempPos% = POS(0)
											LOCATE , , 0
											PRINT MID$(FOut$, POS(0) - FSet%);
											LOCATE , FTempPos% + 1, 1

'  If string plus input too long sound alarm and return.
										ELSE
											Alarm% = TRUE
										END IF
									END IF

'  If string position greater than current string length then add character.
								ELSEIF POS(0) - FSet% > LEN(FOut$) THEN
									FOut$ = FOut$ + FIn$
									PRINT FIn$;
								END IF

'  Cursor past end of field so input is illegal
							ELSE
								Alarm% = TRUE
							END IF

'  Any other key is illegal so set alarm and loop
						CASE ELSE
							Alarm% = TRUE

					END SELECT

			END SELECT

		LOOP

'  Exit, reset cursor, assign passed variable
		LOCATE , , 0, 7, 7
		FTemp$ = FOut$

	END SUB