;***************************************************************************;
;                              STUVUE.M68
;       for use with STUVUE.BAS
;                                                                           ;
;               ORIGINALLY    EDIT.M68   by David F. Pallmann                               ;
;               CRT-oriented type-checked field input routine               ;
;                                                                           ;
;                         Author: David F. Pallmann                         ;
;            Copyright (C) 1984 by LMS Technical Services, Inc.             ;
;                       modified for STUVUE.M68                                                     ;
;                           22-may-86
;                        James A. Jarboe IV
;***************************************************************************;
;
;       Calling Format--.
;
;               XCALL STUVUE, "row col type minsiz maxsiz flags ", field, key
;
;       Where--.
;               row     = CRT row (1-24)
;               col     = CRT column (1-80)
;               type    = one of the following--.
;                               * = string
;                               A = alphabetic
;                               @ = alphanumeric
;                               I = integer
;                               F = floating point
;                               $ = dollar amount
;                               Y = yes/no
;               minsiz  = minimum field size
;               maxsiz  = maximum field size
;               flags   = zero or more of the following--.
;                               R = required field
;                               A = automatic field
;                               U = upper-case field
;                               L = lower-case field
;                               F = folded field
;                               N = no blanks allowed
;                               - = leading minus allowed
;                               E = position at end of field
;                               T = trap ^Cs
;                               P = password field
;
;               field   = string variable to edit
;               key     = 2 byte binary return code--.
;                               0   = standard end of field
;                               1   = ESCape
;                               2   = up-arrow (^K)
;                               3   = down-arrow (^J)
;                               4   = TAB
;                               5   = ^T
;                               6   = ^R
;                               7   = ^B
;                               8   = ^E
;                               9   = ^^ (home)
;                               1xx = function code xx
;                               2xx = shifted function code xx

       OBJNAM  STUVUE.SBR

       VMAJOR=1

       ;edit history

;       VEDIT=0         ;22-Jun-84 DFP created from CRT.M68
       VEDIT=1         ;22-May-86 JAJ modified for STUVUE

       ;universals

       SEARCH  SYS
       SEARCH  SYSSYM
       SEARCH  TRM
       SEARCH  MACLIB

       ;ASCII chars

       BS=10
       TAB=11
       LF=12
       CR=15
       ESC=33
       DEL=177

       ;XCALL offsets

       .OFINI
       .OFDEF  XC.ARG,2                        ;argument count
       .OFDEF  XC.TY1,2                        ;parameter string (type)
       .OFDEF  XC.AD1,4                        ;parameter string (addr)
       .OFDEF  XC.SZ1,4                        ;parameter string (size)
       .OFDEF  XC.TY2,2                        ;string variable (type)
       .OFDEF  XC.AD2,4                        ;string variable (addr)
       .OFDEF  XC.SZ2,4                        ;string variable (size)
       .OFDEF  XC.TY3,2                        ;return variable (type)
       .OFDEF  XC.AD3,4                        ;return variable (addr)
       .OFDEF  XC.SZ3,4                        ;return variable (size)
       .OFDEF  XC.TY4,2                        ;status line text (type)
       .OFDEF  XC.AD4,4                        ;status line text (addr)
       .OFDEF  XC.SZ4,4                        ;status line text (size)
       .OFSIZ  XC.SIZ

       ;variable type codes

       XC$STR=2
       XC$BIN=6

       ;impure area

       .OFINI
       .OFDEF  ROW,2                           ;cursor row
       .OFDEF  COL,2                           ;cursor column
       .OFDEF  TYPE,2                          ;field type--.
               T.STR=0                         ; string
               T.ALF=2                         ; alphabetic
               T.ANM=4                         ; alphanumeric
               T.INT=6                         ; integer
               T.FLT=10                        ; floating point
               T.AMT=12                        ; dollar amount
               T.YNO=14                        ; yes/no
       .OFDEF  MINSIZ,2                        ;min. field size
       .OFDEF  MAXSIZ,2                        ;max. field size
       .OFDEF  FLAGS,4                         ;flags--.
               F.REQ=1                         ; required field
               F.AUT=2                         ; automatic field
               F.UCS=4                         ; upper-case field
               F.LCS=10                        ; lower-case field
               F.NAM=20                        ; namefold field
               F.NSP=40                        ; spaces invalid
               F.NEG=100                       ; leading minus valid
               F.END=200                       ; position cursor at end of field
               F.CTC=400                       ; trap ^Cs                      101
               F.PSW=1000                      ; password field                101
               F.UND=20000
               F.CHR=40000
               F.ERR=100000                    ; an error has occurred
       .OFDEF  SIZE,2                          ;field size
       .OFDEF  POS,2                           ;position within field
       .OFSIZ  IMPSIZ

PAGE
;entry point from AlphaBASIC
;A3 indexes argument list

ENTRY:  PHDR    -1,0,PH$REE!PH$REU      ;program header
       CALL    INIT                    ;initialize storage
       CALL    CHKPRM                  ;check parameters
       RNE                             ; errors
       CALL    DISFLD                  ;display field
       CALL    EDTFLD                  ;edit field
       CALL    REDISP                  ;re-display field
       RTN                             ;return to BASIC

PAGE
;******
;CHKPRM
;******
;check paramters

CHKPRM: CALL    CHKARG                  ;check argument types and sizes
       CALL    GETROW                  ;get row
       CALL    GETCOL                  ;get column
       CALL    GETTYP                  ;get data type
       CALL    GETMIN                  ;get min size
       CALL    GETMAX                  ;get max size
       CALL    GETFLG                  ;get flags
       CALL    GETSTS                  ;get status line
       BIT     #F.ERR,FLAGS(A4)        ;set Z according to errors
       RTN

;check types and sizes of arguments

CHKARG: CMMW    XC.ARG(A3),#3           ;3 arguments (or more) present? 103
       JLT     ARGERR                  ; no - error                    103
       CMMW    XC.TY1(A3),#XC$STR      ;1st argument a string?
       JNE     VARERR                  ; no - error
       CMMW    XC.TY2(A3),#XC$STR      ;2nd argument a string?
       JNE     VARERR                  ; no - error
       CMMW    XC.TY3(A3),#XC$BIN      ;3rd argument binary?
       JNE     VARERR                  ; no - error
       CMM     XC.SZ3(A3),#2           ;3rd argument 2 bytes in length?
       JNE     SIZERR                  ; no - error
       MOV     XC.AD1(A3),A2           ;index parameter string
       RTN

;get row from parameter string

GETROW: BYP
       NUM
       JNE     MISERR
       GTDEC
       MOVW    D1,ROW(A4)
       RTN

;get column from parameter string

GETCOL: BYP
       NUM
       JNE     MISERR
       GTDEC
       MOVW    D1,COL(A4)
       RTN

;get data type from parameter string

GETTYP: BYP
       MOVB    (A2)+,D1
       UCS
       LEA     A0,TYPTBL
       MOV     #-2,D0
10$:    TSTB    @A0
       JEQ     TYPERR
       ADD     #2,D0
       CMMB    (A0)+,D1
       BNE     10$
       MOVW    D0,TYPE(A4)
       RTN

TYPTBL: ASCIZ   /*A@IF$Y/
       EVEN

;get min size from parameter string

GETMIN: BYP
       NUM
       JNE     MISERR
       GTDEC
       MOVW    D1,MINSIZ(A4)
       RTN

;get max size from parameter string

GETMAX: BYP
       NUM
       JNE     MISERR
       GTDEC
       MOVW    D1,MAXSIZ(A4)
       RTN

;get flags from parameter string

GETFLG: BYP                             ;bypass leading spaces
10$:    MOVB    (A2)+,D1                ;get char
       UCS                             ;fold to upper case
       LEA     A0,FLGTBL               ;index flag table
       MOV     #1,D0                   ;set bit flag
20$:    TSTB    @A0                     ;end of table?
       REQ                             ; yes - end of flag processing
       CMMB    (A0)+,D1                ;char match?
       BEQ     30$                     ; yes
       ASL     D0                      ; no - shift to next bit
       BR      20$                     ;try again
30$:    OR      D0,FLAGS(A4)            ;set bit flag
       BR      10$                     ;process next flag char

FLGTBL: ASCIZ   /RAULFN-ETP/
       EVEN

;get status line (if specified)                                         103

GETSTS: CMMW    XC.ARG(A3),#4           ;status line specified?         103
       BGE     10$                     ; yes - branch                  103
       RTN                             ; no                            103
10$:    MOV     XC.AD4(A3),A0           ;                               103
       MOV     XC.SZ4(A3),D0           ;                               103
       MOVW    #-1_8.+38.,D1           ;start                          103
       TCRT                            ; status line                   103
20$:    MOVB    (A0)+,D1                ;                               103
       TTY                             ;                               103
       SOB     D0,20$                  ;                               103
       MOVW    #-1_8.+39.,D1           ;end                            103
       TCRT                            ; status line                   103
;       MOVW    #-1_8.+40.,D1           ;status line                    103
;       TCRT                            ; on                            103
       RTN

PAGE
;****
;INIT
;****
;initialize storage

INIT:   MOV     XC.AD3(A3),A6           ;index return code
       CLRW    @A6                     ;clear return code
       CLRW    SIZE(A4)
       CLRW    POS(A4)
       CLR     FLAGS(A4)
       RTN

PAGE
;******
;DISFLD
;******
;display field for editing

DISFLD: CRT     ROW(A4),COL(A4)         ;position cursor at start of field
       BIT     #F.UND,FLAGS(A4)        ;                               105
       BEQ     4$                      ;                               105
       CRT     #5                      ;                               105
       CRT     #30.                    ;                               105
4$:     CRT     #12.                    ;high intensity
       MOV     XC.AD2(A3),A2           ;index start of buffer
       CLR     D0
       MOVW    MAXSIZ(A4),D0           ;D0 ::= max size
       BEQ     40$                     ;if zero return
10$:    MOVB    (A2)+,D1                ;get next char
       BEQ     20$                     ;branch if NUL
       CALL    TTY                     ;display char                   101
       INCW    SIZE(A4)                ;update size
       SOB     D0,10$                  ;loop till all chars output
       BR      40$                     ;if full bufferm branch
20$:;   CRT     #11.                    ;low intensity
   ;   CALL    PADCHR                  ;                               105
30$:;   TTY                             ;output pad char
   ;   SOB     D0,30$                  ;loop till full size displayed
40$:    BIT     #F.UND,FLAGS(A4)        ;                               105
       BEQ     44$                     ;                               105
       CRT     #31.                    ;                               105
44$:    RTN                             ;return

PAGE
;******
;EDTFLD
;******
;edit field

EDTFLD: MOV     JOBCUR,A0               ;index own JCB
       MOV     JOBTRM(A0),A0           ;index own TRMDEF block
       ORW     #<T$DAT!T$ECS>,T.STS(A0);set data mode, no echo
       CRT     #12.                    ;high intensity
       BIT     #F.END,FLAGS(A4)        ;end-of-field bit set?
       BNE     POSEND                  ; yes - special processing

;index start of field

POSBEG: CRT     ROW(A4),COL(A4)
       MOV     XC.AD2(A3),A2
       BR      GETCHR

;index end of field

POSEND: MOVW    ROW(A4),D1
       ROLW    D1,#8.
       ADDW    COL(A4),D1
       ADDW    SIZE(A4),D1
       TCRT
       MOVW    SIZE(A4),POS(A4)
       MOV     XC.AD2(A3),A2
       ADDW    SIZE(A4),A2

GETCHR: KBD                             ;get char

FKEY:   CMPB    D1,#'@                  ;simulated function key?
       BEQ     SIMFKY                  ; yes
       TSTB    D1                      ;function key sequence?         102
       BPL     CHKCTL                  ; no                            102
       CMPB    D1,#240                 ;shifted function key?          102
       BHIS    10$                     ; yes                           102
       SUB     #28.,D1                 ;unshifted keys return 100. up  102
       BR      20$                     ;                               102
10$:    SUB     #<40+8.>,D1             ;shifted keys return 200. up    102
20$:    MOV     XC.AD3(A3),A6           ; yes - return code             102
       MOVW    D1,@A6                  ;                               102
       JMP     ENDFLD                  ;                               102

SIMFKY: KBD
       CMPB    D1,#'1
       BLE     CHKCTL
       AND     #177,D1
       SUBW    #'1,D1
       MOV     XC.AD3(A3),A6
       MOVW    D1,@A6
       JMP     ENDFLD

CHKCTL: AND     #177,D1                 ;mask to 7-bit ASCII
       BIT     #F.CHR,FLAGS(A4)        ;single char?
       JNE     VALID                   ; yes - valid
       LEA     A0,CHRTBL               ;index char table
       MOV     #-2,D0                  ;pre-set jump index
10$:    TSTB    @A0                     ;end of table?
       JEQ     CHECK                   ; yes - process as a text char
       ADD     #2,D0                   ;update jump index
       CMMB    (A0)+,D1                ;char match?
       BNE     10$                     ; no - try next char in table
       TJMP    D0                      ; yes - branch on index
       OFFSET  BCKWRD                  ;^A  - back word
       OFFSET  CTRL.B                  ;^B  -
       OFFSET  CTRL.C                  ;^C  - abort
       OFFSET  DELCHR                  ;^D  - delete char
       OFFSET  CTRL.E                  ;^E
       OFFSET  INSCHR                  ;^F  - insert char
       OFFSET  BCKCHR                  ;BS  - char left
       OFFSET  TABSCR                  ;TAB - forward screen
       OFFSET  FWDFLD                  ;^J  - forward field
       OFFSET  BCKFLD                  ;^K  - back field
       OFFSET  FWDCHR                  ;^L  - char right
       OFFSET  RETURN                  ;CR  - end of field
       OFFSET  ENDLIN                  ;^N  - end of field
       OFFSET  RTNPGE                  ;^R  - same as ESC
       OFFSET  TRNPGE                  ;^T  - same as TAB
       OFFSET  BEGFLD                  ;^U  - beginning of field
       OFFSET  FWDFLD                  ;^V  - forward field
       OFFSET  FWDWRD                  ;^W  - forward word
       OFFSET  DELEOL                  ;^Y  - delete to end of line
       OFFSET  DELFLD                  ;^Z  - delete field
       OFFSET  TOGGLE                  ;^\  - namefold toggle
       OFFSET  ESCAPE                  ;ESC - back screen
       OFFSET  DELCHR                  ;_   - delete char
       OFFSET  DELCHR                  ;DEL - delete char
       OFFSET  HOME                    ;^^

CHRTBL: BYTE    'A-'@                   ;^A
       BYTE    'B-'@                   ;^B
       BYTE    'C-'@                   ;^C
       BYTE    'D-'@                   ;^D
       BYTE    'E-'@                   ;^E
       BYTE    'F-'@                   ;^F
       BYTE    BS                      ;backspace
       BYTE    TAB                     ;tab
       BYTE    LF                      ;LF
       BYTE    'K-'@                   ;^K
       BYTE    'L-'@                   ;^L
       BYTE    CR                      ;CR
       BYTE    'N-'@                   ;^N
       BYTE    'R-'@                   ;^R
       BYTE    'T-'@                   ;^T
       BYTE    'U-'@                   ;^U
       BYTE    'V-'@                   ;^V
       BYTE    'W-'@                   ;^W
       BYTE    'Y-'@                   ;^Y
       BYTE    'Z-'@                   ;^Z
       BYTE    '\-'@                   ;^\
       BYTE    ESC                     ;ESC
       BYTE    '_                      ;_
       BYTE    DEL                     ;DEL
       BYTE    '^-'@                   ;^^
       BYTE    0
       EVEN

;^A
;back word

BCKWRD: TSTW    POS(A4)
       JEQ     GETCHR
       BR      20$
10$:    TSTW    POS(A4)
       JEQ     GETCHR
       CMMB    @A2,#40
       BNE     30$
20$:    CRT     #5
       DEC     A2
       DECW    POS(A4)
       BR      10$
30$:    TSTW    POS(A4)
       JEQ     GETCHR
       CMMB    -1(A2),#40
       JEQ     GETCHR
       CRT     #5
       DEC     A2
       DECW    POS(A4)
       BR      30$

;^F
;insert char

INSCHR: CMMW    SIZE(A4),MAXSIZ(A4)
       JEQ     GETCHR
       CMMW    POS(A4),SIZE(A4)
       JEQ     GETCHR
       TYPESP
       CLR     D0
       MOVW    SIZE(A4),D0
       SUBW    POS(A4),D0
       SAVE    A2
10$:    MOVB    (A2)+,D1
       CALL    TTY                     ;                               101
       SOB     D0,10$
       MOVW    SIZE(A4),D0
       SUBW    POS(A4),D0
       INC     D0
       MOV     XC.AD2(A3),A2
       ADDW    SIZE(A4),A2
       INC     A2
20$:    MOVB    -(A2),1(A2)
       SOB     D0,20$
       REST    A2
       MOVB    #40,@A2
       INCW    SIZE(A4)
       MOVW    ROW(A4),D1
       ROLW    D1,#8.
       ADDW    COL(A4),D1
       ADDW    POS(A4),D1
       TCRT
       JMP     GETCHR

;^H
;move back one char

BCKCHR: TSTW    POS(A4)
       JEQ     GETCHR
       CRT     #5
       DECW    POS(A4)
       DEC     A2
       JMP     GETCHR

;^K
;back field

BCKFLD: MOV     XC.AD3(A3),A6
       MOVW    #2,@A6
       JMP     ENDFLD

;^I, TAB
;end screen

TABSCR: MOV     XC.AD3(A3),A6
       MOVW    #4,@A6
       JMP     CHKFLD

;^J, LF
;next field

FWDFLD: MOV     XC.AD3(A3),A6
       MOVW    #3,@A6
       JMP     CHKFLD

;^L
;forward char

FWDCHR: CMMW    POS(A4),SIZE(A4)
       JEQ     GETCHR
       CRT     #6
       INCW    POS(A4)
       INC     A2
       JMP     GETCHR

;^M, CR
;end of field

RETURN: MOV     XC.AD3(A3),A6
       CLRW    @A6

;check for valid end of field

CHKFLD: CMMW    POS(A4),MINSIZ(A4)
       JGE     ENDFLD
       TSTW    POS(A4)
       JNE     GETCHR
       CMMW    SIZE(A4),MINSIZ(A4)
       JGE     ENDFLD
       BIT     #F.REQ,FLAGS(A4)
       JEQ     ENDFLD
       JMP     GETCHR

;^U
;beginning of field

BEGFLD: TSTW    POS(A4)
       JEQ     GETCHR
       CLRW    POS(A4)
       MOV     XC.AD2(A3),A2
       CRT     ROW(A4),COL(A4)
       JMP     GETCHR

;^N
;end of field

ENDLIN: CMMW    POS(A4),SIZE(A4)
       JEQ     GETCHR
       MOVW    SIZE(A4),POS(A4)
       MOV     XC.AD2(A3),A2
       ADDW    SIZE(A4),A2
       MOVW    ROW(A4),D1
       ROLW    D1,#8.
       ADDW    COL(A4),D1
       ADDW    SIZE(A4),D1
       TCRT
       JMP     GETCHR

;^W
;forward word

FWDWRD: ;CMMW   POS(A4),SIZE(A4)
       ;JEQ    GETCHR
       ;BR     20$
10$:    CMMW    POS(A4),SIZE(A4)
       JEQ     GETCHR
       CMMB    @A2,#40
       BEQ     30$
20$:    CRT     #6
       INC     A2
       INCW    POS(A4)
       BR      10$
30$:    CMMW    POS(A4),SIZE(A4)
       JEQ     GETCHR
       CMMB    @A2,#40
       JNE     GETCHR
       CRT     #6
       INC     A2
       INCW    POS(A4)
       BR      30$

;^Y
;delete to end of line

DELEOL: TSTW    SIZE(A4)
       JEQ     GETCHR
       CLR     D0
       MOVW    SIZE(A4),D0
       SUBW    POS(A4),D0              ;D0 := chars to right of cursor
       JEQ     GETCHR                  ;nothing to delete
       MOVW    POS(A4),SIZE(A4)
       CLRB    @A2
       CRT     #11.
       CALL    PADCHR                  ;                               105
10$:    TTY
       SOB     D0,10$
       CRT     #12.
       MOVW    ROW(A4),D1
       ROLW    D1,#8.
       ADDW    COL(A4),D1
       ADDW    SIZE(A4),D1
       TCRT
       JMP     GETCHR

;^Z
;delete field

DELFLD: CRT     ROW(A4),COL(A4)
       CLRW    POS(A4)
       CLRW    SIZE(A4)
       MOV     XC.AD2(A3),A2
       CLR     D0
       MOVW    MAXSIZ(A4),D0
       CRT     #11.
       CALL    PADCHR                  ;                       105
10$:    TTY
       SOB     D0,10$
       CRT     #12.
       CRT     ROW(A4),COL(A4)
       JMP     GETCHR

;^\
;toggle namefold

TOGGLE: TTYI
       BYTE    7,0
       XOR     #F.NAM,FLAGS(A4)
       JMP     GETCHR

;^C
CTRL.C: BIT     #F.CTC,FLAGS(A4)
       JNE     GETCHR
       MOV     JOBCUR,A0
       ORW     #<J.CCC>,JOBSTS(A0)
       BR      ENDFLD

;^E
;End of file
CTRL.E:
       MOV     XC.AD3(A3),A6
       MOVW    #8.,@A6
       JMP     ENDFLD
;^^
;HOME
HOME:
       MOV     XC.AD3(A3),A6
       MOVW    #9.,@A6
       JMP     ENDFLD

;^B
; New line
CTRL.B:
       MOV     XC.AD3(A3),A6
       MOVW    #7,@A6
       JMP     ENDFLD
;^T
; turn a page
TRNPGE:
       MOV     XC.AD3(A3),A6
       MOVW    #5,@A6
       JMP     CHKFLD
;^R
; return a page
RTNPGE:
       MOV     XC.AD3(A3),A6
       MOVW    #6,@A6
       JMP     CHKFLD
;ESC
;back screen

ESCAPE: MOV     XC.AD3(A3),A6
       MOVW    #1,@A6

;end of field processing

ENDFLD: ;TSTW   POS(A4)                                                 104
       ;BNE    10$                                                     104
       MOVW    SIZE(A4),POS(A4)
10$:    MOV     JOBCUR,A0
       MOV     JOBTRM(A0),A0
       ANDW    #^C<T$DAT!T$ECS!T$XLT>,T.STS(A0)
       CMMW    POS(A4),MAXSIZ(A4)
       BEQ     20$
       MOV     XC.AD2(A3),A2
       MOVW    POS(A4),D7
       ADDW    D7,A2
       CLRB    @A2
20$:    MOVW    POS(A4),SIZE(A4)
       CMMW    XC.ARG(A3),#4           ;status line specified?         103
;       BLT     30$                     ; no                            103
;       MOVW    #-1_8.+41.,D1           ;status line                    103
;       TCRT                            ; off                           103
30$:    RTN                             ;                               103

;^D, DEL
;delete char

DELCHR: TSTW    SIZE(A4)
       JEQ     GETCHR
       CMMW    POS(A4),SIZE(A4)
       BLT     DELMID
       CRT     #11.
       TTYI
       BYTE    10,0
       CALL    PADCHR
       TTY
       TTYI
       BYTE    10,0
       CRT     #12.
       DECW    POS(A4)
       DECW    SIZE(A4)
       DEC     A2
       JMP     GETCHR

;delete char in middle of string

DELMID: CLR     D0
       MOVW    SIZE(A4),D0
       SUBW    POS(A4),D0
;       INC     D0
       SAVE    A2
       INC     A2
10$:    MOVB    (A2)+,D1
       CALL    TTY                     ;                               101
       MOVB    D1,-2(A2)
       SOB     D0,10$
       CRT     #11.
       CALL    PADCHR
       TTY
       CRT     #12.
       REST    A2
       MOVW    ROW(A4),D1
       ROLW    D1,#8.
       ADDW    COL(A4),D1
       ADDW    POS(A4),D1
       TCRT
       DECW    SIZE(A4)
       JMP     GETCHR

PAGE
;check char against data type

CHECK:  CMPB    D1,#40
       JLT     GETCHR
       CMPB    D1,#125.
       JGT     GETCHR
       TJMP    TYPE(A4)
       OFFSET  CHKSTR
       OFFSET  CHKALF
       OFFSET  CHKANM
       OFFSET  CHKINT
       OFFSET  CHKFLT
       OFFSET  CHKAMT
       OFFSET  CHKYNO

;string

CHKSTR: CALL    SPACE
       JEQ     VALID
       JMP     VALID

;alphabetic

CHKALF: CALL    SPACE
       JEQ     VALID
       CALL    ALPHA
       JEQ     VALID
       JMP     GETCHR

;alphanumeric

CHKANM: CALL    SPACE
       JEQ     VALID
       CALL    ALPHA
       JEQ     VALID
       CALL    NUMBER
       JEQ     VALID
       JMP     GETCHR

;integer

CHKINT: CALL    SPACE
       JEQ     VALID
       CALL    MINUS
       JEQ     VALID
       CALL    NUMBER
       JEQ     VALID
       JMP     GETCHR

;floating point

CHKFLT: CALL    MINUS
       JEQ     VALID
       CALL    NUMBER
       JEQ     VALID
       JMP     GETCHR

;dollar amount

CHKAMT: CALL    MINUS
       JEQ     VALID
       CALL    NUMBER
       JEQ     VALID
       JMP     GETCHR

;yes/no

CHKYNO: CMPB    D1,#'Y
       BEQ     10$
       CMPB    D1,#'N
       BEQ     10$
       CMPB    D1,#'y
       BEQ     10$
       CMPB    D1,#'n
       BEQ     10$
       JMP     GETCHR
10$:    JMP     VALID

;return Z=1 if alphabetic char

ALPHA:  CMPB    D1,#'A
       BLT     10$
       CMPB    D1,#'z
       BGT     10$
       CMPB    D1,#'Z
       BLE     20$
       CMPB    D1,#'a
       BGE     20$
10$:    LCC     #0
       RTN
20$:    LCC     #4
       RTN

;return Z=1 if numeric char

NUMBER: CMPB    D1,#'0
       BLT     20$
       CMPB    D1,#'9
       BGT     20$
10$:    LCC     #4
       RTN
20$:    LCC     #0
       RTN

;return Z=1 if char is a space, and F.NSP is not set

SPACE:  CMPB    D1,#40
       BNE     20$
       BIT     #F.NSP,FLAGS(A4)
       BNE     20$
10$:    LCC     #4
       RTN
20$:    LCC     #0
       RTN

;return Z=1 if char is a minus, and F.NEG set

MINUS:  CMPB    D1,#'-
       BNE     20$
       BIT     #F.NEG,FLAGS(A4)
       BEQ     20$
       TSTW    POS(A4)
       BNE     20$
10$:    LCC     #4
       RTN
20$:    LCC     #0

       RTN

PAGE
;character has been determined to be a valid text character for this field.

VALID:  CMMW    POS(A4),MAXSIZ(A4)      ;is field full?
       JGE     GETCHR                  ; yes - must reject char
       CALL    CASE                    ;perform special case checking
       CALL    TTY                     ;display the char               101
       MOVB    D1,(A2)+                ;store the char
       INCW    POS(A4)                 ;update position
       CMMW    POS(A4),SIZE(A4)        ;do we need to update size?
       BLE     10$                     ; no - get next char
       INCW    SIZE(A4)                ; yes - update size
10$:    BIT     #F.CHR,FLAGS(A4)        ;single char?
       JNE     RETURN                  ; yes
       BIT     #F.AUT,FLAGS(A4)        ;automatic field?
       JEQ     GETCHR                  ; no - get next char
       CMMW    POS(A4),MAXSIZ(A4)      ; yes - end of field?
       JNE     GETCHR                  ;  no - get next char
       JMP     RETURN                  ;  yes - end of edit

;special case fold checking

CASE:   CALL    CHKUCS                  ;check for upper case folding
       CALL    CHKLCS                  ;check for lower case folding
       CALL    CHKNAM                  ;check for namefolding
       RTN

;if F.UCS set, fold to upper case

CHKUCS: BIT     #F.UCS,FLAGS(A4)
       REQ
       UCS
       RTN

;if F.LCS set, fold to lower case

CHKLCS: BIT     #F.LCS,FLAGS(A4)
       REQ
       LCS
       RTN

;if F.NAM set, fold chars at the beginnings of words to upper case

CHKNAM: BIT     #F.NAM,FLAGS(A4)
       REQ
       TSTW    POS(A4)
       BEQ     10$
       CMMB    -1(A2),#40
       RNE
10$:    UCS
       RTN

PAGE
;******
;REDISP
;******
;redisplay field after edit

REDISP: CRT     #12.
       CMMW    TYPE(A4),#T.AMT         ;amount field?
       BEQ     DISAMT                  ; yes - right justify field
       CLR     D0
       MOVW    MAXSIZ(A4),D0
       SUBW    SIZE(A4),D0
RTN
       REQ
       MOVW    SIZE(A4),D7
       ADDW    D7,COL(A4)
       CRT     ROW(A4),COL(A4)
       MOV     #40,D1
10$:    TTY

       SOB     D0,10$
       RTN

;Dollar-amount fields are displayed right-justified, and formatted w/a
;decimal point and a dollar sign

DISAMT: CRT     ROW(A4),COL(A4)
       CRT     #5
       CRT     #5
       CLR     D0
       MOVW    MAXSIZ(A4),D0
       SUBW    SIZE(A4),D0
       BEQ     20$
       MOV     #40,D1
10$:    TTY
       SOB     D0,10$
20$:    TYPE    $
       MOVW    SIZE(A4),D0
       BEQ     50$
       MOV     XC.AD2(A3),A2
30$:    CMPB    D0,#2
       BNE     40$
       TYPE    .
40$:    MOVB    (A2)+,D1
       CALL    TTY                     ;                               101
       SOB     D0,30$
50$:    RTN

TTY:    BIT     #F.CHR,FLAGS(A4)
       BNE     20$
       BIT     #F.PSW,FLAGS(A4)
       BNE     10$
       TTY
       RTN
10$:    TYPE    $
20$:    RTN

PADCHR: BIT     #F.UND,FLAGS(A4)
       BEQ     10$
       MOV     #40,D1
       RTN
10$:    MOV     #' ,D1
       RTN

PAGE
       DEFINE  ERROR   TEXT
               TYPE    <? 'TEXT'>
               JMP     ABORT
               ENDM

ARGERR: ERROR   improper number of arguments
VARERR: ERROR   argument type error
SIZERR: ERROR   argument size error
MISERR: ERROR   missing numeric parameter
TYPERR: ERROR   invalid field type

ABORT:  TYPECR  < in EDIT.SBR>
       OR      #F.ERR,FLAGS(A4)
       MOV     JOBCUR,A6
       ORW     #J.CCC,JOBSTS(A6)
       RTN

       END

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.