! Copyright (C) 2013, Thomas M. Melvin and Keith R. Briffa, see the GNU 
! General Public License.
! 
! Climatic Research Unit, School of Environmental Sciences, University of
! East Anglia, Norwich, NR4 7TJ, U.K.
!
! RCS1CRUST - A program to generate the chronologies and figures of the paper:
! Melvin, TM and KR Briffa. 2013. CRUST: Software for the implementation of 
! Regional Chronology Standardisation: Part 1. Signal-Free RCS.
! Dendrochronologia (2013), http://dx.doi.org/10.1016/j.dendro.2013.06.002.
!
! This program is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! any later version, see <http://www.gnu.org/licenses/>.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.

      MODULE rcs1procs  ! Uses CRUST procedures to produce plots
      USE crustutil     ! and chronologiesx of Melvin et al. 2013.
      CONTAINS   
!-----------------------------------------------------------------
      SUBROUTINE crust_setup()    ! Finds PC details and sets defaults
      IMPLICIT NONE
      b(271)=posn(cnx,btop,gright,bbot,"",TR,TR)    ! Choice table area
      b(272)=posn(2700,30,2900,75,"Continue",TR,TR) ! Next action
      madd(271)=pos2(cnx,btop-45,cnx+480,btop)
      mtext(271)="Choose a Plot/Action"
      madd(1)=pos2(cnx+100,1800,cnx+1200,1850)
      madd(2)=pos2(cnx+1200,1800,cnx+2600,1850)
      madd(3)=pos2(cnx+1200,1850,cnx+2600,1900)
      madd(4)=pos2(cnx+1200,1900,cnx+2600,1950)
      mtext(1)="Copyright (C) 2013 Thomas Melvin - Program RCS1CRUST"
      mtext(2)="This program comes with ABSOLUTELY NO WARRANTY. This is"
      mtext(3)="free software, and you are welcome to redistribute it "
      mtext(4)="under certain conditions (GNU General Public License)."
      bhigh=yellow ;  cur=8 ; srcok=TR 
      cdsp=30 ; idtsl=100 ; idtsn=-66
      RETURN
      END SUBROUTINE crust_setup
!--------------------------------------------------------
      SUBROUTINE tfigs_menu()  ! Creates output displays
      USE rcs
      IMPLICIT NONE
      INTEGER :: i,j,k,plold
      sccc=1 ; k=3 ; chs=1 ; b(272)%ok=FA ; plold=k
      JD: DO j=1,1000   ! Menu attempts  
        CALL ERASE()
        CALL mwrite(271) ; chc(1)=k 
        CALL HEIGHT(18)    
        DO i=1,4 ; CALL mwrite(i) ; ENDDO
        CALL HEIGHT(21)    
        CALL ch_disp(3,fin,rcnam(1:fin),chs,chc,1)
        CALL but_draw(273,cnam(cf)) ; CALL mwrite(273)
        IF (b(272)%ok) CALL but_draw(272,"")
        CALL mouse_click(7,271,273)
        SELECT CASE (mous)
        CASE (271) 
          i=rw*INT(DBLE(3*(msx-cnx))/DBLE(gright-cnx))+ &
            INT(DBLE(rw*(b(mous)%y1-msy))/DBLE(b(mous)%y1-b(mous)%y2))+1
          IF (i.EQ.1) THEN
            EXIT JD
          ELSEIF (i.GT.1.AND.i.LE.fin) THEN
            plold=k ; k=i
            CALL rcsv(k,plold)
          ENDIF
        CASE (272) ; EXIT JD
        ENDSELECT
      ENDDO JD
      RETURN 
      END SUBROUTINE tfigs_menu
!------------------------------------------------------------------------
      SUBROUTINE start_initt()    ! Initialise start menu
      USE rcs 
      IMPLICIT NONE                 
      CALL rcs_val()
      INQUIRE(FILE="RCSdefault.fil",EXIST=fileok)  
      IF (.NOT.fileok) THEN
        WRITE(*,'("File RCSdefault.fil missiing")')
        STOP
      ELSE
        OPEN(23,FILE="RCSdefault.fil",IOSTAT=ios,STATUS="OLD")
        IF (ios.NE.0) THEN
          WRITE(*,'("Error",I7," open RCSdefault.fil")') ios
          STOP 
        ENDIF
        READ(23,*,IOSTAT=ios)   ! Header line
        IF (ios.NE.0) THEN
          WRITE(*,'("Error",I7," read header RCSdefault.fil")') ios
          STOP 
        ENDIF
        READ(23,'(I4)',IOSTAT=ios) screenw
        IF (ios.NE.0) THEN
          WRITE(*,'("Error",I7," read width RCSdefault.fil")') ios
          STOP 
        ENDIF
        READ(23,'(I4)',IOSTAT=ios) screenh
        IF (ios.NE.0) THEN
          WRITE(*,'("Error",I7," read height RCSdefault.fil")') ios
          STOP 
        ENDIF
        CLOSE(23) 
      ENDIF
      CALL METAFL('XWIN')
      CALL WINDOW(0,0,screenw,screenh)  
      CALL SETPAG('DA4L')
      CALL SCRMOD('REVERS')       ! White background
      CALL DISINI()
      CALL WINMOD('NONE')         ! DISINI drops out 
      CALL CSRMOD('READ','POS')   ! Control cursor reading
      CALL SETVLT('VGA')          ! Select 16 colour table
      CALL SIMPLX()
      CALL HEIGHT(25)             ! Character height - plot coords
      CALL SHDPAT(16)             ! Fill areas
      CALL TICPOS('REVERS','XY')  ! Internal tick marks
      CALL HNAME(20)              ! Character height for Axis names
      CALL LABDIG(-1,'X')         ! Digits after decimal -1=integer
      CALL TICKS(10,'X')          ! Number of ticks between labels
      CALL TICKS(5,'Y')           ! Number of ticks between labels
      CALL read_default() 
      INQUIRE(FILE=lnam,EXIST=lfileok)  
      IF (lfileok) THEN
        CALL read_list()    
        INQUIRE(FILE=cnam(cf),EXIST=chronok)  
        IF (chronok) THEN
          nc=0 ; CALL read_rft(cnam(cf))
          CALL detrend()
        ENDIF
      ENDIF
      RETURN
      END SUBROUTINE start_initt
!------------------------------------------------------------------
     END MODULE rcs1procs 
!------------------------------------------------------------------
      PROGRAM RCS1CRUST
      USE rcs1procs
      IMPLICIT NONE
      CALL crust_setup()  ! Buttons and graphics
      CALL start_initt()
      CALL tfigs_menu()
      CALL DISFIN()
      STOP
      END PROGRAM RCS1CRUST
