home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #1 / NN_1993_1.iso / spool / comp / os / vms / 20608 < prev    next >
Encoding:
Internet Message Format  |  1993-01-08  |  7.4 KB
  1. Path: sparky!uunet!dtix!darwin.sura.net!haven.umd.edu!decuac!pa.dec.com!engage.pko.dec.com!e2big.mko.dec.com!dbased.nuo.dec.com!quark.enet.dec.com!lionel
  2. From: lionel@quark.enet.dec.com (Steve Lionel)
  3. Newsgroups: comp.os.vms
  4. Subject: Re: Help a student in distress....
  5. Message-ID: <1993Jan8.190324.20067@dbased.nuo.dec.com>
  6. Date: 8 Jan 93 19:03:24 GMT
  7. References: <20242.2b4c180e@ul.ie>
  8. Sender: news@dbased.nuo.dec.com (USENET News System)
  9. Reply-To: lionel@quark.enet.dec.com (Steve Lionel)
  10. Organization: Digital Equipment Corporation, Nashua NH
  11. Lines: 164
  12.  
  13.  
  14. In article <20242.2b4c180e@ul.ie>, 9120092@ul.ie writes:
  15. ||>(3) Does anybody have any working examples of SMG's used in Cobol (cough cough)?
  16. |>    In particular SMG$CREATE_MENU. I would really appreciate this as the
  17. |>    VMS ver 3 manuals that are available to me don't mention a thing
  18. |>    about it. I know about it 'cause it's in the Ver 5.? help facility.
  19. |>
  20.  
  21. Here's an example which works.  If you subscribe to Digital's DSIN service you
  22. can get examples like this and many others.  The biggest hurdle to cross
  23. with calling SMG$CREATE_MENU is creating the array descriptor for the menu
  24. choices.  You can do this easily in some languages (FORTRAN, Pascal, Ada),
  25. but in COBOL you have to "roll your own", as this example does.  
  26.  
  27. identification division.
  28. program-id. create_menu.
  29. environment division.
  30. data division.
  31. working-storage section.
  32. 01  number-values. 
  33.     05 zero-value       pic s9(9) comp value 0.
  34.     05 three            pic s9(9) comp value 3.
  35.     05 nine             pic S9(9) comp value 9.
  36. 01  smg-variables.
  37.     05 display1         pic 9(9) comp.
  38.     05 paste1           pic 9(9) comp.
  39.     05 keyboard1        pic 9(9) comp.
  40. 01  return-status       pic S9(9) comp.
  41. 01  rows                pic S9(9) comp value 5.
  42. 01  columns             pic S9(9) comp value 10.
  43. 01  smg-externals.
  44.     05 smg$k_vertical   pic S9(9) comp value external SMG$K_VERTICAL.
  45.     05 smg$m_border     pic 9(9)  comp value external SMG$M_BORDER.
  46. 01  choices             pic 9(4) comp.
  47. 01  static_array.
  48.     02  choice occurs 5 times pic x(8).
  49. *
  50. * Descriptor block for CHOICES argument of SMG$CREATE_MENU
  51. *
  52. 01  array-descriptor.
  53. *length of each element in the array
  54.     05  desc-w-length       pic 9(4) comp value 8.
  55. *data type code
  56.     05  desc-b-dtype        pic x.
  57. *descriptor class a
  58.     05  desc-b-class        pic x.
  59. *address of first element in the array
  60.     05  desc-a-pointer      pointer value reference static_array.
  61.     05  desc-b-scale        pic x.
  62.     05  desc-b-digits       pic x.
  63.     05  desc-b-aflags       pic x.
  64. *number of dimensions
  65.     05  desc-b-dimct        pic x.
  66. *size of array in bytes  (length_of_element * number_of_elements)
  67.     05  desc-l-arsize       pic s9(9) comp value 40.
  68.     05  desc-a-a0           pic  9(9) comp value 0.
  69.     05  desc-l-m            pic s9(9) comp value 10.
  70.     05  desc-l-l            pic s9(9) comp value 1.
  71.     05  desc-l-u            pic s9(9) comp value 5.
  72. 01  value_s-1               pic s9(4) comp value -1.
  73. 01  value_s-1_1st_byte redefines value_s-1 pic x.
  74. 01  value_192               pic 9(4) comp value 192.
  75. 01  value_192_1st_byte  redefines value_192 PIC X.
  76. 01  value_s0                pic s9(4) comp value 0.
  77. 01  value_s0_1st_byte redefines value_s0  pic x.
  78. 01  value_0                 pic 9(4) comp value 0.
  79. 01  value_0_1st_byte redefines value_0 pic x.
  80. 01  value_1                 pic 9(4) comp value 1.
  81. 01  value_1_1st_byte redefines value_1 pic x.
  82. 01  type_t                  pic 9(4) comp value external DSC$K_DTYPE_T.
  83. 01  type-t-1st-byte redefines type_t pic x.
  84. 01  class-a                 pic 9(4) comp value external DSC$K_CLASS_A.
  85. 01  class-a-1st-byte redefines class-a pic X.
  86. PROCEDURE DIVISION.
  87. P0.
  88. * Create the pasteboard.
  89.  
  90.         CALL "SMG$CREATE_PASTEBOARD" using by reference paste1
  91.                                      giving return-status.
  92.         if return-status is not success
  93.            then call "lib$stop" using by value return-status.
  94.  
  95. * Create the virtual display with a border.
  96.  
  97.         CALL "SMG$CREATE_VIRTUAL_DISPLAY" using by reference rows columns
  98.                                                              display1
  99.                                                              smg$m_border
  100.                                           giving return-status.
  101.         if return-status is not success
  102.              then call "lib$stop" using by value return-status.
  103.  
  104. * Create a virtual keyboard
  105.  
  106.         CALL "SMG$CREATE_VIRTUAL_KEYBOARD" using by reference keyboard1
  107.                                            giving return-status.
  108.         if return-status is not success
  109.             then call "lib$stop" using by value return-status.
  110.  
  111. * Paste the virtual display at line 3, column 9.
  112.  
  113.         CALL "SMG$PASTE_VIRTUAL_DISPLAY" using by reference display1 paste1
  114.                                                             three nine
  115.                                          giving return-status.
  116.         if return-status is not success
  117.            then call "lib$stop" using by value return-status.
  118.  
  119.         move spaces to static_array.
  120.         move "Option 1" to choice(1).
  121.         move "Option 2" to choice(2).
  122.         move "Option 3" to choice(3).
  123.         move "Option 4" to choice(4).
  124.         move "Option 5" to choice(5).
  125.  
  126. *fill in the rest of the descriptor
  127.         move type-t-1st-byte    to desc-b-dtype.
  128.         move class-a-1st-byte   to desc-b-class.
  129.         move value_s0_1st_byte  to desc-b-scale.
  130.         move value_0_1st_byte   to desc-b-digits.
  131.         move value_192_1st_byte to desc-b-aflags.
  132.         move value_1_1st_byte   to desc-b-dimct.
  133.  
  134.         call "SMG$CREATE_MENU"  using by reference display1 array-descriptor
  135.                                                    smg$k_vertical
  136.                                          omitted omitted omitted omitted
  137.                                 giving return-status.
  138.         if return-status is not success
  139.                 then call "lib$stop" using by value return-status.
  140.  
  141.         call "SMG$SELECT_FROM_MENU" using by reference keyboard1 display1
  142.                                                        choices
  143.                                              omitted omitted omitted
  144.                                              omitted omitted omitted
  145.                                              omitted
  146.                                     giving  return-status.
  147.         if return-status is not success
  148.                 then call "lib$signal" using by value return-status.
  149. *cleanup
  150.         call 'smg$delete_virtual_keyboard' using by reference keyboard1
  151.                                           giving return-status.
  152.         if return-status is not success
  153.                 then call "lib$signal" using by value return-status.
  154.  
  155.         call 'smg$delete_pasteboard' using by reference paste1 zero-value
  156.                                           giving return-status.
  157.         if return-status is not success
  158.                 then call "lib$signal" using by value return-status.
  159.  
  160.         call 'smg$delete_virtual_display' using by reference display1
  161.                                           giving return-status.
  162.         if return-status is not success
  163.                 then call "lib$signal" using by value return-status.
  164.  
  165.         display "you selected option :" at line 24 column 1.
  166.         display choices at line 24 column 40 with conversion.
  167.  
  168.         stop run.
  169.  
  170. --
  171.  
  172. Steve Lionel                    lionel@quark.enet.dec.com
  173. SDT Languages Group
  174. Digital Equipment Corporation
  175. 110 Spit Brook Road
  176. Nashua, NH 03062
  177.