PreviousTutorial - ACCEPT/DISPLAY

Appendix B: Examples and Sample Programs

This chapter contains examples and sample code to illustrate details given in earlier chapters. They should be read in conjunction with the earlier chapters, and not viewed as standalone code.

B.1 Enhanced ACCEPT/DISPLAY

working-storage section.
01 a-screen-text.
	  03 cust-name-text		pic x(14) value "Customer name".
	  03 filler				pic x(20).
	  03 cust-number-text 	pic x(16) value "Customer amount".
01 a-screen-data redefines a-screen-text.
	  03 filler				pic x(14).
	  03 customer-name		pic x(20).
	  03 filler				pic x(16).
	  03 customer-amount	pic z9.9.
01 ws-customer-amount	pic 99v9.
procedure division.
run-start.
	  move zero to customer-amount
	  display a-screen-text at line 12 column 1
	  accept a-screen-data at line 12 column 1
	  move customer-amount to ws-customer-amount
	  perform until ws-customer-amount not=zero
        display "Customer amount must not be zero"
                at line 25 column 1 with bell
        display customer-amount at line 12 column 51
                with reverse-video blink
        accept a-screen-data at line 12 column 1
        move customer-amount to ws-customer-amount
    end-perform
    stop run.

B.2 ANSI ACCEPT/DISPLAY

 working-storage section.
 01 a-field   pic 9999.
 procedure division.
 run-start.
     accept a-field
     display "A-Field=" a-field
     stop run.

B.3 CALL Statement

call x"AF" using set-bit-pairs
                 parameter-block

where the parameters are defined as follows:

01 set-bit-pairs 	      	pic 9(2) comp-x value 1.
01 parameter-block.
   03 bit-pair-setting   pic 9(2) comp-x.
   03 bit-map-section 	  pic x value "2".
   03 bit-pair-number	  	pic 9(2) comp-x.
   03 filler				         pic 9(2) comp-x value 1.

The values to be set for the fields bit-pair-setting and bit-pair-number vary according to the function you want to perform. The required values for these two parameters are given in the individual descriptions.

With all x"AF" calls, if an error occurs,set-bit-pairs is set to the value 255 on return from the call.

B.4 CRT Status Clause Syntax

special-names
	crt status is key-status

Where key-status is a three-byte data item in the Working-Storage Section of your program with the following definition:

 01 key-status.
 		 03 key-type		  pic x.
 		 03 key-code-1		pic 9(2) comp-x.
 		 03 key-code-2		pic 9(2) comp-x.

Whenever an ACCEPT statement is executed, key-status is set to indicate how the ACCEPT was terminated. In general, the individual fields in key-status have the following uses:

key-type Indicates how the ACCEPT was terminated. The values returned are as follows :
"0" Normal termination of the ACCEPT.
"1" Termination by a user function key.
"2" Termination by an enhanced ACCEPT/DISPLAY syntax key.
"3" Termination by an 8-bit data key.
"4" Termination by a 16-bit data key.
"5" Termination by a shift key.
"6" Termination by a lock key.
"9" Error.
key-code-1 Indicates the number of the key that terminated the ACCEPT operation. The exact meaning of this number depends on the value returned in key-type.
key-code-2 If key-type and key-code-1 are 0, key-code-2 contains the raw keyboard code for the key that terminated the ACCEPT operation. Where a sequence of keystrokes rather than a single key has been configured to perform a single function, only the code for the first keystroke is returned.
If key-type is 4, key-code-2 contains the second byte of the character which caused the ACCEPT operation to terminate.
Otherwise, the contents of key-code-2 are undefined.

B.5 Using Library Routines to Create a Character User Interface

This example writes an 80-byte string of text and attributes to the screen. The text appears on the top line of the screen.

 working-storage section.
 01 screen-position.
     03 screen-row       pic 9(2) comp-x value 0.
     03 screen-col       pic 9(2) comp-x value 0.
 01 string-length        pic 9(4) comp-x value 80.
 01 character-buffer     pic x(80).
 01 attribute-buffer     pic x(80).
 procedure division.
     move all "x" to character-buffer
     move all x"70" to attribute-buffer
     call "CBL_WRITE_SCR_CHATTRS" using screen-position
                                        character-buffer
                                        attribute-buffer
                                        string-length

B.6 MODE IS BLOCK Clause

Consider the following group item:

 01 display-item.
  03 display-item-1     pic x(20).
  03 filler             pic x(35).  
  03 display-item-2     pic 9(10).
  03 filler             pic x(105). 
  03 display-item-3     pic z(4)9.

If the following statement is executed:

display display-item at 0101 mode is block.

display-item is treated as if it is an elementary item defined as:

01 display-item  	pic x(175).

Consequently, the contents of the FILLER items are also displayed.

B.7 Using the Screen Section to Create a Character User Interface

Click the button to start Net Express and load the demonstration project.

      $set ans85

****************************************************************
* Copyright Micro Focus Limited 1994.    All Rights Reserved.  *
* This demonstration program is provided for use by users of   *
* Micro Focus products and may be used, modified and           *
* distributed as part of your application provided that you    *
* properly acknowledge the copyright of Micro Focus in this    *
* material.                                                    *
****************************************************************

****************************************************************
*                                                              *
* ADSAMP.CBL                                                   *
*                                                              *
* This program assumes that the default                        *
* configuration has been selected using Adiscf.                *
****************************************************************

  special-names.
      cursor is cursor-position
      crt status is key-status.

  data division.
  working-storage section. 

 **************************************************
 * Parameters to be used for the x"AF" calls.
 **************************************************
  
  01 set-bit-pairs                 pic 9(2) comp-x value 1.
  01 get-single-character          pic 9(2) comp-x value 26.
  
  01 enable-esc-and-f1.
      03 filler                    pic 9(2) comp-x value 1.
      03 filler                    pic x value "1".
      03 filler                    pic 9(2) comp-x value 0.
      03 filler                    pic 9(2) comp-x value 2.
  
  01 disable-all-other-user-keys.
      03 filler                    pic 9(2) comp-x value 0.
      03 filler                    pic x value "1".
      03 filler                    pic 9(2) comp-x value 2.
      03 filler                    pic 9(2) comp-x value 126.
  
  
  01 enable-slash-key.
      03 filler                    pic 9(2) comp-x value 1. 
      03 filler                    pic x value "3".
      03 filler                    pic x value "/".
      03 filler                    pic 9(2) comp-x value 1. 

 **************************************************
 * Status returned after termination of an ACCEPT.
 **************************************************
  01 key-status.
      03 key-type                  pic x.
      03 key-code-1                pic 9(2) comp-x.
      03 key-code-1-x              redefines key-code-1 pic x.
      03 key-code-2                pic 9(2) comp-x.
  
 **************************************************
 * Cursor-Position is returned by ADIS containing 
 * the position of the cursor when the ACCEPT was 
 * terminated.
 ***************************************************
  01 cursor-position.
      03 cursor-row                pic 99.
      03 cursor-column             pic 99.
  
 **************************************************
 * Work areas used by the program.
 ************************************************** 
  01 work-areas.
      03 wa-name                   pic x(30).
      03 wa-address-line-1         pic x(40).
      03 wa-address-line-2         pic x(40).
      03 wa-address-line-3         pic x(40).
      03 wa-address-line-4         pic x(40).
      03 wa-age                    pic 999 value 0.
  
  01 exit-flag                     pic 9(2) comp-x value 0.
  
  
 **************************************************
 * Screen Section.
 **************************************************
  screen section.
  
  01 main-screen.
      03 blank screen.
      03 line 2 column 27 
          value "Typical Data Entry Screen".
      03 line 3 column 27 
          value "-------------------------".
      03 line 5 column 1 value "name     [".
      03 pic x(30) using wa-name highlight prompt " ".
      03 value "]".
      03 line 7 column 1 value "address  [".
      03 pic x(40) using wa-address-line-1 highlight prompt " ".
      03 value "]".
      03 line 8 column 1 value "         [".
      03 pic x(40) using wa-address-line-2 highlight prompt " ".
      03 value "]".
      03 line 9 column 1 value "         [".
      03 pic x(40) using wa-address-line-3 highlight prompt " ".
      03 value "]".
      03 line 10 column 1 value "         [".
      03 pic x(40) using wa-address-line-4 highlight prompt " ".
      03 value "]".
      03 line 12 column 1 value "age      [".
      03 pic zz9 using wa-age highlight prompt " ".
      03 value "]".
      03 line 20 column 1 value
         "---------------------------------------------------------
 -       "----------------------------------------".
      03 line 21 column 1 value "f1" highlight.
      03 value "=/help".
      03 column 75 value "esc" highlight.
      03 value "ape".
  
  01 help-screen.
      03 blank screen.
      03 line 1 column 34 value "help screen".
      03 line + 1 column 34 value "-----------".
      03 line 4 value "escape" highlight.
      03 value "     leave this program.".
      03 line 6 column 1 value "f1 or /h" highlight.
      03 value "   obtains this screen.".
      03 line 8 column 1 
          value "use cursor keys to move around ".
      03 value "the fields on the screen". 
      03 value "enter will".
      03 line + 1 column 1 value "accept the data ".
      03 value " present new blank form to fill in.".
      03 line 24 column 25 
          value "press any key to continue ...".
  
 **************************************************
 * Procedure Division.
 **************************************************
  
  procedure division.
  entry-point section.
  
 * First we want to ensure that the keys are enabled as we want
 * them. Enable the Escape and F1 keys.
  
      call x"AF" using set-bit-pairs 
                       enable-esc-and-f1
  
 * disable every other user function key. 
      call x"AF" using set-bit-pairs
                       disable-all-other-user-keys
  
 * set up "/" key to act as a function key and terminate 
 * the ACCEPT operation.
  
      call x"AF" using set-bit-pairs 
                       enable-slash-key
  
 * Now ensure that the cursor position will be returned when an
 * ACCEPT is terminated. Setting to row 1, column 1 will ensure
 * that the cursor will be initially positioned at the start of 
 * the first field.
  
      move 1 to cursor-row
      move 1 to cursor-column
  
 * Loop until the Escape key is pressed.
  
      perform until exit-flag = 1
          display main-screen
          accept main-screen
          evaluate key-type
            when "0"
  
 * The ACCEPT operation terminated normally; that is the Enter key
 * was pressed. In this case, we simply blank out the work areas
 * and restart in the first field.
  
              initialize work-areas
              move 1 to cursor-row
              move 1 to cursor-column
  
            when "1"
  
 * A user function key has been pressed. This will either be
 * Escape or F1 as all others have been disabled.
  
              if key-code-1 = 0
 
 * Escape has been pressed, so we wish to leave the program.
  
                  move 1 to exit-flag
              else
 
 * F1 has been pressed so display the help screen. 
                  perform display-help-screen
             end-if
  
            when "3"
  
 * A data key has terminated the ACCEPT operation. It must be "/"
 * as no other keys have been enabled to do this. Now get the 
 * next character to see if "H" or "h" has been pressed.
  
              call x"AF" using get-single-character
                               key-status
              if key-type = "3" and
                (key-code-1-x = "h" or 
                 key-code-1-x = "H")
                  perform display-help-screen
              end-if
  
          end-evaluate
      end-perform
      stop run.
  
  display-help-screen section.
 
 * Display the help screen and then wait for a key to be pressed.
  
      display help-screen
      call x"AF" using get-single-character
                       key-status.

B.8 Changing Program Mappings

The following code changes the action of the Backspace key (key number 14) to simply move the cursor to the left (function 3), and changes the Tab key (key number 8) to perform theTab function (function 8):

* Change mapping of Backspace key
     move 14 to adis-key-number
     move 3 to adis-mapping-byte
     call x"AF" using set-map-byte
                      adis-key-mapping
* Change mapping of the tab key
     move 8 to adis-key-number
     move 8 to adis-mapping-byte
     call x"AF" using set-map-byte
                      adis-key-mapping

B.9 Configuring Adis to Terminate an ACCEPT

The following is an example of configuring the enhanced ACCEPT/DISPLAY syntax to terminate an ACCEPT operation.

accept data-item at 0101
if key-type="0"
		if key-code-1=48
             display "Terminated by return key"
      else
             display "Terminated by auto-skip last field"
      end-if
end-if.

B.10 Detecting Adis Keys

The following code sets up Tab and Backtab to act as function keys and the Ü and Þ keys to act as function keys if they cause the cursor to leave the field.

* Set up Tab (key 8) and Backtab (Key 9) to act as function keys
     move 1 to adis-key-setting
     move 8 to first-adis-key
     move 2 to number-of-adis-keys
     call x"AF" using set-bit-pairs
                      adis-key-control
* Set up cursor-left (key 3) and cursor-right (key 4) to act as
* function keys ONLY if they cause the cursor to leave the field.
     move 3 to adis-key-setting
     move 3 to first-adis-key
     move 2 to number-of-adis-keys
     call x"AF" using set-bit-pairs
                      adis-key-control
     accept data-item at 0101
		if key-type="2"
       evaluate key-code-1
         when 3
          display "cursor-left caused the cursor to
-          "leave the field"
         when 4
           display "cursor right caused the cursor to
-          "leave the field"
         when 8
          display "the tab key was pressed"
         when 9
          display "the back tab key was pressed"
       end-evaluate
     end-if.

B.11 Detecting Data Keys Set up to act as Function Keys

* Set up the characters "A" through "Z" to terminate the
* ACCEPT operation
     move 1 to data-key-setting
     move "A" to first-data-key
     move 26 to number-of-data-keys
     call x"AF" using set-bit-pairs
                      data-key-control
		accept data-item at 0101
		if key-type="3"
        evaluate key-code-1
          when 65
            display "A pressed"
          when 66
            display "B pressed"
          when 90
            display "Z pressed"
        end-evaluate
     end-if.

B.12 Detecting User Function Keys

The following code detects which function key is pressed, assuming that the only enabled function keys are Escape,F1 and F10:

	accept data-item at 0101
	if key-type="1"
         evaluate key-code-1
           when 0
             display "escape was pressed"
           when 1
             display "F1 was pressed"
           when 10
             display "F10 was pressed"
         end-evaluate
     end-if.

B.13 Using Function Keys - Sample Program

The following is an example of how to write programs that make use of function keys. It assumes that Escape is available, but any other function key can be selected either by pressing the function key or by pressing a slash (/) followed by the first letter of the option.

$set ans85
**************************************************
* This program assumes that the default 
* configuration has been selected using Adiscf.
***************************************************

 special-names.
     cursor is cursor-position
     crt status is key-status.
 data division.
 working-storage section. 
**************************************************
* Parameters to be used for the x"AF" calls.
**************************************************

 01 set-bit-pairs 			pic 9(2) comp-x value 1.
 01 get-single-character 	pic 9(2) comp-x value 26.

 01 enable-esc-and-f1.
    03 filler				pic 9(2) comp-x value 1.
    03 filler				pic x value "1".
    03 filler				pic 9(2) comp-x value 0.
    03 filler   				pic 9(2) comp-x value 2.
 01 disable-all-other-user-keys.
    03 filler  				pic 9(2) comp-x value 0.
    03 filler   				pic x value "1".
    03 filler  				pic 9(2) comp-x value 2.
    03 filler  				pic 9(2) comp-x value 126.

 01 enable-slash-key.
    03 filler  				pic 9(2) comp-x value 1. 
    03 filler    			pic x value "3".
    03 filler				pic x value "/".
    03 filler				pic 9(2) comp-x value 1. 
**************************************************
* Status returned after termination of an ACCEPT.
**************************************************
 01 key-status.
    03 key-type  			pic x.
    03 key-code-1  			pic 9(2) comp-x.
    03 key-code-1-x  		redefines key-code-1 pic x.
    03 key-code-2  			pic 9(2) comp-x.

**************************************************
* Cursor-Position is returned by Adis containing 
* the position of the cursor when the ACCEPT was 
* terminated.
***************************************************
 01 cursor-position.
    03 cursor-row  			pic 99.
    03 cursor-column  		pic 99.

**************************************************
* Work areas used by the program.
************************************************** 
 01 work-areas.
    03 wa-name   			pic x(30).
    03 wa-address-line-1  	pic x(40).
    03 wa-address-line-2  	pic x(40).
    03 wa-address-line-3  	pic x(40).
    03 wa-address-line-4  	pic x(40).
    03 wa-age  				pic 999 value 0.

 01 exit-flag   				pic 9(2) comp-x value 0.
**************************************************
* Screen Section. 
**************************************************
 screen section. 

 01 main-screen. 
    03 blank screen. 
    03 line 2 column 27 
        value "Typical Data Entry Screen".
    03 line 3 column 27 
        value "-------------------------".
    03 line 5 column 1 value "name     [".
    03 pic x(30) using wa-name highlightprompt " ".
    03 value "]".
    03 line 7 column 1 value "address  [".
    03 pic x(40) using wa-address-line-1 highlight prompt " ".
    03 value "]".
    03 line 8 column 1 value "         [".
    03 pic x(40) using wa-address-line-2 highlight prompt " ".
    03 value "]".
    03 line 9 column 1 value "         [".
    03 pic x(40) using wa-address-line-3 highlight prompt " ".
    03 value "]".
    03 line 10 column 1 value "         [".
    03 pic x(40) using wa-address-line-4 highlight prompt " ".
    03 value "]".
    03 line 12 column 1 value "age      [".
    03 pic zz9 using wa-age highlight prompt " ".
    03 value "]".
    03 line 20 column 1 value
       "------------------------------------
-      "----------------------------------------".
    03 line 21 column 1 value "f1" highlight. 
    03 value "=/help".
    03 column 75 value "esc" highlight. 
    03 value "ape".
 01 help-screen. 
    03 blank screen. 
    03 line 1 column 34 value "help screen".
    03 line + 1 column 34 value "-----------".
    03 line 4 value "escape" highlight. 
    03 value "     leave this program.". 
    03 line 6 column 1 value "f1 or /h" highlight. 
    03 value "   obtains this screen.". 
    03 line 8 column 1 
        value "use cursor keys to move around ".
    03 value "the fields on the screen". 
    03 value "enter will".
    03 line + 1 column 1 value "accept the data ".
    03 value " present new blank form to fill in.". 
    03 line 24 column 25 
        value "press any key to continue ...". 

**************************************************
* Procedure Division. 
**************************************************

 procedure division. 
 entry-point section. 

* First we want to ensure that the keys are enabled as we want
* them. Enable the Escape and F1 keys. 

     call x"AF" using set-bit-pairs 
                      enable-esc-and-f1

* disable every other user function key. 
     call x"AF" using set-bit-pairs
                      disable-all-other-user-keys

* set up "/" key to act as a function key and terminate 
* the ACCEPT operation. 

     call x"AF" using set-bit-pairs 
                      enable-slash-key

* Now ensure that the cursor position will be returned when an
* ACCEPT is terminated. Setting to row 1, column 1 will ensure
* that the cursor will be initially positioned at the start of 
* the first field. 

     move 1 to cursor-row
     move 1 to cursor-column

* Loop until the Escape key is pressed. 

     perform until exit-flag = 1
         display main-screen
         accept main-screen
         evaluate key-type
           when "0"


* The ACCEPT operation terminated normally; that is the Enter 
key
* was pressed. In this case, we simply blank out the work areas
* and restart in the first field. 

             initialize work-areas
             move 1 to cursor-row
             move 1 to cursor-column

           when "1"

* A user function key has been pressed. This will either be
* Escape or F1 as all others have been disabled.

             if key-code-1 = 0

* Escape has been pressed, so we wish to leave the program. 

                 move 1 to exit-flag
            else

* F1 has been pressed so display the help screen. 
                 perform display-help-screen
            end-if

           when "3"
* A data key has terminated the ACCEPT operation. It must be "/"
* as no other keys have been enabled to do this. Now get the 
* next character to see if "H" or "h" has been pressed. 

             call x"AF" using get-single-character
                              key-status
             if key-type = "3" and
               (key-code-1-x = "h" or 
                key-code-1-x = "H")
                 perform display-help-screen
             end-if

         end-evaluate
     end-perform
     stop run. 

display-help-screen section. 

* Display the help screen and then wait for a key to be pressed. 

     display help-screen
     call x"AF" using get-single-character
                      key-status.


Copyright © 2000 MERANT International Limited. All rights reserved.
This document and the proprietary marks and names used herein are protected by international law.

PreviousTutorial - ACCEPT/DISPLAY