GOTO INPTEND
ASK'YN:
       R$="S": R3=1: R4=2: R5$="YN": CALL INPT: RETURN
!
! New INPT.BSI that supports VUE-like control characters
! Hytek Amplifier Inc / PO Box 670 / Joplin MO 64802
! Copyright (c) 1986 by Brad Horine.  All Rights Reserved to Author.
!
! Notes:  This routine exits with "protected fields enabled".  If your
!         application does not disable protected fields before exiting,
!         your CRT screen may behave strangely (no scrolling, unable to
!         move cursor into "dim" areas, etc.)  Issuing a clear-screen
!         command will also disable protected fields on most CRTs.
!
!         See accompanying INPT.MAP file for variable useage.  Note
!         that all variable names are in the format Rn or Rn$, and that
!         all labels begin with INPT.  It may be wise to refrain from
!         using these variables within your application program.
!
!         See accompanying file INPT.DOC for actions performed by
!         keyboard control characters, and for theory of operation,
!         explanations, and other necessary, boring stuff.
!
!         This routine assumes an 80-column CRT.  If your CRT supports
!         132 columns, and you wish to begin an input field past
!         column 99 of the CRT, you will need to use the 'longhand'
!         method of specifying the coordinates (ie, R$="S": R1=102:
!         R2=18: R3=15  instead of  R$="S,102,18,15".)
!
INPT:
       IF LEN(R$) > 1 THEN &
         R1 = VAL(R$[3;2]) : R2 = VAL(R$[6;2]) : &
         R3 = VAL(R$[9;2]) : R$ = R$[1;1]      ! handle long format of R$
!
       IF R9$ = "" THEN GOTO INPT6             ! bypass if no prompt
       IF R9 = 0 OR R10 = 0 THEN &
         R9 = 1 : R10 = 24                     ! setup prompt coords
       PRINT TAB(R10,R9); R9$;                 ! display prompt
INPT6:
!
       PRINT TAB(-1,14);                       ! disable protected fields
       CALL INPT2                              ! get input
!
       IF R12 THEN R8$ = R6$ + SPACE(R3)       ! handle defualt input
!
       IF R$="N" THEN GOTO INPT1               ! branch if numeric input
!
       IF R3 > 1 OR R5$ = "" THEN GOTO INPT9   ! if not single char, pad
                                               !   with blanks and go to
                                               !   final processing
       IF R8$ = "END" THEN GOTO INPT9
       IF INSTR(1,R5$[1;R4],R8$[1;1]) &
         THEN GOTO INPT9                       ! if ok, do final procs
       PRINT CHR(7);: GOTO INPT                !   else redo
!
INPT1:  ! Numeric entry processing
       IF R8$ = "END" THEN GOTO INPT9          ! if numeric and "END" then
                                               !   go to final processing
! Check for invalid numeric characters
       R7 = 1
INPT7:
       IF INSTR(1," 0123456789.,-",R8$[R7;1]) = 0 &
         THEN PRINT CHR(7);: GOTO INPT         ! if invalid chars in
                                               !   numeric then retry
       IF R7 < R13 THEN &
         R7 = R7 + 1 : GOTO INPT7              ! test next char
!
INPT8:  ! Filter out any commas
       R0 = INSTR(1,R8$,",")                   ! find next comma
       IF R0 = 0 THEN GOTO INPT8A              !   but forget it if none
       IF R0 = R3 THEN R8$[R3;1] = " " ELSE &
         R8$[R0,R3-1] = R8$[R0+1,R3] : &
         R8$[R3;1] = " " : GOTO INPT8          ! delete comma if found
INPT8A:
! Process decimal positioning
       IF INSTR(1,R8$,".") THEN &
         R8 = VAL(R8$): GOTO INPT3             ! if explicit decimal then
                                               !   bypass "." processing
       XCALL STRIP, R3$
       R11 = INSTR(1,R3$,".")                  ! find "." in mask
       IF R11 = 0 THEN R8 = VAL(R8$): &
         GOTO INPT3                            !   bypass if none
       IF R3$[-1;1] = "-" THEN R11 = R11 + 1   ! ajdust for trailing sign
       R8 = VAL(R8$) / 10^(LEN(R3$)-R11)       ! adjust decimal in R8
       IF R8 < R5 OR R8 > R6 THEN &
         PRINT CHR(7);: GOTO INPT              ! if < min or > max then
                                               !   start over
!
INPT3:
       IF R8$ <> "" THEN R8$ = R8 USING R3$    ! reassign R8$ to formatted
                                               !   result unless null
!
INPT9:  ! Final processing & return to calling program
       IF R8$ <> "" AND R8$ <> "END" &
         THEN R8$ = R8$[1;R3]                  ! chop R8$ to proper length
       PRINT TAB(R2,R1); R8$[1;R3];            ! print final value
       IF R9$ <> " " THEN &
         PRINT TAB(R10,R9); SPACE(LEN(R9$));   ! clear prompt
       R3$ = "" : R4 = 0 : R5$ = ""            ! reset all control
       R5 = 0 : R6 = 0 : R6$ = "" : R9$ = ""   !   variables to
       R9 = 0 : R10 = 0 : R11 = 0              !   zero & nulls
       PRINT TAB(-1,13);                       ! reenable protected fields
       RETURN                                  ! string in R8$, number in R8
!
!
INPTPOS:        ! Position cursor on CRT
       PRINT TAB(R2,R1+R7-1);
       GOTO INPT0
!
! Actual keyboard input routines
! Text and control characters are handled here
!
INPT2:
! Fall-through to ^Z first time through to
! display default
!
INPTZ:  ! ^Z -- Erase input & start over
       R4$ = R6$: XCALL STRIP, R4$             ! remove trailing blanks
       PRINT TAB(R2,R1); TAB(-1,11); R4$[1;R3];!   and print default
       IF LEN(R4$) < R3 THEN PRINT R7$[LEN(R4$)+1,R3];
       PRINT TAB(-1,12);                       !   value in dim video,
                                               !   padded with _'s
       PRINT TAB(R2,R1);                       ! reposition cursor
       R8$ = SPACE(R3) : R7 = 1 : R12 = -1     ! initialize variables
       R13 = 0 : R8 = 0
!
INPTB:  ! all
INPTC:  ! of
INPTG:  ! these
INPTP:  ! control
INPTT:  ! chars
INPT28: ! are to
INPT29: ! be
INPT31: ! ignored
INPT0:
       XCALL GET, R0$: R0 = ASC(R0$)           ! get a char from keybd
       IF R0 = 0 THEN GOTO INPT0               !  ignore if null
       IF R12 AND R0 <> 24 AND R0 <> 13 THEN &
         PRINT TAB(R2,R1); R7$[1;R3]; TAB(R2,R1);: &
         R12 = 0                               ! disable ^X if not ^X
       IF R0 < 31 THEN GOTO INPT4              ! branch if ctrl char
       IF R0 = 127 THEN GOTO INPT5             ! branch if DEL
!
       IF R7 > R3 OR (R8 AND R3 = R13) &
         THEN PRINT CHR(7);: GOTO INPT0        ! ignore if at max length
       IF R8 THEN R8$[R7+1,R3] = R8$[R7,R3-1]  ! if ^Q on, move chars up one
       R8$[R7;1] = R0$ : R7 = R7 + 1           ! assign char & incr pointer
       PRINT R0$;                              ! print char
       IF R8 THEN R13 = R13 + 1 &
         ELSE R13 = R13 MAX (R7 - 1)           ! adj length
       IF R8 AND R13 <> R7 - 1 &
         THEN PRINT R8$[R7,R13];: &
         GOTO INPTPOS                          ! if ^Q on, print remainder
                                               !   of line & reposn cursor
       GOTO INPT0                              ! get another char
!
!
INPT5:  ! Handle <DEL>
       IF R7 = 1 THEN GOTO INPT0               ! ignore if beg of line
       IF R7 = R13 + 1 THEN R0$ = R7$[1;1] : R13 = R13 - 1 &
         ELSE R0$ = " "                        ! get replacement char and
                                               !  adj len if at end
       R7 = R7 - 1 : R8$[R7;1] = " "           ! replace char with blank
       PRINT CHR(8); R0$; CHR(8);              ! clean up CRT
       GOTO INPT0                              ! get another char
!
!
INPT4:                                          ! Handle control chars 1-31
       ON R0 GOTO INPTA, INPTB, INPTC, INPTD, INPTE, INPTF, INPTG, INPTH, &
                  INPTI, INPTJ, INPTK, INPTL, INPTM, INPTN, INPTO, INPTP, &
                  INPTQ, INPTR, INPTS, INPTT, INPTU, INPTV, INPTW, INPTX, &
                  INPTY, INPTZ, INPT27, INPT28, INPT29, INPT30, INPT31
       GOTO INPT0
!
INPTA:  ! ^A - Beginning of Word
       IF R7 = 1 THEN GOTO INPT0               ! ignore if beg of line
INPTA2:
       IF R7 = 2 THEN R7 = 1 : GOTO INPTPOS    ! if pos=2 then pos=1
       R7 = R7 - 1
       IF R8$[R7-1;1] = " " AND R8$[R7;1] <> " " &
         THEN GOTO INPTPOS                     ! if prev char blank then
                                               !   this is it
       GOTO INPTA2                             !   else backup & try again
!
INPTD:  ! ^D -- Delete char at cursor
       R8$[R7,R3-1] = R8$[R7+1,R3]             ! move chars down one
       R8$[R13;1] = " "                                ! blank out end char
       GOTO INPTR                              ! fix CRT display
!
INPTE:  ! ^E -- Cursor to end of line
INPTN:  ! ^N -- Cursor to end of line
       R7 = R13 + 1                            ! cursor to last + 1
       GOTO INPTPOS                            ! position cursor on CRT
!
INPTF:  ! ^F -- Insert space at cursor
       IF R13 = R3 THEN PRINT CHR(7): &
         GOTO INPT0                            ! ignore if line is full
       R8$[R7+1,R3] = R8$[R7,R3-1]             ! move chars up one
       R8$[R7;1] = " "                         ! blank this char
       R13 = R13 + 1                           ! increase max
       GOTO INPTR                              ! fix CRT display
!
INPTH:  ! ^H -- Cursor left one char
       IF R7 = 1 AND R13 = 0 THEN R8$ = "END": &
         RETURN                                ! if cursor was at 1,
                                               !   then return "END"
       IF R7 = 1 THEN GOTO INPT0               ! ignore if beg of line
       R7 = R7 - 1 : PRINT CHR(8);             ! move cursor back
       GOTO INPT0                              ! thats it
!
INPTI:  ! ^I -- Cursor to beg of next word
INPTW:  ! ^W -- Cursor to beg of next word
       IF R7 => R13 THEN GOTO INPT0            ! ignore if end of line
       IF R8$[R7;1] = " " THEN GOTO INPTW2
       R0 = INSTR(R7,R8$," ")                  ! locate next blank
       IF R0 = 0 THEN GOTO INPTN &
         ELSE R7 = R0                          ! if no blank, end of line
                                               !   else set cursor to blank
INPTW2:
       R7 = R7 + 1                             ! increment char
       IF R7 => R13 THEN GOTO INPTN            ! stop if end of line
       IF R8$[R7;1] <> " " THEN GOTO INPTPOS &
         ELSE GOTO INPTW2                      ! if non-blank then stop
                                               !   else loop back
!
INPTJ:  ! ^J -- Fold character to lower case
       R8$[R7;1] = LCS(R8$[R7;1])              ! fold character
       PRINT R8$[R7;1]; CHR(8);                ! display it
       GOTO INPT0                              ! thats it
!
INPTK:  ! ^K -- Fold character to upper case
       R8$[R7;1] = UCS(R8$[R7;1])              ! fold character
       PRINT R8$[R7;1]; CHR(8);                ! display it
       GOTO INPT0                              ! thats it
!
INPTL:  ! ^L -- Move cursor right one char
       IF R7 = R13 + 1 THEN GOTO INPT0         ! ignore if end of line
       PRINT R8$[R7;1];: R7 = R7 + 1           ! print current char
       GOTO INPT0                              ! thats it
!
INPTM:  ! ^M -- End input and return
       RETURN                                  ! return & do final procs
!
INPTO:  ! ^O -- Delete blanks at & ahead of cursor
       IF R8$[R7;1] <> " " THEN GOTO INPTR     ! ignore if not blank
       R8$[R7,R3-1] = R8$[R7+1,R3]             ! move chars down one
       R8$[R13;1] = " " : R13 = R13 - 1        ! blank last char
       GOTO INPTO                              ! play it again sam
!
INPTQ:  ! ^Q -- Toggle insert-char mode
       IF R8 = -1 THEN R8 = 0 : GOTO INPTQ2    ! if on then turn off
       IF R8 = 0 THEN R8 = -1                  ! if off then turn on
INPTQ2:
       PRINT CHR(7);: GOTO INPT0               ! ring bell & return
!
INPTR:  ! ^R -- Retype current line
       R4$ = R8$ : XCALL STRIP, R4$            ! strip trailing blanks
       R13 = LEN(R4$)                          !   and reset max length
       PRINT TAB(R2,R1); R8$[1;R13];           ! print current line
       IF R13 <> R3 THEN PRINT R7$[R13+1,R3]   !   and pad with _'s
       R8 = 0 : GOTO INPTPOS                   ! thats it
!
INPTS:  ! ^S -- Swap this char with following char
       IF R7 = R13 THEN GOTO INPT0             ! ignore if end of line
       R4$ = R8$[R7;1] : R8$[R7;1] = R8$[R7+1;1] : R8$[R7+1;1] = R4$
       GOTO INPTR                              ! swap & redraw line
!
INPTU:  ! ^U -- Cursor to position 1
INPT30: ! ^^ -- Cursor to position 1
       R7 = 1 : GOTO INPTPOS                   ! point to pos 1
!
INPTV:  ! ^V -- Delete this word (from cursor to next blank)
       IF R7 = R13 THEN GOTO INPT0             ! ignore if end of line
       R0 = INSTR(R7,R8$," ")                  ! find next blank
       IF R0 = 0 THEN GOTO INPTY               !   goto ^Y if appropriate
       R8$[R7,R0] = SPACE(R0-R7+1)             ! force data to blanks
       GOTO INPTO                              !   and delete them
!
INPTX:  ! ^X -- Accept displayed default and allow editing
       IF NOT R12 THEN GOTO INPT0              ! ignore if any text input
                                               !   has occurred
       R8$ = R6$ : R12 = 0 : GOTO INPTR        ! assign default value &
                                               !   redisplay line
!
INPTY:  ! ^Y -- Erase from cursor to end of line
       IF R7 = R13 + 1 THEN GOTO INPT0         ! ignore if end of line
       R8$[R7,R3] = SPACE(R3-R7+1)             ! force data to blanks
       GOTO INPTR                              !   and retype line
!
INPT27: ! <ESC> -- Force "END" into R8$ (like ^H at beg of line)
       !          Will force END at any point within line
       R8$ = "END" : RETURN                    ! force END
!
INPTEND:

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.