home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / P_FOTRAN.LZH / DEMOS.FOR / GEMDEMO.FOR < prev    next >
Text File  |  1987-12-31  |  3KB  |  113 lines
  1.       PROGRAM gemdemo
  2. *
  3. *     Date: 5  June  1987
  4. *
  5. *     This simple GEM program displays an alert, and then
  6. *     draws a graph in a window.  It illustrates the most
  7. *     basic use of GEM.  Normal use of GEM would require
  8. *     event-handling and redraw logic, and a resource file.
  9. *     (Such a program is normally a thousand or more lines
  10. *     long.)
  11. *
  12.  
  13.       IMPLICIT NONE
  14.  
  15.       INTEGER*4 handle, desk_x, desk_y, desk_w, desk_h
  16.       INTEGER*4 wx, wy, ww, wh, my_window, dummy
  17. *     Clip rectangle:
  18.       INTEGER*2 clip_rect(0:3)
  19. *     Variable used for setting the window's title:
  20.       CHARACTER*17 my_title
  21. *     Variables used to calculate graph points:
  22.       REAL a, b, x_scale, y_scale
  23. *     VDI parameter arrays:
  24.       INTEGER*2 points(0:200), work_in(0:10), work_out(0:56)
  25. *     DO loops:
  26.       INTEGER*4 I
  27.  
  28.       INCLUDE 'GEMCONST'
  29.       INCLUDE 'GEMFUNCS'
  30.  
  31. *     Initialise AES
  32.       CALL appl_init
  33.  
  34. *     Open virtual workstation
  35.       handle = graf_handle(dummy, dummy, dummy, dummy)
  36.       DO 1 I = 0, 9
  37. 1     work_in(I) = 1
  38.       work_in(3) = 3         ! Marker style 3
  39.       work_in(7) = 0         ! Fill interior hollow
  40.       work_in(10) = 2        ! RC coordinate system
  41.       CALL v_opnvwk(work_in, handle, work_out)
  42.       IF (handle .eq. 0) GOTO 999     ! open failed
  43.  
  44. *     Display an alert, with button 1 as default
  45.       dummy = form_alert(1,
  46.      +'[1][This program draws|a graph in a window.][ OK ]'//char(0))
  47.  
  48. *     Determine desktop window work area size
  49.       CALL wind_get(0, WF_WXYWH, desk_x, desk_y, desk_w, desk_h)
  50.  
  51. *     Determine my window work area size
  52.       ww = desk_w/2
  53.       wh = desk_h/2
  54.       wx = desk_x+ww/2
  55.       wy = desk_y+wh/2
  56.  
  57. *     Create window half size
  58.       my_window = wind_create(1, wx, wy, ww, wh)
  59.  
  60. *     Set the window's name
  61.       my_title = 'y=sin(ax)exp(bx)'//CHAR(0)
  62.  
  63.       CALL wind_title(my_window, my_title)
  64.  
  65. *     Open the window
  66.       CALL wind_open(my_window, wx, wy, ww, wh)
  67.  
  68. *     Set clip rectangle to work area of window
  69.       CALL wind_get(my_window, WF_WXYWH, wx, wy, ww, wh)
  70.       clip_rect(0) = wx
  71.       clip_rect(1) = wy
  72.       clip_rect(2) = wx+ww
  73.       clip_rect(3) = wy+wh
  74.       CALL vs_clip(handle, 1, clip_rect)
  75.  
  76. *     Hide mouse while drawing
  77.       CALL graf_mouse(256, 0)
  78.  
  79. *     Fill rectangle with background (white)
  80.       CALL vr_recfl(handle, clip_rect)
  81.  
  82. *     Calculate the points on the curve
  83.       a = 0.3
  84.       b = 0.02
  85.       x_scale = ww/100.0
  86.       y_scale = wh/10.0
  87.       DO 5 I=0, 198, 2
  88.       points(I) = wx + I*x_scale
  89. 5     points(I+1) = wy+wh/2 - SIN(a*I)*EXP(b*I)*y_scale
  90.  
  91. *     Draw the curve
  92.       CALL v_pline(handle, 100, points)
  93.  
  94. *     Mark every fifth point
  95.       DO 10 I = 0, 38, 2
  96.       points(I) = points(I*5)
  97. 10    points(I+1) = points(I*5+1)
  98.       CALL v_pmarker(handle, 20, points)
  99.  
  100. *     Show mouse after update
  101.       CALL graf_mouse(0, 0)
  102.       CALL graf_mouse(257, 0)
  103.  
  104. *     Wait for any key before closing window
  105.       CALL evnt_keybd
  106.       CALL wind_close(my_window)
  107.  
  108. *     Application exit
  109.       CALL v_clsvwk(handle)
  110. 999   CALL appl_exit
  111.       END
  112.  
  113.