!--------------------------------------------------------------------------------------------
!  Rfortran Library License Information  
!
!  (c) Copyright 2006-2010. Mark Thyer, Michael Leonard. All rights reserved.
!
!  This file is part of the RFortran library.
!
!  The RFortran library is free software: you can redistribute it and/or modify
!  it under the terms of the lesser GNU General Public License as published by
!  the Free Software Foundation, either version 3 of the License, or
!  (at your option) any later version.
!
!  The Rfortran library is distributed WITHOUT ANY WARRANTY; 
!  without even the implied warranty of MERCHANTABILITY or FITNESS FOR 
!  A PARTICULAR PURPOSE.  See the lesser GNU General Public License 
!  for more details.
!
!   You should have received a copy of the lesser GNU General Public License
!   along with the Rfortran library.  If not, see <http://www.gnu.org/licenses/>.
!
!--------------------------------------------------------------------------------------------
!  Rfortran Library General Information 
! 
!  For How to Use, FAQ, Bug Reporting/Feature Requests, latest updates, etc. refer to:
!  
!  http://www.rfortran.org
!   
!---------------------------------------------------------------------------------------------
module Rfortran_Rgraphicsdevice
  ! Tools for graphics device handling in R
  !
  ! Description:
  ! Keeps track of graphics device (via RGraphicsDevTypeDef - stored in RFortran_GlobalVars) 
  ! to enable Rfortran to write to same graphics device when multiple executables are sending 
  ! information to R simultaneously
  !
  ! Other Misc graphics device routines
  ! Please do not change the contents of this module without contacting the authors.  
  use Rfortran_globalvars
  use Rfortran_Rput_Rget, only: Rput,Rget,addcmd,addcmdprefix,Reval
  use kinds_dmsl_kit 
  use MUtilsLib_messagelog
  use MUtilsLib_System, only: findCurrentDir
  use MUtilsLib_StringFuncs, only: fwdslash
  
  implicit none

  private ! keep hidden unless declared public
  public :: &
    Rpostscript,&           ! Creates a new postscript file for plotting, Wrapper for postscript() function
    Rpdf, &                 ! Creates a new pdf file for plotting, Wrapper for pdf() function  
    RopenGraphicsDevice, &  ! Opens a New Graphics Device
    RcloseGraphicsDevice, & ! Closes a New Graphics Device
    RsetGraphicsDevice, &   ! Sets Graphics Device for plotting 
    Rdev_set, &             !  Wrapper for R dev.set(which=k)
    Rdev_cur, &             !  Wrapper for R dev.cur()
    ! Deprecated Routines    
    RopenOutput,&           ! Sets Up Different OutputTypes
    RcloseOutput, &         ! Closes Different OutputTypes
    RopenNewGraphicsDevice,& ! Opens new graphics device
    RsetActiveGraphicsDevice ! Sets Active Graphics Device
contains
!************************************************
function RopenGraphicsDevice(RgraphicsDevTypeIn,name,cmdIn,SetRGraphicsDevNoIn) result(ok)
  ! Opens a New R Graphics Device
  use MUtilsLib_varFuncs, only: checkPresent
  implicit none
  !! Dummies
  integer(mik), intent(in),optional :: RgraphicsDevTypeIn  ! Options for different graphics device types used by RGraphicsDevType, 
                                                           !  options include:
                                                           !  WINDOW     - Opens a graphics windows
                                                           !  PDF        - Opens a pdf file
                                                           !  POSTSCRIPT - Opens a postscript file
  character(len=*), intent(in),optional :: name            ! name (WINDOWS) or filename (PDF/PS) (full path) 
                                                           ! where graphics device will be directed 
  character(len=*), intent(in),optional :: cmdIn           ! Specifies extra cmds to be supplied to initialise graphics device
  logical, intent(in), optional :: SetRGraphicsDevNoIn     ! Specifies setting of RgraphicsDecNo to keep track of graphics device
  
  ! Result
  integer(mik) :: ok
  
  ! Locals
  character(len=len_longStr) :: title
  integer(mik) :: RgraphicsDevType
  logical :: SetRGraphicsDevNo
  
  ! Set variables
  ok=0
  RgraphicsDevType=checkPresent(RgraphicsDevTypeIn,RgraphicsDevTypeDef) ! Ensures that DevType is set by default or input arguement
  RgraphicsDevTypeDef=RgraphicsDevType ! Ensures that default value is adopted
  SetRGraphicsDevNo=checkPresent(SetRGraphicsDevNoIn,.true.) 
  title=checkPresent(name,"")
  title="title='"//trim(title)//"'" 
    
  !! Open Graphics Device
  SELECT CASE(RgraphicsDevType)
  case(WINDOW) ! Windows
    ok=Reval("windows("//trim(title)//trim(addcmd(cmdIn))//")") 
    if (ok/=0) call message(log_error,"Cannot open window in RopenGraphicsDevice")
  case(PDF)    ! PDF
    ok=Rpdf(file=fwdslash(name),cmd=cmdIn); 
    if (ok/=0) call message(log_error,"Cannot open pdf graphics device with filename:"//TRIM(name)//" in RopenGraphicsDevice")
  case(POSTSCRIPT) ! Postscript
    ok=Rpostscript(file=fwdslash(name),cmd=cmdIn); 
    if (ok/=0) call message(log_error,"Cannot open postscript graphics device with filename:"//&
                            TRIM(name)//" in RopenGraphicsDevice")
  case default
    call message(log_error,"Unknown Graphics Device Type in RopenGraphicsDevice"); ok=1; return 
  end select
  
  if (setRGraphicsDevNo) then
    ok=Rdev_cur(deviceNo=RgraphicsDevNo) 
    if (ok/=0) call message(log_error,"Cannot set R graphics device number:"//TRIM(name)//" in RopenGraphicsDevice")
  end if  
end function RopenGraphicsDevice
!!************************************************
function RcloseGraphicsDevice(closeDeviceIn,RgraphicsDevTypeIn) result(ok)
  ! Closes the graphics device, dependent on RgraphicsDevTypeIn and argument closeDeviceIn, as follows
  !     If RgraphicsDevType/=window (e.g. output is to a pdf/ps etc.) then the graphics devices needs
  !                                 to closed to be viewed, hence this routine closes them
  !     If RgraphicsDevType=windows (e.g. output is to a graphics window) them the graphics device 
  !                                 is only closed if closeDevice=TRUE, 
  
  use MUtilsLib_varFuncs, only: checkPresent
  implicit none
  ! Dummies
  logical, intent(in),optional :: closeDeviceIn             ! Sets whether WINDOW() device is closed
  integer(mik), intent(in),optional :: RgraphicsDevTypeIn   ! If RgraphicsDevTypeIn is not set, defaults to RgraphicsDevTypeDef
  ! Locals
  integer(mik) :: RgraphicsDevType
  logical :: closeDevice
  ! Function Results
  integer(mik) :: ok
  
  ! Intialise Variables
  ok=0
  RgraphicsDevType=checkPresent(RgraphicsDevTypeIn,RgraphicsDevTypeDef)
  CloseDevice=checkPresent(CloseDeviceIn,.true.)
    
  ! Set to current graphics Device
  ok=Rdev_set(which=RgraphicsDevNo); 
  if (ok/=0) call message(log_error,"Was not able to set current graphics device to RgraphicsDevNo in RcloseGraphicsDevice")
  
  ! Close Graphics Device
  select case(RgraphicsDevType)
  case(WINDOW)
    if (closeDevice) then
        ! Turn device off
        ok=Rput("dev.off()"); if (ok/=0) call message(log_error,"Was not able to set turn device off in RcloseGraphicsDevice")
    end if
  case(PDF,POSTSCRIPT)
        ! Turn device off
        ok=Reval("dev.off()"); if (ok/=0) call message(log_error,"Was not able to set turn device off in RcloseGraphicsDevice")
  case default
    call message(log_error,"Sorry, that R graphics output option is not available yet")
  end select
  
end function RcloseGraphicsDevice
!************************************************
function Rdev_set(which) result(ok)
  ! Wrapper for R Function dev.set(which=k)
  implicit none
  ! Dummies
  integer(mik), intent(in) :: which
  ! Locals
  integer(mik) :: ok

  ! Close Output Type
  ok=Rput("xx",which)
  ok=Reval("dev.set(which=xx)")
  ok=Reval("rm(xx)")

end function Rdev_set
!************************************************
function Rdev_cur(deviceNo) result(ok)
  ! Wrapper for R Function dev.cur()
  implicit none
  ! Dummies
  integer(mik), intent(out) :: deviceNo
  ! Locals
  integer(mik) :: ok

  ok=Reval("xx=dev.cur()")
  ok=Rget("xx",deviceNo)
  ok=Reval("rm(xx)")
end function Rdev_cur
!!************************************************
function RsetGraphicsDevice(overwrite,setRGraphicsDevNo) result (ok)
  ! Sets Graphics Device for plotting 
  ! Action depends on value of Routputtype and optional argument, overwrite
  ! if RgraphicsDevTypeDef==window
  !       if overwrite=true  => set Active device to saved RgraphicsDevNo and overwrite existing plot
  !       if overwrite=false or not present =>  open a new graphics window
  ! if RgraphicsDevType/=window (e.g. pdf or ps)
  !       sets active device to saved RgraphicsDevNo and plot is added to pdf/ps file. 
  use MUtilsLib_stringfuncs, only: operator(//)
  implicit none
  ! Dummies
  logical, intent(in), optional :: overwrite ! If true, current window is overwritten, 
                                             ! if false a new one is created 
                                             ! - only used for RgraphicsDevTypeDef=window 
  logical, intent(in), optional :: setRGraphicsDevNo ! If true, setRGraphicsDevNo to the opened device
                                                     ! If false, don't setRGraphicsDevNo to the opened device 
                                                     ! - useful if you to write to ps/pdf/window, 
                                                     ! but don't want it updated with other graphs
  ! Locals
  integer(mik) :: ok

  select case(RgraphicsDevTypeDef)
  case(window)
    if (present(overwrite)) then
      if (overwrite) then
         ! Set active device to saved RgraphicsDevice
         ok=Rdev_set(which=RgraphicsDevNo)
      else
       ! Open new graphices device
       ok=RopenGraphicsDevice(setRGraphicsDevNoIn=setRGraphicsDevNo); 
       if (ok/=0) call message(log_error,"Was not able to open new graphics device in RsetActiveGraphicsDevice")
      end if
    else
      ok=RopenGraphicsDevice(setRGraphicsDevNoIn=setRGraphicsDevNo); 
      if (ok/=0) call message(log_error,"Was not able to open new graphics device in RsetActiveGraphicsDevice")
    end if
    ! Notify where windows output was sent to.
    call message(log_blank,"Output was sent to Windows Device No:"//RgraphicsDevNo)
  case default ! Everything else except window
    ! Set active device to saved RgraphicsDevice
    ok=Rdev_set(which=RgraphicsDevNo); 
    if (ok/=0) call message(log_error,"Was not able set graphics device to RgraphicsDevNo in RsetActiveGraphicsDevice")
  end select
end function RsetGraphicsDevice
!**************************************************************************************************************
function Rpostscript(file,cmd) result(ok) 
    !! Description: Creates a new postscript file for plotting, Wrapper for postscript() function
      implicit none
      ! Dummies
      character(len=*), intent(in) :: file
      character(len=*), intent(in),optional :: cmd
      ! Function Result
      integer(mik) :: ok
      ok = Reval("postscript(file='" // trim(file) //"'"//addcmd(cmd)//")")
    end function
!**************************************************************************************************************
function Rpdf(file,cmd) result(ok)
      !! Description: Wrapper for pdf() function
      implicit none
      ! Dummies
      character(len=*), intent(in),optional :: file
      character(len=*), intent(in),optional :: cmd
      ! Function Result
      integer(mik) :: ok
      character(len=len_vLongStr) :: cmdLoc
      
      if (.not.present(cmd)) then ! Sets default paper type to 'a4' because R doesn't
        cmdLoc=",paper='a4'" 
      else
        cmdLoc=addcmd(cmd)
      end if
      
      cmdLoc=trim(addCmdPrefix(cmd_pre="file=",cmd="'"//trim(file)//"'"))//trim(cmdLoc)
      
      ok = Reval("pdf("//cmdLoc//")")
    end function Rpdf
!**************************************************************************************************************
! Deprecated Routines
function RopenOutput(outputtype,dir,filename,papertype,msg,cmd) result(ok)
!  !! Deprecated
!  !! Description: Sets Up Different OutputTypes
  use MUtilsLib_varFuncs, only: checkPresent
  implicit none
  integer(mik) :: ok
!  !! Dummies
  character(len=*), intent(in)          :: outputtype       !! specifyies output type: "WINDOW", "PS", "PDF"
  character(len=*), intent(in),optional :: dir,filename     !! specifies directory and filename for certain output type
  character(len=*), intent(in),optional :: papertype        !! specifies papertype, current options are "a4" and "a4r"
  character(len=*), intent(in),optional :: msg              !! Retained for Backwards Compatibility
  character(len=*), intent(in),optional :: cmd              !! Specifies the extra cmds to be supplied to output type
  
  !Locals 
  character(len=200) :: filename_def='output'    !! specifies default filename
  character(len=200) :: file                     !! specifies actual filename
  
  ! Provide warning
  call message(log_warn,"RopenOutput is a deprecated function, only maintained for backwards compatibility, &
                        &please use RopenGraphicsDevice instead")
  if (present(msg)) call message(log_warn,"Msg argument is now obsolete in RopenOutput")
  
  ! Initialise
  ok=0
  
    !! Specify output Type
  SELECT CASE(outputtype)
  case("pdf","PDF")
    RgraphicsDevTypeDef=PDF
    file=checkPresent(filename,trim(filename_def)//".pdf")
    ok=RopenGraphicsDevice(name=trim(dir)//trim(file),cmdIn=(addcmd(papertype)//addcmd(cmd)))
    if (ok/=0) call message(log_error,"Cannot open pdf file:"//TRIM(file)//" in RopenOutput")
  case("window","WINDOW")
    RgraphicsDevTypeDef=WINDOW
    ok=RopenGraphicsDevice(cmdin=addcmd(cmd)); if (ok/=0) call message(log_error,"Cannot open window")
  case("postscript","ps","POSTSCRIPT","PS")
    RgraphicsDevTypeDef=POSTSCRIPT
    file=checkPresent(filename,trim(filename_def)//".ps")
    ok=RopenGraphicsDevice(name=trim(dir)//trim(file),cmdin=(addcmd(papertype)//addcmd(cmd)))
    if (ok/=0) call message(log_error,"Cannot open ps file:"//TRIM(file)//" in RopenOutput")
  case default
    call message(log_error,"Unknown output type in RopenOutput"); ok=1; return 
  end select
end function RopenOutput
!!***************************************************************************************************************
function RcloseOutput(outputtype,msg) result(ok)
    !! Deprecated
    !! Description: Closes Output 
    implicit none
    integer(mik) :: ok
    !! Dummies
    character(len=*), intent(in) :: outputtype                     !! specifyies output type: "WINDOW", "PS", "PDF"
    character(len=*), intent(in),optional :: msg  !! Retained for Backwards Compatibility
    ok=0
    if (present(msg)) call message(log_warn,"Msg argument is now obselete in RcloseOutput")
    call message(log_warn,"RCloseOutput is a deprecated function, only maintained for backwards compatibility, &
                           & please use RCloseGraphicsDevice instead")
  
    !! Specify output Type
    SELECT CASE(outputtype); 
    case("pdf","PDF","postscript","ps"); 
        ok=Reval("dev.off()")
    end select  !! Close Windows
end function RcloseOutput
!************************************************
subroutine RopenNewGraphicsDevice()
! Deprecated
! Opens a New Graphics Device
  implicit none
  ! Locals
  integer(mik) :: ok
  
  call message(log_warn,"Subroutine RopenNewGraphicsDevice is deprecated, &
                        &only maintained for backwards compatibility, please use function RopenGraphicsDevice instead")

  ! Open Output Type
  ok=RopenGraphicsDevice(); if (ok/=0) call message(log_error,"RopenGraphicsDevice returned an error in RopenNewGraphicsDevice")
    
end subroutine RopenNewGraphicsDevice
!************************************************
subroutine RsetActiveGraphicsDevice(overwrite)
  ! Deprecated
  ! Sets Active Device for plotting 
  ! Action depends on value of Routputtype and optional argument, overwrite
  ! if Routputtype==window
  !       if overwrite=true  => set Active device to saved RgraphicsDevice and overwrite existing plot
  !       if overwrite=false or not present =>  open a new graphics window
  ! if Routputtype/=window (e.g. pdf or ps)
  !       sets active device to saved RgraphicsDevice and plot is added to pdf/ps file. 
  
  implicit none
  ! Dummies
  logical, intent(in), optional :: overwrite ! If overwrite=true, current window is overwritten, otherwise a new one is created 

  ! Locals
  integer(mik) :: ok  
  
  call message(log_warn,"Subroutine RsetActiveGraphicsDevic is deprecated, &
                        &only maintained for backwards compatibility, please use function RsetGraphicsDevice instead")
  
  ok=RsetGraphicsDevice(overwrite=overwrite); 
  if (ok/=0) call message(log_error,"RsetActiveGraphicsDevice returned an error in RsetActiveGraphicsDevice_s") 

end subroutine RsetActiveGraphicsDevice

end module Rfortran_Rgraphicsdevice