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: