#!/bin/sh
#
# This is a shell archive.  To extract its contents,
# execute this file with /bin/sh to create the file(s):
#
# README.1ST	    d4_cust.4gl		disparr.4gl	    usr_funcs.c
# README.2ND	    d4_globals.4gl
#
# This shell archive created: Mon Dec 28 13:33:53 EST 1992
#
echo "Extracting file README.1ST"
sed -e 's/^X//' <<\SHAR_EOF > README.1ST
XThese files comprise a demonstration of a method for handling the display of
Xarrays in Informix-4GL created by Bob Kane <bob@worms-emh2.army.mil>.  Bob's
Xcomments in README.2ND refer to his original distribution method of using a
Xtar file.  You may need to modify his installation instructions somewhat since
Xthese files come to you in a shell archive.
X
XWalt Hultgren
Xwalt@rmy.emory.edu
SHAR_EOF
if [ `wc -c < README.1ST` -ne      387 ]
then
    echo "Lengths do not match -- Bad Copy of README.1ST"
fi
echo "Extracting file README.2ND"
sed -e 's/^X//' <<\SHAR_EOF > README.2ND
XThis tar file includes 3 4GL modules and a module written in 'c'.  In order
Xto run the sample code for the screen array function, you must first install
Xthe 4GL demo code that comes with most version of Informix 4GL.  I designed
Xthis sample code to replace some of the demo code, so I would not have to
Xinclude an entire application with modules, forms, a database, and data files.
X
XAfter installing the 4GL demo code, usually by typing 'i4gldemo', you will
Xneed to untar the replacement modules from the arrdemo.tar file.  These
Xare 'd4_globals.4gl', 'd4_cust.4gl', 'disparr.4gl' and 'usr_funcs.c'.  Note:
Xthe 'usr_funcs.c' was written by Dave Snyder and included with his excellent
Xpublic domain 4GL programs and functions.  If you are using release 4.1 of
X4GL, you will not need the functions in 'usr_funcs.c' since their equivalent
Xis included in this release.
X
XAfter you have untared the replacement code, you will need to recompile the
X'demo4.4ge' program.  You need to included the following modules:
X
X                     *d4_globals.4gl
X                      d4_main.4gl
X                     *d4_cust.4gl
X                      d4_orders.4gl
X                      d4_stock.4gl
X                      d4_report.4gl
X                      d4_demo.4gl
X                     *disparr.4gl
X
X                     *usr_funcs.c
X
X* New or replacement modules.
X
XOnce you have recompiled, give a try adding a new customer.  As soon as you get
Xinto the state field, type in an invalid 2 digit state code and the new display
Xarray function will pop-up.  You can also leave the field blank.  One you get
Xthe array up, press any letter, and the array will magically move to that 
Xposition.  The standard keys like, 'Page Up', 'Page Down', and 'UP' or 'DOWN'
Xarrow are also implimented.  You will also note that the highlight bar moves
Xalong with your cursor movement.  Enjoy!  Please send any bugs or enahance-
Xments to bob@worms-emh2.army.mil.  My thanks to Dave Snyder and his fgl_getkey
Xand fgl_keyval functions that allow this whole thing to work.
SHAR_EOF
if [ `wc -c < README.2ND` -ne     2041 ]
then
    echo "Lengths do not match -- Bad Copy of README.2ND"
fi
echo "Extracting file d4_cust.4gl"
sed -e 's/^X//' <<\SHAR_EOF > d4_cust.4gl
XGLOBALS
X    "d4_globals.4gl"
X
X
XFUNCTION customer()
X
X    OPTIONS 
X	FORM LINE 7
X    OPEN FORM customer FROM "custform"
X    DISPLAY FORM customer 
X	ATTRIBUTE(MAGENTA)
X    CALL ring_menu()
X    CALL fgl_drawbox(3,32,3,42)
X    CALL fgl_drawbox(3,61,8,7)
X    CALL fgl_drawbox(11,61,8,7)
X    LET p_customer.customer_num = NULL
X    MENU "CUSTOMER"
X	COMMAND "One-add" "Add a new customer to the database" HELP 201
X	    CALL add_customer(FALSE)
X	COMMAND "Many-add" "Add several new customer to database" HELP 202
X	    CALL add_customer(TRUE)
X	COMMAND "Find-cust" "Look up specific customer" HELP 203
X	    IF query_customer(23) THEN
X		NEXT OPTION "Update-cust"
X	    END IF
X	COMMAND "Update-cust" "Modify current customer information" HELP 204
X	    CALL update_customer()
X    	    NEXT OPTION "Find-cust"
X	COMMAND "Delete-cust" "Remove a customer from database" HELP 205
X	    CALL delete_customer()
X    	    NEXT OPTION "Find-cust"
X	COMMAND "Exit" "Return to MAIN Menu" HELP 206
X	    CLEAR SCREEN
X	    EXIT MENU
X    END MENU
X    OPTIONS 
X	FORM LINE 3 
XEND FUNCTION
X
X
XFUNCTION add_customer(repeat)
X    DEFINE repeat INTEGER
X
X    CALL clear_menu()
X    MESSAGE "Press F1 or CTRL-F for field help; ",
X	    "F2 or CTRL-Z to return to menu"
X    IF repeat THEN
X	WHILE input_cust()
X	    ERROR "Customer data entered" ATTRIBUTE (GREEN)
X	END WHILE
X	CALL mess("Multiple insert completed - current screen values ignored", 23)
X    ELSE
X	IF input_cust() THEN
X	    ERROR "Customer data entered" ATTRIBUTE (GREEN)
X	ELSE
X    	    CLEAR FORM
X    	    LET p_customer.customer_num = NULL
X            ERROR "Customer addition aborted" ATTRIBUTE (RED, REVERSE)
X	END IF
X    END IF
XEND FUNCTION
X
X
XFUNCTION input_cust()
X#
X#   This function has been modified to include a call to state_not_valid()
X#   and get_pos().  The state_not_valid function scans the state array
X#   and returns true if the state the user entered is not found.  The get_pos
X#   function takes the state code the user entered and searches for the  
X#   closest match in the state array, returning the position in the array.
X#
X 
X    DEFINE z SMALLINT
X
X    DISPLAY "Press ESC to enter new customer data" AT 1,1
X    INPUT BY NAME p_customer.*
X        AFTER FIELD state
X           IF LENGTH(p_customer.state) = 0 THEN
X              CALL statehelp(1)
X           ELSE
X              IF state_not_valid() THEN
X                 CALL get_pos(p_customer.state) RETURNING z
X                 IF z > 0 THEN
X                    CALL statehelp(z)
X                 ELSE
X                    CALL statehelp(1)
X                 END IF
X              END IF
X           END IF
X    	   DISPLAY "Press ESC to enter new customer data", "" AT 1,1
X	ON KEY (F1, CONTROL-F)
X            CALL customer_help()
X	ON KEY (F2, CONTROL-Z)
X	    LET int_flag = TRUE
X	    EXIT INPUT
X    END INPUT
X    IF int_flag THEN
X	LET int_flag = FALSE
X	RETURN(FALSE)
X    END IF
X    LET p_customer.customer_num = 0
X    INSERT INTO customer VALUES (p_customer.*)
X    LET p_customer.customer_num = SQLCA.SQLERRD[2]
X    DISPLAY BY NAME p_customer.customer_num ATTRIBUTE(MAGENTA)
X    RETURN(TRUE)
XEND FUNCTION
X
X
XFUNCTION query_customer(mrow)
X    DEFINE where_part CHAR(200),
X           query_text CHAR(250),
X           answer CHAR(1),
X	   mrow, chosen, exist SMALLINT
X
X    CLEAR FORM
X    CALL clear_menu()
X
X    MESSAGE "Enter criteria for selection"
X    CONSTRUCT where_part ON customer.* FROM customer.*
X    MESSAGE ""
X    IF int_flag THEN
X        LET int_flag = FALSE
X	CLEAR FORM
X        ERROR "Customer query aborted" ATTRIBUTE(RED, REVERSE)
X	LET p_customer.customer_num = NULL
X	RETURN (p_customer.customer_num)
X    END IF
X    LET query_text = "select * from customer where ", where_part CLIPPED,
X			" order by lname"
X    PREPARE statement_1 FROM query_text
X    DECLARE customer_set SCROLL CURSOR FOR statement_1
X
X    OPEN customer_set
X    FETCH FIRST customer_set INTO p_customer.*
X    IF status = NOTFOUND THEN
X	LET exist = FALSE
X    ELSE
X        LET exist = TRUE
X	DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA)
X	MENU "BROWSE"
X	    COMMAND "Next" "View the next customer in the list"
X		FETCH NEXT customer_set INTO p_customer.*
X		IF status = NOTFOUND THEN
X		    ERROR "No more customers in this direction" ATTRIBUTE(RED, REVERSE)
X		    FETCH LAST customer_set INTO p_customer.*
X		END IF
X		DISPLAY BY NAME p_customer.*  ATTRIBUTE(MAGENTA)
X	    COMMAND "Previous" "View the previous customer in the list"
X		FETCH PREVIOUS customer_set INTO p_customer.*
X		IF status = NOTFOUND THEN
X		    ERROR "No more customers in this direction" ATTRIBUTE(RED, REVERSE)
X		    FETCH FIRST customer_set INTO p_customer.*
X		END IF
X		DISPLAY BY NAME p_customer.*  ATTRIBUTE(MAGENTA)
X	    COMMAND "First" "View the first customer in the list"
X		FETCH FIRST customer_set INTO p_customer.*
X		DISPLAY BY NAME p_customer.*  ATTRIBUTE(MAGENTA)
X	    COMMAND "Last" "View the last customer in the list"
X		FETCH LAST customer_set INTO p_customer.*
X		DISPLAY BY NAME p_customer.*  ATTRIBUTE(MAGENTA)
X	    COMMAND "Select" "Exit BROWSE selecting the current customer"
X		LET chosen = TRUE
X		EXIT MENU
X	    COMMAND "Quit" "Quit BROWSE without selecting a customer"
X		LET chosen = FALSE
X		EXIT MENU
X	END MENU
X    END IF
X    CLOSE customer_set
X
X    CALL clear_menu()
X    IF NOT exist THEN
X	CLEAR FORM
X	CALL mess("No customer satisfies query", mrow)
X        LET p_customer.customer_num = NULL
X	RETURN (FALSE)
X    END IF
X    IF NOT chosen THEN
X	CLEAR FORM
X	LET p_customer.customer_num = NULL
X	CALL mess("No selection made", mrow)
X	RETURN (FALSE)
X    END IF
X    RETURN (TRUE)
XEND FUNCTION
X
X
XFUNCTION update_customer()
X#
X#   This function has been modified to include a call to state_not_valid()
X#   and get_pos().  The state_not_valid function scans the state array
X#   and returns true if the state the user entered is not found.  The get_pos
X#   function takes the state code the user entered and searches for the  
X#   closest match in the state array, returning the position in the array.
X#
X
X    DEFINE z SMALLINT
X
X    CALL clear_menu()
X    IF p_customer.customer_num IS NULL THEN
X	ERROR "No customer has been selected; use the Find-cust option"
X	    ATTRIBUTE (RED, REVERSE)
X	RETURN
X    END IF
X    MESSAGE "Press F1 or CTRL-F for field-level help"
X    DISPLAY "Press ESC to update customer data; DEL to abort" AT 1,1
X    INPUT BY NAME p_customer.* WITHOUT DEFAULTS
X	AFTER FIELD state
X           IF LENGTH(p_customer.state) = 0 THEN
X              CALL statehelp(1)
X           ELSE
X              IF state_not_valid() THEN
X                 CALL get_pos(p_customer.state) RETURNING z
X                 IF z > 0 THEN
X                    CALL statehelp(z)
X                 ELSE
X                    CALL statehelp(1)
X                 END IF
X              END IF
X           END IF
X    	   DISPLAY "Press ESC to update customer data; DEL to abort", "" AT 1,1
X	ON KEY (F1, CONTROL-F)
X	    CALL customer_help()
X        END INPUT
X    IF NOT int_flag THEN
X        UPDATE customer SET customer.* = p_customer.*
X	    WHERE customer_num = p_customer.customer_num
X        CALL mess("Customer data modified", 23)
X    ELSE
X	LET int_flag = FALSE
X	SELECT * INTO p_customer.* FROM customer
X	    WHERE customer_num = p_customer.customer_num
X	DISPLAY BY NAME p_customer.* ATTRIBUTE(MAGENTA)
X	ERROR "Customer update aborted" ATTRIBUTE (RED, REVERSE)
X    END IF
XEND FUNCTION
X
X
XFUNCTION delete_customer()
X    DEFINE answer CHAR(1),
X	   num_orders INTEGER
X
X    CALL clear_menu()
X    IF p_customer.customer_num IS NULL THEN
X	ERROR "No customer has been selected; use the Find-cust option"
X	    ATTRIBUTE (RED, REVERSE)
X	RETURN
X    END IF
X
X    SELECT COUNT(*) INTO num_orders
X	FROM orders
X	WHERE customer_num = p_customer.customer_num
X    IF num_orders THEN
X	ERROR "This customer has active orders and can not be removed"
X	    ATTRIBUTE (RED, REVERSE)
X	RETURN
X    END IF
X
X    PROMPT " Are you sure you want to delete this customer row? "
X	FOR CHAR answer
X    IF answer MATCHES "[yY]" THEN
X	DELETE FROM customer 
X	    WHERE customer_num = p_customer.customer_num
X	CLEAR FORM
X	CALL mess("Customer entry deleted", 23)
X	LET p_customer.customer_num = NULL
X    ELSE
X	ERROR "Deletion aborted" ATTRIBUTE (RED, REVERSE)
X    END IF
XEND FUNCTION
X
X
XFUNCTION customer_help()
X    CASE
X	WHEN infield(customer_num) CALL showhelp(1001)
X	WHEN infield(fname) CALL showhelp(1002)
X	WHEN infield(lname) CALL showhelp(1003)
X	WHEN infield(company) CALL showhelp(1004)
X	WHEN infield(address1) CALL showhelp(1005)
X	WHEN infield(address2) CALL showhelp(1006)
X	WHEN infield(city) CALL showhelp(1007)
X	WHEN infield(state) CALL showhelp(1008)
X	WHEN infield(zipcode) CALL showhelp(1009)
X	WHEN infield(phone) CALL showhelp(1010)
X    END CASE
XEND FUNCTION
SHAR_EOF
if [ `wc -c < d4_cust.4gl` -ne     8639 ]
then
    echo "Lengths do not match -- Bad Copy of d4_cust.4gl"
fi
echo "Extracting file d4_globals.4gl"
sed -e 's/^X//' <<\SHAR_EOF > d4_globals.4gl
XDATABASE stores
X
XGLOBALS
X    DEFINE
X        p_customer RECORD LIKE customer.*,
X        p_orders RECORD 
X                order_num LIKE orders.order_num,
X                order_date LIKE orders.order_date,
X                po_num LIKE orders.po_num,
X	        ship_instruct LIKE orders.ship_instruct
X            END RECORD,
X        p_items ARRAY[10] OF RECORD
X                item_num LIKE items.item_num,
X                stock_num LIKE items.stock_num,
X                manu_code LIKE items.manu_code,
X                description LIKE stock.description,
X                quantity LIKE items.quantity,
X                unit_price LIKE stock.unit_price,
X                total_price LIKE items.total_price
X            END RECORD,
X        p_stock ARRAY[30] OF RECORD
X	        stock_num LIKE stock.stock_num,
X	        manu_code LIKE manufact.manu_code,
X	        manu_name LIKE manufact.manu_name,
X	        description LIKE stock.description,
X	        unit_price LIKE stock.unit_price,
X	        unit_descr LIKE stock.unit_descr
X	    END RECORD,
X        p_state ARRAY[50] OF RECORD LIKE state.*,
X        state_cnt, stock_cnt INTEGER,
X        print_option CHAR(1),
X        scrsize    SMALLINT,
X        scrline    SMALLINT,
X        arr_pntr   INTEGER
XEND GLOBALS
X
SHAR_EOF
if [ `wc -c < d4_globals.4gl` -ne     1249 ]
then
    echo "Lengths do not match -- Bad Copy of d4_globals.4gl"
fi
echo "Extracting file disparr.4gl"
sed -e 's/^X//' <<\SHAR_EOF > disparr.4gl
XDATABASE stores
X
XGLOBALS "d4_globals.4gl"
X
XFUNCTION statehelp(s_posn)
X#
X#  This function controls the state array pop-up help screen.
X#  It use a WHILE statement to keep the user in the array until
X#  the ACCEPT or INTERRUPT is pressed.  The users key strokes are
X#  captured using the fgl_getkey FUNCTION that is included in the
X#  usr_funcs.c module from Dave Snyder.  Note: if you are using 
X#  release 4.1 of 4GL, do not include usr_funcs.c in the compile.
X#  The captured key stroke is stored in the variable key_pressed.
X#  The value of key_pressed is than compared to value for various
X#  function keys and arrow keys using the fgl_keyval function
X#  that returns the value for a key name such as 'DOWN', 'UP', etc.
X#  When a key stroke is matched to a key, the appropriate function 
X#  is called to perform the display array like action on screen.
X#
X
X    DEFINE s_posn SMALLINT,
X           key_pressed INTEGER,
X           goto_strg CHAR(1),
X           exit_xref SMALLINT
X
X    LET scrsize = 7
X    LET arr_pntr = s_posn
X    LET exit_xref = FALSE
X
X    DISPLAY "Move cursor using F3, F4, and arrow keys; press ESC to select state" AT 1,1
X
X    OPEN WINDOW w_state AT 8,37 
X       WITH FORM "state_list" 
X       ATTRIBUTE (BORDER, RED, FORM LINE 2)
X
X    CALL show_page()
X   
X    WHILE TRUE
X
X        LET key_pressed = fgl_getkey()
X
X        CASE
X           WHEN key_pressed = fgl_keyval("DOWN") OR
X                key_pressed = fgl_keyval("CONTROL-M")
X                CALL line_down()
X           WHEN key_pressed = fgl_keyval("UP")
X                CALL line_up()
X           WHEN key_pressed = fgl_keyval("F4")
X                CALL page_down()
X           WHEN key_pressed = fgl_keyval("F3")
X                CALL page_up()
X           WHEN key_pressed = fgl_keyval("ACCEPT")
X                LET exit_xref = TRUE
X                EXIT CASE
X           #
X           #  These two when clauses handle the user pressing
X           #  'a-z' or 'A-Z', allowing the array pointer to
X           #  jump to the appropriate starting position in the
X           #  array for that letter.
X           #
X           WHEN key_pressed > 96 AND key_pressed < 123
X                LET goto_strg = ASCII key_pressed
X                LET goto_strg = UPSHIFT(goto_strg)
X                CALL get_pos(goto_strg) RETURNING s_posn
X                IF s_posn > 0 THEN
X                   LET arr_pntr = s_posn
X                   CALL show_page()
X                END IF
X           WHEN key_pressed > 64 AND key_pressed < 91
X                LET goto_strg = ASCII key_pressed
X                CALL get_pos(goto_strg) RETURNING s_posn
X                IF s_posn > 0 THEN
X                   LET arr_pntr = s_posn
X                   CALL show_page()
X                END IF
X           WHEN key_pressed = fgl_keyval("INTERRUPT")
X                MESSAGE "Aborting..."
X                LET exit_xref = TRUE
X                EXIT CASE
X           OTHERWISE
X                ERROR ""
X        END CASE
X
X        IF exit_xref THEN
X           LET p_customer.state = p_state[arr_pntr].code
X           EXIT WHILE
X        END IF
X     
X    END WHILE
X
X    CLOSE WINDOW w_state
X    DISPLAY BY NAME p_customer.state ATTRIBUTE (MAGENTA)
X
XEND FUNCTION
X
X
XFUNCTION line_down()
X#
X#  This function handles downward movement in the screen array
X#  a line at a time.  It also provides the visual display of 
X#  movement by setting the display attribute of the current line
X#  to normal, and that of the next to reverse.  In the case where
X#  the next line is not on the current screen page, the screen array
X#  is pushed up one line using SCROLL statement.  If the user is on
X#  last line of the screen array when down arrow or return is pressed,
X#  the screen array is returned to the first page.                  
X#
X
X    IF arr_pntr + 1 > state_cnt THEN
X       LET arr_pntr = 1 
X       CALL show_page()
X       RETURN
X    END IF
X
X    DISPLAY p_state[arr_pntr].code, p_state[arr_pntr].sname
X         TO s_state[scrline].code, s_state[scrline].sname 
X       ATTRIBUTE (NORMAL)
X
X    LET arr_pntr = arr_pntr + 1
X
X    IF scrline + 1 > scrsize THEN
X       SCROLL s_state.* UP
X    ELSE
X       LET scrline = scrline + 1
X    END IF
X
X    DISPLAY p_state[arr_pntr].code, p_state[arr_pntr].sname
X         TO s_state[scrline].code, s_state[scrline].sname 
X       ATTRIBUTE (REVERSE)
X
XEND FUNCTION
X
X
XFUNCTION line_up()
X#
X#  This function handles upward movement in the screen array
X#  a line at a time.  It also provides the visual display of 
X#  movement by setting the display attribute of the current line
X#  to normal, and that of the previous to reverse.  In the case where
X#  the next line is not on the current screen page, the screen array
X#  is pushed down one line using SCROLL statement.  If the user is on
X#  first line of the screen array when up arrow is pressed, the screen 
X#  array is postioned on the last page.                  
X#
X    IF arr_pntr - 1 < 1 THEN
X       IF state_cnt < scrsize THEN
X          LET arr_pntr = 1
X       ELSE
X          LET arr_pntr = state_cnt - (scrsize - 1)
X       END IF
X       CALL show_page()
X       RETURN
X    END IF
X
X    DISPLAY p_state[arr_pntr].code, p_state[arr_pntr].sname
X         TO s_state[scrline].code, s_state[scrline].sname 
X       ATTRIBUTE (NORMAL)
X
X    LET arr_pntr = arr_pntr - 1
X
X    IF scrline - 1 < 1 THEN
X       SCROLL s_state.* DOWN
X    ELSE
X       LET scrline = scrline - 1
X    END IF
X
X    DISPLAY p_state[arr_pntr].code, p_state[arr_pntr].sname
X         TO s_state[scrline].code, s_state[scrline].sname 
X       ATTRIBUTE (REVERSE)
X
XEND FUNCTION
X
X
XFUNCTION show_page()
X#
X#  This fuction displays a full screen of array records with the attribute
X#  set to normal.  The first line on screen is then displayed in reverse.
X#
X
X    DEFINE n,s SMALLINT
X
X    CLEAR FORM 
X    LET n = arr_pntr
X
X    FOR s = 1 TO scrsize
X        DISPLAY p_state[n].code, p_state[n].sname
X             TO s_state[s].code, s_state[s].sname ATTRIBUTE (NORMAL)
X        LET n = n + 1
X        IF n > state_cnt THEN
X           EXIT FOR
X        END IF
X    END FOR
X
X    DISPLAY p_state[arr_pntr].code, p_state[arr_pntr].sname
X         TO s_state[1].code, s_state[1].sname ATTRIBUTE (REVERSE)
X
X    LET scrline = 1
X
XEND FUNCTION
X
X
XFUNCTION page_down()
X#
X#  This function emulates the Informix page down capibility for screen
X#  arrays.  It first determines if the next page will exceed the number
X#  of elements in the array and returns to the first page if this is
X#  true.  Otherwise, the starting postion of the next page is determined
X#  and the show_page() function is used to display the next page.
X#
X
X    IF (arr_pntr - scrline + 1) + scrsize > state_cnt THEN
X       LET arr_pntr = 1
X    ELSE
X       LET arr_pntr = (arr_pntr - scrline + 1) + scrsize
X    END IF
X
X    CALL show_page()
X 
XEND FUNCTION
X
X
XFUNCTION page_up()
X#
X#  This function emulates the Informix page up capibility for screen
X#  arrays.  It first determines if the previous page is outside of the     
X#  array bounds, the last page is displayed.  Otherwise, the starting 
X#  postion of the previous page is determined and the show_page() 
X#  function is used to display the previous page.
X#
X    IF arr_pntr = 1 THEN
X       IF state_cnt < scrsize THEN
X          LET arr_pntr = 1
X       ELSE
X          LET arr_pntr = state_cnt - (scrsize - 1)
X       END IF
X    ELSE
X       IF (arr_pntr - scrline + 1) - scrsize < 1 THEN
X          LET arr_pntr = 1
X       ELSE
X          LET arr_pntr = (arr_pntr - scrline + 1) - scrsize
X       END IF
X    END IF
X
X    CALL show_page()
X
XEND FUNCTION
X
X
XFUNCTION get_pos(match_chars)
X#
X#  This function used to determine the postion in the array of a users
X#  selection.  It checks the first two characters of a string for a match
X#  in the array.  After the first character is matched it continues matching
X#  for the second character until a match is found or the value of the first
X#  character changes.  After the second match, the position is returned.
X#  Visually, what occurs is that if a user types 'AS' and there is no value
X#  matching 'AS' in the array, the pointer is set to the position for the
X#  last row of the array that has 'A' as it's initial letter.
X#
X
X    DEFINE match_chars CHAR(2),
X           x SMALLINT,
X           hold_pos SMALLINT,
X           first_char CHAR(1),
X           second_char CHAR(1)
X
X    LET hold_pos = 0
X
X    FOR x = 1 TO state_cnt
X  
X        LET first_char = p_state[x].code[1,1]
X        LET second_char = p_state[x].code[2,2]
X        IF match_chars[1,1] = first_char THEN
X           IF hold_pos = 0 THEN
X              LET hold_pos = x
X           END IF
X           IF match_chars[2,2] = second_char THEN 
X              RETURN x
X           ELSE
X              LET hold_pos = x
X           END IF
X        END IF
X
X    END FOR
X
X    IF hold_pos > 0 THEN
X       RETURN hold_pos
X    ELSE
X       RETURN 0
X    END IF
X
XEND FUNCTION
X
X
XFUNCTION state_not_valid()
X#
X#  This function queries the state table to determine if the state code
X#  the user entered is valid.  If the state code is not found or the
X#  user left the field blank or null, the function returns TRUE, indicating
X#  that the statehelp() function should be called.
X#
X
X    DEFINE state_test SMALLINT
X
X    LET state_test = 0
X
X    IF p_customer.state IS NULL OR p_customer.state = "  " THEN
X       RETURN FALSE
X    END IF
X
X    SELECT COUNT(*) INTO state_test FROM state
X     WHERE code = p_customer.state
X
X    IF state_test THEN
X       RETURN FALSE
X    ELSE
X       RETURN TRUE
X    END IF
X
XEND FUNCTION
SHAR_EOF
if [ `wc -c < disparr.4gl` -ne     9436 ]
then
    echo "Lengths do not match -- Bad Copy of disparr.4gl"
fi
echo "Extracting file usr_funcs.c"
sed -e 's/^X//' <<\SHAR_EOF > usr_funcs.c
X/* usr_funcs.c
X * This module contains 'C' functions that are used by Informix-4GL
X * at run-time.  They should work with both RAPID and COMPILED 4GL.
X */
X
X#include <malloc.h>
X#include <stdio.h>
X#include <string.h>
X
X#define LT_FOUR_ONE		/* Un-comment if running 4GL versions < 4.10 */
X
X
X/******************************************************************************
X* This function prints whatever is on the screen (including windows).         *
X******************************************************************************/
X
X#define bool		char
X#define CHAR		short
X#define _ATTRIBUTE	(0x7f00)
X#define _CHARACTER	(0x00ff)
X#define _GRAPHMODE	(0x8000)
X
Xtypedef struct window {
X	short	_cury, _curx;
X	short	_maxy, _maxx;
X	short	_begy, _begx;
X	short	_flags;
X	bool	_clear;
X	bool	_leave;
X	bool	_scroll;
X	CHAR	**_y;
X	short	*_firstch;
X	short	*_lastch;
X	short	_attr;
X} WINDOW;
X
Xtypedef struct _efwindow {
X	struct _efwindow *upper, *lower;
X	int *win;
X	int *swin;
X	char *formname;
X	int *winfrm;
X	short rows, columns;
X	short promptline;
X	short msgline;
X	short formline;
X	short cmtline;
X	short flag;
X	short forecolor;
X	unsigned long ucount;
X} _EFwindow;
X
X
Xextern _EFwindow	*topwin, *botwin, *_Wscreen;
Xextern WINDOW		*_efbigwin;
Xextern char	*GB;
X
Xfgl_prtscr(arg)
Xint	arg;
X{
X	register FILE		*fp;
X	register _EFwindow	*scr;
X	register WINDOW		*win;
X	register CHAR		**line, *data;
X	register int	y, x;
X	register char	c;
X	char	*getenv(), *dbprint;
X
X	if ((dbprint = getenv("DBPRINT")) == NULL)
X		dbprint = "lp -s";
X
X	if (topwin == _Wscreen)
X		/* the user is looking at the "screen" */
X
X		win = (WINDOW * ) _Wscreen->win;
X	else {
X		/* the user is looking at the one or more "windows" */
X
X		win = _efbigwin;
X
X		for (scr = botwin; scr != (_EFwindow * )0; 
X		    scr  = (_EFwindow * )scr->upper) {
X			overwrite((WINDOW * ) scr->win, win);
X		}
X	}
X
X	if ((fp = popen(dbprint, "w")) != (FILE * )0) {
X		for (y = 0, line = win->_y; y < win->_maxy; y++, line++) {
X			for (x = 0, data = *line; x < win->_maxx; x++, data++) {
X				c = (char) *data & _CHARACTER;
X
X				if ((*data & _GRAPHMODE) && *GB) {
X					if (c == GB[0])
X						c = '+';
X					else if (c == GB[1])
X						c = '+';
X					else if (c == GB[2])
X						c = '+';
X					else if (c == GB[3])
X						c = '+';
X					else if (c == GB[4])
X						c = '-';
X					else if (c == GB[5])
X						c = '|';
X				}
X				(void)fputc(c, fp);
X			}
X			(void)fputc('\n', fp);
X		}
X		(void)pclose(fp);
X	}
X	return 0;
X}
X
X
X/******************************************************************************
X* This function waits for a key on the keyboard to be hit and returns an      *
X* INTEGER code for that key.                                                  *
X******************************************************************************/
X
Xextern short	eflastkey;
X
Xfgl_getkey(arg)
Xint	arg;
X{
X	extern short	_acckey;
X	short	keyhit;
X
X	eflastkey = ((keyhit = rgetkey()) == _acckey) ? 2016 : keyhit;
X	clrmsg();
X	retlong((long) eflastkey);
X	return(1);
X}
X
X
X#ifdef LT_FOUR_ONE
X/*******************************************************************************
X* This function returns the character value of an environment variable.        *
X*******************************************************************************/
X
Xfgl_getenv(arg)
Xint	arg;
X{
X	char	s[33], *getenv();
X	register int	i;
X
X	popquote(s, sizeof(s));
X	for (i = strlen(s) - 1; i >= 0; i--)
X		if (s[i] == ' ')
X			s[i] = '\0';
X	retquote(getenv(s));
X	return(1);
X}
X
X
X/*******************************************************************************
X* This function returns an INTEGER code for the last key a user hit before the *
X* function was called.                                                         *
X*******************************************************************************/
X
Xfgl_lastkey(arg)
Xint	arg;
X{
X	retlong((long) eflastkey);
X	return(1);
X}
X
X
X/******************************************************************************
X* This function lets you provide a character string or character variable     *
X* which the value obtained by fgl_lastkey() or fgl_getkey() can be compared   *
X* against.  (Informix handles F1 through F64, if you have more than 16        *
X* function keys in your application then you finish keying them in!)          *
X******************************************************************************/
X
Xfgl_keyval(arg)
Xint	arg;
X{
X	char	s[10];
X	register int	i;
X
X	popquote(s, sizeof(s));
X	for (i = strlen(s) - 1; i >= 0; i--)
X		if (s[i] == ' ')
X			s[i] = '\0';
X	if (strlen(s) > 1)
X		rdownshift(s);
X
X	if (!strcmp(s, "control-a"))
X		retlong(1L);
X	else if (!strcmp(s, "control-b"))
X		retlong(2L);
X	else if (!strcmp(s, "control-c"))
X		retlong(3L);
X	else if (!strcmp(s, "control-d"))
X		retlong(4L);
X	else if (!strcmp(s, "control-e"))
X		retlong(5L);
X	else if (!strcmp(s, "control-f"))
X		retlong(6L);
X	else if (!strcmp(s, "control-g"))
X		retlong(7L);
X	else if (!strcmp(s, "control-h"))
X		retlong(8L);
X	else if (!strcmp(s, "control-i"))
X		retlong(9L);
X	else if (!strcmp(s, "control-j"))
X		retlong(10L);
X	else if (!strcmp(s, "control-k"))
X		retlong(11L);
X	else if (!strcmp(s, "control-l"))
X		retlong(12L);
X	else if (!strcmp(s, "control-m") || !strcmp(s, "return"))
X		retlong(13L);
X	else if (!strcmp(s, "control-n"))
X		retlong(14L);
X	else if (!strcmp(s, "control-o"))
X		retlong(15L);
X	else if (!strcmp(s, "control-p"))
X		retlong(16L);
X	else if (!strcmp(s, "control-q"))
X		retlong(17L);
X	else if (!strcmp(s, "control-r"))
X		retlong(18L);
X	else if (!strcmp(s, "control-s"))
X		retlong(19L);
X	else if (!strcmp(s, "control-t"))
X		retlong(20L);
X	else if (!strcmp(s, "control-u"))
X		retlong(21L);
X	else if (!strcmp(s, "control-v"))
X		retlong(22L);
X	else if (!strcmp(s, "control-w"))
X		retlong(23L);
X	else if (!strcmp(s, "control-x"))
X		retlong(24L);
X	else if (!strcmp(s, "control-y"))
X		retlong(25L);
X	else if (!strcmp(s, "control-z"))
X		retlong(26L);
X	else if (!strcmp(s, "esc") || !strcmp(s, "escape"))
X		retlong(27L);
X	else if (strlen(s) == 1)
X		retlong((long) s[0]);
X	else if (!strcmp(s, "up"))
X		retlong(2000L);
X	else if (!strcmp(s, "down"))
X		retlong(2001L);
X	else if (!strcmp(s, "left"))
X		retlong(2002L);
X	else if (!strcmp(s, "right"))
X		retlong(2003L);
X	else if (!strcmp(s, "nextpage"))
X		retlong(2005L);
X	else if (!strcmp(s, "prevpage"))
X		retlong(2006L);
X	else if (!strcmp(s, "insert"))
X		retlong(2009L);
X	else if (!strcmp(s, "delete"))
X		retlong(2010L);
X	else if (!strcmp(s, "interrupt"))
X		retlong(2011L);
X	else if (!strcmp(s, "accept"))
X		retlong(2016L);
X	else if (!strcmp(s, "f1"))
X		retlong(3000L);
X	else if (!strcmp(s, "f2"))
X		retlong(3001L);
X	else if (!strcmp(s, "f3"))
X		retlong(3002L);
X	else if (!strcmp(s, "f4"))
X		retlong(3003L);
X	else if (!strcmp(s, "f5"))
X		retlong(3004L);
X	else if (!strcmp(s, "f6"))
X		retlong(3005L);
X	else if (!strcmp(s, "f7"))
X		retlong(3006L);
X	else if (!strcmp(s, "f8"))
X		retlong(3007L);
X	else if (!strcmp(s, "f9"))
X		retlong(3008L);
X	else if (!strcmp(s, "f10"))
X		retlong(3009L);
X	else if (!strcmp(s, "f11"))
X		retlong(3010L);
X	else if (!strcmp(s, "f12"))
X		retlong(3011L);
X	else if (!strcmp(s, "f13"))
X		retlong(3012L);
X	else if (!strcmp(s, "f14"))
X		retlong(3013L);
X	else if (!strcmp(s, "f15"))
X		retlong(3014L);
X	else if (!strcmp(s, "f16"))
X		retlong(3015L);
X	else
X		retlong(0L);
X
X	return(1);
X}
X#endif /* LT_FOUR_ONE */
X
X
X/******************************************************************************
X* These four(4) functions handle the dynamic rowid array for all standard     *
X* 4GL screens.                                                                *
X******************************************************************************/
X
Xstatic long	*ptr;
X
Xi_rowid_s(arg)
Xint	arg;
X{
X	ptr = (long *)malloc(sizeof(long));
X	return(0);
X
X}
X
X
Xr_rowid_s(arg)
Xint	arg;
X{
X	int	pos;
X
X	popint(&pos);
X	retint(ptr[pos]);
X	return(1);
X}
X
X
Xs_rowid_s(arg)
Xint	arg;
X{
X	int	size;
X
X	popint(&size);
X	if ((ptr = (long *)realloc((char *)ptr, (unsigned)(size + 1) * sizeof(long))) != NULL)
X		retint(0);
X	else
X		retint(1);
X	return(1);
X}
X
X
Xw_rowid_s(arg)
Xint	arg;
X{
X	int	pos, value;
X
X	popint(&value);
X	popint(&pos);
X	ptr[pos] = value;
X	return(0);
X}
X
X
SHAR_EOF
if [ `wc -c < usr_funcs.c` -ne     8049 ]
then
    echo "Lengths do not match -- Bad Copy of usr_funcs.c"
fi
echo "Done."