*>***************************************************************** *> *> LIBCOBCURSES : CODE FOR SHARED LIBRARY *> *> Warren W. Gay VE3WWG *> *>***************************************************************** *>***************************************************************** *> INITIALIZATION ROUTINE "libcobcurses" : *>***************************************************************** IDENTIFICATION DIVISION. PROGRAM-ID. libcobcurses. DATA DIVISION. WORKING-STORAGE SECTION. 01 NC-COBCURSES-EXIT. 10 NC-INSTALL-FLAG PIC 9999 COMP-5 VALUE 0. 01 NC-EXIT-PROC USAGE IS PROGRAM-POINTER. 01 WS-COBCURSES-NORECOVERY-VALUE PIC X VALUE 'N'. LINKAGE SECTION. COPY COBCURSG. PROCEDURE DIVISION USING NC-COBCURSES. MAIN-PROGRAM. IF NC-INSTALL-FLAG = ZERO THEN *> *> WHEN ENVIRONMENT VARIABLE COBCURSES_NORECOVERY=Y (OR 1) *> THEN THE COBOL RECOVERY MECHANISM IS DISABLED. THIS *> IS ESPECIALLY HELPFUL WHEN AN ERROR MESSAGE HAS BEEN *> DISPLAYED, BUT WHEN CURSES endwin() IS CALLED, THE MESSAGE *> IS CLEARED (OR LEFT ON THE OTHER LOGICAL SCREEN) *> CALL "NC_NORECOVERY" USING WS-COBCURSES-NORECOVERY-VALUE IF WS-COBCURSES-NORECOVERY-VALUE = 'Y' THEN MOVE 'Y' TO NC-NO-RECOVERY END-IF END-IF. IF NC-INSTALL-FLAG = ZERO THEN IF NC-NO-RECOVERY NOT = 'Y' THEN SET NC-EXIT-PROC TO ADDRESS OF PROGRAM "COBCURSES-TERMINATE" ELSE SET NC-EXIT-PROC TO ADDRESS OF PROGRAM "COBCURSES-NULL-TERMINATE" END-IF CALL "CBL_EXIT_PROC" USING NC-INSTALL-FLAG, NC-EXIT-PROC MOVE 2 TO NC-INSTALL-FLAG *> *> INITIALIZE cobcurses.c MODULE *> CALL "NC_LIBCOBCURSES" END-IF. GOBACK. END PROGRAM libcobcurses. *>***************************************************************** *> SUPPORT FOR NC-OPEN *>***************************************************************** PROGRAM-ID. COBCURSES-OPEN. DATA DIVISION. WORKING-STORAGE SECTION. COPY COBCATTR. COPY COBCCOLOUR. LINKAGE SECTION. COPY COBCURSG. PROCEDURE DIVISION USING NC-COBCURSES. *> *> OPEN TERMINAL I/O *> *> RETURN-CODE: *> 0 = OK *> 1 = FAILED *> 2 = ALREADY OPEN *> ENTRY-COBCURSES-OPEN. CALL "NC_OPEN" USING NC-COLUMNS, NC-LINES, NC-CAP-COLOUR, NC-CHG-COLOUR, NC-COLOUR-PAIRS, NC-MOUSE-SUPPORT, NC-MOUSE-CLICK-MS, NC-HAS-UNDERLINE-FLAG. IF RETURN-CODE = 0 THEN PERFORM NC-INTERNAL-OPEN-OK END-IF. MOVE NC-CAP-COLOUR TO NC-CAP-COLOUR-SAVED. GOBACK. NC-INTERNAL-OPEN-OK. MOVE NC-ATTR-REVERSE TO NC-EDIT-ATTR IF NC-HAS-COLOUR AND NC-COLOUR-PAIRS > 16 MOVE NC-COLOUR-PAIRS TO NC-ALERT-MSG-PAIR, NC-INFO-MSG-PAIR, NC-EDIT-PAIR SUBTRACT 1 FROM NC-ALERT-MSG-PAIR SUBTRACT 2 FROM NC-INFO-MSG-PAIR SUBTRACT 3 FROM NC-EDIT-PAIR MOVE NC-ALERT-MSG-PAIR TO NC-PAIR-NUMBER MOVE NC-COLOUR-WHITE TO NC-FOREGROUND-COLOUR MOVE NC-COLOUR-RED TO NC-BACKGROUND-COLOUR PERFORM NC-INIT-COLOUR-PAIR-X MOVE NC-INFO-MSG-PAIR TO NC-PAIR-NUMBER MOVE NC-COLOUR-BLACK TO NC-FOREGROUND-COLOUR MOVE NC-COLOUR-GREEN TO NC-BACKGROUND-COLOUR PERFORM NC-INIT-COLOUR-PAIR-X MOVE NC-EDIT-PAIR TO NC-PAIR-NUMBER MOVE NC-COLOUR-GREEN TO NC-FOREGROUND-COLOUR MOVE NC-COLOUR-BLACK TO NC-BACKGROUND-COLOUR PERFORM NC-INIT-COLOUR-PAIR-X ELSE MOVE 0 TO NC-ALERT-MSG-PAIR, NC-INFO-MSG-PAIR, NC-EDIT-PAIR END-IF. MOVE 'YN' TO NC-YN. CALL "NC_TITLE_ATTRS" USING NC-TITLE-ATTR. IF NC-HAS-COLOUR THEN MOVE 1 TO NC-PAIR-NUMBER, NC-TITLE-PAIR MOVE NC-COLOUR-BLUE TO NC-FOREGROUND-COLOUR MOVE NC-COLOUR-WHITE TO NC-BACKGROUND-COLOUR CALL "NC_INITCOLOUR" USING NC-PAIR-NUMBER, NC-FOREGROUND-COLOUR, NC-BACKGROUND-COLOUR MOVE 3 TO NC-PAIR-NUMBER, NC-MENU-PAIR MOVE NC-COLOUR-BLUE TO NC-FOREGROUND-COLOUR MOVE NC-COLOUR-BLACK TO NC-BACKGROUND-COLOUR CALL "NC_INITCOLOUR" USING NC-PAIR-NUMBER, NC-FOREGROUND-COLOUR, NC-BACKGROUND-COLOUR MOVE 2 TO NC-PAIR-NUMBER, NC-BACKGROUND-PAIR MOVE NC-COLOUR-YELLOW TO NC-FOREGROUND-COLOUR MOVE NC-COLOUR-BLACK TO NC-BACKGROUND-COLOUR CALL "NC_INITCOLOUR" USING NC-PAIR-NUMBER, NC-FOREGROUND-COLOUR, NC-BACKGROUND-COLOUR CALL "NC_SETCOLOUR" USING NC-PAIR-NUMBER END-IF. MOVE ZERO TO RETURN-CODE. GOBACK. NC-INIT-COLOUR-PAIR-X. CALL "NC_INITCOLOUR" USING NC-PAIR-NUMBER, NC-FOREGROUND-COLOUR, NC-BACKGROUND-COLOUR. EXIT. END PROGRAM COBCURSES-OPEN. *>***************************************************************** *> SUPPORT FOR NC-CLOSE *>***************************************************************** PROGRAM-ID. COBCURSES-CLOSE. PROCEDURE DIVISION. ENTRY-COBCURSES-CLOSE. *> *> CLOSE TERMINAL I/O *> *> RETURN-CODE: *> 0 = OK *> 1 = FAILED *> 2 = WAS NOT OPEN *> CALL "NC_CLOSE". GOBACK. END PROGRAM COBCURSES-CLOSE. *>***************************************************************** *> TERMINATION ROUTINE (WITH CURSES CLEANUP) *>***************************************************************** PROGRAM-ID. COBCURSES-TERMINATE. DATA DIVISION. WORKING-STORAGE SECTION. 01 TERMINATE-FLAG PIC X VALUE 'N'. 88 TERMINATE-CALLED VALUE 'Y'. PROCEDURE DIVISION. SHUTDOWN-COBCURSES. IF NOT TERMINATE-CALLED THEN SET TERMINATE-CALLED TO TRUE CALL "COBCURSES-CLOSE" END-IF. GOBACK. END PROGRAM COBCURSES-TERMINATE. *>***************************************************************** *> TERMINATION ROUTINE (WITH *NO* CURSES CLEANUP) *>***************************************************************** PROGRAM-ID. COBCURSES-NULL-TERMINATE. DATA DIVISION. WORKING-STORAGE SECTION. 01 TERMINATE-FLAG PIC X VALUE 'N'. 88 TERMINATE-CALLED VALUE 'Y'. PROCEDURE DIVISION. SHUTDOWN-COBCURSES. IF NOT TERMINATE-CALLED THEN SET TERMINATE-CALLED TO TRUE END-IF. GOBACK. END PROGRAM COBCURSES-NULL-TERMINATE. *>***************************************************************** *> SUPPORT FOR NC-INIT *>***************************************************************** PROGRAM-ID. COBCURSES-INIT. DATA DIVISION. WORKING-STORAGE SECTION. COPY COBCATTR. COPY COBCCOLOUR. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. ENTRY-COBCURSES-INIT. *> *> INITIALIZE STORAGE FOR NCURSES BINDING, IN *> "ACTION" MODE : *> CALL "libcobcurses" USING NC-COBCURSES. CALL "COBCURSES-INIT-X" USING COPY COBCPARMS. MOVE 'A' TO NC-FIELD-MODE. GOBACK. END PROGRAM COBCURSES-INIT. *>***************************************************************** *> INTERNAL - INITIALIZATION CODE *>***************************************************************** PROGRAM-ID. COBCURSES-INIT-X. DATA DIVISION. WORKING-STORAGE SECTION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. ENTRY-COBCURSES-INIT-X. INITIALIZE NC-FIELD. *> *> INITIALIZE THE RESTRICTED CHAR SETS *> PERFORM VARYING NC-RESTRICTX FROM 1 BY 1 UNTIL NC-RESTRICTX > 20 MOVE " " TO NC-RESTRICT-CHARSET(NC-RESTRICTX) END-PERFORM. *> *> INITIALIZE FIELD DEFINITIONS ARRAY *> PERFORM VARYING NC-FIELD-NUMBER FROM 1 BY 1 UNTIL NC-FIELD-NUMBER > NC-MAX-FIELDS MOVE ZERO TO NC-FDESC-LINE(NC-FIELD-NUMBER) MOVE ZERO TO NC-FDESC-COLUMN(NC-FIELD-NUMBER) MOVE NULL TO NC-FDESC-ADDRESS(NC-FIELD-NUMBER) MOVE ZERO TO NC-FDESC-LENGTH(NC-FIELD-NUMBER) MOVE ZERO TO NC-FDESC-WINLENGTH(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-CLEAR(NC-FIELD-NUMBER) MOVE 'Y' TO NC-FDESC-UPPERCASE(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-MASK(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-NOT-BLANK(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-YN(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-VERIFY(NC-FIELD-NUMBER) MOVE ZERO TO NC-FDESC-RESTRICT(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-SIGNED(NC-FIELD-NUMBER) MOVE ZERO TO NC-FDESC-DIGITS(NC-FIELD-NUMBER), NC-FDESC-DECPLACES(NC-FIELD-NUMBER) SET NC-FDESC-INFO(NC-FIELD-NUMBER) TO NULL MOVE ZERO TO NC-FDESC-INFOLEN(NC-FIELD-NUMBER) MOVE 'Y' TO NC-FDESC-VISIBLE(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-IGNORE-CHGS(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-COLOUR-FLAG(NC-FIELD-NUMBER) MOVE ZERO TO NC-FDESC-COLOUR-PAIR(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-READ-ONLY(NC-FIELD-NUMBER) MOVE 'N' TO NC-FDESC-ACTION-EDIT(NC-FIELD-NUMBER) MOVE ZERO TO NC-FDESC-COMP-TYPE(NC-FIELD-NUMBER) SET NC-FDESC-COMP-PTR(NC-FIELD-NUMBER) TO NULL SET NC-FDESC-MENU-PTR(NC-FIELD-NUMBER) TO NULL END-PERFORM. *> *> INITIALIZE THE SCREEN TEXT DEFINITION ARRAY *> PERFORM VARYING NC-SCREENX FROM 1 BY 1 UNTIL NC-SCREENX > NC-MAX-SCRSEGS MOVE NULL TO NC-BG-TEXT(NC-SCREENX) MOVE ZERO TO NC-BG-LENGTH(NC-SCREENX) MOVE ZERO TO NC-BG-Y(NC-SCREENX) MOVE ZERO TO NC-BG-X(NC-SCREENX) MOVE ZERO TO NC-BG-COLOUR-PAIR(NC-SCREENX) MOVE 'N' TO NC-BG-BOLD(NC-SCREENX), NC-BG-UNDERLINE(NC-SCREENX), NC-BG-REVERSE(NC-SCREENX) MOVE 'N' TO NC-BG-TITLE-FLAG(NC-SCREENX), NC-BG-DATE(NC-SCREENX), NC-BG-TIME(NC-SCREENX) END-PERFORM. *> *> INITIALIZE FIELD SEQUENCES & STATE *> PERFORM VARYING NC-FSEQ-STATE FROM 1 BY 1 UNTIL NC-FSEQ-STATE > NC-MAX-STATES MOVE 0 TO NC-FSEQ-FIELD-NO(NC-FSEQ-STATE), NC-FSEQ-BCK-TO(NC-FSEQ-STATE), NC-FSEQ-FWD-TO(NC-FSEQ-STATE), NC-FSEQ-ESC-TO(NC-FSEQ-STATE), NC-FSEQ-SLASH-TO(NC-FSEQ-STATE) END-PERFORM. MOVE 1 TO NC-FSEQ-STATE. CALL "COBCURSES-RESET-CHANGES" USING COPY COBCPARMS. INITIALIZE NC-MOUSE-MASKS. *> *> COBCURSES SUPPORTS EVENTS THAT NCURSES RECOGNIZES *> AS "CLICKED" OR "PRESSED" (SOMETIMES NCURSES HAS *> TROUBLE DISTINGUISHING THOSE). *> MOVE 'Y' TO NC-B1-PRESSED-MSK, NC-B1-CLICKED-MSK,. MOVE 'N' TO NC-B1-RELEASED-MSK, NC-B1-D-CLICKED-MSK, NC-B1-T-CLICKED-MSK. MOVE 'N' TO NC-B2-CLICKED-MSK, NC-B2-PRESSED-MSK, NC-B2-RELEASED-MSK, NC-B2-D-CLICKED-MSK, NC-B2-T-CLICKED-MSK. MOVE NC-B2-MASK TO NC-B3-MASK. IF NC-MOUSE-SUPPORTED THEN CALL "COBCURSES-MOUSE-MASK" USING COPY COBCPARMS. END-IF. MOVE ZERO TO RETURN-CODE. GOBACK. END PROGRAM COBCURSES-INIT-X. *>***************************************************************** *> SUPPORT FOR NC-MOUSE-MASK *>***************************************************************** PROGRAM-ID. COBCURSES-MOUSE-MASK. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> SET THE MOUSE EVENTS YOU WISH TO SUPPORT. *> *> INPUTS : *> NC-MOUSE-MASKS. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> 3 - NOT SUPPORTED (NO MOUSE SUPPORT) *> *> NOTES : *> CODE 3 MEANS THAT THERE IS NO MOUSE SUPPORT *> COMPILED IN. *> ENTRY-MOUSE-MASK. CALL "NC_MOUSE_MASK" USING NC-B1-PRESSED-MSK, NC-B1-RELEASED-MSK, NC-B1-CLICKED-MSK, NC-B1-D-CLICKED-MSK, NC-B1-T-CLICKED-MSK, NC-B2-PRESSED-MSK, NC-B2-RELEASED-MSK, NC-B2-CLICKED-MSK, NC-B2-D-CLICKED-MSK, NC-B2-T-CLICKED-MSK, NC-B3-PRESSED-MSK, NC-B3-RELEASED-MSK, NC-B3-CLICKED-MSK, NC-B3-D-CLICKED-MSK, NC-B3-T-CLICKED-MSK. GOBACK. END PROGRAM COBCURSES-MOUSE-MASK. *>***************************************************************** *> SUPPORT FOR NC-CLEAR *>***************************************************************** PROGRAM-ID. COBCURSES-CLEAR. PROCEDURE DIVISION. ENTRY-COBCURSES-CLEAR. *> *> CLEAR SCREEN. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_CLEAR". GOBACK. END PROGRAM COBCURSES-CLEAR. *>***************************************************************** *> SUPPORT FOR NC-CLEAR-TO-END-LINE *>***************************************************************** PROGRAM-ID. COBCURSES-CLEAR-TO-END-LINE. PROCEDURE DIVISION. ENTRY-COBCURSES-CLEAR-TO-ENDL. *> *> CLEAR TO END OF LINE. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_CLRTOEOL". GOBACK. END PROGRAM COBCURSES-CLEAR-TO-END-LINE. PROGRAM-ID. COBCURSES-CLEAR-TO-BOTTOM. PROCEDURE DIVISION. ENTRY-COBCURSES-CLEAR-TO-BOTTOM. *> *> CLEAR TO BOTTOM OF SCREEN. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_CLRTOBOT". GOBACK. END PROGRAM COBCURSES-CLEAR-TO-BOTTOM. *>***************************************************************** *> SUPPORT FOR NC-COLOUR-PAIR *>***************************************************************** PROGRAM-ID. COBCURSES-COLOUR-PAIR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. ENTRY-COBCURSES-COLOUR-PAIR. *> *> CREATE A COLOUR ATTRIBUTE VALUE FROM TWO *> CHOSEN COLOURS (FOREGROUND & BACKGROUND) *> *> INPUTS : *> NC-PAIR-NUMBER (1 TO NC-COLOUR-PAIRS) *> NC-FOREGROUND-COLOUR *> NC-BACKGROUND-COLOUR *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_INITCOLOUR" USING NC-PAIR-NUMBER, NC-FOREGROUND-COLOUR, NC-BACKGROUND-COLOUR. GOBACK. END PROGRAM COBCURSES-COLOUR-PAIR. *>***************************************************************** *> SUPPORT FOR NC-SET-COLOUR *>***************************************************************** PROGRAM-ID. COBCURSES-SET-COLOUR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. ENTRY-COBCURSES-SET-COLOUR. *> *> SET TO USE THE COLOUR PAIR SPECIFIED. *> *> INPUTS : *> NC-PAIR-NUMBER *> NC-SET-COLOUR. CALL "NC_SETCOLOUR" USING NC-PAIR-NUMBER. GOBACK. END PROGRAM COBCURSES-SET-COLOUR. *>***************************************************************** *> SUPPORT FOR NC-SET-ATTRIBUTE *>***************************************************************** PROGRAM-ID. COBCURSES-SET-ATTRIBUTE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. ENTRY-COBCURSES-SET-ATTRIBUTE. *> *> SET NCURSES TO DRAW WITH THE NEW ATTRIBUTE. *> *> INPUTS : *> NC-ATTRIBUTE *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> *> NOTES : *> THIS API CALL ONLY CHANGES THE ATTRIBUTES *> WITHOUT CHANGING THE COLOUR PAIR USED. *> CALL "NC_SETATTR" USING NC-ATTRIBUTE. GOBACK. END PROGRAM COBCURSES-SET-ATTRIBUTE. *>***************************************************************** *> SUPPORT FOR NC-MOVE *>***************************************************************** PROGRAM-ID. COBCURSES-MOVE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. ENTRY-COBCURSES-MOVE. *> *> MOVE CURSOR. *> *> INPUT : *> NC-POSITION-DATA. *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_MOVE" USING NC-POS-LINE, NC-POS-COLUMN. GOBACK. END PROGRAM COBCURSES-MOVE. *>***************************************************************** *> SUPPORT FOR NC-ADDCH *>***************************************************************** PROGRAM-ID. COBCURSES-ADDCH. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> WRITE CHARACTER TO TERMINAL. *> *> INPUT: *> NC-CHAR. *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_ADDCH" USING NC-CHAR. GOBACK. END PROGRAM COBCURSES-ADDCH. *>***************************************************************** *> SUPPORT FOR NC-ADDSTR *>***************************************************************** PROGRAM-ID. COBCURSES-ADDSTR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> WRITE TEXT TO TERMINAL. *> *> INPUT : *> NC-STRING-DATA. *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_ADDSTR" USING NC-STR-DATA, NC-STR-LENGTH. GOBACK. END PROGRAM COBCURSES-ADDSTR. *>***************************************************************** *> SUPPORT FOR NC-GETCH *>***************************************************************** PROGRAM-ID. COBCURSES-GETCH. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> GET KEY CODE FROM TERMINAL. *> *> RETURNS : *> NC-KEY-DATA *> RETURN-CODE: *> 0 - OK *> 1 - FAILED *> CALL "NC_GETCH" USING NC-KEY-CODE, NC-KEY-CHAR, NC-KEY-CODE-FLAG. GOBACK. END PROGRAM COBCURSES-GETCH. *>***************************************************************** *> SUPPORT FOR NC-DRAW-BOX *>***************************************************************** PROGRAM-ID. COBCURSES-DRAW-BOX. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> DRAW A BOX ON THE SCREEN *> *> INPUTS : *> NC-BOX-TOP-LINE *> NC-BOX-LEFT-COLUMN *> NC-BOX-BOTTOM-LINE *> NC-BOX-BOTTOM-COLUMN *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_DRAW_BOX" USING NC-BOX-TOP-LINE, NC-BOX-LEFT-COLUMN, NC-BOX-BOTTOM-LINE, NC-BOX-BOTTOM-COLUMN. GOBACK. END PROGRAM COBCURSES-DRAW-BOX. *>***************************************************************** *> SUPPORT FOR NC-GET-TEXT-RAW *>***************************************************************** PROGRAM-ID. COBCURSES-GET-TEXT-RAW. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-COMP-TYPE PIC 9999 COMP-5. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> GET TEXT FROM A WINDOWED FIELD. *> *> INPUT : *> NC-FIELD-DATA. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> *> NOTES : *> 1. THIS ROUTINE IS NOT NORMALLY CALLED BY THE *> PROGRAMMER (NC-GET-TEXT/X CALLS THIS). THIS IS *> USED BY PROGRAMS LIKE THE SCREEN DESIGNER. *> MOVE NC-FIELD-COMP-TYPE TO WS-COMP-TYPE. EVALUATE WS-COMP-TYPE WHEN 01 CONTINUE WHEN 02 CONTINUE WHEN OTHER SET NC-FIELD-COMP-PTR TO NULL END-EVALUATE. CALL "NC_GETTEXT" USING NC-FIELD-Y, NC-FIELD-X, NC-EDIT-ATTR, NC-EDIT-PAIR, NC-FIELD-LENGTH, NC-FIELD-WINLEN, NC-FIELD-BUFFER, NC-FIELD-CLEAR, NC-FIELD-UPPERCASE, NC-FIELD-MASK, NC-FIELD-NOT-BLANK, NC-FIELD-RESTRICT, NC-FIELD-SIGNED, NC-FIELD-DIGITS, NC-FIELD-DECPLACES, NC-FIELD-MODE, NC-FIELD-X-POS, NC-FIELD-EXIT, NC-FIELD-FB, NC-FIELD-CHG-FLAG, NC-FIELD-MOUSE-FLAG, NC-FIELD-ACTION, NC-FIELD-SEARCH, WS-COMP-TYPE, NC-FIELD-COMP-PTR, NC-FIELD-MENU, NC-MENU-PAIR, NC-TITLE-ATTR. IF NC-FIELD-MOUSE-EVENT THEN CALL "COBCURSES-GET-MOUSE-EVENT" USING COPY COBCPARMS. END-IF. MOVE 'N' TO NC-FIELD-EDIT-TARGET. IF NC-FMODE-ACTION THEN IF NC-FIELD-SEARCH > ZERO AND NC-FIELD-SEARCH <= NC-MAX-FIELDS THEN IF NC-FDESC-ACTION-EDIT(NC-FIELD-SEARCH) = 'Y' AND NC-FDESC-READ-ONLY(NC-FIELD-SEARCH) = 'N' THEN MOVE 'Y' TO NC-FIELD-EDIT-TARGET END-IF END-IF ELSE MOVE 'Y' TO NC-FIELD-EDIT-TARGET *> ALL FIELDS ARE VALID IN 3270 MODE END-IF. GOBACK. END PROGRAM COBCURSES-GET-TEXT-RAW. *>***************************************************************** *> SUPPORT FOR NC-GET-MOUSE-EVENT *>***************************************************************** PROGRAM-ID. COBCURSES-GET-MOUSE-EVENT. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> GET MOUSE EVENT DATA *> *> INPUTS : *> NONE. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED (NO MOUSE DATA) *> 3 - NOT SUPPORTED (NO MOUSE SUPPORT) *> *> NOTES : *> CODE 3 MEANS THAT THERE IS NO MOUSE SUPPORT *> COMPILED IN. *> CALL "NC_MOUSE_EVENT" USING NC-MOUSE-ID, NC-MOUSE-X, NC-MOUSE-Y, NC-MOUSE-Z, NC-B1-PRESSED-FLG, NC-B1-RELEASED-FLG, NC-B1-CLICKED-FLG, NC-B1-D-CLICKED-FLG, NC-B1-T-CLICKED-FLG, NC-B2-PRESSED-FLG, NC-B2-RELEASED-FLG, NC-B2-CLICKED-FLG, NC-B2-D-CLICKED-FLG, NC-B2-T-CLICKED-FLG, NC-B3-PRESSED-FLG, NC-B3-RELEASED-FLG, NC-B3-CLICKED-FLG, NC-B3-D-CLICKED-FLG, NC-B3-T-CLICKED-FLG. GOBACK. END PROGRAM COBCURSES-GET-MOUSE-EVENT. *>***************************************************************** *> SUPPORT FOR NC-SELECT-FIELD *>***************************************************************** PROGRAM-ID. COBCURSES-SELECT-FIELD. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> SELECT A FIELD FOR OPERATION (INTERNAL) *> *> INPUT : *> NC-FIELD-NUMBER *> MOVE NC-FDESC-LINE(NC-FIELD-NUMBER) TO NC-FIELD-Y. MOVE NC-FDESC-COLUMN(NC-FIELD-NUMBER) TO NC-FIELD-X. MOVE NC-FDESC-ADDRESS(NC-FIELD-NUMBER) TO NC-FIELD-BUFFER. MOVE NC-FDESC-LENGTH(NC-FIELD-NUMBER) TO NC-FIELD-LENGTH. MOVE NC-FDESC-WINLENGTH(NC-FIELD-NUMBER) TO NC-FIELD-WINLEN. IF NC-FDESC-COLOUR-FLAG(NC-FIELD-NUMBER) = 'Y' THEN MOVE NC-FDESC-COLOUR-PAIR(NC-FIELD-NUMBER) TO NC-TEMP-COLOUR-PAIR ELSE MOVE NC-EDIT-PAIR TO NC-TEMP-COLOUR-PAIR END-IF. MOVE NC-FDESC-COMP-TYPE(NC-FIELD-NUMBER) TO NC-FIELD-COMP-TYPE. MOVE NC-FDESC-COMP-PTR(NC-FIELD-NUMBER) TO NC-FIELD-COMP-PTR. MOVE NC-FDESC-MENU-PTR(NC-FIELD-NUMBER) TO NC-FIELD-MENU. GOBACK. END PROGRAM COBCURSES-SELECT-FIELD. *>***************************************************************** *> SUPPORT FOR NC-SELECT-FIELD-AND-OPTS *> FORMERLY NC-SELECT-FIELD-AND-OPTIONS *>***************************************************************** PROGRAM-ID. COBCURSES-SELECT-FIELD-AND-OPTS. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> SELECT A FIELD FOR OPERATION AND OPTIONS *> *> INPUT : *> NC-FIELD-NUMBER *> CALL "COBCURSES-SELECT-FIELD" USING COPY COBCPARMS. MOVE NC-FDESC-CLEAR(NC-FIELD-NUMBER) TO NC-FIELD-CLEAR. MOVE NC-FDESC-UPPERCASE(NC-FIELD-NUMBER) TO NC-FIELD-UPPERCASE. MOVE NC-FDESC-MASK(NC-FIELD-NUMBER) TO NC-FIELD-MASK. MOVE NC-FDESC-NOT-BLANK(NC-FIELD-NUMBER) TO NC-FIELD-NOT-BLANK. MOVE NC-FDESC-SIGNED(NC-FIELD-NUMBER) TO NC-FIELD-SIGNED. MOVE NC-FDESC-DIGITS(NC-FIELD-NUMBER) TO NC-FIELD-DIGITS. MOVE NC-FDESC-DECPLACES(NC-FIELD-NUMBER) TO NC-FIELD-DECPLACES. MOVE NC-FDESC-RESTRICT(NC-FIELD-NUMBER) TO NC-RESTRICTX. IF NC-RESTRICTX > 0 THEN MOVE ADDRESS OF NC-RESTRICT-CHARSET(NC-RESTRICTX) TO NC-FIELD-RESTRICT ELSE MOVE NULL TO NC-FIELD-RESTRICT END-IF. GOBACK. END PROGRAM COBCURSES-SELECT-FIELD-AND-OPTS. *>***************************************************************** *> SUPPORT FOR NC-PUT-TEXT-RAW *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-TEXT-RAW. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> LIKE NC-PUT-TEXT, BUT WITHOUT ANY CONNECTION *> TO "DEFINED FIELDS". *> *> INPUTS : *> NC-FIELD-Y *> NC-FIELD-X *> NC-TEMP-COLOUR-PAIR *> NC-FIELD-LENGTH *> NC-FIELD-WINLEN *> NC-FIELD-BUFFER *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_PUTTEXT" USING NC-FIELD-Y, NC-FIELD-X, NC-TEMP-COLOUR-PAIR, NC-FIELD-LENGTH, NC-FIELD-WINLEN, NC-FIELD-BUFFER. GOBACK. END PROGRAM COBCURSES-PUT-TEXT-RAW. *>***************************************************************** *> SUPPORT FOR NC-PUT-TEXT-RAW-NORMAL *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-TEXT-RAW-NORMAL. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> LIKE NC-PUT-TEXT-RAW EXCEPT THAT IT FALLS BACK *> TO ATTRIBUTE A_NORMAL IF NO COLOUR PAIR. *> *> INPUTS : *> NC-FIELD-Y *> NC-FIELD-X *> NC-EDIT-PAIR *> NC-FIELD-LENGTH *> NC-FIELD-WINLEN *> NC-FIELD-BUFFER *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_PUTTEXTNORM" USING NC-FIELD-Y, NC-FIELD-X, NC-EDIT-PAIR, NC-FIELD-LENGTH, NC-FIELD-WINLEN, NC-FIELD-BUFFER. GOBACK. END PROGRAM COBCURSES-PUT-TEXT-RAW-NORMAL. *>***************************************************************** *> SUPPORT FOR NC-PAUSE *>***************************************************************** PROGRAM-ID. COBCURSES-PAUSE. PROCEDURE DIVISION. *> *> WAIT FOR THE USER TO HIT ANY KEY. *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_PAUSE". GOBACK. END PROGRAM COBCURSES-PAUSE. *>***************************************************************** *> SUPPORT FOR NC-REFRESH *>***************************************************************** PROGRAM-ID. COBCURSES-REFRESH. PROCEDURE DIVISION. *> *> WRITE ANY PENDING CHANGES OUT TO TERMINAL. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "NC_REFRESH". GOBACK. END PROGRAM COBCURSES-REFRESH. *>***************************************************************** *> SUPPORT FOR NC-MSG-STRIP-BLANKS-INTERNAL *> FORMERLY COBCURSES-MSG-STRIP-BLANKS-INTERNAL. *>***************************************************************** PROGRAM-ID. COBCURSES-MSG-STRIP-BLANKS-INT. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *>** INTERNAL *** DON'T USE IN APPLICATIONS *** *> MOVE LENGTH OF NC-MSGBUF TO NC-MSG-LENGTH CALL "NC_STRIP" USING NC-MSGBUF, NC-MSG-LENGTH SET NC-MSG-TEXT TO ADDRESS OF NC-MSGBUF. GOBACK. END PROGRAM COBCURSES-MSG-STRIP-BLANKS-INT. *>***************************************************************** *> SUPPORT FOR NC-ERROR-MESSAGE-CR *>***************************************************************** PROGRAM-ID. COBCURSES-ERROR-MESSAGE-CR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> WRITE ERROR MESSAGE AT BOTTOM OF SCREEN *> AND WAIT FOR ANY KEY. *> *> INPUTS : *> NC-MSG-TEXT *> NC-MSG-LENGTH *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> MOVE 'Y' TO NC-MSG-PAUSE CALL "NC_MSG" USING NC-MSG-TEXT, NC-MSG-LENGTH, NC-ALERT-MSG-PAIR, NC-MSG-PAUSE. GOBACK. END PROGRAM COBCURSES-ERROR-MESSAGE-CR. *>***************************************************************** *> SUPPORT FOR NC-INFO-MESSAGE *>***************************************************************** PROGRAM-ID. COBCURSES-INFO-MESSAGE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> WRITE INFO MESSAGE AT BOTTOM OF SCREEN *> *> INPUTS : *> NC-MSG-TEXT *> NC-MSG-LENGTH *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> *> OVERRIDE PREVENTS NEXT GET-TEXT-MSG TO *> REPLACE THE INFO MESSAGE (WORKS ONCE) *> MOVE 'N' TO NC-MSG-PAUSE. CALL "NC_MSG" USING NC-MSG-TEXT, NC-MSG-LENGTH, NC-INFO-MSG-PAIR, NC-MSG-PAUSE. GOBACK. END PROGRAM COBCURSES-INFO-MESSAGE. *>***************************************************************** *> SUPPORT FOR NC-INFO-MESSAGE-OVERRIDE *>***************************************************************** PROGRAM-ID. COBCURSES-INFO-MESSAGE-OVERRIDE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> WRITE INFO MESSAGE AT BOTTOM OF SCREEN *> *> INPUTS : *> NC-MSG-TEXT *> NC-MSG-LENGTH *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> *> OVERRIDE PREVENTS NEXT GET-TEXT-MSG TO *> REPLACE THE INFO MESSAGE (WORKS ONCE) *> MOVE 'Y' TO NC-FIELD-WAIVE-INFO. CALL "COBCURSES-INFO-MESSAGE" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-INFO-MESSAGE-OVERRIDE. *>***************************************************************** *> SUPPORT FOR NC-PUT-TEXT *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-TEXT. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> PUT REFORMATED TEXT BACK TO A WINDOWED FIELD. *> *> INPUT : *> NC-FIELD-DATA. *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> *> COMMENTS: *> THIS ROUTINE IS IDENTICAL TO NC-GET-TEXT *> EXCEPT THAT IT DOES NOT WAIT FOR ANY *> INPUT (IT JUST PUTS THE DATA OUT INTO *> THE FIELD'S SPECIFIED WINDOW). THIS ALLOWS *> THE CALLER TO REFORMAT THE TEXT, AND THEN *> CALL THIS ROUTINE AGAIN TO PUT THE FINAL *> VALUE OUT TO THE SCREEN. *> CALL "COBCURSES-SELECT-FIELD" USING COPY COBCPARMS. CALL "COBCURSES-PUT-TEXT-RAW" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-PUT-TEXT. *>***************************************************************** *> SUPPORT FOR NC-PUT-MESSAGE *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-MESSAGE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INPUT : *> NC-MSGBUF *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "COBCURSES-MSG-STRIP-BLANKS-INT" USING COPY COBCPARMS. CALL "COBCURSES-INFO-MESSAGE" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-PUT-MESSAGE. *>***************************************************************** *> SUPPORT FOR NC-PUT-MESSAGE-CR *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-MESSAGE-CR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INPUT : *> NC-MSGBUF *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "COBCURSES-MSG-STRIP-BLANKS-INT" USING COPY COBCPARMS. CALL "COBCURSES-INFO-MESSAGE-CR" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-PUT-MESSAGE-CR. *>***************************************************************** *> SUPPORT FOR NC-PUT-MESSAGE-OVERRIDE *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-MESSAGE-OVERRIDE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INPUT : *> NC-MSGBUF *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "COBCURSES-MSG-STRIP-BLANKS-INT" USING COPY COBCPARMS. CALL "COBCURSES-INFO-MESSAGE-OVERRIDE" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-PUT-MESSAGE-OVERRIDE. *>***************************************************************** *> SUPPORT FOR NC-PUT-ERROR *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-ERROR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INPUT : *> NC-MSGBUF *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "COBCURSES-MSG-STRIP-BLANKS-INT" USING COPY COBCPARMS. CALL "COBCURSES-ERROR-MESSAGE-CR" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-PUT-ERROR. *>***************************************************************** *> SUPPORT FOR NC-PUT-ERROR-CR *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-ERROR-CR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INPUT : *> NC-MSGBUF *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "COBCURSES-MSG-STRIP-BLANKS-INT" USING COPY COBCPARMS. CALL "COBCURSES-ERROR-MESSAGE-CR" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-PUT-ERROR-CR. *>***************************************************************** *> SUPPORT FOR NC-PUT-ERROR-OVERRIDE *>***************************************************************** PROGRAM-ID. COBCURSES-PUT-ERROR-OVERRIDE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INPUT : *> NC-MSGBUF *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "COBCURSES-MSG-STRIP-BLANKS-INT" USING COPY COBCPARMS. CALL "COBCURSES-ERROR-MSG-OVERRIDE" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-PUT-ERROR-OVERRIDE. *>***************************************************************** *> SUPPORT FOR NC-ERROR-MESSAGE *>***************************************************************** PROGRAM-ID. COBCURSES-ERROR-MESSAGE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. MOVE 'N' TO NC-MSG-PAUSE CALL "NC_MSG" USING NC-MSG-TEXT, NC-MSG-LENGTH, NC-ALERT-MSG-PAIR, NC-MSG-PAUSE. GOBACK. END PROGRAM COBCURSES-ERROR-MESSAGE. *>***************************************************************** *> SUPPORT FOR NC-INFO-MESSAGE-CR *>***************************************************************** PROGRAM-ID. COBCURSES-INFO-MESSAGE-CR. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> WRITE INFO MESSAGE AT BOTTOM OF SCREEN *> AND THEN WAIT FOR ANY KEY. *> *> INPUTS : *> NC-MSG-TEXT *> NC-MSG-LENGTH *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> MOVE 'Y' TO NC-MSG-PAUSE CALL "NC_MSG" USING NC-MSG-TEXT, NC-MSG-LENGTH, NC-INFO-MSG-PAIR, NC-MSG-PAUSE. GOBACK. END PROGRAM COBCURSES-INFO-MESSAGE-CR. *>***************************************************************** *> SUPPORT FOR NC-DRAW-SCREEN *>***************************************************************** PROGRAM-ID. COBCURSES-DRAW-SCREEN. DATA DIVISION. WORKING-STORAGE SECTION. COPY COBCRETC. 77 WS-GOT-SCREEN-COLUMNS PIC 999. 77 WS-GOT-SCREEN-LINES PIC 999. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> DRAW SCREEN BASED UPON THE NC-SCREEN-DEFINITION. *> CALL "COBCURSES-CLEAR" USING COPY COBCPARMS. IF ( NC-SCREEN-COLUMNS-REQ > 0 AND NC-SCREEN-COLUMNS-REQ > NC-COLUMNS ) OR ( NC-SCREEN-LINES-REQ > 0 AND NC-SCREEN-LINES-REQ > NC-LINES ) THEN PERFORM 8000-SCREEN-SIZE-MESSAGE MOVE NC-RET-FAILED TO RETURN-CODE ELSE PERFORM 5000-PROCESS MOVE NC-RET-OK TO RETURN-CODE END-IF. GOBACK. 5000-PROCESS. IF NC-HAS-COLOUR THEN IF NC-SCREEN-PAIRS-REQ > NC-COLOUR-PAIRS THEN SET NC-HAS-COLOUR TO FALSE END-IF END-IF. IF NC-HAS-COLOUR THEN CALL "NC_SETCOLOUR" USING NC-BACKGROUND-PAIR END-IF. PERFORM VARYING NC-SCREENX FROM 1 BY 1 UNTIL NC-SCREENX > NC-SCREEN-COUNT IF NC-BG-TITLE-FLAG(NC-SCREENX) = 'N' MOVE NC-BG-Y(NC-SCREENX) TO NC-POS-LINE MOVE NC-BG-X(NC-SCREENX) TO NC-POS-COLUMN CALL "COBCURSES-MOVE" USING COPY COBCPARMS. MOVE NC-BG-TEXT(NC-SCREENX) TO NC-STR-DATA MOVE NC-BG-LENGTH(NC-SCREENX) TO NC-STR-LENGTH CALL "COBCURSES-ADDSTR" USING COPY COBCPARMS. ELSE MOVE NC-SCREENX TO NC-SCREEN-TITLEX CALL "COBCURSES-UPDATE-TITLE" USING COPY COBCPARMS. END-IF END-PERFORM. CALL "COBCURSES-REFRESH" USING COPY COBCPARMS. EXIT. 8000-SCREEN-SIZE-MESSAGE. MOVE NC-COLUMNS TO WS-GOT-SCREEN-COLUMNS. MOVE NC-LINES TO WS-GOT-SCREEN-LINES. MOVE SPACES TO NC-MSGBUF. STRING "SCREEN TOO SMALL: REQUIRES ", NC-SCREEN-COLUMNS-REQ, "X", NC-SCREEN-LINES-REQ, ", GOT ", WS-GOT-SCREEN-COLUMNS, "X", WS-GOT-SCREEN-LINES, "." INTO NC-MSGBUF. CALL "COBCURSES-PUT-ERROR-CR" USING COPY COBCPARMS. EXIT. END PROGRAM COBCURSES-DRAW-SCREEN. *>***************************************************************** *> SUPPORT FOR NC-UPDATE-TITLE *>***************************************************************** PROGRAM-ID. COBCURSES-UPDATE-TITLE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> UPDATE TITLE LINE WITH NEW DATE/TIME INFO. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> *> NOTES : *> NC-SCREEN-TITLEX MUST BE > 0 TO CAUSE UPDATE *> NC-SCREEN-TITLEX IS RESET TO ZERO AFTER AN *> UPDATE IF THERE IS NO REQUEST FOR DATE *> OR TIME. *> CALLED BY NC-DRAW-SCREEN. *> IF NC-SCREEN-TITLEX > 0 THEN IF NC-BG-DATE(NC-SCREEN-TITLEX) = 'Y' THEN ACCEPT NC-SCREEN-DATE FROM DATE END-IF IF NC-BG-TIME(NC-SCREEN-TITLEX) = 'Y' THEN ACCEPT NC-SCREEN-TIME FROM TIME END-IF CALL "NC_TITLE" USING NC-BG-Y(NC-SCREEN-TITLEX), NC-BG-TEXT(NC-SCREEN-TITLEX), NC-BG-LENGTH(NC-SCREEN-TITLEX), NC-BG-COLOUR-PAIR(NC-SCREEN-TITLEX), NC-BG-BOLD(NC-SCREEN-TITLEX), NC-BG-UNDERLINE(NC-SCREEN-TITLEX), NC-BG-REVERSE(NC-SCREEN-TITLEX), NC-SCREEN-DATE, NC-SCREEN-TIME IF ( NOT NC-BG-DATE(NC-SCREEN-TITLEX) = 'Y' ) AND ( NOT NC-BG-TIME(NC-SCREEN-TITLEX) = 'Y' ) MOVE ZERO TO NC-SCREEN-TITLEX *> DISABLE FUTURE UPDATES END-IF ELSE MOVE ZERO TO RETURN-CODE END-IF. GOBACK. END PROGRAM COBCURSES-UPDATE-TITLE. *>***************************************************************** *> SUPPORT FOR NC-CLEAR-FIELD *>***************************************************************** PROGRAM-ID. COBCURSES-CLEAR-FIELD. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. 01 WS-COMP-1 COMP-1. 01 WS-COMP-2 COMP-2. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> CLEAR A FIELD'S CONTENTS TO BLANKS *> *> INPUT : *> NC-FIELD-NUMBER *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> CALL "COBCURSES-SELECT-FIELD" USING COPY COBCPARMS. CALL "NC_BLANK" USING NC-FIELD-BUFFER, NC-FIELD-LENGTH. EVALUATE NC-FIELD-COMP-TYPE WHEN 01 IF NC-FIELD-COMP-PTR NOT = NULL SET ADDRESS OF WS-COMP-1 TO NC-FIELD-COMP-PTR MOVE ZERO TO WS-COMP-1 END-IF WHEN 02 IF NC-FIELD-COMP-PTR NOT = NULL SET ADDRESS OF WS-COMP-2 TO NC-FIELD-COMP-PTR MOVE ZERO TO WS-COMP-2 END-IF WHEN OTHER CONTINUE END-EVALUATE. GOBACK. END PROGRAM COBCURSES-CLEAR-FIELD. *>***************************************************************** *> SUPPORT FOR NC-GET-TEXT-X *>***************************************************************** PROGRAM-ID. COBCURSES-GET-TEXT-X. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> GET TEXT FROM A WINDOWED FIELD. *> *> INPUT : *> NC-FIELD-DATA. *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> *> NOTES : *> 1. THIS ROUTINE IS NOT NORMALLY CALLED BY THE *> PROGRAMMER (NC-GET-TEXT CALLS THIS). THIS IS *> USED BY PROGRAMS LIKE THE SCREEN DESIGNER. *> CALL "COBCURSES-GET-TEXT-RAW" USING COPY COBCPARMS. MOVE NC-FIELD-CHG-FLAG TO NC-FDESC-CHG-FLAG(NC-FIELD-NUMBER). GOBACK. END PROGRAM COBCURSES-GET-TEXT-X. *>***************************************************************** *> SUPPORT FOR NC-ERROR-MESSAGE-OVERRIDE *> FORMERLY COBCURSES-ERROR-MESSAGE-OVERRIDE. *>***************************************************************** PROGRAM-ID. COBCURSES-ERROR-MSG-OVERRIDE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. MOVE 'Y' TO NC-FIELD-WAIVE-INFO CALL "COBCURSES-ERROR-MESSAGE" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-ERROR-MSG-OVERRIDE. *>***************************************************************** *> SUPPORT FOR NC-CLEAR-FIELDS *>***************************************************************** PROGRAM-ID. COBCURSES-CLEAR-FIELDS. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> CLEARS ALL FIELD BUFFERS DEFINED IN *> NC-FIELD-DESCRIPTORS. *> *> INPUT : *> NC-FIELD-DESCRIPTORS *> PERFORM VARYING NC-FIELD-NUMBER FROM 1 BY 1 UNTIL NC-FIELD-NUMBER > NC-MAX-FIELDS IF NC-FDESC-ADDRESS(NC-FIELD-NUMBER) NOT = NULL AND NC-FDESC-LENGTH(NC-FIELD-NUMBER) > 0 CALL "COBCURSES-CLEAR-FIELD" USING COPY COBCPARMS. END-IF END-PERFORM. GOBACK. END PROGRAM COBCURSES-CLEAR-FIELDS. *>***************************************************************** *> SUPPORT FOR NC-CLEAR-FIELDS *>***************************************************************** PROGRAM-ID. COBCURSES-COUNT-CHANGES. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> COUNT HOW MANY FIELDS HAVE CHANGED VALUES *> *> OUTPUTS : *> NC-FIELD-CHANGES CONTAINS THE COUNT *> MOVE ZERO TO NC-FIELD-CHANGES PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS IF NOT NC-FDESC-IGNORE-CHGS(NC-FIELD-INDEX) = 'Y' AND NC-FDESC-CHANGED(NC-FIELD-INDEX) ADD 1 TO NC-FIELD-CHANGES END-IF END-PERFORM. GOBACK. END PROGRAM COBCURSES-COUNT-CHANGES. *>***************************************************************** *> SUPPORT FOR NC-DRAW-FIELDS *>***************************************************************** PROGRAM-ID. COBCURSES-DRAW-FIELDS. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. . *> *> DISPLAY ALL FIELD CONTENT ON THE SCREEN. *> IF NC-FIELD-NUMBER >= 1 AND NC-FIELD-NUMBER <= NC-MAX-FIELDS MOVE NC-FIELD-NUMBER TO NC-FIELD-INDEX ELSE MOVE 1 TO NC-FIELD-INDEX END-IF. PERFORM VARYING NC-FIELD-NUMBER FROM 1 BY 1 UNTIL NC-FIELD-NUMBER > NC-MAX-FIELDS IF NC-FDESC-ADDRESS(NC-FIELD-NUMBER) NOT = NULL AND NC-FDESC-LENGTH(NC-FIELD-NUMBER) > 0 AND NC-FDESC-VISIBLE(NC-FIELD-NUMBER) = 'Y' CALL "COBCURSES-PUT-TEXT" USING COPY COBCPARMS. END-IF END-PERFORM. MOVE NC-FIELD-INDEX TO NC-FIELD-NUMBER. CALL "COBCURSES-SELECT-FIELD" USING COPY COBCPARMS. GOBACK. END PROGRAM COBCURSES-DRAW-FIELDS. *>***************************************************************** *> SUPPORT FOR NC-SET-MOUSE-CLICK *>***************************************************************** PROGRAM-ID. COBCURSES-SET-MOUSE-CLICK. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> SET THE MOUSE CLICK INTERVAL (MILLISECS) *> *> INPUTS : *> NC-MOUSE-CLICK-MS *> *> RETURN-CODE : *> 0 - OK *> 1 - FAILED *> 3 - NOT SUPPORTED (NO MOUSE SUPPORT) *> *> NOTES : *> CODE 3 MEANS THAT THERE IS NO MOUSE SUPPORT *> COMPILED IN. *> CALL "NC_MOUSE_INTERVAL" USING NC-MOUSE-CLICK-MS. GOBACK. END PROGRAM COBCURSES-SET-MOUSE-CLICK. *>***************************************************************** *> SUPPORT FOR NC-FIND-MOUSE-FIELD *>***************************************************************** PROGRAM-ID. COBCURSES-FIND-MOUSE-FIELD. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> LOCATES THE FIELD NUMBER FROM THE MOUSE COORDINATES *> *> INPUT : *> NC-MOUSE-DATA *> NC-FIELD-DESCRIPTIONS *> *> OUTPUT : *> NC-FIELD-SEARCH *> ZERO - NO FIELD MATCHED *> > 0 - FIELD NUMBER MATCHING MOUSE COORDS *> MOVE ZERO TO NC-FIELD-SEARCH PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS OR NC-FIELD-SEARCH > ZERO IF NC-FDESC-ADDRESS(NC-FIELD-INDEX) NOT = NULL AND NC-FDESC-LENGTH(NC-FIELD-INDEX) > 0 AND NC-FDESC-VISIBLE(NC-FIELD-INDEX) = 'Y' THEN IF NC-FDESC-WINLENGTH(NC-FIELD-INDEX) = ZERO THEN SUBTRACT 1 FROM NC-FDESC-LENGTH(NC-FIELD-INDEX) GIVING NC-TEMP-END-COLUMN ELSE SUBTRACT 1 FROM NC-FDESC-WINLENGTH(NC-FIELD-INDEX) GIVING NC-TEMP-END-COLUMN END-IF ADD NC-FDESC-COLUMN(NC-FIELD-INDEX) TO NC-TEMP-END-COLUMN IF NC-FDESC-LINE(NC-FIELD-INDEX) = NC-MOUSE-Y AND NC-MOUSE-X >= NC-FDESC-COLUMN(NC-FIELD-INDEX) AND NC-MOUSE-X <= NC-TEMP-END-COLUMN THEN MOVE NC-FIELD-INDEX TO NC-FIELD-SEARCH END-IF END-IF END-PERFORM. GOBACK. END PROGRAM COBCURSES-FIND-MOUSE-FIELD. *>***************************************************************** *> SUPPORT FOR NC-RESET-CHANGES *>***************************************************************** PROGRAM-ID. COBCURSES-RESET-CHANGES. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> RESET CHANGED INDICATOR FOR ALL FIELDS. *> PERFORM VARYING NC-FIELD-NUMBER FROM 1 BY 1 UNTIL NC-FIELD-NUMBER > NC-MAX-FIELDS CALL "COBCURSES-RESET-CHANGE" USING COPY COBCPARMS. END-PERFORM. MOVE 'N' TO NC-FIELD-CHG-FLAG. GOBACK. END PROGRAM COBCURSES-RESET-CHANGES. *>***************************************************************** *> SUPPORT FOR NC-RESET-CHANGE *>***************************************************************** PROGRAM-ID. COBCURSES-RESET-CHANGE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. MOVE 'N' TO NC-FDESC-CHG-FLAG(NC-FIELD-NUMBER). GOBACK. END PROGRAM COBCURSES-RESET-CHANGE. *>***************************************************************** *> SUBSTITUTE ANY OCCURRENCES OF ${VARNAME} IN THE PATHNAME *> WITH THE CONTENTS OF AN ENVIRONMENT VARIABLE *>***************************************************************** PROGRAM-ID. COBCURSES-EDIT-PATHNAME. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-PATHNAME-PTR POINTER. 01 WS-PATH-LENGTH-PTR POINTER. 01 WS-PATH-LENGTH PIC 9999 COMP-5. LINKAGE SECTION. COPY COBCURSG. PROCEDURE DIVISION USING NC-COBCURSES. SET WS-PATHNAME-PTR TO ADDRESS OF NC-PATHNAME. MOVE LENGTH OF NC-PATHNAME TO WS-PATH-LENGTH. SET WS-PATH-LENGTH-PTR TO ADDRESS OF WS-PATH-LENGTH. CALL "NC_PATHNAME" USING WS-PATHNAME-PTR, WS-PATH-LENGTH-PTR. MOVE WS-PATH-LENGTH TO NC-PATHNAME-LENGTH. GOBACK. END PROGRAM COBCURSES-EDIT-PATHNAME. *>***************************************************************** *> *> 3 2 7 0 T E R M I N A L M O D E S U P P O R T *> *>***************************************************************** *>***************************************************************** *> SUPPORT FOR NC-INIT-3270 *>***************************************************************** PROGRAM-ID. COBCURSES-INIT-3270. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INITIALIZE STORAGE FOR NCURSES BINDING *> FOR 3270 MODE. *> CALL "COBCURSES-INIT-X" USING COPY COBCPARMS. PERFORM VARYING NC-FKEY-INDEX FROM 1 BY 1 UNTIL NC-FKEY-INDEX > 12 MOVE 'N' TO NC-FKEY-EXEMPT(NC-FKEY-INDEX) END-PERFORM. MOVE 'F' TO NC-FIELD-MODE. MOVE ZERO TO NC-FIELD-NUMBER. GOBACK. END PROGRAM COBCURSES-INIT-3270. *>***************************************************************** *> SUPPORT FOR NC-3270-VERIFY-FIELD *>***************************************************************** PROGRAM-ID. COBCURSES-3270-VERIFY-FIELD. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> INPUTS : *> NC-FIELD-NUMBER *> *> RETURNS : *> RETURN-CODE = 0 WHEN FIELD VALIDATES OK *> NC-FIELD-NUMBER = 0 WHEN FIELD VALIDATES OK *> INITIALIZE NC-FIELD. CALL "COBCURSES-SELECT-FIELD-AND-OPTS" USING COPY COBCPARMS. CALL "NC_VERIFY" USING NC-FIELD-LENGTH, NC-FIELD-BUFFER, NC-FIELD-NOT-BLANK, NC-FIELD-RESTRICT, NC-FIELD-SIGNED, NC-FIELD-DIGITS, NC-FIELD-DECPLACES. IF RETURN-CODE = 0 THEN MOVE ZERO TO NC-FIELD-NUMBER END-IF. GOBACK. END PROGRAM COBCURSES-3270-VERIFY-FIELD. *>***************************************************************** *> SUPPORT FOR NC-3270-STATE-MACHINE *>***************************************************************** PROGRAM-ID. COBCURSES-3270-STATE-MACHINE. DATA DIVISION. LINKAGE SECTION. COPY COBCURSG. COPY COBCURSL. PROCEDURE DIVISION USING COPY COBCPARMS. *> *> (FOR 3270 MODE USE ONLY) *> ASK FOR INPUT FROM ANY/ALL FIELDS, UNTIL THE *> USER PRESSES "ENTER" OR A PF KEY. *> IF NC-FIELD-MODE NOT = 'F' THEN MOVE "NC-FIELD-MODE IS NOT MODE 'F'!" TO NC-MSGBUF CALL "COBCURSES-PUT-ERROR-CR" USING COPY COBCPARMS. ELSE PERFORM NC-3270-STATE-MACHINE-1 END-IF. GOBACK. NC-3270-STATE-MACHINE-1. INITIALIZE NC-FIELD. IF NC-FIELD-NUMBER < 1 OR NC-FIELD-NUMBER > NC-MAX-FIELDS PERFORM NC-3270-LOCATE-FIELD END-IF. IF NC-FIELD-NUMBER > 0 THEN PERFORM NC-3270-STATE-MACHINE-2 ELSE MOVE "NO DEFINED FIELDS!" TO NC-MSGBUF CALL "COBCURSES-PUT-ERROR-CR" USING COPY COBCPARMS. END-IF. EXIT. NC-3270-STATE-MACHINE-2. PERFORM UNTIL NC-FIELD-NUMBER = 0 PERFORM NC-3270-FIELD EVALUATE TRUE WHEN NC-FIELD-EXIT-CR OR NC-FIELD-EXIT-FKEY IF NC-FIELD-EXIT-FKEY AND NC-FKEY-EXEMPT(NC-FIELD-FKEY-NO) = 'Y' THEN *> *> THIS FKEY IS EXEMPT FROM VALIDATION (ESCAPE KEY?) *> MOVE ZERO TO NC-FIELD-NUMBER ELSE PERFORM NC-3270-VERIFY-FORM END-IF WHEN NC-FIELD-EXIT-CD PERFORM NC-3270-NEXT WHEN NC-FIELD-EXIT-TAB PERFORM NC-3270-TAB WHEN NC-FIELD-EXIT-CU PERFORM NC-3270-UP WHEN NC-FIELD-EXIT-BTAB PERFORM NC-3270-BTAB WHEN NC-FIELD-EXIT-ESC CONTINUE WHEN NC-FIELD-EXIT-DOT CONTINUE WHEN NC-FIELD-EXIT-SLASH CONTINUE END-EVALUATE END-PERFORM. EXIT. NC-3270-LOCATE-FIELD. MOVE NC-FIELD-NUMBER TO NC-FIELD-INDEX MOVE ZERO TO NC-FIELD-NUMBER PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS OR NC-FIELD-NUMBER > ZERO EVALUATE TRUE WHEN NC-FDESC-ADDRESS(NC-FIELD-INDEX) = NULL CONTINUE WHEN NC-FDESC-LENGTH(NC-FIELD-INDEX) < 1 CONTINUE WHEN NC-FDESC-VISIBLE(NC-FIELD-INDEX) NOT = 'Y' CONTINUE WHEN NC-FDESC-COLOUR-FLAG(NC-FIELD-INDEX) = 'N' MOVE NC-FIELD-INDEX TO NC-FIELD-NUMBER END-EVALUATE ADD 1 TO NC-FIELD-INDEX END-PERFORM. EXIT. *> *> RETURNS: *> NC-FIELD-NUMBER WILL BE ZERO IF THE ENTIRE *> FORM VERIFIED OK. *> *> NC-FIELD-NUMBER WILL BE > ZERO, AND INDICATE *> THE FIELD THAT DIDN'T PASS VERIFICATION. *> NC-3270-VERIFY-FORM. MOVE NC-FIELD-EXIT TO NC-SAVED-EXIT. MOVE NC-FIELD-FKEY-NO TO NC-SAVED-FKEY. MOVE ZERO TO NC-FIELD-NUMBER. PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS OR NC-FIELD-NUMBER > ZERO EVALUATE TRUE WHEN NC-FDESC-ADDRESS(NC-FIELD-INDEX) = NULL CONTINUE WHEN NC-FDESC-LENGTH(NC-FIELD-INDEX) < 1 CONTINUE WHEN NC-FDESC-VISIBLE(NC-FIELD-INDEX) NOT = 'Y' CONTINUE WHEN NC-FDESC-COLOUR-FLAG(NC-FIELD-INDEX) = 'N' MOVE NC-FIELD-INDEX TO NC-FIELD-NUMBER CALL "COBCURSES-3270-VERIFY-FIELD" USING COPY COBCPARMS. END-EVALUATE END-PERFORM. MOVE NC-SAVED-EXIT TO NC-FIELD-EXIT. MOVE NC-SAVED-FKEY TO NC-FIELD-FKEY-NO. EXIT. NC-3270-UP. SUBTRACT 1 FROM NC-FIELD-Y. MOVE ZERO TO NC-BEST-FIELD. MOVE HIGH-VALUES TO NC-DIFF-Y, NC-DIFF-X. PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS EVALUATE TRUE WHEN NC-FDESC-ADDRESS(NC-FIELD-INDEX) = NULL CONTINUE WHEN NC-FDESC-LENGTH(NC-FIELD-INDEX) < 1 CONTINUE WHEN NC-FDESC-VISIBLE(NC-FIELD-INDEX) NOT = 'Y' CONTINUE WHEN NC-FDESC-COLOUR-FLAG(NC-FIELD-INDEX) = 'N' PERFORM NC-3270-PREV-FIELD END-EVALUATE END-PERFORM. PERFORM NC-3270-FINALIZE-2. EXIT. NC-3270-NEXT. ADD 1 TO NC-FIELD-Y. MOVE ZERO TO NC-BEST-FIELD. MOVE HIGH-VALUES TO NC-DIFF-Y, NC-DIFF-X. PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS EVALUATE TRUE WHEN NC-FDESC-ADDRESS(NC-FIELD-INDEX) = NULL CONTINUE WHEN NC-FDESC-LENGTH(NC-FIELD-INDEX) < 1 CONTINUE WHEN NC-FDESC-VISIBLE(NC-FIELD-INDEX) NOT = 'Y' CONTINUE WHEN NC-FDESC-COLOUR-FLAG(NC-FIELD-INDEX) = 'N' PERFORM NC-3270-NEXT-FIELD END-EVALUATE END-PERFORM. PERFORM NC-3270-FINALIZE. EXIT. NC-3270-TAB. MOVE ZERO TO NC-BEST-FIELD. MOVE HIGH-VALUES TO NC-DIFF-Y, NC-DIFF-X. PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS EVALUATE TRUE WHEN NC-FDESC-ADDRESS(NC-FIELD-INDEX) = NULL CONTINUE WHEN NC-FDESC-LENGTH(NC-FIELD-INDEX) < 1 CONTINUE WHEN NC-FDESC-VISIBLE(NC-FIELD-INDEX) NOT = 'Y' CONTINUE WHEN NC-FDESC-COLOUR-FLAG(NC-FIELD-INDEX) = 'N' PERFORM NC-3270-TAB-FIELD END-EVALUATE END-PERFORM. PERFORM NC-3270-FINALIZE. EXIT. NC-3270-FINALIZE. IF NC-BEST-FIELD > 0 THEN MOVE NC-BEST-FIELD TO NC-FIELD-NUMBER ELSE MOVE ZERO TO NC-FIELD-NUMBER PERFORM NC-3270-LOCATE-FIELD END-IF. EXIT. NC-3270-NEXT-FIELD. EVALUATE TRUE WHEN NC-FIELD-INDEX = NC-FIELD-NUMBER CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) < NC-FIELD-Y CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) >= NC-FIELD-Y PERFORM NC-3270-NEXT-GE END-EVALUATE. EXIT. NC-3270-PREV-FIELD. EVALUATE TRUE WHEN NC-FIELD-INDEX = NC-FIELD-NUMBER CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) > NC-FIELD-Y CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) <= NC-FIELD-Y PERFORM NC-3270-PREV-LE END-EVALUATE. EXIT. NC-3270-TAB-FIELD. EVALUATE TRUE WHEN NC-FIELD-INDEX = NC-FIELD-NUMBER CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) < NC-FIELD-Y CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) = NC-FIELD-Y PERFORM NC-3270-TAB-EQ WHEN NC-FDESC-LINE(NC-FIELD-INDEX) > NC-FIELD-Y PERFORM NC-3270-TAB-GT END-EVALUATE. EXIT. NC-3270-X-ABS-DIFF. IF NC-FDESC-COLUMN(NC-FIELD-INDEX) < NC-FIELD-X SUBTRACT NC-FDESC-COLUMN(NC-FIELD-INDEX) FROM NC-FIELD-X GIVING NC-DIFF ELSE SUBTRACT NC-FIELD-X FROM NC-FDESC-COLUMN(NC-FIELD-INDEX) GIVING NC-DIFF END-IF. EXIT. NC-3270-NEXT-GE. SUBTRACT NC-FIELD-Y FROM NC-FDESC-LINE(NC-FIELD-INDEX) GIVING NC-DIFF EVALUATE TRUE WHEN NC-DIFF < NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-Y PERFORM NC-3270-X-ABS-DIFF MOVE NC-DIFF TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD WHEN NC-DIFF = NC-DIFF-Y PERFORM NC-3270-X-ABS-DIFF IF NC-DIFF <= NC-DIFF-X THEN MOVE ZERO TO NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD END-IF WHEN NC-DIFF > NC-DIFF-Y CONTINUE END-EVALUATE. EXIT. NC-3270-PREV-LE. SUBTRACT NC-FDESC-LINE(NC-FIELD-INDEX) FROM NC-FIELD-Y GIVING NC-DIFF EVALUATE TRUE WHEN NC-DIFF < NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-Y PERFORM NC-3270-X-ABS-DIFF MOVE NC-DIFF TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD WHEN NC-DIFF = NC-DIFF-Y PERFORM NC-3270-X-ABS-DIFF IF NC-DIFF <= NC-DIFF-X THEN MOVE ZERO TO NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD END-IF WHEN NC-DIFF > NC-DIFF-Y CONTINUE END-EVALUATE. EXIT. NC-3270-TAB-EQ. IF NC-FDESC-COLUMN(NC-FIELD-INDEX) > NC-FIELD-X IF NC-DIFF-Y > 0 THEN MOVE HIGH-VALUES TO NC-DIFF-X, NC-DIFF-Y END-IF SUBTRACT NC-FDESC-COLUMN(NC-FIELD-INDEX) FROM NC-FIELD-X GIVING NC-DIFF IF NC-DIFF < NC-DIFF-X THEN MOVE ZERO TO NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD END-IF END-IF. EXIT. NC-3270-TAB-GT. SUBTRACT NC-FDESC-LINE(NC-FIELD-INDEX) FROM NC-FIELD-Y GIVING NC-DIFF EVALUATE TRUE WHEN NC-DIFF-Y = 0 CONTINUE WHEN NC-DIFF < NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-Y MOVE NC-FDESC-COLUMN(NC-FIELD-INDEX) TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD WHEN NC-DIFF = NC-DIFF-Y IF NC-FDESC-COLUMN(NC-FIELD-INDEX) < NC-DIFF-X MOVE NC-FDESC-COLUMN(NC-FIELD-INDEX) TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD END-IF WHEN NC-DIFF > NC-DIFF-Y CONTINUE END-EVALUATE. EXIT. NC-3270-BTAB. MOVE ZERO TO NC-BEST-FIELD. MOVE HIGH-VALUES TO NC-DIFF-Y, NC-DIFF-X. PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS EVALUATE TRUE WHEN NC-FDESC-ADDRESS(NC-FIELD-INDEX) = NULL CONTINUE WHEN NC-FDESC-LENGTH(NC-FIELD-INDEX) < 1 CONTINUE WHEN NC-FDESC-VISIBLE(NC-FIELD-INDEX) NOT = 'Y' CONTINUE WHEN NC-FDESC-COLOUR-FLAG(NC-FIELD-INDEX) = 'N' PERFORM NC-3270-BTAB-FIELD END-EVALUATE END-PERFORM. PERFORM NC-3270-FINALIZE-2. EXIT. NC-3270-LOCATE-LAST. MOVE ZERO TO NC-FIELD-X, NC-FIELD-Y, NC-FIELD-NUMBER. PERFORM VARYING NC-FIELD-INDEX FROM 1 BY 1 UNTIL NC-FIELD-INDEX > NC-MAX-FIELDS EVALUATE TRUE WHEN NC-FDESC-ADDRESS(NC-FIELD-INDEX) = NULL CONTINUE WHEN NC-FDESC-LENGTH(NC-FIELD-INDEX) < 1 CONTINUE WHEN NC-FDESC-VISIBLE(NC-FIELD-INDEX) NOT = 'Y' CONTINUE WHEN NC-FDESC-COLOUR-FLAG(NC-FIELD-INDEX) NOT = 'N' CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) > NC-FIELD-Y MOVE NC-FDESC-LINE(NC-FIELD-INDEX) TO NC-FIELD-Y MOVE NC-FDESC-COLUMN(NC-FIELD-INDEX) TO NC-FIELD-X MOVE NC-FIELD-INDEX TO NC-FIELD-NUMBER WHEN NC-FDESC-LINE(NC-FIELD-INDEX) = NC-FIELD-Y IF NC-FDESC-COLUMN(NC-FIELD-INDEX) > NC-FIELD-X MOVE NC-FDESC-COLUMN(NC-FIELD-INDEX) TO NC-FIELD-X MOVE NC-FIELD-INDEX TO NC-FIELD-NUMBER END-IF END-EVALUATE END-PERFORM. EXIT. NC-3270-FINALIZE-2. IF NC-BEST-FIELD > 0 THEN MOVE NC-BEST-FIELD TO NC-FIELD-NUMBER ELSE PERFORM NC-3270-LOCATE-LAST END-IF. EXIT. NC-3270-BTAB-FIELD. EVALUATE TRUE WHEN NC-FIELD-INDEX = NC-FIELD-NUMBER CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) > NC-FIELD-Y CONTINUE WHEN NC-FDESC-LINE(NC-FIELD-INDEX) = NC-FIELD-Y PERFORM NC-3270-BTAB-EQ WHEN NC-FDESC-LINE(NC-FIELD-INDEX) < NC-FIELD-Y PERFORM NC-3270-BTAB-GT END-EVALUATE. EXIT. NC-3270-BTAB-EQ. IF NC-FDESC-COLUMN(NC-FIELD-INDEX) < NC-FIELD-X IF NC-DIFF-Y > 0 THEN MOVE HIGH-VALUES TO NC-DIFF-X, NC-DIFF-Y END-IF SUBTRACT NC-FDESC-COLUMN(NC-FIELD-INDEX) FROM NC-FIELD-X GIVING NC-DIFF IF NC-DIFF < NC-DIFF-X THEN MOVE ZERO TO NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD END-IF END-IF. EXIT. NC-3270-BTAB-GT. SUBTRACT NC-FDESC-LINE(NC-FIELD-INDEX) FROM NC-FIELD-Y GIVING NC-DIFF EVALUATE TRUE WHEN NC-DIFF-Y = 0 CONTINUE WHEN NC-DIFF < NC-DIFF-Y MOVE NC-DIFF TO NC-DIFF-Y MOVE NC-FDESC-COLUMN(NC-FIELD-INDEX) TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD WHEN NC-DIFF = NC-DIFF-Y IF NC-FDESC-COLUMN(NC-FIELD-INDEX) > NC-DIFF-X MOVE NC-FDESC-COLUMN(NC-FIELD-INDEX) TO NC-DIFF-X MOVE NC-FIELD-INDEX TO NC-BEST-FIELD END-IF WHEN NC-DIFF > NC-DIFF-Y CONTINUE END-EVALUATE. EXIT. NC-3270-FIELD. CALL "COBCURSES-UPDATE-TITLE" USING COPY COBCPARMS. INITIALIZE NC-FIELD. CALL "COBCURSES-SELECT-FIELD-AND-OPTS" USING COPY COBCPARMS. *> *> ISSUE FIELD INFO IF CONFIGURED FOR IT *> IF NOT NC-FDESC-INFO(NC-FIELD-NUMBER) = NULL AND NC-FDESC-INFOLEN(NC-FIELD-NUMBER) > ZERO SET NC-MSG-TEXT TO NC-FDESC-INFO(NC-FIELD-NUMBER) MOVE NC-FDESC-INFOLEN(NC-FIELD-NUMBER) TO NC-MSG-LENGTH CALL "COBCURSES-INFO-MESSAGE" USING COPY COBCPARMS. END-IF. IF NC-FDESC-YN(NC-FIELD-NUMBER) = 'Y' SET NC-FIELD-RESTRICT TO ADDRESS OF NC-YN MOVE 'Y' TO NC-FIELD-UPPERCASE END-IF. IF NC-FDESC-VERIFY(NC-FIELD-NUMBER) = 'Y' THEN MOVE 'N' TO NC-FIELD-VERIFIED ELSE MOVE 'Y' TO NC-FIELD-VERIFIED END-IF. *> *> GO GET INPUT FROM THE USER FOR THIS FIELD *> MOVE ZERO TO NC-FIELD-X-POS CALL "COBCURSES-GET-TEXT-X" USING COPY COBCPARMS. IF NC-FIELD-MOUSE-EVENT THEN CALL "COBCURSES-FIND-MOUSE-FIELD" USING COPY COBCPARMS. CALL "COBCURSES-MOUSE-EVENT" USING COPY COBCPARMS. END-IF. EXIT. END PROGRAM COBCURSES-3270-STATE-MACHINE. IDENTIFICATION DIVISION. PROGRAM-ID. COBCURSES-SHOW-MENU. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-BUFLEN PIC 9999 COMP-5. LINKAGE SECTION. COPY COBCURSG. 01 LS-MENU-DEFN PIC X(32). *> SIZE HERE IS UNIMPORTANT (REF TO MENU DEFN) 01 LS-RET-BUFFER PIC X(99). *> RETURN BUFFER REF (SIZE IS IGNORED HERE) 01 LS-RET-BUFFER-LENGTH PIC 9999. *> BUFFER'S LENGTH PROCEDURE DIVISION USING NC-COBCURSES, LS-MENU-DEFN, LS-RET-BUFFER, LS-RET-BUFFER-LENGTH. *> *> RETURN-CODE : *> NC-RET-OK A MENU SELECTION WAS MADE (OR MENU EXITED) *> NC-RET-FAIL THE MENU HAD A FAILURE OF SOME SORT *> MOVE LS-RET-BUFFER-LENGTH TO WS-BUFLEN. CALL "NC_SHOW_MENU" USING LS-MENU-DEFN, LS-RET-BUFFER, WS-BUFLEN, NC-MENU-PAIR, NC-TITLE-ATTR. GOBACK. END PROGRAM COBCURSES-SHOW-MENU. *>***************************************************************** *> *> END LIBCOBCURSES *> *>*****************************************************************