home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / ACCEPT.ZIP / INPUT.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-08-02  |  4.2 KB  |  154 lines
  1. '   INPT.BAS
  2. '       This subprogram accepts input from allowable characters
  3. '       in string valid$ starting at row r% and column c%.  The
  4. '       input is echoed to the screen with attribute type%.
  5. '       The maximum allowable string size is passed in nc%.
  6. '       The insert, delete, left and right arrow, backspace, enter,
  7. '       and escape keys are active.  The escape key returns the input
  8. '       string to what was originally on the screen at the time the
  9. '       INPT routine was called.
  10.  
  11.     SUB inpt(r%, c%, type%, nc%, valid$, sc%) STATIC
  12.  
  13.     ' r% and c% are the row and column locations where input starts
  14.     ' type% is the screen attribute used throughout the input length
  15.     ' nc% is the maximum allowabe length of the input
  16.     ' valid$ is a string containing all allowable characters
  17.     ' sc% is the ascii code of the character used to fill in at the
  18.     '     end of the input line.
  19.  
  20.         sp$ = " "  'blank space
  21.         RR$ = ""   'existing response
  22.         r1% = r%: c1% = c%
  23.  
  24. ' Read RR$ from the screen for possible use if esc is pressed.
  25.         FOR i% = 1 to nc%
  26.           RR$ = RR$ + CHR$(SCREEN(r1%, c1%))
  27.           c1% = c1% + 1
  28.           IF c1% > 80 THEN c1% = c1% - 80: r1% = r1% + 1
  29.         NEXT i%
  30.  
  31. ' Establish row and column for maximum input length
  32.         c1% = c1% - 1
  33.         IF c1% < 1 THEN c1% = 80: r1% = r1% - 1
  34.         rmax% = r1%: cmax% = c1%
  35.  
  36. ' Add these codes to the list of those allowed for input
  37.         enter$ = CHR$(13)
  38.         rgt$ = CHR$(0)+CHR$(77)
  39.         lft$ = CHR$(0)+CHR$(75)
  40.         backsp$ = CHR$(8)
  41.         insert$ = CHR$(0)+CHR$(82)
  42.         delete$ = CHR$(0)+CHR$(83)
  43.         esc$ = CHR$(27)
  44.  
  45.         test$ = valid$+enter$+backsp$+rgt$+lft$+insert$+delete$+esc$
  46.  
  47. ' Begin the input routine
  48.         done% = false%
  49.         r1% = r%: c1% = c%
  50.  
  51.      WHILE NOT done%
  52.         ky$ = ""
  53.         keyent% = false%
  54.  
  55.         WHILE NOT keyent%
  56.             CALL GETKBD(insert%,capslock%,numlock%,scrolllock%)
  57.             IF insert% THEN
  58.                 LOCATE r1%, c1%, 1, 5, 8
  59.                 insflg% = true%
  60.             ELSE
  61.                 LOCATE r1%, c1%, 1, 12
  62.                 insflg% = false%
  63.             END IF
  64.             CALL CLRKBD  ' clear the keyboard buffer
  65.  
  66. '   Get a single key entry from the keyboard
  67.           B:
  68.             ky$ = INKEY$
  69.             IF LEN(ky$)=0 THEN GOTO B
  70.             IF INSTR(test$,ky$) = 0 THEN GOTO B
  71.             keyent% = true%
  72.             IF ky$ = enter$ THEN
  73.                 ky$ = "enter"
  74.             ELSEIF ky$ = backsp$ THEN ky$ = "backsp"
  75.             ELSEIF ky$ = rgt$ THEN ky$ = "right"
  76.             ELSEIF ky$ = lft$ THEN ky$ = "left"
  77.             ELSEIF ky$ = insert$ THEN ky$ = "insert"
  78.             ELSEIF ky$ = delete$ THEN ky$ = "delete"
  79.             ELSEIF ky$ = esc$ THEN ky$ = "escape"
  80.             END IF
  81.         WEND
  82.         SELECT CASE ky$
  83.             CASE "enter"
  84.                 done% = true%
  85.             CASE "backsp"
  86.                 CALL P(sp$,r1%,c1%,type%)
  87.                 GOSUB moveleft
  88.             CASE "right"
  89.                 GOSUB moveright
  90.             CASE "left"
  91.                 GOSUB moveleft
  92.             CASE "insert"
  93.             CASE "delete"
  94.                 moved% = false%
  95.                 WHILE NOT moved%
  96.                     r2% = rmax%: c2% = cmax%
  97.                     y$ = CHR$(sc%)
  98.                     WHILE NOT (r2% < r1%) AND NOT (c2% < c1%)
  99.                        x% = SCREEN(r2%,c2%): x$ = CHR$(x%)
  100.                        CALL P(y$,r2%,c2%,type%)
  101.                        y$ = x$
  102.                        c2% = c2% - 1
  103.                        IF c2% < 1 THEN c2% = 80 + c2%: r2% = r2% - 1
  104.                     WEND
  105.                     moved% = true%
  106.                 WEND
  107.             CASE "escape"
  108.             CALL P(RR$,r%,c%,type%)
  109.             r1% = r%: c1% = c%
  110.             CASE ELSE
  111.                 moved% = false%
  112.                 WHILE insflg% AND NOT moved%
  113.                     r2% = r1%: c2% = c1%
  114.                     y$ = " "
  115.                     WHILE NOT (r2% > rmax%) AND NOT (c2% > cmax%)
  116.                        x% = SCREEN(r2%,c2%): x$ = CHR$(x%)
  117.                        CALL P(y$,r2%,c2%,type%)
  118.                        y$ = x$
  119.                        c2% = c2% + 1
  120.                        IF c2% > 80 THEN c2% = c2% - 80: r2% = r2% + 1
  121.                     WEND
  122.                     moved% = true%
  123.                 WEND
  124.                 CALL P(ky$,r1%,c1%,type%)
  125.                 GOSUB moveright
  126.         END SELECT
  127.       WEND
  128.       GOTO leaveinpt 'jump over the subroutines
  129.  
  130. ' The following are subroutines used within the subprogram
  131.             moveleft:
  132.                 IF NOT (r1% = r% AND c1% = c%) THEN
  133.                     IF c1% = 1 THEN
  134.                         c1% = 80: r1% = r1% - 1
  135.                     ELSE
  136.                         c1% = c1% - 1
  137.                     END IF
  138.                 ELSE BEEP
  139.                 END IF
  140.             RETURN
  141.             moveright:
  142.                 IF NOT (r1% = rmax% AND c1% = cmax%) THEN
  143.                     IF c1% = 80 THEN
  144.                         c1% = 1: r1% = r1% + 1
  145.                     ELSE
  146.                         c1% = c1% + 1
  147.                     END IF
  148.                 ELSE BEEP
  149.                 END IF
  150.             RETURN
  151.     leaveinpt:
  152.     END SUB
  153.  
  154.