c
c  This file contains routines that adapt the vogle graphics package
c  to my way of doing graphics. This is mostly a result of adapting
c  the code from the earlier version of telio which used the di3000
c  graphics package.
c
c
c  Debug statements are included in this file. They are activated by the 
c  /DEF=DEBUG compiler directive in the makefile. 
c  These compiler directives are specific to the watcom compiler.
c
c  Copyright 1993 by Dwight Meglan
c

      subroutine getdevices
      implicit none

      include 'vogle.fi'

      integer*4 key,ierr
      character*20 vsdev,vpdev
      character*40 vpfile
      common /devices/ vsdev,vpdev,vpfile

      write(6,100) 
 100  format(' VOGLE Screen device    : ',$)
      read(5,110) vsdev
 110  format(a20)

      write(6,120) 
 120  format(' VOGLE Printer device   : ',$)
      read(5,110) vpdev

      write(6,130) 
 130  format(' VOGLE Printer file name: ',$)
      read(5,110) vpfile

c
c     Try activating both device drivers so that if one is invalid, the 
c     program will bomb out now rather than later on after having used
c     the program. This can happen if an invalid device name is given for
c     the printer and an attempt is made later on to send output to the
c     printer. The program will bomb out- not nice if you have been 
c     working for a while.
c
      call vinit(vsdev(1:lentrim(vsdev))//char(0))
      ierr= voutput(vpfile(1:lentrim(vpfile))//char(0))
      call vnewdev(vpdev(1:lentrim(vpdev))//char(0))
      call vnewdev(vsdev(1:lentrim(vsdev))//char(0))
      return
      end


      subroutine dvexit
      implicit none

      include 'vogle.fi'

      character*20 vsdev,vpdev
      character*40 vpfile
      common /devices/ vsdev,vpdev,vpfile

      call vinit(vsdev(1:lentrim(vsdev))//char(0))
      call vexit()
      return
      end


      subroutine TurnScreenOn(ratio)

      real*4 ratio

      character*20 vsdev,vpdev
      character*40 vpfile
      common /devices/ vsdev,vpdev,vpfile

      include 'vogle.fi'

      call vnewdev(vsdev(1:lentrim(vsdev))//char(0))
      ratio= getaspect()
*$ifdef DEBUG
      write(2,100)
 100  format(' Screen turned on')
*$endif
      return
      end


      subroutine TurnPrinterOn(ratio)

      real*4 ratio

      include 'vogle.fi'

      character*20 vsdev,vpdev
      character*40 vpfile
      common /devices/ vsdev,vpdev,vpfile

      call vnewdev(vpdev(1:lentrim(vpdev))//char(0))
      ratio= getaspect()
*$ifdef DEBUG
      open(unit=3,file=vpfile)
      write(3,99)
 99   format('Printer turned on')
      close(unit=3)
      write(2,100)
 100  format(' Printer turned on')
*$endif
      return
      end


      subroutine dviewport( xmin,xmax,ymin,ymax )
      implicit none

      include 'vogle.fi'

*$ifdef DEBUG
      include 'tel_cons.inc'
      include 'tel_strc.inc'
      record /CmndLine/    CMND
      record /MacroStuff/  MACRO
      common /debug_info/ CMND,MACRO
*$endif

      real*4 xmin,xmax,ymin,ymax
      real*4 dxmin,dxmax,dymin,dymax,wf,hf,ratio
      integer*4 key

      call getfactors( wf,hf )
  
      dxmin= (wf-1.0)/2.0 + xmin*(wf+1.0)/2.0
      dxmax= (wf-1.0)/2.0 + xmax*(wf+1.0)/2.0
      dymin= ((hf-1.0)/2.0 + ymin*(hf+1.0)/2.0)*wf
      dymax= ((hf-1.0)/2.0 + ymax*(hf+1.0)/2.0)*wf

*$ifdef DEBUG
      ratio= getaspect()
      write(2,90) xmin,xmax,ymin,ymax
 90   format(' vwpt : ',4(f10.5,1x))
      write(2,100) hf,wf,ratio
 100  format(' hf,wf: ',f10.5,1x,f10.5/' ratio: ',f10.5)
      write(2,110) dxmin,dxmax,dymin,dymax
 110  format(' dvwpt: ',4(f10.5,1x))
*$endif

      call viewport( dxmin,dxmax,dymin,dymax )

      return
      end

      

      subroutine dfont( num )
      implicit none

      include 'vogle.fi'

      integer*4 num

      character*10 fontname(23)

      common /voglefonts/ fontname

      data fontname /'futura.l  ','futura.m  ','times.g   ','times.ib  ',
     &               'times.i   ','times.r   ','times.rb  ','cursive   ',
     &               'script    ','gothic.eng','gothic.ger','gothic.ita',
     &               'cyrillic  ','symbolic  ','math.low  ','math.upp  ',
     &               'greek     ','markers   ','astrolog  ','meteorol  ',
     &               'music     ','small     ','large     '/
      


      if ( num .lt. 0 .or. num .gt. 23 ) num= 1

      call font( fontname(num)(1:lentrim(fontname(num)))//char(0) )

      return
      end




      subroutine djust( horiz, vert )
      implicit none

      include 'vogle.fi'

      integer*4 horiz,vert


      if ( horiz .eq. 1 ) then
         call leftjustify()
      else if ( horiz .eq. 2 ) then
         call xcentertext()
      else if ( horiz .eq. 3 ) then
         call rightjustify()
      end if

      if ( vert .eq. 1 ) then
         call bottomjustify()
      else if ( vert .eq. 2 ) then
         call ycentertext()
      else if ( vert .eq. 3 ) then
         call topjustify()
      end if

      return
      end


      subroutine dstrg( text )
      implicit none

      include 'vogle.fi'

      character*(*) text
      character*100 tmp
      integer*4 i

      do i= 1, 100
        tmp(i:i)= ' '
      end do
      do i= 1, lentrim(text)
        tmp(i:i)= text(i:i)
      end do
      tmp(i:i)= char(0)
      call drawstr(tmp)

      return
      end


      subroutine dpath( dir )
      implicit none

      include 'vogle.fi'

      integer*4 dir

      if ( dir .eq. 1 ) then
         call textang(0.0)
      else if ( dir .eq. 2 ) then
         call textang(90.0)
      else if ( dir .eq. 3 ) then
         call textang(180.0)
      else if ( dir .eq. 4 ) then
         call textang(270.0)
      endif
      return
      end


      subroutine dlstyl( istyle )
      implicit none

      include 'vogle.fi'

      integer*4 istyle

c      if ( istyle .eq. 0 ) then
c         call linestyle(' '//char(0))
c      else if ( istyle .eq. 1 ) then
c         call linestyle('10'//char(0))
c      else if ( istyle .eq. 2 ) then
c         call linestyle('110'//char(0))
c      else if ( istyle .eq. 3 ) then
c         call linestyle('111010'//char(0))
c      else if ( istyle .ge. 4 ) then
c         call linestyle('0001'//char(0))
c      end if
      return
      end
