! @(#)mosdefine.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:54:39
! +++++++++++++++++++++++++++++++++++++++++++++++++
!.COPYRIGHT    (C) 1994 Landessternwarte Heidelberg
!.IDENT        mosdefine.prg
!.AUTHORS      Sabine Moehler (LSW)
!              Otmar Stahl (LSW)
!.KEYWORDS     Spectroscopy, MOS
!  
!.PURPOSE      execute the command DEFINE/MOS
!
!.VERSION      1.0 Creation 02/07/94
! 
! DEFINE/MOS image mos_table windows_table threshold window binning plot_option
!
! -------------------------------------------------
!
CROSSREF OBJECT MOS WINDOWS THRESH WIND XBIN CENTMET
!
DEFINE/PARAM P1 {OBJ}      IMAGE   "Enter input image:"
DEFINE/PARAM P2 {MOS}      TABLE   "Enter MOS table:"
DEFINE/PARAM P3 {WINDOWS}   TABLE   "Enter output table:"
DEFINE/PARAM P4 {THRESH}   NUMBER  "Threshold:"
DEFINE/PARAM P5 {WIND}     NUMBER  "Window:"
DEFINE/PARAM P6 {XBIN}     NUMBER  "binning in X:"
DEFINE/PARAM P7 {SCAN_POS} NUMBER  "center for scan (world coordinates)"
DEFINE/PARAM P8 0.           NUMBER  "Plot option"
!-------------------------------------------------
! Plot parameters
!-------------------------------------------------
DEFINE/LOCAL PLOTPAR1/I/1/1 0.
DEFINE/LOCAL PLOTPAR2/I/1/1 0.
DEFINE/LOCAL PLOTPAR3/I/1/1 0.
DEFINE/LOCAL PLOTPAR4/I/1/1 0.
define/local tmp1/d/1/1 0.
define/local tmp2/i/1/2 0.,0.
define/local tmp3/i/1/1 0.
define/local tmp4/i/1/1 0.
! 	Continue flag
DEFINE/LOCAL CONT/C/1/1 y
! 	Decision keyword
DEFINE/LOCAL PATH/I/1/2 0.,0.
! 	Counter
DEFINE/LOCAL I/I/1/1 0
DEFINE/LOCAL J/I/1/1 0
! 	Position keyword
DEFINE/LOCAL POSR/R/1/3 0.,0.,0.
! 	Qualifier keyword
DEFINE/LOCAL QUALIF/C/1/4  " " all
! 	Scan keyword
DEFINE/LOCAL SCAN/D/1/1 0.
! 	Selection keyword
DEFINE/LOCAL SELECT/I/1/1 0.
! 	Keyword to determine whether slitlet has been searched
DEFINE/LOCAL FOUND/I/1/1 0.
!
!define/local OUT_A/c/1/60 "{p3}"
WRITE/KEYW QUALIF {MID$CMND(11:14)}
WRITE/KEYW IN_A  {P1}
WRITE/KEYW IN_B  {P2}
WRITE/KEYW OUT_A {P3}
define/local OUT_D/c/1/60 "{P3}"
WRITE/KEYW INPUTI {P5},{P6},{P8}
WRITE/KEYW INPUTR {P4}
WRITE/KEYW SCAN {P7}

COPY/DK {IN_A} START/D/1/1 PLOTPAR1
COPY/DK {IN_A} STEP/D/1/1 TMP1
COPY/DK {IN_A} NPIX/I/1/2 TMP2

IF SCAN .eq. 0 THEN
  SCAN = TMP2/2*TMP1+PLOTPAR1
ENDIF
!
RUN STD_EXE:MOSDEFINE
!-------------------------------------------------------------------------------
! Plot options 
!-------------------------------------------------------------------------------

IF {INPUTI(3)} .eq. 1 .or. {INPUTI(3)} .eq. 3 THEN

!-------------------------------------------------------------------------------
! 2-dim display
!-------------------------------------------------------------------------------

  LOAD {P1}
  WRITE/OUT "object = blue"
  CLEAR/CHAN OVERLAY
  PLOTPAR3 = PLOTPAR1+{TMP1}*({TMP2(1)}-1)
  
  COPY/DK {OUT_D}.tbl NOBJ/I/1/1 NOBJ
  IF {NOBJ} .GT. 0 THEN	
    DO I = 1 {NOBJ}
      PLOTPAR2 = {{OUT_D},:Obj_Strt,{I}}
      PLOTPAR4 = {{OUT_D},:Obj_End,{I}}
      SET/MIDAS OUTPUT=LOGONLY
      DRAW/RECTA {PLOTPAR1},{PLOTPAR2},{PLOTPAR3},{PLOTPAR4} F ? 5 ? 
      SET/MIDAS OUTPUT=ON
    ENDDO
  ENDIF	

  write/keyw cont/c/1/1 y
  if m$existk("alltutos") .eq. 1 then
     if alltutos .eq. 1 goto cont_check
  endif

  inquire/keyw cont "Press return to plot sky, n to stop"

cont_check:
  IF cont .eq. "y" then
    WRITE/OUT "sky = green "
    COPY/DK {OUT_D}.tbl NSKY/I/1/1 NSKY
    IF NSKY .GT. 0 THEN	
      DO I = 1 {NSKY}
        PLOTPAR2 = {{OUT_D},:Sky_Strt,{I}}
        PLOTPAR4 = {{OUT_D},:Sky_End,{I}}
        SET/MIDAS OUTPUT=LOGONLY
        DRAW/RECTA {PLOTPAR1},{PLOTPAR2},{PLOTPAR3},{PLOTPAR4} F ? 4 ? 
        SET/MIDAS OUTPUT=ON
      ENDDO
    ENDIF	
  ELSE 
    WRITE/KEYW cont/c/1/1 y
  ENDIF
ENDIF

IF INPUTI(3) .ge. 2 THEN

!-------------------------------------------------------------------------------
! Graphical display
!-------------------------------------------------------------------------------

  WRITE/OUT "Now computing 1-dimensional frames"
  TMP3 = SCAN-{INPUTI(2)}/2
  TMP4 = SCAN+{INPUTI(2)}/2
  AVER/COLUMN MIDTMPC = {P1} {TMP3},{TMP4}
  TMP3 = PLOTPAR1+{TMP1}*{INPUTI(1)}
  TMP4 = PLOTPAR1+{TMP1}*({INPUTI(1)}+{INPUTI(2)})
  AVER/COLUMN MIDTMPS = {P1} {TMP3},{TMP4}
  TMP3 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)}-{INPUTI(2)})
  TMP4 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)})
  AVER/COLUMN MIDTMPE = {P1} {TMP3},{TMP4}
  write/key OUT_D "{p3}"
  SET/GRAP COLOUR=1 LTYPE=1
  PLOT MIDTMPC
  SET/GRAP COLOUR=1 LTYPE=2
  OVER MIDTMPS
  OVER MIDTMPE
  SET/GRAP COLOUR=4 LTYPE=1
  COPY/DK {OUT_D}.tbl NOBJ/I/1/1 NOBJ
  DO I = 1 NOBJ
    PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
    PLOTPAR2 = {{OUT_D},:Obj_Strt,{I}}
    PLOTPAR4 = {{OUT_D},:Obj_End,{I}}
    OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
    OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
    OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
  ENDDO
  SET/GRAP COLOUR=3
  COPY/DK {OUT_D}.tbl NSKY/I/1/1 NSKY
  DO I = 1 NSKY
    PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
    PLOTPAR2 = {{OUT_D},:Sky_Strt,{I}}
    PLOTPAR4 = {{OUT_D},:Sky_End,{I}}
    OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
    OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
    OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
  ENDDO
  SET/GRAP COLOUR=1
ENDIF
   

!-------------------------------------------------------------------------------
! Possibility to change objects' and sky positions
!-------------------------------------------------------------------------------

ask:
  write/key cont/c/1/1 y
  if m$existk("alltutos") .eq. 1 then
     if alltutos .eq. 1 goto end
  endif

  INQUIRE/KEYW cont "Are you satisfied with this? Default = y"
  IF cont .eq. "y" GOTO end 

decide:
  WRITE/KEYW cont/c/1/1 y
  WRITE/OUT "Do you want to ..."
  WRITE/OUT "... delete an object?    --> 1"
  WRITE/OUT "... add an object?       --> 2"
  WRITE/OUT "... delete a sky region? --> 3"
  WRITE/OUT "... add a sky region?    --> 4"
  WRITE/OUT "... change an object   ? --> 5"
  WRITE/OUT "... change a sky region? --> 6"
  WRITE/OUT "... have a closer look?  --> 7"
  WRITE/OUT "... stop?                --> 8"
  inquire/keyw path/i/1/1 "Enter choice: "
  IF path(1) .eq. 8 GOTO end

!-------------------------------------------------------------------------------
! Plot only slitlet to deal with
!-------------------------------------------------------------------------------

INQUIRE/KEYW J "Enter number of slitlet"
path(2) = {J}


IF {INPUTI(3)} .le. 1 THEN
  WRITE/OUT "Now computing 1-dimensional frames"
  DISPLAY/LONG
  TMP3 = SCAN-{INPUTI(2)}/2
  TMP4 = SCAN+{INPUTI(2)}/2
  AVER/COLUMN MIDTMPC = {P1} {TMP3},{TMP4}
  TMP3 = PLOTPAR1+{TMP1}*{INPUTI(1)}
  TMP4 = PLOTPAR1+{TMP1}*({INPUTI(1)}+{INPUTI(2)})
  AVER/COLUMN MIDTMPS = {P1} {TMP3},{TMP4}
  TMP3 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)}-{INPUTI(2)})
  TMP4 = PLOTPAR1+{TMP1}*({TMP2(1)}-{INPUTI(1)})
  AVER/COLUMN MIDTMPE = {P1} {TMP3},{TMP4}
  WRITE/KEYW INPUTI/I/3/3 2
ENDIF
plotslit:
  TMP3 = {{IN_B},:ystart,@{J}}
  TMP4 = {{IN_B},:yend,@{J}}
  PLOT MIDTMPC ? {TMP3},{TMP4}
  SET/GRAP COLOUR=1 LTYPE=2
  OVER MIDTMPS
  OVER MIDTMPE

!-------------------------------------------------------------------------------
! Mark objects
!-------------------------------------------------------------------------------

  SET/GRAP COLOUR=4 LTYPE=1
  COPY/DK {OUT_D}.tbl NOBJ/I/1/1 NOBJ
  DO I = 1 {NOBJ}
    SELECT = {{OUT_D},:Obj_Slit,{I}}
    IF SELECT .EQ. PATH(2) THEN
      PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
      PLOTPAR2 = {{OUT_D},:Obj_Strt,{I}}
      PLOTPAR4 = {{OUT_D},:Obj_End,{I}}
      OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
      OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
      OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
      WRITE/KEYW FOUND/I/1/1 1
    ENDIF
  ENDDO
 
!-------------------------------------------------------------------------------
! Mark sky
!-------------------------------------------------------------------------------

  SET/GRAP COLOUR=3
  COPY/DK {OUT_D}.tbl NSKY/I/1/1 NSKY
  DO I = 1 {NSKY}
    SELECT = {{OUT_D},:Sky_Slit,{I}}
    IF SELECT .EQ. PATH(2) THEN
      PLOTPAR1 = {PLRGRAP(5)}*0.5+{PLRGRAP(6)}*0.5
      PLOTPAR2 = {{OUT_D},:Sky_Strt,{I}}
      PLOTPAR4 = {{OUT_D},:Sky_End,{I}}
      OVERPLOT/LINE 1 {PLOTPAR2},{PLRGRAP(5)} {PLOTPAR2},{PLRGRAP(6)}
      OVERPLOT/LINE 1 {PLOTPAR4},{PLRGRAP(5)} {PLOTPAR4},{PLRGRAP(6)}
      OVERPLOT/LINE 1 {PLOTPAR2},{PLOTPAR1} {PLOTPAR4},{PLOTPAR1}
      WRITE/KEYW FOUND/I/1/1 1
    ENDIF
  ENDDO
  SET/GRAP COLOUR=1

  IF FOUND .eq. 0 THEN
    WRITE/OUT "                  *** No results for this slitlet ***"
  ELSE
    WRITE/KEYW FOUND/I/1/1 0.
  ENDIF

  IF path(1) .eq. 1 THEN
    GOTO delobj
  ELSEIF path(1) .eq. 2 THEN
    GOTO add
  ELSEIF path(1) .eq. 3 THEN
    GOTO delsky
  ELSEIF path(1) .eq. 4 THEN
    GOTO add
  ELSEIF path(1) .eq. 5 THEN
    GOTO change
  ELSEIF path(1) .eq. 6 THEN
    GOTO change
  ELSEIF path(1) .eq. 7 THEN
    GOTO decide
  ELSEIF path(1) .gt. 8 THEN
    GOTO decide
ENDIF

delobj:
!-------------------------------------------------------------------------------
! Delete object
!-------------------------------------------------------------------------------

  WRITE/OUT "Click on object you want to delete"
  GET/GCURSOR
  WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
  write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
  RUN STD_EXE:CHANGEDEF
  WRITE/KEYW cont/c/1/1 y
  WRITE/KEYW path/i/1/1 9
  WRITE/OUT "Results..."
  GOTO plotslit

add:
!-------------------------------------------------------------------------------
! Define new object or sky
!-------------------------------------------------------------------------------

  IF path(1) .eq. 2 THEN
    WRITE/OUT "Click on object you want to add"
  ELSEIF path(1) .eq. 4 THEN
    WRITE/OUT "Click on sky you want to add"
  ENDIF
  WRITE/OUT "First left/lower limit"
  GET/GCURSOR
  WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
  WRITE/OUT "Now right/upper limit"
  GET/GCURSOR
  WRITE/KEYW POSR/R/2/2 {OUTPUTR(5)}
!-------------------------------------------------------------------------------
! Check new object resp. sky
!-------------------------------------------------------------------------------
  SET/GRAP COLOUR=2
  OVERPLOT/LINE 1 {POSR(1)},{PLRGRAP(5)} {POSR(1)},{PLRGRAP(6)}
  OVERPLOT/LINE 1 {POSR(2)},{PLRGRAP(5)} {POSR(2)},{PLRGRAP(6)}
  SET/GRAP COLOUR=1
  INQUIRE/KEYW cont "Are you satisfied with this? Default = y"
  IF cont .eq. "y" then
    write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
    RUN STD_EXE:CHANGEDEF
  ELSE 
    WRITE/KEYW cont/c/1/1 y
    GOTO add
  ENDIF
  WRITE/KEYW path/i/1/1 9
  WRITE/OUT "Results..."
  GOTO plotslit

delsky:
!-------------------------------------------------------------------------------
! Delete sky
!-------------------------------------------------------------------------------

  WRITE/OUT "Click on sky you want to delete"
  GET/GCURSOR
  WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
  write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
  RUN STD_EXE:CHANGEDEF
  WRITE/KEYW cont/c/1/1 y
  WRITE/KEYW path/i/1/1 9
  WRITE/OUT "Results..."
  GOTO plotslit

change:
!-------------------------------------------------------------------------------
! Change object/sky
!-------------------------------------------------------------------------------

  WRITE/KEYW cont/c/1/1 y
  IF path(1) .eq. 5 THEN
    WRITE/OUT "Click on object you want to change"
    WRITE/OUT "First old object"
  ELSEIF path(1) .eq. 6 THEN
    WRITE/OUT "Click on sky you want to change"
    WRITE/OUT "First old sky"
  ENDIF
  GET/GCURSOR
  WRITE/KEYW POSR/R/3/3 {OUTPUTR(5)}
  INQUIRE/KEYW cont "Do you want to change left/lower limit? Default = y"
  IF cont .eq. "n" then
    WRITE/KEYW POSR/R/1/1 -9999.9
  ELSE
    GET/GCURSOR
    WRITE/KEYW POSR/R/1/1 {OUTPUTR(5)}
  ENDIF
  WRITE/KEYW cont/c/1/1 y
  INQUIRE/KEYW cont "Do you want to change right/upper limit? Default = y"
  IF cont .eq. "n" then
    WRITE/KEYW POSR/R/2/2 -9999.9
  ELSE
    GET/GCURSOR
    WRITE/KEYW POSR/R/2/2 {OUTPUTR(5)}
  ENDIF
  WRITE/KEYW cont/c/1/1 y
!-------------------------------------------------------------------------------
! Check new object/sky
!-------------------------------------------------------------------------------
  SET/GRAP COLOUR=2
  OVERPLOT/LINE 1 {POSR(1)},{PLRGRAP(5)} {POSR(1)},{PLRGRAP(6)}
  OVERPLOT/LINE 1 {POSR(2)},{PLRGRAP(5)} {POSR(2)},{PLRGRAP(6)}
  SET/GRAP COLOUR=1
  INQUIRE/KEYW cont "Are you satisfied with this? Default = y"
  IF cont .eq. "y" then
    write/keyw OUT_A/c/1/60 {OUT_D(1:60)}
    RUN STD_EXE:CHANGEDEF
  ELSE 
    WRITE/KEYW cont/c/1/1 y
    GOTO change
  ENDIF
  WRITE/KEYW path/i/1/1 9
  WRITE/OUT "Results..."
  GOTO plotslit

end:
dele MIDTMPS no
dele MIDTMPC no
dele MIDTMPE no