      ************************************************************************
      * Copyright (C) 1984-1999 Micro Focus International Ltd.
      * All rights reserved.
      *  
      * This demonstration program is provided for use by users of 
      * Micro Focus products (the "Software") 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.
      *     
      * All conditions, warranties and undertakings, express or implied, 
      * statutory or otherwise, on the part of Micro Focus are excluded, 
      * including without limitation those of merchantability or fitness  
      * for purpose. This shall not, however, purport to exclude or 
      * restrict the liability of Micro Focus to any extent not 
      * permitted by law.
      *
      * IN NO EVENT WILL MICRO FOCUS BE LIABLE FOR ANY INDIRECT, 
      * INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT 
      * OF THE USE OF THE DEMONSTRATION PROGRAM DISTRIBUTED WITH THE 
      * SOFTWARE, WHETHER OR NOT INFORMED OF THE POSSIBILITIES OF 
      * DAMAGES IN ADVANCE.  THESE LIMITATIONS APPLY TO ALL CAUSES OF 
      * ACTION, INCLUDING BREACH OF CONTRACT, BREACH OF WARRANTY, STRICT
      * LIABILITY, AND ANY ACTIONS IN TORTS.
      ************************************************************************
      *                                                              
      *  Demonstration of COBOL multi-threading features
      *                                                              
      *  @(#)SERVUI.CBL	1.4
      *                                                              
      *  Last Modified on 96/08/29 at 10:50:46
      ************************************************************************

	identification division.
	program-id.  servui.

        environment division.
	special-names.   console is crt.

	data division.
	working-storage section.
	*>
	78  78-RETURN-OBJECT-BUSY       value 1010.

        copy "servdisp.cpy".

	copy "servwrk.cpy".

	*>
	*>  Miscellaneous work variables.
	*>
        01  .
	    05  hold-request-type          pic x.
	    05  service-poll-return     pic x comp-x.
	    05  execution-state         pic x.
	      88  execution-state-running  value 'R'.
	      88  execution-state-exiting  value 'E'.
	      88  execution-state-exited   value 'X'.
 
        *>
        *>  Some status message templates
        *>
        01  work-msg1.
  	    05  filler    pic x(10) value 'Completed '.
	    05  work-id1  pic 99.
	    05  filler    pic x(11)  value ' - retcode '.
	    05  work-rc1  pic Z9.

        01  work-msg2.
	    05  filler    pic x(10)  value 'Started '.
	    05  work-id2  pic 99.

	*>
	*>  Variables for handling keyboard input
	*>
	01 .
	  05  key-status              pic x comp-x.
	  05  key-read                pic x.

	*>
	*>  Work variables for menu and screen access
	*>
	01 .
	  05  csr-row-col.
	      10  csr-row              pic x comp-x.
	      10  csr-col              pic x comp-x.

	  78  78-cvert                   value '1'.
	  78  78-rhorz                   value '2'.
	  78  78-rcdiagl                 value '3'.
	  78  78-rcdiagr                 value '4'.
	  78  78-doexit                  value 'E'.

          78  78-menu-status-lines      value 5.
          78  78-menu-lines             value 13.
	  78  78-menu-width             value 42.

	  78  78-menu-prompt-len        value 37.
	  78  78-menu-status-len        value 11.

	  78  78-menu-picx              value 78-menu-lines
	  				     * 78-menu-width.

	  05  menu-row-len           pic xx comp-x 
	  			      value 78-menu-width.
	  05  menu-menu.
	    10  menu-value           pic x(78-menu-picx)  value 
	            '      Enter direction of movement ->      ' &
		    '------------------------------------------' &
		    '            ' &
 	            78-cvert   & ') Vertical                   ' &
		    '            ' &
	            78-rhorz   & ') Horizontal                 ' &
		    '            ' &
	            78-rcdiagl & ') Diagonal left              ' &
		    '            ' &
	            78-rcdiagr & ') Diagonal right             ' &
		    '            ' &
	            78-doexit  & ') EXIT                       ' &
	            '------------------------------------------' &
		    ' Status ->                                '.
            10  menu-item  redefines menu-value
	                    occurs 78-menu-lines  
			    indexed by menu-i
			              pic x(78-menu-width).

          78  78-menu-status-msg-len  value 78-menu-width
	                                    - 78-menu-status-len.
          05  menu-status-msg        pic x(78-menu-status-msg-len).
	  05  menu-status-msg-len    pic xx comp-x
	  			      value 78-menu-status-msg-len.
	  05  menu-status-work       pic x(78-menu-status-msg-len).
	  05  menu-status-row        pic xx comp-x.

	procedure division.
	main section.
	docode.
	    *>***********************************************************<*
	    *> Initialize display controlling mutex, some Global display
	    *>  settings and make sure we have enough screen real-estate 
	    *>  for program operation.
	    *>***********************************************************<*
            open disp-mutex

	    call 'CBL_CLEAR_SCR'        using ' ' x'07'

	    call 'CBL_GET_SCR_SIZE'     using disp-dim-row
	    			              disp-dim-col
            if  disp-dim-row <= 78-menu-lines
	    or  disp-dim-col <= 78-menu-width
		display 'Screen size too small for program operation.' 
		     & '  Exiting... '

		move 78-SERVICE-EXIT       to hold-request-type
		perform service-request

		perform service-poll 
		  until service-poll-return not = 0

		perform service-acknowledge

		go to doexit
	    end-if


	    *>***********************************************************<*
	    *> Compute start row and column for menu display,
	    *>  set the 'reserved' menu area of the screen
	    *>  and finally display the text menu
	    *>***********************************************************<*
	    compute disp-res-srow
		    csr-row   = disp-dim-row 
	    		      - 78-menu-lines
	    compute disp-res-scol
	            csr-col   = (disp-dim-col / 2) 
	    		      - (78-menu-width / 2)
	    compute disp-res-ecol = csr-col + 78-menu-width - 1
	    compute disp-res-erow = csr-row + 78-menu-lines - 1
	    compute menu-status-row = disp-res-erow 
	    			    - 78-menu-status-lines + 1
	    perform varying menu-i from 1 by 1 
	            until   menu-i > 78-menu-lines
		call 'CBL_SET_CSR_POS'    using csr-row-col
	    	call 'CBL_WRITE_SCR_TTY'  using menu-item(menu-i)
						menu-row-len
						
		                                
		add 1                        to csr-row
    	    end-perform


	    *>***********************************************************<*
	    *> Cycle through prompting and giving status
	    *>***********************************************************<*
	    set execution-state-running      to true
	    perform until exit
		compute csr-row   = disp-res-srow
		compute csr-col   = disp-res-scol
				  + 78-menu-prompt-len

		perform display-acquire
		call 'CBL_SET_CSR_POS'     using csr-row-col
		call 'CBL_WRITE_SCR_TTY'   using ' '
						X'0001'
		perform display-release

		*>
		*> Two steps here 
		*>  - Check for service completion and respond to messages
		*>    from the server.
		*>  - Check for user interaction and send server requests
		*>    in turn.
		*>
		perform until exit

		    perform handle-server
		    if  execution-state-exited
		    	go to doexit
		    end-if

		    compute csr-row   = disp-res-srow
		    compute csr-col   = disp-res-scol
				      + 78-menu-prompt-len
		    perform display-acquire
		    call 'CBL_SET_CSR_POS'     using csr-row-col
		    call 'CBL_GET_KBD_STATUS'  using key-status
		    if  key-status not = 0 
			exit perform
		    end-if
		    perform display-release

		    call 'CBL_THREAD_YIELD'
		end-perform

		call 'CBL_READ_KBD_CHAR'   using key-read
		call 'CBL_TOUPPER'         using key-read
					by value 1
		call 'CBL_WRITE_SCR_TTY'   using key-read
						 X'0001'
		perform display-release

		*>
		*>  If we are exiting then don't respond to key strokes
		*>  ... let the user know we are still waiting an exit
		*>
                if  execution-state-exiting
		    move 'Still waiting for server exit...'
		    			     to menu-status-msg
		    perform menu-status-display
		    exit perform cycle
		end-if

		perform handle-user

	    end-perform
	    next sentence.

        doexit.
	    close disp-mutex
	    call 'CBL_THREAD_EXIT'  using by value 0
	    exit program 
	    stop run.

        *>****************************************************************<*
        *>                                                                <*
        *> Handle service polls and status messages returned from         <*
        *>  the server.                                                   <*
        *>                                                                <*
        *>****************************************************************<*

	handle-server section.
	    perform service-poll
	    if  service-poll-return = 1
		evaluate  service-done-type
		when 78-DONE-ABORT 
		    move 'Unable to start service '
					to menu-status-msg
		    perform menu-status-display
		when 78-DONE-STARTED
		    move service-done-id to work-id2
		    move work-msg2       to menu-status-msg
		    perform menu-status-display

		when 78-DONE-FINISHED
		    move service-done-id to work-id1
		    move service-done-rc to work-rc1
		    move work-msg1       to menu-status-msg
		    perform menu-status-display
			    
		when 78-DONE-EXIT
		    move '... server is letting us exit'
					to menu-status-msg
		    perform menu-status-display
		    set execution-state-exited
		    			to true

		when other
		    move 'Bad poll...'  to menu-status-msg
		    perform menu-status-display
		end-evaluate
		perform service-acknowledge

		compute csr-row   = disp-res-srow
		compute csr-col   = disp-res-scol
				  + 78-menu-prompt-len
	    end-if
	    exit section.

        *>****************************************************************<*
        *>                                                                <*
        *> Handle user requests as submitted in key-read...               <*
        *>                                                                <*
        *>****************************************************************<*

	handle-user section.
	    evaluate key-read
	    when 78-cvert
		move 'Vertical...'       to menu-status-msg
		perform menu-status-display

		move 78-SERVICE-VERT     to hold-request-type
		perform service-request

	    when 78-rhorz
		move 'Horizontal...'     to menu-status-msg
		perform menu-status-display

		move 78-SERVICE-HORIZ    to hold-request-type
		perform service-request

	    when 78-rcdiagl
		move 'Diagonal left...'  to menu-status-msg
		perform menu-status-display

		move 78-SERVICE-LDIAG    to hold-request-type
		perform service-request

	    when 78-rcdiagr
		move 'Diagonal right...' to menu-status-msg
		perform menu-status-display

		move 78-SERVICE-RDIAG    to hold-request-type
		perform service-request

	    when 78-doexit
		move 'Waiting for server exit...' 
					 to menu-status-msg
		perform menu-status-display

		move 78-SERVICE-EXIT     to hold-request-type
		perform service-request

		set execution-state-exiting to true
	    when other
		move 'Invalid command!'  to menu-status-msg
		perform menu-status-display
	    end-evaluate
	    exit section.

        *>****************************************************************<*
        *>                                                                <*
        *> Status message display...  Handle scrolling and the like.      <*
        *>                                                                <*
        *>****************************************************************<*
	menu-status-display section.
	    
	    perform display-acquire

	    compute csr-row   = disp-res-erow - 1
	    compute csr-col   = disp-res-scol + 78-menu-status-len

	    perform until csr-row < menu-status-row
		call 'CBL_READ_SCR_CHARS'  using csr-row-col
					         menu-status-work
						 menu-status-msg-len
		add 1    to csr-row 
		call 'CBL_WRITE_SCR_CHARS' using csr-row-col
					         menu-status-work
						 menu-status-msg-len
		subtract 2                  from csr-row
	    end-perform 

	    add 1                             to csr-row
	    call 'CBL_SET_CSR_POS'         using csr-row-col
	    call 'CBL_WRITE_SCR_TTY'       using menu-status-msg
					         menu-status-msg-len
	    perform display-release
	    exit section.

        *>****************************************************************<*
        *>                                                                <*
        *> Handle exclusion on the screen....                             <*
        *>                                                                <*
        *>****************************************************************<*
	display-acquire section.
            set disp-mutex		to on
	    exit section.

	display-release section.
            set disp-mutex		to off
	    exit section.

        *>****************************************************************<*
        *>                                                                <*
        *> Service Request - Issue a request to the server for an         <*
        *>                   operation of some sort.                      <*
        *>                                                                <*
        *>****************************************************************<*
	service-request section.


	    perform until exit
	        *>
		*> Service provider will make sure that this flag is up
		*>  when a request can be handled - wait until it is
		*>  but make sure that the server can still send us 
		*>  messages before he is ready to accept a request...
		*>
		call 'CBL_SEMAPHORE_ACQUIRE'   using 
					    by value service-req-sem
						     h'01'
		if  return-code = 0 
		    exit perform
		end-if
		if  return-code not = 78-RETURN-OBJECT-BUSY
		    call 'CBL_ERROR_API_REPORT' using
				    by value return-code
				by reference 'CBL_SEMAPHORE_ACQUIRE'
		end-if

		perform handle-server

		call 'CBL_THREAD_YIELD'
	    end-perform

	    *>
	    *> Provider is ready for our packet and we won't destroy
	    *>  a previous value there - fill in packet
	    *>
	    move hold-request-type            to service-req-type

	    *>
	    *> Tell the service provider that he can check for a
	    *>  request - there's one there
	    *>
	    set service-req-ack-sem     up by 1
	    exit section.

        *>****************************************************************<*
        *>                                                                <*
        *> Service Poll    - Check for messages from the server and       <*
        *> Service Ack     -  after we handle them, acknowledge that we   <*
	*>                    are ready for more work                     <*
        *>                                                                <*
        *>****************************************************************<*
	service-poll section.
	    call 'CBL_SEMAPHORE_ACQUIRE'   using
				        by value service-done-sem
						 h'01'
	    move 1 			      to service-poll-return
	    if  return-code not = 0 
	    	if  return-code not = 78-RETURN-OBJECT-BUSY
		    call 'CBL_ERROR_API_REPORT' using
				    by value return-code
				by reference 'CBL_SEMAPHORE_ACQUIRE'
		end-if
	        move 0                        to service-poll-return
	    end-if
	    exit section.

	service-acknowledge section.
	    set service-done-ack-sem      up by 1 
	    exit section.


