From: lionel@quark.enet.dec.com (Steve Lionel)
Newsgroups: comp.os.vms
Subject: Re: Help a student in distress....
Date: 8 Jan 93 19:03:24 GMT
Reply-To: lionel@quark.enet.dec.com (Steve Lionel)
Organization: Digital Equipment Corporation, Nashua NH


In article <20242.2b4c180e@ul.ie>, 9120092@ul.ie writes:
||>(3) Does anybody have any working examples of SMG's used in Cobol (cough cough)?
|>    In particular SMG$CREATE_MENU. I would really appreciate this as the
|>    VMS ver 3 manuals that are available to me don't mention a thing
|>    about it. I know about it 'cause it's in the Ver 5.? help facility.
|>

Here's an example which works.  If you subscribe to Digital's DSIN service you
can get examples like this and many others.  The biggest hurdle to cross
with calling SMG$CREATE_MENU is creating the array descriptor for the menu
choices.  You can do this easily in some languages (FORTRAN, Pascal, Ada),
but in COBOL you have to "roll your own", as this example does.  

identification division.
program-id. create_menu.
environment division.
data division.
working-storage section.
01  number-values. 
    05 zero-value       pic s9(9) comp value 0.
    05 three            pic s9(9) comp value 3.
    05 nine             pic S9(9) comp value 9.
01  smg-variables.
    05 display1         pic 9(9) comp.
    05 paste1           pic 9(9) comp.
    05 keyboard1        pic 9(9) comp.
01  return-status       pic S9(9) comp.
01  rows                pic S9(9) comp value 5.
01  columns             pic S9(9) comp value 10.
01  smg-externals.
    05 smg$k_vertical   pic S9(9) comp value external SMG$K_VERTICAL.
    05 smg$m_border     pic 9(9)  comp value external SMG$M_BORDER.
01  choices             pic 9(4) comp.
01  static_array.
    02  choice occurs 5 times pic x(8).
*
* Descriptor block for CHOICES argument of SMG$CREATE_MENU
*
01  array-descriptor.
*length of each element in the array
    05  desc-w-length       pic 9(4) comp value 8.
*data type code
    05  desc-b-dtype        pic x.
*descriptor class a
    05  desc-b-class        pic x.
*address of first element in the array
    05  desc-a-pointer      pointer value reference static_array.
    05  desc-b-scale        pic x.
    05  desc-b-digits       pic x.
    05  desc-b-aflags       pic x.
*number of dimensions
    05  desc-b-dimct        pic x.
*size of array in bytes  (length_of_element * number_of_elements)
    05  desc-l-arsize       pic s9(9) comp value 40.
    05  desc-a-a0           pic  9(9) comp value 0.
    05  desc-l-m            pic s9(9) comp value 10.
    05  desc-l-l            pic s9(9) comp value 1.
    05  desc-l-u            pic s9(9) comp value 5.
01  value_s-1               pic s9(4) comp value -1.
01  value_s-1_1st_byte redefines value_s-1 pic x.
01  value_192               pic 9(4) comp value 192.
01  value_192_1st_byte  redefines value_192 PIC X.
01  value_s0                pic s9(4) comp value 0.
01  value_s0_1st_byte redefines value_s0  pic x.
01  value_0                 pic 9(4) comp value 0.
01  value_0_1st_byte redefines value_0 pic x.
01  value_1                 pic 9(4) comp value 1.
01  value_1_1st_byte redefines value_1 pic x.
01  type_t                  pic 9(4) comp value external DSC$K_DTYPE_T.
01  type-t-1st-byte redefines type_t pic x.
01  class-a                 pic 9(4) comp value external DSC$K_CLASS_A.
01  class-a-1st-byte redefines class-a pic X.
PROCEDURE DIVISION.
P0.
* Create the pasteboard.
 
        CALL "SMG$CREATE_PASTEBOARD" using by reference paste1
                                     giving return-status.
        if return-status is not success
           then call "lib$stop" using by value return-status.
 
* Create the virtual display with a border.
 
        CALL "SMG$CREATE_VIRTUAL_DISPLAY" using by reference rows columns
                                                             display1
                                                             smg$m_border
                                          giving return-status.
        if return-status is not success
             then call "lib$stop" using by value return-status.
 
* Create a virtual keyboard
 
        CALL "SMG$CREATE_VIRTUAL_KEYBOARD" using by reference keyboard1
                                           giving return-status.
        if return-status is not success
            then call "lib$stop" using by value return-status.
 
* Paste the virtual display at line 3, column 9.
 
        CALL "SMG$PASTE_VIRTUAL_DISPLAY" using by reference display1 paste1
                                                            three nine
                                         giving return-status.
        if return-status is not success
           then call "lib$stop" using by value return-status.
 
        move spaces to static_array.
        move "Option 1" to choice(1).
        move "Option 2" to choice(2).
        move "Option 3" to choice(3).
        move "Option 4" to choice(4).
        move "Option 5" to choice(5).
 
*fill in the rest of the descriptor
        move type-t-1st-byte    to desc-b-dtype.
        move class-a-1st-byte   to desc-b-class.
        move value_s0_1st_byte  to desc-b-scale.
        move value_0_1st_byte   to desc-b-digits.
        move value_192_1st_byte to desc-b-aflags.
        move value_1_1st_byte   to desc-b-dimct.
 
        call "SMG$CREATE_MENU"  using by reference display1 array-descriptor
                                                   smg$k_vertical
                                         omitted omitted omitted omitted
                                giving return-status.
        if return-status is not success
                then call "lib$stop" using by value return-status.
 
        call "SMG$SELECT_FROM_MENU" using by reference keyboard1 display1
                                                       choices
                                             omitted omitted omitted
                                             omitted omitted omitted
                                             omitted
                                    giving  return-status.
        if return-status is not success
                then call "lib$signal" using by value return-status.
*cleanup
        call 'smg$delete_virtual_keyboard' using by reference keyboard1
                                          giving return-status.
        if return-status is not success
                then call "lib$signal" using by value return-status.

        call 'smg$delete_pasteboard' using by reference paste1 zero-value
                                          giving return-status.
        if return-status is not success
                then call "lib$signal" using by value return-status.

        call 'smg$delete_virtual_display' using by reference display1
                                          giving return-status.
        if return-status is not success
                then call "lib$signal" using by value return-status.

        display "you selected option :" at line 24 column 1.
        display choices at line 24 column 40 with conversion.
 
        stop run.

--

Steve Lionel                    lionel@quark.enet.dec.com
SDT Languages Group
Digital Equipment Corporation
110 Spit Brook Road
Nashua, NH 03062