c
c     Copyright (c) 1999,2000, Compaq Computer Corporation
c
c     See the file "license.terms" for information on usage and redistribution
c     of this file, and for a DISCLAIMER OF ALL WARRANTIES.
c
c     A set of GKS$ bindings to QuickWin graphics routines.
c
c     A WORK IN PROGRESS...
c
c     Segment pick and delete "work" only in conjunction with Postmini's
c     annotation functions.
c
      logical function initialsettings
      use dflib
      use dfwin
      implicit none
c
      include 'gks_to_qwin.cmn'
c
      type (qwinfo) winfo
      integer irc
c
      winfo.type = QWIN$MAX
      winfo.x = -1
      winfo.y = -1
      winfo.h = -1
      winfo.w = -1
      irc = setwsizeqq(QWIN$FRAMEWINDOW,winfo)
c
c     We must use this tricky way to get the thread id
c     of the primary thread that handles the windows messages.
      qwin_primarythreadid = GetCurrentThreadId()
c
      initialsettings = .TRUE.
c
      return
      end
c
      subroutine gks$set_pmark_color_index(index)
      use dflib
      integer index
c
      include 'gks_to_qwin.cmn'
c
      integer*2 rc
c
      gks_pmark_color_index = index
c
      if( qwin_color_index .ne. index ) then
         qwin_color_index = int2(index)
         rc = setcolor(qwin_color_index)
      endif
c
      return
      end
c
      subroutine gks$set_text_color_index(index)
      use dflib
      implicit none
c
      integer index
c
      include 'gks_to_qwin.cmn'
c
      integer*2 rc
c
      gks_text_color_index = index
c
      if( qwin_color_index .ne. index ) then
         qwin_color_index = int2(index)
         rc = setcolor(int2(qwin_color_index))
      endif
c
      return
      end
c
      subroutine gks$inq_ws_defer_and_update(wsid, err, def, reg,
     1           surface, frame)
      implicit none
      integer wsid, err, def, reg, surface, frame
      return
      end
c
      subroutine gks$open_gks(errfile, buffer)
      implicit none
      character*(*) errfile
      integer buffer
c
      include 'gksdefs.cmn'
      include 'gks_to_qwin.cmn'
c
      integer i
c
c     Initialize GKS state
c
      gks_state = GKS$K_GKOP
      do i=1,NUM_WS
         gks_wsid_list(i) = -1
         gks_ws_active_list(i) = .FALSE.
      end do
c
      do i=1,NUM_XFORMS
         gks_xform_data(i,1) = 0.0
         gks_xform_data(i,2) = 1.0
         gks_xform_data(i,3) = 0.0
         gks_xform_data(i,4) = 1.0
         gks_xform_data(i,5) = 0.0
         gks_xform_data(i,6) = 1.0
         gks_xform_data(i,7) = 0.0
         gks_xform_data(i,8) = 1.0
      end do
      gks_current_xform = 1
c
      gks_pline_color_index = 1
      gks_pline_linetype    = GKS$K_LINETYPE_SOLID
      gks_pline_linewidth   = 1.0
c
      gks_pmark_color_index = 1
      gks_pmark_type        = GKS$K_MARKERTYPE_CIRCLE
      gks_pmark_size        = 1.0
c
      gks_text_color_index  = 1
      gks_text_font         = 1
      gks_text_prec         = GKS$K_TEXT_PRECISION_STROKE
      gks_text_valign       = GKS$K_TEXT_VALIGN_NORMAL  ! == BASE
      gks_text_halign       = GKS$K_TEXT_HALIGN_NORMAL  ! == LEFT
      gks_text_upvec(1)     = 0.0
      gks_text_upvec(2)     = 1.0
      gks_text_height       = 1.0
      gks_text_expfac       = 1.0
c
      gks_fill_color_index  = 1
c
c     Initialize QWIN state
      qwin_color_index = -1
      qwin_font_height = 14
      qwin_font_name   = 'Arial'
      qwin_font_style  = ' '
      qwin_note_type = 0
      qwin_note_id = 0
      qwin_console_lu = 6
c
      return
      end
c
      subroutine gks$set_text_spacing(spacing)
      implicit none
      real spacing
c
      include 'gks_to_qwin.cmn'
c
      gks_text_spacing = spacing
c
      return
      end
c
      subroutine gks$activate_ws(wsid)
      use dflib
      implicit none
c
      integer wsid
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      integer rc, i
      integer rgb, old_rgb
c
      gks_state = GKS$K_WSAC
      do i=1,NUM_WS
         if( gks_wsid_list(i) .eq. wsid ) then
            gks_ws_active_list(i) = .TRUE.
            goto 100
         endif
      end do
100   continue
c
      rgb = #FFFFFF   ! This should be set to the actual color index 0 value
      old_rgb = setbkcolorrgb(rgb)
c
      rc = setactiveqq(wsid)
      rc = focusqq(wsid)
c
      return
      end
c
      subroutine gks$inq_ws_type(wsid, err, conid, wstype, ilen)
      implicit none
      integer wsid, err, wstype, ilen
      character*(*) conid
c
      include 'gksdefs.f'
c
      conid = ' '
      ilen = 1
      wstype = GKS$K_MOTIF
c
      err = 0
c
      return
      end
c
      subroutine gks$inq_ws_category(wstype, err, cat)
      implicit none
      integer wstype, err, cat     
c
      include 'gksdefs.f'
c
      if( wstype .eq. GKS$K_MOTIF .or.
     1    wstype .eq. GKS$K_VT125BW .or.
     1    wstype .eq. GKS$K_VT125   .or.
     1    wstype .eq. GKS$K_VT240   .or.
     1    wstype .eq. GKS$K_VT240BW .or.
     1    wstype .eq. GKS$K_VT330   .or.
     1    wstype .eq. GKS$K_VT340   .or.
     1    wstype .eq. GKS$K_TEK4014 .or.
     1    wstype .eq. GKS$K_VT340   ) then
         cat = GKS$K_WSCAT_OUTIN
      else
         cat = GKS$K_WSCAT_OUTPUT
      endif
c
      err = 0
      return
      end
c
      integer function gks$set_viewport(xform, x1, x2, y1, y2)
      use dflib
      implicit none
c
      integer xform
      real x1, x2, y1, y2
c
      include 'gksdefs.f'
      include 'gksmsgs.f'
      include 'gks_to_qwin.cmn'
c
      type(windowconfig) wconfig
      type(xycoord) t
      integer*2 upx, upy, downx, downy
      logical rc
      real ratiox, ratioy
c
      if( xform .gt. NUM_XFORMS .or. xform .lt. 1 ) then
         gks$set_viewport = GKS$_ERROR_1  ! This is not the right error number
         return
      endif
c
      gks_xform_data(xform,5) = x1
      gks_xform_data(xform,6) = x2
      gks_xform_data(xform,7) = y1
      gks_xform_data(xform,8) = y2
c
      rc = getwindowconfig(wconfig)
      if( wconfig.numxpixels .gt. wconfig.numypixels ) then
         ratiox = 1.0
         ratioy = float(wconfig.numxpixels)/float(wconfig.numypixels)
      else
         ratioy = 1.0
         ratiox = float(wconfig.numypixels)/float(wconfig.numxpixels)
      endif
      upx   = int(x1*ratiox*float(wconfig.numxpixels))
      downx = int(x2*ratiox*float(wconfig.numxpixels))
      upy   = int((1.0-y2*ratioy)*float(wconfig.numypixels))
      downy = int((1.0-y1*ratioy)*float(wconfig.numypixels))
*
      call setviewport(upx,upy,downx,downy)
**      call setcliprgn(upx,upy,downx,downy)
**      call setvieworg(upx,upy,t)
**      write(100,*) x1,y1,x2,y2
**      write(100,*) upx, upy, downx, downy
**      write(100,*) 'Old view origin: ',t.xcoord, t.ycoord
c
      gks$set_viewport = GKS$_SUCCESS
c
      return
      end
c
      subroutine gks$set_pmark_type(index)
      implicit none
      integer index
c
      include 'gks_to_qwin.cmn'
c
      gks_pmark_type = index
c
      return
      end
c
      subroutine gks$inq_xform(xform, err, window, vport)
      implicit none
      integer err, xform
      real window(4), vport(4)
c
      include 'gks_to_qwin.cmn'
      include 'gksmsgs.f'
c
      if( xform .gt. NUM_XFORMS .or. xform .lt. 1 ) then
         err = GKS$_ERROR_50
      endif
c
      window(1) = gks_xform_data(xform,1)
      window(2) = gks_xform_data(xform,2)
      window(3) = gks_xform_data(xform,3)
      window(4) = gks_xform_data(xform,4)
c
      vport(1)  = gks_xform_data(xform,5)
      vport(2)  = gks_xform_data(xform,6)
      vport(3)  = gks_xform_data(xform,7)
      vport(4)  = gks_xform_data(xform,8)
c
      err = GKS$_SUCCESS
c
      return
      end
c
      subroutine gks$set_pick_mode(wsid, dev, mode, echo)
      implicit none
      integer wsid, dev, mode, echo
      return
      end
c
      subroutine gks$clear_ws(wsid,cntl)
      use dflib
      implicit none
c
      integer wsid, cntl
c
      integer rgb, old_rgb
      rgb = #FFFFFF   ! White
      old_rgb = setbkcolorrgb(rgb)
      call clearscreen($GCLEARSCREEN)
c
      return
      end
c
      subroutine gks$set_ws_window(wsid, x1, x2, y1, y2)
      implicit none
      integer wsid
      real x1, x2, y1, y2
      end
c
      subroutine gks$init_pick(wsid, dev,
     1                 istatus, isegment, ipick,
     2                 pet_type, echo_area,
     3                 data_record, record_buffer_length)
      implicit none
c
      integer wsid, dev, istatus, isegment, ipick,
     1        pet_type, record_buffer_length
      real    echo_area(4), data_record(1)
      return
      end
c
      subroutine gks$request_pick(wsid, dev, istatus, seg, pickid)
      use dflib
      implicit none
c
      integer wsid, dev, istatus, seg, pickid
c
      include 'gks_to_qwin.cmn'
      include 'annotations.cmn'
c
      type(wxycoord) wt
      real pos_x, pos_y, xmin, xmax, ymin, ymax,
     1     x1, x2, y1, y2
      integer mouseevent, keystate, ix, iy, result, state
      integer i, note_wsid, lookup_ws_id
c
      state = 0
      mouseevent = MOUSE$LBUTTONDOWN .OR. MOUSE$RBUTTONDOWN
      result = waitonmouseevent(mouseevent,keystate,ix,iy)
c
c     These variables keep track of the annotation we picked
      qwin_note_type = 0
      qwin_note_id = 0
c
      if( keystate .and. MOUSE$KS_LBUTTON ) then
         state = 1
      else
c        This is our 'cancel' input
         state = 2
      endif
c
      mouseevent = MOUSE$LBUTTONUP .OR. MOUSE$RBUTTONUP
      result = waitonmouseevent(mouseevent,keystate,ix,iy)
c
      if( state .eq. 1 ) then
         call getwindowcoord(ix,iy,wt)
         pos_x = wt.wx
         pos_y = wt.wy
         istatus = 1
      else
         istatus = 0
      endif
c
      if( istatus .eq. 1 ) then
c
c        Look through annotations to find one which contains the
c        coordinates (pos_x,pos_y)
         do i=1,MAX_TEXT_NOTES
            if( text_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(text_notes(i)%window)
c              We don't have the text bounding box information, so fake it
c              by taking a small region around the text origin.
c              This is pretty poor...
               if( text_notes(i)%use_x_graph_coords .and.
     1             text_notes(i)%use_y_graph_coords ) then
                  call anno_graph_to_norm_coords(
     1                 text_notes(i)%xloc,text_notes(i)%yloc,1,x1,y1)
               else if( text_notes(i)%use_x_graph_coords ) then
                  call anno_graph_to_norm_coords(
     1                 text_notes(i)%xloc,1.0,1,x1,y1)
                  y1 = text_notes(i)%yloc
               else if( text_notes(i)%use_y_graph_coords ) then
                  call anno_graph_to_norm_coords(
     1                 1.0,text_notes(i)%yloc,1,x1,y1)
                  x1 = text_notes(i)%xloc
               else
                  x1 = text_notes(i)%xloc
                  y1 = text_notes(i)%yloc
               endif
               if( note_wsid .eq. wsid .and.
     1            pos_x .ge. 0.9*x1 .and. pos_x .le. 1.1*x1 .and.
     1            pos_y .gt. 0.9*y1 .and. pos_y .le. 1.1*y1 ) then
                  seg = text_notes(i)%segment
                  qwin_note_type = TEXT_NOTE_TYPE
                  qwin_note_id = i
                  goto 1000
               endif
            endif
         end do
         do i=1,MAX_MARKER_NOTES
            if( marker_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(marker_notes(i)%window)
c              Since the marker's extent is unknown, just enlarge the
c              (x,y) position slightly. This will work pretty well for
c              Postmini's annotations, which are on a (0,1,0,1) transform.
               if( marker_notes(i)%use_graph_coords ) then
                  call anno_graph_to_norm_coords(
     1               marker_notes(i)%xloc,marker_notes(i)%yloc,1,x1,y1)
               else
                  x1 = marker_notes(i)%xloc
                  y1 = marker_notes(i)%yloc
               endif
               if( note_wsid .eq. wsid .and.
     1            pos_x .ge. 0.95*x1 .and. pos_x .le. 1.05*x1 .and.
     1            pos_y .gt. 0.95*y1 .and. pos_y .le. 1.05*y1 ) then
                  seg = marker_notes(i)%segment
                  qwin_note_type = MARKER_NOTE_TYPE
                  qwin_note_id = i
                  goto 1000
               endif
            endif
         end do
         do i=1,MAX_BOX_NOTES
            if( box_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(box_notes(i)%window)
               if( box_notes(i)%use_graph_coords ) then
                  call anno_graph_to_norm_coords(
     1                 box_notes(i)%x1,box_notes(i)%y1,1,x1,y1)
                  call anno_graph_to_norm_coords(
     1                 box_notes(i)%x2,box_notes(i)%y2,1,x2,y2)
               else
                  x1 = box_notes(i)%x1
                  y1 = box_notes(i)%y1
                  x2 = box_notes(i)%x2
                  y2 = box_notes(i)%y2
               endif
               xmin = MIN(x1,x2)
               xmax = MAX(x1,x2)
               ymin = MIN(y1,y2)
               ymax = MAX(y1,y2)
               if( note_wsid .eq. wsid .and.
     1             pos_x .ge. xmin .and. pos_x .le. xmax .and.
     1             pos_y .gt. ymin .and. pos_y .le. ymax ) then
                  seg = box_notes(i)%segment
                  qwin_note_type = BOX_NOTE_TYPE
                  qwin_note_id = i
                  goto 1000
               endif
            endif
         end do
         do i=1,MAX_LINE_NOTES
            if( line_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(line_notes(i)%window)
               if( line_notes(i)%use_graph_coords ) then
                  call anno_graph_to_norm_coords(
     1                 line_notes(i)%x1,line_notes(i)%y1,1,x1,y1)
                  call anno_graph_to_norm_coords(
     1                 line_notes(i)%x2,line_notes(i)%y2,1,x2,y2)
               else
                  x1 = line_notes(i)%x1
                  y1 = line_notes(i)%y1
                  x2 = line_notes(i)%x2
                  y2 = line_notes(i)%y2
               endif
               xmin = 0.95*MIN(x1,x2)
               xmax = 1.05*MAX(x1,x2)
               ymin = 0.95*MIN(y1,y2)
               ymax = 1.05*MAX(y1,y2)
               if( note_wsid .eq. wsid .and.
     1             pos_x .ge. xmin .and. pos_x .le. xmax .and.
     1             pos_y .gt. ymin .and. pos_y .le. ymax ) then
                  seg = line_notes(i)%segment
                  qwin_note_type = LINE_NOTE_TYPE
                  qwin_note_id = i
                  goto 1000
               endif
            endif
         end do
         do i=1,MAX_ELLIPSE_NOTES
            if( ellipse_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(ellipse_notes(i)%window)
               if( ellipse_notes(i)%use_graph_coords ) then
                  call anno_graph_to_norm_coords(
     1                 ellipse_notes(i)%x1,ellipse_notes(i)%y1,1,x1,y1)
                  call anno_graph_to_norm_coords(
     1                 ellipse_notes(i)%x2,ellipse_notes(i)%y2,1,x2,y2)
               else
                  x1 = ellipse_notes(i)%x1
                  y1 = ellipse_notes(i)%y1
                  x2 = ellipse_notes(i)%x2
                  y2 = ellipse_notes(i)%y2
               endif
               xmin = MIN(x1,x2)
               xmax = MAX(x1,x2)
               ymin = MIN(y1,y2)
               ymax = MAX(y1,y2)
               if( note_wsid .eq. wsid .and.
     1             pos_x .ge. xmin .and. pos_x .le. xmax .and.
     1             pos_y .gt. ymin .and. pos_y .le. ymax ) then
                  seg = ellipse_notes(i)%segment
                  qwin_note_type = ELLIPSE_NOTE_TYPE
                  qwin_note_id = i
                  goto 1000
               endif
            endif
         end do
      endif
c
c     If we reached here, we didn't find a segment that was within the
c     pointer location.
      istatus = 0
c
1000  continue
c
      return
      end
c
      subroutine gks$inq_max_ds_size(wstype, err, units, px, py,
     1           rasx, rasy )
      use dflib
      implicit none
c
      integer wstype, err, units, rasx, rasy
      real px, py
c
      type(windowconfig) wconfig
      logical rc
c
      rc = getwindowconfig(wconfig)
      rasx = wconfig.numxpixels
      rasy = wconfig.numypixels
      px = float(wconfig.numxpixels)
      py = float(wconfig.numypixels)
c
      return
      end
c
      subroutine gks$set_text_expfac(efactor)
      implicit none
      real efactor
c
      include 'gks_to_qwin.cmn'
c
      gks_text_expfac = efactor
c
      return
      end
c
      subroutine gks$escape(esc_id, in_data, in_data_size,
     1                      out_buffer, record_buffer_length,
     2                      record_size)
      use dflib
      implicit none
c
      integer esc_id, in_data_size, record_buffer_length, record_size
c
c     The variables declared integer*4 should be *8 under 64bit addressing os's
      structure /gesc/
         integer    nints
         integer    nfloats
         integer    nstr
         integer*4  int_addr
         integer*4  float_addr
         integer*4  str_len_addr
         integer*4  str_addr
         integer    npointers
         integer*4  pointer_addr
         integer    nlongs
         integer*4  long_addr
      end structure 
      record /gesc/ in_data, out_buffer
c
      include 'gksdefs.f'
      include 'const.h'
      include 'sysdep.cmn'
      include 'annotations.cmn'
      include 'gks_to_qwin.cmn'
c
      integer wrt_mode, segment, wsid, note_wsid, i
      integer pm_deref_int, lookup_ws_id
      integer*2 rc, old_color
      real x(1), x0, y0
      pointer (px,x)
c
      if( esc_id .eq. GKS$K_ESC_SET_WRITING_MODE ) then
         wrt_mode = pm_deref_int(%VAL(in_data.int_addr),1)
         if( wrt_mode .eq. GKS$K_WRT_MODE_COMPLEMENT ) then
            old_color = setcolor(0)
            rc = setwritemode($GXOR)
         else if( wrt_mode .eq. GKS$K_WRT_MODE_DEFAULT ) then
            old_color = setcolor(qwin_color_index)
            rc = setwritemode($GPSET)
         endif
      else if( esc_id .eq. GKS$K_ESC_INQ_SEGMENT_EXTENT ) then
c        Returning the segment origin is OK for the current level
c        of emulation.
         wsid    = pm_deref_int(%VAL(in_data.int_addr),1)
         segment = pm_deref_int(%VAL(in_data.int_addr),2)
c
         do i=1,MAX_TEXT_NOTES
            if( text_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(text_notes(i)%window)
               if( note_wsid .eq. wsid .and.
     1             text_notes(i)%segment .eq. segment ) then
                  if( text_notes(i)%use_x_graph_coords .and.
     1                text_notes(i)%use_y_graph_coords ) then
                     call anno_graph_to_norm_coords(
     1                  text_notes(i)%xloc,text_notes(i)%yloc,1,x0,y0)
                  else if( text_notes(i)%use_x_graph_coords ) then
                     call anno_graph_to_norm_coords(
     1                  text_notes(i)%xloc,1.0,1,x0,y0)
                     y0 = text_notes(i)%yloc
                  else if( text_notes(i)%use_y_graph_coords ) then
                     call anno_graph_to_norm_coords(
     1                  1.0,text_notes(i)%yloc,1,x0,y0)
                     x0 = text_notes(i)%xloc
                  else
                     x0 = text_notes(i)%xloc
                     y0 = text_notes(i)%yloc
                  endif
                  goto 100
               endif
            endif
         end do
c
         do i=1,MAX_LINE_NOTES
            if( line_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(line_notes(i)%window)
               if( note_wsid .eq. wsid .and.
     1             line_notes(i)%segment .eq. segment ) then
                  if( line_notes(i)%use_graph_coords ) then
                     call anno_graph_to_norm_coords(
     1                  line_notes(i)%x1,line_notes(i)%y1,1,x0,y0)
                  else
                     x0 = line_notes(i)%x1
                     y0 = line_notes(i)%y1
                  endif
                  goto 100
               endif
            endif
         end do
c
         do i=1,MAX_BOX_NOTES
            if( box_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(box_notes(i)%window)
               if( note_wsid .eq. wsid .and.
     1             box_notes(i)%segment .eq. segment ) then
                  if( box_notes(i)%use_graph_coords ) then
                     call anno_graph_to_norm_coords(
     1                  box_notes(i)%x1,box_notes(i)%y1,1,x0,y0)
                  else
                     x0 = box_notes(i)%x1
                     y0 = box_notes(i)%y1
                  endif
                  goto 100
               endif
            endif
         end do
c
         do i=1,MAX_MARKER_NOTES
            if( marker_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(marker_notes(i)%window)
               if( note_wsid .eq. wsid .and.
     1             marker_notes(i)%segment .eq. segment ) then
                  if( marker_notes(i)%use_graph_coords ) then
                     call anno_graph_to_norm_coords(
     1               marker_notes(i)%xloc,marker_notes(i)%yloc,1,x0,y0)
                  else
                     x0 = marker_notes(i)%xloc
                     y0 = marker_notes(i)%yloc
                  endif
                  goto 100
               endif
            endif
         end do
c
         do i=1,MAX_ELLIPSE_NOTES
            if( ellipse_notes(i)%window .ne. -1 ) then
               note_wsid = lookup_ws_id(ellipse_notes(i)%window)
               if( note_wsid .eq. wsid .and.
     1             ellipse_notes(i)%segment .eq. segment ) then
                  if( ellipse_notes(i)%use_graph_coords ) then
                     call anno_graph_to_norm_coords(
     1               ellipse_notes(i)%x1,ellipse_notes(i)%y1,1,x0,y0)
                  else
                     x0 = ellipse_notes(i)%x1
                     y0 = ellipse_notes(i)%y1
                  endif
                  goto 100
               endif
            endif
         end do
c
100      continue
c        Use a "Cray" pointer variable to transfer data into specified address
         px = out_buffer.float_addr
         x(1) = x0
         x(2) = x0
         x(3) = y0
         x(4) = y0
      endif
c
      return
      end
c
      integer function pm_deref_int(iarray,i)
      implicit none
c
      integer i, iarray(*)
c
      pm_deref_int = iarray(i)
c
      return
      end
c
      subroutine gks$close_seg()
      implicit none
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      gks_state = GKS$K_WSAC
c
      return
      end
c
      subroutine gks$polymarker_old(npts, x, y)
      use dflib
      implicit none
c
      integer npts
      real x(npts), y(npts)
c
      include 'gks_to_qwin.cmn'
c
      integer i
      integer*2 width
      double precision xx,yy
      type(wxycoord) wxy
      type(xycoord)  xy
      type(fontinfo) info
      integer*2 rc, old_color
c
c     It's probably better in the long run to implement markers with
c     drawing routines, rather than use fonts.
c
      width = getgtextextent('o')
      rc = getfontinfo(info)
c
      if( qwin_color_index .ne. gks_pmark_color_index ) then
         qwin_color_index = gks_pmark_color_index
         old_color = setcolor(qwin_color_index)
      endif
c
      do i=1,npts
         xx = x(i)
         yy = y(i)
         call getviewcoord_w(xx,yy,xy)
         xy.xcoord = xy.xcoord - width/2
         xy.ycoord = xy.ycoord - info.pixheight/2
         call getwindowcoord(xy.xcoord,xy.ycoord,wxy)
         xx = wxy.wx
         yy = wxy.wy
         call moveto_w(xx,yy,wxy)
         call outgtext('o')
      end do
c
      return
      end
c
      subroutine gks$set_viewport_priority(xform1, xform2, prio)
      implicit none
      integer xform1, xform2, prio
      return
      end
c
      subroutine gks$set_defer_state(wsid, dmode, rmode)
      implicit none
      integer wsid, dmode, rmode
      return
      end
c
      subroutine gks$delete_seg(id)
      use dflib
      implicit none
c
      integer id
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'annotations.cmn'
      include 'plot.cmn'
      include 'gks_to_qwin.cmn'
c
      integer*2 rc, old_color
      integer i, note_ws, irc, rgb, old_rgb, lookup_ws_id
      logical error_occurred, lactive
c
c     If workstation is deactivated, then make it active for the duration
c     of this subroutine call.
      lactive = .FALSE.
      do i=1,NUM_WS
         if( gks_wsid_list(i) .eq. ws_id .and.
     1       gks_ws_active_list(i) .eq. .FALSE. ) then
            rgb = #FFFFFF   ! This should be set to the actual
                            ! color index 0 value user set
            old_rgb = setbkcolorrgb(rgb)
            rc = setactiveqq(ws_id)
            lactive = .TRUE.
            goto 100
         endif
      end do
100   continue
c
      if( qwin_note_type .eq. TEXT_NOTE_TYPE ) then
         note_ws = lookup_ws_id(text_notes(qwin_note_id)%window)
         if( note_ws .eq. ws_id .and.
     1      text_notes(qwin_note_id)%segment .eq. id ) then
!           Draw in background to "erase" (doesn't work if annotation
!           is over other graphics)
            old_color = setcolor(0)
!           We do the following to fool drawing routine so that it does not
!           change the Quickwin color index
            qwin_color_index = text_notes(qwin_note_id)%color
            call anno_draw_text(qwin_note_id,ws_id,error_occurred)
!           Now reset color index
            qwin_color_index = old_color
            old_color = setcolor(old_color)
         endif
      else if( qwin_note_type .eq. MARKER_NOTE_TYPE ) then
         note_ws = lookup_ws_id(marker_notes(qwin_note_id)%window)
         if( note_ws .eq. ws_id .and.
     1      marker_notes(qwin_note_id)%segment .eq. id ) then
            old_color = setcolor(0)
            qwin_color_index = marker_notes(qwin_note_id)%color
            call anno_draw_marker(qwin_note_id)
            qwin_color_index = old_color
            old_color = setcolor(old_color)
         endif
      else if( qwin_note_type .eq. LINE_NOTE_TYPE ) then
         note_ws = lookup_ws_id(line_notes(qwin_note_id)%window)
         if( note_ws .eq. ws_id .and.
     1      line_notes(qwin_note_id)%segment .eq. id ) then
            old_color = setcolor(0)
            qwin_color_index = line_notes(qwin_note_id)%color
            call anno_draw_line(qwin_note_id)
            qwin_color_index = old_color
            old_color = setcolor(old_color)
         endif
      else if( qwin_note_type .eq. BOX_NOTE_TYPE ) then
         note_ws = lookup_ws_id(box_notes(qwin_note_id)%window)
         if( note_ws .eq. ws_id .and.
     1      box_notes(qwin_note_id)%segment .eq. id ) then
            old_color = setcolor(0)
!           We do the following to force color to stay at index 0
!           although this doesn't work if the box has an interior fill
!           color different from the boundary color index
            qwin_color_index = box_notes(qwin_note_id)%color
            call anno_draw_box(qwin_note_id)
            qwin_color_index = old_color
            old_color = setcolor(old_color)
         endif
      else if( qwin_note_type .eq. ELLIPSE_NOTE_TYPE ) then
         note_ws = lookup_ws_id(ellipse_notes(qwin_note_id)%window)
         if( note_ws .eq. ws_id .and.
     1      ellipse_notes(qwin_note_id)%segment .eq. id ) then
            old_color = setcolor(0)
            qwin_color_index = ellipse_notes(qwin_note_id)%color
            call anno_draw_ellipse(qwin_note_id,.TRUE.)
            qwin_color_index = old_color
            old_color = setcolor(old_color)
         endif
      endif
c
1000  continue
c
      if( lactive ) then
         rc = setactiveqq(qwin_console_lu)
         old_rgb = setbkcolorrgb(old_rgb)
      endif
c
      return
      end
c
      subroutine gks$init_locator(wsid, dev, px, py, xform, pet, echo,
     1                            data_record, rec_len)
      implicit none
      integer wsid, dev, xform, pet, rec_len
      real px, py, echo(4)
      integer data_record(2)
c
      return
      end
c
      subroutine gks$inq_color_fac(wstype, err, ncolors, flag, nindices)
      use dflib
      implicit none
c
      integer wstype, err, ncolors, flag, nindices
c
      include 'gksdefs.f'
c
      flag = GKS$K_COLOR
      ncolors = 256
      nindices = 256
c
      return
      end
c
      subroutine gks$set_locator_mode(wsid, dev, imode, iecho)
      implicit none
      integer wsid, dev, imode, iecho
      end
c
      subroutine gks$set_ws_viewport(wsid, x1, x2, y1, y2)
      implicit none
      integer wsid
      real x1, x2, y1, y2
      return
      end
c
      subroutine gks$inq_text_extent(wsid, px, py, string, err,
     1           con_pt_x, con_pt_y, ext_x, ext_y)
      use dflib
      implicit none
c
      integer wsid, err
      character*(*) string
      real px, py, con_pt_x, con_pt_y, ext_x(4), ext_y(4)
c
      include 'gks_to_qwin.cmn'
c
      type(wxycoord) wxy
      integer*2 width, height
      double precision xx,yy, theta, sint, cost
      type(xycoord)  xy
      type(fontinfo) info
      integer*2 ix, iy, irc
      type(windowconfig) wconfig
      real ratio
      logical rc
c
c     This code ASSUMES normal text alignment (should be modified for
c     all text alignments for general use...)
c
      width = getgtextextent(string)
      irc = getfontinfo(info)
      height = info.pixheight
c
      xx = px
      yy = py
      call getviewcoord_w(xx,yy,xy)
c
      rc = getwindowconfig(wconfig)
      ratio = FLOAT(wconfig.numypixels)/FLOAT(wconfig.numxpixels)
c
      theta = atan2(gks_text_upvec(1)*ratio,gks_text_upvec(2))
      sint = sin(theta)
      cost = cos(theta)
c
c     Compute concatenation point
      ix = xy.xcoord
      iy = xy.ycoord
      ix = ix + width*cost
      iy = iy + width*sint
      call getwindowcoord(ix,iy,wxy)
      con_pt_x = wxy.wx
      con_pt_y = wxy.wy
c
c     Compute extent box
      ext_x(1) = px
      ext_y(1) = py
c
      ext_x(2) = con_pt_x
      ext_y(2) = con_pt_y
c
      ix = xy.xcoord
      iy = xy.ycoord
      ix = ix + width*cost
      iy = iy + width*sint
      ix = ix + height*sint
      iy = iy - height*cost
      call getwindowcoord(ix,iy,wxy)
      ext_x(3) = wxy.wx
      ext_y(3) = wxy.wy
c
      ix = xy.xcoord
      iy = xy.ycoord
      ix = ix + height*sint
      iy = iy - height*cost
      call getwindowcoord(ix,iy,wxy)
      ext_x(4) = wxy.wx
      ext_y(4) = wxy.wy
c
      err = 0
c
      return
      end
c
      subroutine gks$set_color_rep(wsid, index, r, g, b)
      use dflib
      implicit none
c
      integer wsid, index
      real r, g, b
c
      integer rc, color
      integer ir, ig, ib
c
      ir = INT(r*255.0)
      ig = INT(g*255.0)
      ib = INT(b*255.0)
      color = ir + 256*ig + 65536*ib
c
      rc = remappalettergb(index,color)
c
      return
      end
c
      subroutine gks$inq_operating_state(op_state)
      implicit none
      integer op_state
c
      include 'gks_to_qwin.cmn'
c
      op_state = gks_state
c
      return
      end
c
      subroutine gks$fill_area(npts, x, y)
      use dflib
      implicit none
c
      integer npts
      real x(npts), y(npts)
c
      include 'gks_to_qwin.cmn'
c
      type(wxycoord) wxy(100)
      integer i, rc
      integer*2 old_color
c
      if( npts .gt. 100 ) return
c
      if( qwin_color_index .ne. gks_fill_color_index ) then
         qwin_color_index = gks_fill_color_index
         old_color = setcolor(qwin_color_index)
      endif
c
      do i=1,npts
         wxy(i).wx = x(i)
         wxy(i).wy = y(i)
      end do
      rc = polygon_w($GFILLINTERIOR,wxy,npts)
c
      return
      end
c
      subroutine gks$set_pline_color_index(index)
      use dflib
      implicit none
c
      integer index
c
      integer*2 old_color
c
      include 'gks_to_qwin.cmn'
c
      gks_pline_color_index = index
c
      if( qwin_color_index .ne. gks_pline_color_index ) then
         qwin_color_index = gks_pmark_color_index
         old_color = setcolor(qwin_color_index)
      endif
c
      return
      end
c
      integer function gks$select_xform(xform)
      implicit none
      integer xform
c
      include 'sysdep.cmn'
      include 'gksdefs.f'
c
      gks$select_xform = GKS$_SUCCESS
c
      return
      end
c
      subroutine gks$set_text_height(height)
      implicit none
      real height
      return
      end
c
      subroutine gks$update_ws(wsid, cntl)
      implicit none
      integer wsid, cntl
      return
      end
c
      subroutine gks$set_fill_color_index(index)
      use dflib
      implicit none
c
      integer index
c
      include 'gks_to_qwin.cmn'
c
      integer*2 old_color
c
      gks_fill_color_index = index
c
      if( qwin_color_index .ne. gks_fill_color_index ) then
         qwin_color_index = gks_fill_color_index
         old_color = setcolor(qwin_color_index)
      endif
c
      return
      end
c
      subroutine gks$polyline(npts, x, y)
      use dflib
      implicit none
c
      integer npts
      real x(npts), y(npts)
c
      include 'gks_to_qwin.cmn'
c
      integer i, rc
      type (wxycoord) wxy
      integer*2 old_color
c
      if( qwin_color_index .ne. gks_pline_color_index ) then
         qwin_color_index = gks_pline_color_index
         old_color = setcolor(qwin_color_index)
      endif
c
      call moveto_w(DBLE(x(1)),DBLE(y(1)),wxy)
      do i=2,npts
         rc = lineto_w(DBLE(x(i)),DBLE(y(i)))
      end do
c
      return
      end
c
      subroutine gks$request_locator(wsid, dev, istatus, xform,
     1                               pos_x, pos_y)
      use dflib
      use dfwin
      implicit none
c
      integer wsid, dev, istatus, xform
      real pos_x, pos_y
c
      include 'gks_to_qwin.cmn'
c
      type(wxycoord) wt
      integer mouseevent, keystate, ix,iy, result, state, istat
c
c     Change mouse cursor to a cross
      qwin_cursor    = LoadCursor(0, IDC_CROSS)
c     (NOTE: new QWIN call as of Compaq Visual Fortran V6.1)
      istat = setmousecursor(qwin_cursor)
c
      state = 0
      mouseevent = MOUSE$LBUTTONDOWN .OR. MOUSE$RBUTTONDOWN
      result = waitonmouseevent(mouseevent,keystate,ix,iy)
c
      if( keystate .and. MOUSE$KS_LBUTTON ) then
         state = 1
      else
c        This is our 'cancel' input
         state = 2
      endif
c
      mouseevent = MOUSE$LBUTTONUP .OR. MOUSE$RBUTTONUP
      result = waitonmouseevent(mouseevent,keystate,ix,iy)
c
      if( state .eq. 1 ) then
         call getwindowcoord(ix,iy,wt)
         pos_x = wt.wx
         pos_y = wt.wy
         istatus = 1
      else
         istatus = 0
      endif
c
c     Reset things...
c     Change mouse cursor to a arrow
      qwin_cursor = LoadCursor(0, IDC_ARROW) 
      istat = setmousecursor(qwin_cursor)
c
      return
      end
c
      subroutine gks$inq_pick_state(wsid, dev,
     1              type, error_status, input_mode,
     2              echo_flag, init_status, init_seg, init_pick,
     3              init_pet, init_echo_area, record_buffer,
     4              record_buffer_length, record_size)
      implicit none
c
      integer wsid, dev, type, error_status, input_mode, echo_flag,
     1        init_status, init_seg, init_pick, init_pet
      integer record_buffer_length, record_size
      real init_echo_area(4), record_buffer(1)
      return
      end
c
      integer function gks$set_window(xform, x1, x2, y1, y2)
      use dflib
      implicit none
c
      integer xform
      real x1, x2, y1, y2
c
      include 'sysdep.cmn'
      include 'gksdefs.f'
c
      logical*2 finvert
      double precision wx1,wx2,wy1,wy2
      integer rc
c
      finvert = .TRUE.
      wx1 = x1
      wx2 = x2
      wy1 = y2
      wy2 = y1
      rc = setwindow(finvert, wx1, wy1, wx2, wy2)
c
      gks$set_window = GKS$_SUCCESS
c
      return
      end
c
      subroutine gks$gdp(isize,x,y,igdp,in_esc,in_data_size)
      implicit none
c
      integer isize, igdp, in_esc, in_data_size
      real x,y
c
      return
      end
c
      subroutine gks$set_pline_linetype(itype)
      use dflib
      implicit none
c
      integer itype
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      integer*2 mask
c
      gks_pline_linetype = itype
c
      select case(itype)
      case (GKS$K_LINETYPE_SOLID)
         mask = #FFFF
      case (GKS$K_LINETYPE_DASHED)
         mask = #FF00
      case (GKS$K_LINETYPE_DOTTED)
         mask = #3333
      case (GKS$K_LINETYPE_DASHED_DOTTED)
         mask = #FF18
      case (GKS$K_LINETYPE_DASH_2_DOT)
         mask = #FF6C
      case (GKS$K_LINETYPE_DASH_3_DOT)
         mask = #FF54
      case (GKS$K_LINETYPE_LONG_DASH)
         mask = #FFF0
      case (GKS$K_LINETYPE_LONG_SHORT_DASH)
         mask = #FF3C
      case (GKS$K_LINETYPE_SPACED_DASH)
         mask = #F0F0
      case (GKS$K_LINETYPE_SPACED_DOT)
         mask = #1818
      case (GKS$K_LINETYPE_DOUBLE_DOT)
         mask = #6C6C
      case (GKS$K_LINETYPE_TRIPLE_DOT)
         mask = #2A2A
      case default
         mask = #FFFF
      end select
c
      call setlinestyle(mask)
c
      return
      end
c
      subroutine gks$set_text_fontprec(font, prec)
      use dflib
      implicit none
c
      integer font, prec
c
      include 'gks_to_qwin.cmn'
c
      integer*2 irc
      character*60 font_name
      integer ilen, string_len
c
      gks_text_font = font
      gks_text_prec = prec
c
      if( font .eq. -101 ) then ! New Times
         qwin_font_name = 'Times New Roman'
         qwin_font_style = ' '
      else if( font .eq. -103 ) then ! New Times bold
         qwin_font_name = 'Times New Roman'
         qwin_font_style = 'b'
      else if( font .eq. -102 ) then ! New Times italic
         qwin_font_name = 'Times New Roman'
         qwin_font_style = 'i'
      else if( font .eq. -109 ) then ! Courier
         qwin_font_name = 'Courier New'
         qwin_font_style = ' '
      else if( font .eq. -111 ) then ! Courier bold
         qwin_font_name = 'Courier New'
         qwin_font_style = 'b'
      else if( font .eq. -110 ) then ! Courier oblique
         qwin_font_name = 'Courier New'
         qwin_font_style = 'i'
      else if( font .eq. -105 ) then ! Arial
         qwin_font_name = 'Arial'
         qwin_font_style = ' '
      else if( font .eq. -107 ) then ! Arial bold
         qwin_font_name = 'Arial'
         qwin_font_style = 'b'
      else if( font .eq. -106 ) then ! Arial oblique
         qwin_font_name = 'Arial'
         qwin_font_style = 'i'
      else if( font .eq. -113 ) then ! Symbol
         qwin_font_name = 'Symbol'
         qwin_font_style = ' '
      else if( font .eq. -9 ) then
         qwin_font_name  = 'Arial'
         qwin_font_style = ' '
      else
         qwin_font_name  = 'Arial'
         qwin_font_style = ' '
      endif
c
      ilen = string_len(qwin_font_name)
      if( qwin_font_height .lt. 10 ) then
         write(font_name,100) qwin_font_name(1:ilen), qwin_font_height,
     1                        qwin_font_style
100      format('t''',a,'''h',i1,a)
      else
         write(font_name,101) qwin_font_name(1:ilen), qwin_font_height,
     1                        qwin_font_style
101      format('t''',a,'''h',i2,a)
      endif
      irc = setfont(font_name)
**      write(100,*) gks_text_font, qwin_font_name(1:20),
**     1             font_name(1:20), irc
c
      return
      end
c
      subroutine gksqwin_scale_text_size(scale)
      use dflib
      implicit none
c
      real scale
c
      include 'gks_to_qwin.cmn'
c
      integer*2 irc
      character*60 font_name
      integer ilen, string_len, height
c
      ilen = string_len(qwin_font_name)
      height = INT(FLOAT(qwin_font_height)*scale)
      if( height .lt. 10 ) then
         write(font_name,100) qwin_font_name(1:ilen), height,
     1                   qwin_font_style
100      format('t''',a,'''h',i1,a)
      else
         write(font_name,101) qwin_font_name(1:ilen), height,
     1                   qwin_font_style
101      format('t''',a,'''h',i2,a)
      endif
      irc = setfont(font_name)
**      write(100,*) gks_text_font, qwin_font_name(1:20),
**     1             font_name(1:20), irc
c
      return
      end
c
      subroutine gks$set_clipping(flag)
      implicit none
      integer flag
      return
      end
c
      subroutine gks$create_seg(id)
      implicit none
c
      integer id
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      gks_state = GKS$K_SGOP
c
      return
      end
c
      subroutine gks$set_pline_linewidth(width)
      implicit none
      real width
c
      include 'gks_to_qwin.cmn'
c
      gks_pline_linewidth = width
c
      return
      end
c
      subroutine gks$close_ws(wsid)
      implicit none
      integer wsid
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      integer i
c
      do i=1,NUM_WS
         if( gks_wsid_list(i) .eq. wsid ) then
            gks_wsid_list(i) = -1
         endif
      end do
c
      close(unit=wsid)
c
      return
      end
c
      subroutine gks$inq_indiv_attb(err, pl_type, pl_width, pl_index,
     1     pm_type, pm_size, pm_index,
     2     text_font, text_prec, char_exp_fac, char_spacing,
     3     text_index, interior_style, style_index, fill_index,
     4     attrib_sflgs)
c
      implicit none
c
      integer pl_type, pl_index, pm_type, pm_index, text_index
      integer interior_style, style_index, fill_index
      integer attrib_sflgs(13)
      real    pl_width, pm_size, char_exp_fac, char_spacing
      integer text_font, text_prec
      integer err
c
      include 'gks_to_qwin.cmn'
      include 'gksmsgs.f'
c
      err = 0
c
      pl_type  = gks_pline_linetype
      pl_width = gks_pline_linewidth
      pl_index = gks_pline_color_index
c
      pm_type  = gks_pmark_type
      pm_size  = gks_pmark_size
      pm_index = gks_pmark_color_index
c
      text_index   = gks_text_color_index
      char_spacing = gks_text_spacing
      char_exp_fac = gks_text_expfac
      text_font    = gks_text_font
      text_prec    = gks_text_prec
c
      return
      end
c
      subroutine gks$close_gks()
      implicit none
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      gks_state = GKS$K_GKCL
c
      return
      end
c
      subroutine gks$set_pmark_size(size)
      implicit none
      real size
c
      include 'gks_to_qwin.cmn'
c
      gks_pmark_size = size
c
      return
      end
c
      subroutine gks$set_text_align(halign, valign)
      implicit none
      integer halign, valign
c
      include 'gks_to_qwin.cmn'
c
      gks_text_halign = halign
      gks_text_valign = valign
c
      return
      end
c
      subroutine gks$inq_prim_attb(err, list_bundle_indexes,
     1           ch_height, ch_up_vec, ch_width, text_base_vec,
     2           ch_path, ch_align, pattern_width, pattern_height,
     3           pattern_ref_pt)
      use dflib
      implicit none
c
c     CAUTION: only elements that Postmini uses are inquired
c
      integer err, list_bundle_indexes(4), ch_path, ch_align(2)
      real    ch_height, ch_up_vec(2), ch_width, text_base_vec(2),
     1        pattern_width(2), pattern_height(2), pattern_ref_pt(2)
c
      include 'gks_to_qwin.cmn'
c
      type(fontinfo) info
      integer*2 rc
      type(xycoord) xy
      type(wxycoord) wxy
      double precision xx, yy
c
      err = 0
c
c     Compute height of current font in world coordinate units
      rc = getfontinfo(info)
      xx = 0.0
      yy = 0.0
      call getviewcoord_w(xx,yy,xy)
      xy.ycoord = xy.ycoord - info.pixheight
      call getwindowcoord(xy.xcoord,xy.ycoord,wxy)
c
      ch_up_vec(1) = gks_text_upvec(1)
      ch_up_vec(2) = gks_text_upvec(2)
c
      ch_height = wxy.wy
c
      ch_align(1) = gks_text_halign
      ch_align(2) = gks_text_valign
c
      return
      end
c
      subroutine gks$set_seg_detectability(id, detect)
      implicit none
      integer id, detect
      return
      end
c
      integer function gks$open_ws(wsid, conid, wstype)
      use dflib
      implicit none
c
      integer wsid, wstype
      character*(*) conid
c
      include 'gksdefs.f'
      include 'gksmsgs.f'
      include 'gks_to_qwin.cmn'
c
      type (windowconfig) wc
      type (qwinfo) winfo
      integer*2 num_fonts, irc
      logical rc, lfound
      integer ilen, i, string_len
      character*60 font_name
c
c     Allow the Motif workstation type only
      if( IAND(wstype,#FFFF) .ne. GKS$K_MOTIF ) then
         gks$open_ws = GKS$_ERROR_26
         return
      endif
c
      lfound = .FALSE.
      do i=1,NUM_WS
         if( gks_wsid_list(i) .eq. -1 ) then
            gks_wsid_list(i) = wsid
            gks_ws_active_list(i) = .FALSE.
            lfound = .TRUE.
            goto 10
         endif
      end do
10    continue
      if( .NOT. lfound ) then
         gks$open_ws = GKS$_ERROR_26
         return
      endif
c
      gks_state = GKS$K_WSOP
c
      open(unit=wsid,file='USER',status='UNKNOWN')
      rc = setactiveqq(wsid)
      num_fonts = initializefonts()
      wc.numxpixels = 500
      wc.numypixels = 375
      wc.numtextcols = -1
      wc.numtextrows = -1
      wc.numcolors = -1
*     wc.fontsize = #0007000F   ! 7x15 font
      wc.fontsize = -1
      wc.title = 'Postmini Plot Window'C
      rc = setwindowconfig(wc)
*      if( .not. rc ) then
*         rc = setwindowconfig(wc)
*      endif
*      irc = displaycursor($GCURSORON)
*      write(100,*) 'rows,cols = ',wc.numtextrows, wc.numtextcols
      winfo.type = QWIN$SET
      winfo.x = 30
      winfo.y = 3
      winfo.h = 100 ! wc.numtextrows
      winfo.w = 100 !wc.numtextcols
      irc = setwsizeqq(wsid,winfo)
      ilen = string_len(qwin_font_name)
      if( qwin_font_height .lt. 10 ) then
         write(font_name,100) qwin_font_name(1:ilen), qwin_font_height,
     1      qwin_font_style
100      format('t''',a,'''h',i1,a)
      else
         write(font_name,101) qwin_font_name(1:ilen), qwin_font_height,
     1      qwin_font_style
101      format('t''',a,'''h',i2,a)
      endif
      irc = setfont(font_name)
c
      gks$open_ws = GKS$_SUCCESS
c
      return
      end
c
      subroutine gks$inq_ws_xform(wsid, err, state, r_win, c_win,
     1                            r_view, c_view)
      use dflib
      implicit none
c
      integer wsid, err, state
      real r_win(4), c_win(4), r_view(4), c_view(4)
c
      type (windowconfig) wc
      logical rc
c
      rc = getwindowconfig(wc)
c
      c_view(1) = 0.0
      c_view(2) = FLOAT(wc.numxpixels)
      c_view(3) = 0.0
      c_view(4) = FLOAT(wc.numypixels)
c
      return
      end
c
      subroutine gks$deactivate_ws(wsid)
      use dflib
      implicit none
c
      integer wsid
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      integer rc, rgb, old_rgb, i
c
c     Reset qwin color state so that color is set on re-entry
      qwin_color_index = -1
c
      gks_state = GKS$K_WSOP
      do i=1,NUM_WS
         if( gks_wsid_list(i) .eq. wsid ) then
            gks_ws_active_list(i) = .FALSE.
         endif
      end do
c
c     Set console window to receive graphics activity
      rc = setactiveqq(qwin_console_lu)
      rgb = #FFFFFF  ! White
      old_rgb = setbkcolorrgb(rgb)
      return
      end
c
      subroutine gks$set_text_upvec(x, y)
      use dflib
      implicit none
c
      real x, y
c
      include 'gks_to_qwin.cmn'
c
      type(windowconfig) wconfig
      real ang, ratio
      integer tenths_of_degree
      logical rc
c
      gks_text_upvec(1) = x
      gks_text_upvec(2) = y
c
      rc = getwindowconfig(wconfig)
      ratio = FLOAT(wconfig.numypixels)/FLOAT(wconfig.numxpixels)
c
      ang = -180.0/3.14159245*atan2(x*ratio,y)
      tenths_of_degree = INT(ang*10.0)
      call setgtextrotation(tenths_of_degree)
c
      return
      end
c
      subroutine gks$text(x, y, text)
      use dflib
      implicit none
c
      real x, y
      character*(*) text
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      type(wxycoord) wxy
      integer*2 width
      double precision xx,yy, theta, sint, cost, delx, dely, ratio
      type(windowconfig)  wconfig
      type(xycoord)  xy
      type(fontinfo) info
      integer*2 rc, old_color
      integer ilen, string_len
      logical lrc
c
      ilen = MAX(1,string_len(text))
      width = getgtextextent(text(1:ilen))
      rc = getfontinfo(info)
c
      if( qwin_color_index .ne. gks_text_color_index ) then
         qwin_color_index = gks_text_color_index
         old_color = setcolor(qwin_color_index)
      endif
c
      xx = x
      yy = y
      call getviewcoord_w(xx,yy,xy)
c
c     Adjust angle by aspect ratio of plot window
c
      lrc = getwindowconfig(wconfig)
      ratio = FLOAT(wconfig.numypixels)/FLOAT(wconfig.numxpixels)
      theta = atan2(gks_text_upvec(1)*ratio, gks_text_upvec(2))
      sint = sin(theta)
      cost = cos(theta)
c
      if( gks_text_halign .eq. GKS$K_TEXT_HALIGN_NORMAL .or.
     1    gks_text_halign .eq. GKS$K_TEXT_HALIGN_LEFT ) then
c
      else if( gks_text_halign .eq. GKS$K_TEXT_HALIGN_CENTER ) then
         xy.xcoord = xy.xcoord - width/2*cost
         xy.ycoord = xy.ycoord - width/2*sint
      else if( gks_text_halign .eq. GKS$K_TEXT_HALIGN_RIGHT ) then
         xy.xcoord = xy.xcoord - width*cost
         xy.ycoord = xy.ycoord - width*sint
      endif
c
      if( gks_text_valign .eq. GKS$K_TEXT_VALIGN_NORMAL .or.
     1    gks_text_valign .eq. GKS$K_TEXT_VALIGN_BASE .or.
     1    gks_text_valign .eq. GKS$K_TEXT_VALIGN_BOTTOM) then
         xy.ycoord = xy.ycoord - info.pixheight*cost
         xy.xcoord = xy.xcoord + info.pixheight*sint
      else if( gks_text_valign .eq. GKS$K_TEXT_VALIGN_HALF ) then
         xy.ycoord = xy.ycoord - info.pixheight/2*cost
         xy.xcoord = xy.xcoord + info.pixheight/2*sint
      else if( gks_text_valign .eq. GKS$K_TEXT_VALIGN_TOP .or.
     1         gks_text_valign .eq. GKS$K_TEXT_VALIGN_CAP ) then
      endif
c
      call getwindowcoord(xy.xcoord,xy.ycoord,wxy)
      xx = wxy.wx
      yy = wxy.wy
      call moveto_w(xx,yy,wxy)
      call outgtext(text(1:ilen))
c
      return
      end
c
      subroutine gks$set_fill_int_style(istyle)
      implicit none
      integer istyle
      return
      end
c
      subroutine gks$await_event(timeout, work_id, class, dev_num)
      implicit none
c
      real timeout
      integer work_id, class, dev_num
c
      return
      end
c
      subroutine gks$get_locator(xform, x, y)
      implicit none
c
      real x, y
      integer xform
c
      return
      end
c
      subroutine gks$set_fill_style_index(istyle)
      implicit none
c
      integer istyle
c
      return
      end
c
      subroutine gks$gpd(isize,x,y,igdp,in_esc,in_data_size)
      implicit none
c
      integer isize, igdp, in_data_size
      real x(isize), y(isize)
c
c     The variables declared integer*4 should be *8 under 64bit addressing os's
      structure /gesc/
         integer    nints
         integer    nfloats
         integer    nstr
         integer*4  int_addr
         integer*4  float_addr
         integer*4  str_len_addr
         integer*4  str_addr
         integer    npointers
         integer*4  pointer_addr
         integer    nlongs
         integer*4  long_addr
      end structure 
      record /gesc/ in_esc
c
      return
      end
c
      subroutine gks$polymarker(npts, x, y)
      use dflib
      implicit none
c
      integer npts
      real x(npts), y(npts)
c
      include 'gksdefs.f'
      include 'gks_to_qwin.cmn'
c
      integer i, orientation
      integer*2 old_color
      logical fill_flag
c
      if( gks_pmark_color_index .ne. qwin_color_index ) then
         qwin_color_index = gks_pmark_color_index
         old_color = setcolor(qwin_color_index)
      endif
c
      fill_flag = .FALSE.
      orientation = 1
      if( gks_pmark_type .eq. GKS$K_MARKERTYPE_DOT ) then
         do i=1,npts
            call gksqwin_dot(x(i),y(i))
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_PLUS ) then
         do i=1,npts
            call gksqwin_plus(x(i),y(i))
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_ASTERISK ) then
         do i=1,npts
            call gksqwin_asterisk(x(i),y(i))
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_CIRCLE ) then
         do i=1,npts
            call gksqwin_circle(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_DIAGONAL_CROSS )then
         do i=1,npts
            call gksqwin_dcross(x(i),y(i))
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SOLID_CIRCLE ) then
         fill_flag = .TRUE.
         do i=1,npts
            call gksqwin_circle(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SQUARE ) then
         do i=1,npts
            call gksqwin_square(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SOLID_SQUARE ) then
         fill_flag = .TRUE.
         do i=1,npts
            call gksqwin_square(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_TRIANGLE_UP ) then
         do i=1,npts
            call gksqwin_triangle(x(i),y(i),orientation,fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SOLID_TRI_UP ) then
         fill_flag = .TRUE.
         do i=1,npts
            call gksqwin_triangle(x(i),y(i),orientation,fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_TRIANGLE_DOWN ) then
         orientation = 2
         do i=1,npts
            call gksqwin_triangle(x(i),y(i),orientation,fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SOLID_TRI_DOWN )then
         orientation = 2
         fill_flag = .TRUE.
         do i=1,npts
            call gksqwin_triangle(x(i),y(i),orientation,fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_BOWTIE ) then
         do i=1,npts
            call gksqwin_bowtie(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SOLID_BOWTIE ) then
         fill_flag = .TRUE.
         do i=1,npts
            call gksqwin_bowtie(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_HOURGLASS ) then
         do i=1,npts
            call gksqwin_hglass(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SOLID_HGLASS ) then
         fill_flag = .TRUE.
         do i=1,npts
            call gksqwin_hglass(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_DIAMOND ) then
         do i=1,npts
            call gksqwin_diamond(x(i),y(i),fill_flag)
         end do
      else if( gks_pmark_type .eq. GKS$K_MARKERTYPE_SOLID_DIAMOND ) then
         fill_flag = .TRUE.
         do i=1,npts
            call gksqwin_diamond(x(i),y(i),fill_flag)
         end do
      else
         do i=1,npts
            call gksqwin_circle(x(i),y(i),fill_flag)
         end do
      endif
c
      return
      end
      subroutine gksqwin_circle(x,y,fill_flag)
      use dflib
      implicit none
c
      real x, y
      logical fill_flag
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter(NPTS = 9)
      integer xc(NPTS), yc(NPTS)
      data xc/2,1,0,-1,-2,-1, 0, 1,2/
      data yc/0,1,2, 1, 0,-1,-2,-1,0/
c
      call gksqwin_draw_marker(x,y,xc,yc,NPTS,fill_flag)
c
      return
      end
c
      subroutine gksqwin_square(x,y,fill_flag)
      use dflib
      implicit none
c
      real x, y
      logical fill_flag
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter(NPTS = 5)
      integer xc(NPTS), yc(NPTS)
      data xc/2,-2,-2, 2, 2/
      data yc/2, 2,-2,-2, 2/
c
      call gksqwin_draw_marker(x,y,xc,yc,NPTS,fill_flag)
c
      return
      end
c
      subroutine gksqwin_triangle(x,y,orientation,fill_flag)
      use dflib
      implicit none
c
      real x,y
      integer orientation
      logical fill_flag
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter(NPTS = 4)
      integer xc(NPTS), yc(NPTS), xc2(NPTS), yc2(NPTS)
      data xc/ 2,-2, 0, 2/
      data yc/ 2, 2,-2, 2/
      data xc2/ 2, 0,-2, 2/
      data yc2/-2, 2,-2,-2/
c
      if( orientation .eq. 1 ) then
         call gksqwin_draw_marker(x,y,xc,yc,NPTS,fill_flag)
      else
         call gksqwin_draw_marker(x,y,xc2,yc2,NPTS,fill_flag)
      endif
c
      return
      end
c
      subroutine gksqwin_dot(x,y)
      use dflib
      implicit none
c
      real x, y
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter(NPTS = 2)
      integer xc(NPTS), yc(NPTS)
      logical fill_flag
      data xc/0,0/
      data yc/0,0/
c
      fill_flag = .FALSE.
      call gksqwin_draw_marker(x,y,xc,yc,NPTS,fill_flag)
c
      return
      end
c
      subroutine gksqwin_plus(x,y)
      use dflib
      implicit none
c
      real x, y
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter (NPTS = 4)
      integer i, rc
      integer(2) xc(NPTS), yc(NPTS)
      type(xycoord) xy(NPTS), center, t
      data xc/-2, 2, 0, 0/
      data yc/ 0, 0,-2, 2/
c
      call getviewcoord_w(DBLE(x),DBLE(y),center)
c
      do i=1,NPTS
         xy(i).xcoord = center.xcoord + xc(i)*gks_pmark_size
         xy(i).ycoord = center.ycoord + yc(i)*gks_pmark_size
      end do
      call moveto(xy(1).xcoord,xy(1).ycoord,t)
      rc = lineto(xy(2).xcoord,xy(2).ycoord)
      call moveto(xy(3).xcoord,xy(3).ycoord,t)
      rc = lineto(xy(4).xcoord,xy(4).ycoord)
c
      return
      end
c
      subroutine gksqwin_asterisk(x,y)
      use dflib
      implicit none
c
      real x, y
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter (NPTS = 8)
      integer i, rc
      integer(2) xc(NPTS), yc(NPTS)
      type(xycoord) xy(NPTS), center, t
      data xc/-2, 2, 0, 0,-2, 2,-2, 2/
      data yc/ 0, 0,-2, 2,-2, 2, 2,-2/
c
      call getviewcoord_w(DBLE(x),DBLE(y),center)
c
      do i=1,NPTS
         xy(i).xcoord = center.xcoord + xc(i)*gks_pmark_size
         xy(i).ycoord = center.ycoord + yc(i)*gks_pmark_size
      end do
      call moveto(xy(1).xcoord,xy(1).ycoord,t)
      rc = lineto(xy(2).xcoord,xy(2).ycoord)
      call moveto(xy(3).xcoord,xy(3).ycoord,t)
      rc = lineto(xy(4).xcoord,xy(4).ycoord)
      call moveto(xy(5).xcoord,xy(5).ycoord,t)
      rc = lineto(xy(6).xcoord,xy(6).ycoord)
      call moveto(xy(7).xcoord,xy(7).ycoord,t)
      rc = lineto(xy(8).xcoord,xy(8).ycoord)
c
      return
      end
c
      subroutine gksqwin_dcross(x,y)
      use dflib
      implicit none
c
      real x, y
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter (NPTS = 4)
      integer i, rc
      integer(2) xc(NPTS), yc(NPTS)
      type(xycoord) xy(NPTS), center, t
      data xc/-2, 2,-2, 2/
      data yc/-2, 2, 2,-2/
c
      call getviewcoord_w(DBLE(x),DBLE(y),center)
c
      do i=1,NPTS
         xy(i).xcoord = center.xcoord + xc(i)*gks_pmark_size
         xy(i).ycoord = center.ycoord + yc(i)*gks_pmark_size
      end do
      call moveto(xy(1).xcoord,xy(1).ycoord,t)
      rc = lineto(xy(2).xcoord,xy(2).ycoord)
      call moveto(xy(3).xcoord,xy(3).ycoord,t)
      rc = lineto(xy(4).xcoord,xy(4).ycoord)
c
      return
      end
c
      subroutine gksqwin_diamond(x,y,fill_flag)
      use dflib
      implicit none
c
      real x, y
      logical fill_flag
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter(NPTS = 5)
      integer xc(NPTS), yc(NPTS)
      data xc/ 0, 2, 0,-2, 0/
      data yc/-2, 0, 2, 0,-2/
c
      call gksqwin_draw_marker(x,y,xc,yc,NPTS,fill_flag)
c
      return
      end
c
      subroutine gksqwin_bowtie(x,y,fill_flag)
      use dflib
      implicit none
c
      real x, y
      logical fill_flag
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter(NPTS = 5)
      integer xc(NPTS), yc(NPTS)
      data xc/-2, 2, 2,-2,-2/
      data yc/ 2,-2, 2,-2, 2/
c
      call gksqwin_draw_marker(x,y,xc,yc,NPTS,fill_flag)
c
      return
      end
c
      subroutine gksqwin_hglass(x,y,fill_flag)
      use dflib
      implicit none
c
      real x, y
      logical fill_flag
c
      include 'gks_to_qwin.cmn'
c
      integer NPTS
      parameter(NPTS = 5)
      integer xc(NPTS), yc(NPTS)
      data xc/-2, 2,-2, 2,-2/
      data yc/ 2, 2,-2,-2, 2/
c
      call gksqwin_draw_marker(x,y,xc,yc,NPTS,fill_flag)
c
      return
      end
c
      subroutine gksqwin_draw_marker(x,y,xoff,yoff,npts,fill_flag)
      use dflib
      implicit none
c
      include 'gks_to_qwin.cmn'
c
      real x,y
      integer npts, xoff(npts), yoff(npts)
      logical fill_flag
c
      integer i
      integer*2 rc
      type(xycoord) xy(25), center, t
c
      if(npts .gt. 25) return
c
      call getviewcoord_w(DBLE(x),DBLE(y),center)
c
      do i=1,npts
         xy(i).xcoord = center.xcoord + INT2(xoff(i)*gks_pmark_size)
         xy(i).ycoord = center.ycoord + INT2(yoff(i)*gks_pmark_size)
      end do
c
      if( fill_flag ) then
         rc = polygon($GFILLINTERIOR,xy,npts)
      else
         call moveto(xy(1).xcoord,xy(1).ycoord,t)
         do i=2,npts
            rc = lineto(xy(i).xcoord,xy(i).ycoord)
         end do
      endif
c
      return
      end
c
      subroutine gksqwin_set_console_lu(lu)
      implicit none
c
      integer lu
c
      include 'gks_to_qwin.cmn'
c
      qwin_console_lu = lu
c
      return
      end
c
      integer function gksqwin_CursorRetProc(nCode, wParam, lParam)
!     This routine is called from Windows, so use stdcall (implies
!     pass by value for scalars).
!DEC$ ATTRIBUTES STDCALL :: gksqwin_CursorRetProc
      use dflib
      use dfwin
      implicit none
c
      integer*4 nCode           ! hook code 
      integer*4 wParam          ! current process flag 
      integer*4 lParam          ! address of message data structure
                                ! of type (CWPRETSTRUCT)
c
      include 'gks_to_qwin.cmn'
c
      type CWPRETSTRUCT 
      integer*4 lResult ! result of WndProc 
      integer*4 lParam  ! info with message
      integer*4 wParam  ! info with message
      integer*4 message ! the message
      integer*4 hwnd    ! window that processed message
      end type CWPRETSTRUCT; 
c
      integer*4 i, status
c 
      type (CWPRETSTRUCT) msgdat
      pointer(msgptr,msgdat) 
c
      msgptr = lParam
      
c     Check ok to process  
      if ( (nCode .EQ. HC_ACTION) .AND.
     1     (msgdat.hwnd .EQ. qwin_cursorwnd) ) then
c        May process this
c        Because QwickWin sets the class cursor to
c        IDC_ARROW, it is necessary to always set
c        the cursor on EVERY windows message.  
         status = SetCursor(qwin_cursor)
         gksqwin_CursorRetProc = 0
      else if(nCode .lt. 0 ) then
         gksqwin_CursorRetProc = CallNextHookEx(qwin_hookhandle,
     1                           nCode, wParam, lParam)
      else
         gksqwin_CursorRetProc = 0
      endif
c
      return
      end

