Mouse Handling: Sample Code

identification division.
program-id.  mouse-sample.
   This program provides an example of programmed 
   mouse handling.
data division.
working-storage section.

77  key-entered    pic 9(3).
    88  mouse-button-clicked  value 81, 87.
    88  left-button-clicked   value 81.
    88  right-button-clicked  value 87.

77  menu-selection  pic 9 value 1.
    88  exit-selected  value 9.

77  MOUSE-FLAGS    pic 9(5).
77  pointer-idx    pic 9 value zero.

01  name-array.
  03 name-data.
    05  filler    pic x(9) value "arrow".
    05  filler    pic x(9) value "bar".
    05  filler    pic x(9) value "cross". 
    05  filler    pic x(9) value "hourglass".
  03  mouse-name redefines name-data occurs 4    pic x(9).

copy "acugui.def".
screen section.
01  main-screen.
  03  "The Screen", reverse high line 1 col 20.
  03  "Change Pointer", reverse high line 2 col 3.
  03  "Describe Pointer", reverse high line 4 col 3. 
  03  "EXIT", reverse high line 6 col 3.
procedure division.

* Test for presence of mouse on system.
    call "w$mouse" using test-mouse-presence.
    if return-code = zero
      display "No mouse present"
      go to main-logic-exit.

* Enable program to recognize left and right button clicks. 
    add allow-left-down, allow-right-down giving mouse-flags.
    set environment "mouse-flags" to mouse-flags.

    display main-screen.
    perform main-screen-handling
      until exit-selected.

    stop run.


    accept omitted, line 1, control key in key-entered.

    if mouse-button-clicked
      call "w$mouse" using get-mouse-status, mouse-info 
      evaluate mouse-row
        when 2   perform change-mouse-shape 
        when 4   perform display-mouse-shape
        when 6   set exit-selected to true
        when other 
          display "Clicked" 

    if pointer-idx < 4
      add 1 to pointer-idx
      move 1 to pointer-idx. 
    call "w$mouse" using set-mouse-shape, pointer-idx.

    call "w$mouse" using get-mouse-shape.
  display "Current mouse shape is" mouse-name (return-code).