GETNPUT.BAS 2/3

 BBS: Inland Empire Archive
Date: 02-15-93 (00:45)             Number: 382
From: LEE HERRON                   Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: GETNPUT.BAS 2/3                Conf: (2) Quik_Bas

'BEGIN PART II

LOCATE 18, 3: PRINT UNEncd$
END

DEFSNG A-Z
SUB getinput (p$, d$, st$, u#, n#, a#)
SHARED i$
SHARED shit
uc = u#: ns = n#: au = a#
IF au = uc THEN uc = 0
getinput:
c = 0: d = 1:

   IF p$ = "" THEN p$ = d$: IF st$ = "" THEN st$ = " ":

'======= (* Sets cursor position *) ========================================

   IF y = 0 THEN y = CSRLIN
   IF x = 0 THEN x = POS(0)

TGI:
   DO: c = c + d
      IF c < 1 THEN c = 1: d = 1
      IF c > LEN(p$) THEN c = LEN(p$): d = -1
   LOOP UNTIL MID$(d$, c, 1) = st$
   IF c <> LEN(p$) THEN once = 0
'======= (* Delete routine *) ==============================================

   IF dflag THEN MID$(p$, c, 1) = " ": dflag = 0

'======= (* Position cursor turns cursor off *) ============================
   LOCATE y, x, 0
   PRINT p$
   LOCATE y, x + c - 1, 1

   d = 0

   DO:                        ' ---[* Get key inputs..
      k$ = INKEY$:
   LOOP UNTIL k$ > ""

'======= (* Process inputs... *) ===========================================

   SELECT CASE ASC(k$)

   CASE 27, 13                ' ---[* Checking for <Esc> or <Return> then...
      i$ = p$: p$ = ""
      LOCATE y, x + LEN(i$) + 1:
      x = 0: y = 0: st$ = "": uc = 0: ns = 0:

'======= (* LEAVING PROGRAM RESET VARIBLES *) ==============================

      i$ = RTRIM$(i$)
      IF Z = 1 THEN           ' ---[* Converting spaces to underscores
         FOR Z = 1 TO LEN(i$):
            IF MID$(i$, Z, 1) = " " THEN MID$(i$, Z) = "_"
         NEXT Z
         Z = 0: c = 0
      END IF

GOTO toutput                  ' ---[* Ending Sub

   CASE 0                     ' ---[* Checking k$ for <extented code>

      IF RIGHT$(k$, 1) = CHR$(83) THEN MID$(p$, c) = MID$(d$, c, 1)
      IF RIGHT$(k$, 1) = CHR$(75) THEN d = -1
      IF RIGHT$(k$, 1) = CHR$(77) THEN d = 1

' Things like Function key defaults/Macro inputs, etc...
'-----^-----------^----------^-----------^-------- (* Put DEFAULTS here *) -

' END PART II

--- GoldED 2.40
 * Origin: NightFlight BBS [16.8 HST-DS]  (1:3612/130)