home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / P_FOTRAN.LZH / DEMOS.FOR / MENUDEMO.FOR < prev    next >
Text File  |  1987-12-31  |  2KB  |  58 lines
  1. *     A demonstration program to illustrate the dynamic creation of
  2. *     a menu bar from Prospero Fortran
  3. *
  4. *     Author : R K Chapman
  5. *     Date   : 5 August 1987
  6. *
  7.       PROGRAM tmenu
  8.       IMPLICIT none
  9.       
  10.       INTEGER*4 menu_create, menu_title, menu_item, AESret, form_alert
  11.  
  12.       INTEGER*4 my_menu_bar, title_1, title_2
  13.       INTEGER*4 opt1, opt2, opt3, opt4, opt5, dummy
  14.       INTEGER*4 title, item
  15.       INTEGER*2 buffer(0:7)
  16.       CHARACTER*4 quote
  17.  
  18.       INCLUDE 'gemconst'
  19.  
  20.       CALL appl_init
  21.       IF (AESret() .lt. 0) GOTO 999
  22.       my_menu_bar = menu_create(5, 5, '  Desk '//char(0))
  23.       title_1 = menu_title(my_menu_bar, ' File '//char(0))
  24.       title_2 = menu_title(my_menu_bar, ' Test '//char(0))
  25.       opt1 = menu_item(my_menu_bar, title_1,' Open   '//char(0))
  26.       opt2 = menu_item(my_menu_bar, title_1,' Quit'//char(0))
  27.       opt3 = menu_item(my_menu_bar, title_2,' Test   '//char(0))
  28.       opt4 = menu_item(my_menu_bar, title_2,'-----------'//char(0))
  29.       opt5 = menu_item(my_menu_bar, title_2,' Mode ... '//char(0))
  30.       CALL menu_ienable(my_menu_bar, opt4, .FALSE.)
  31.       CALL menu_bar(my_menu_bar, .TRUE.)
  32.  
  33. 10    CONTINUE
  34.         CALL evnt_mesag(buffer)
  35.         title = buffer(3)
  36.         item = buffer(4)
  37.         IF (buffer(0) .eq. MN_SELECTED) THEN
  38.           IF (item .eq. opt2) THEN
  39.             GOTO 20
  40.           ELSE IF (item .eq. opt1) THEN
  41.             quote = 'Open'
  42.           ELSE IF (item .eq. opt3) THEN
  43.             quote = 'Test'
  44.           ELSE IF (item .eq. opt5) THEN
  45.             quote = 'Mode'
  46.           ELSE IF (title .eq. 3) THEN
  47.             quote = 'Desk'
  48.           END IF 
  49.           dummy = form_alert(1, '[1][You selected ' // quote //
  50.      -                       '][ OK ]' // char(0))
  51. 20        CONTINUE
  52.           CALL menu_tnormal(my_menu_bar, title, .TRUE.)
  53.           IF (item .ne. opt2) GOTO 10
  54.         END IF
  55.       CALL appl_exit
  56. 999   CONTINUE
  57.       END
  58.