;auto92.ana, made from rawtt92.ana	7/1/92  r. shine
;runs multiple sets from a tape
;top level program is auto which runs setup and reduce
;make dark file prefix a global #fnd, 6/27/92  r. shine
;tailor removed, still in rawtt91
;1992 version modified to use Grinnell again  6/27/92  r. shine
;r. shine 8/30/90
;a new approach that is supposed to better automate the process
;@dua1:[soup]lpnortharrow
;@dua1:[soup]mogul91
;@dua1:[soup]ccdlog
;@dua1:[soup]dtlab
;@dua0:[ana]dtsetup
;@dua1:[soup]lp91flaws
;@dub0:[shine]look92
;========================================================================
block track_info
;
;assume catload has been run and parameters are available
;computing tracks is trivial if there are not duplicate wavelengths that
;we want to combine into double or triple (or...) length video sequences,
;all the complication is to accomplish just that. Is it worth it ?
;this generates 3 vectors that together with nvspace and ivstart
;define the track numbers, combining duplicates into longer video sequences
;the formula used is:
;
;  track=ivstart + (ir-1)*tdup(is-1) + toffset(is-1) + nvspace*tplace(is-1)
;
;where ir is the repeat count (starting with 1, hence the -1) and is is the
;sequence count (also starting with 1), nvspace is usually = nrep unless
;several sets are being combined, in which case it is the sum of the reps in
;all the sets
toffset=zero(intarr(nexp))
tdup=toffset+1
tplace=indgen(tdup)
;these are the defaults if no dups, now check for the dups and adjust
iq=indgen(flatindx)
for k=1,nflat do {
if (total(flatindx eq k) gt 1.1) then {	;ck if we have a dup
jq=sieve(iq,flatindx eq k)		;get locations
nq=num_elem(jq)				;get dup count
tdup(jq)=nq
toffset(jq)=indgen(jq)		}}
;now adjust the tplace's
tplace(0)=0	nq=tdup(0)	;nq is for next non-duplicated set
for k=1,nexp-1 do {
if toffset(k) ne 0 then {
;this is a duplicate and not the first in a series, it assumes the same
;tplace as the first in the series (but with a different offset)
kq=k-1
jq=sieve(iq(0:kq),(flatindx(0:kq) eq flatindx(k)) and (toffset(0:kq) eq 0))
tplace(k)=tplace(jq(0))	} else {
;the other, more normal, case
tplace(k)=nq		nq=nq+tdup(k) }}
endblock
;========================================================================
subr set_record_track,itr
;
;sometimes the video recorder gets confused, the search is the most likely
;command to bomb so we try several times if it doesn't work the first time
sq='CS;SR'+istring(itr,5,2)+':'
if opcmd(sq) ne 1 then panic,'bad SR'
endsubr
;========================================================================
func opcmd(s)
;tries several times if necessary
for itry=1,20 do begin
if op1cmd(s) eq 1 then return,1
type,'a problem with video recorder, command = ',s,'  trying again'
#vid_errors+=1
if itry ge 5 then {
 type,'problem with video disk, hit return to try again or 0 to abort'
 kay=''
 read,kay
 if num_elem(kay) gt 0 then { if kay eq '0' then retall } }
wait,0.5		;some time to ponder it's input stream
end	;end of itry loop
return,0
endfunc
;========================================================================
func enable_record(itr)
;if the argument is passed, then after enabling the record, it
;reads back the current track # and compares with itr
;which is where it should be, if it isn't, tries to move it there again
narg=!narg
;first the enable command at wherever we are
sq='RM'+istring(1,5,2)+':'
if opcmd(sq) ne 1 then panic,'bad RM'

ty,'enable done, return = ',op1read(10)
;need to check track ?

if narg gt 0 then {
for itry=1,3 do {		;we make a few attempts to reposition
;first verify position, don't want to allow forward slips
repeat {
sq='NO'
;ty,'doing NO'
if opcmd(sq) ne 1 then ty,'problem with ACK on NO'
;now readback the result
sck=op1read(1)		;the 1 is the timeout in seconds
;ty,'return from op1read =',sck
ok=0
if num_elem(sck) gt 6 then { if sck(0:1) eq 'NO' then ok=1 }
if ok eq 0 then { ty,'a problem with video recorder, bad readback'
	#vid_errors+=1		wait,0.5 }
} until ok eq 1
;we have a track # (we hope), is it the expected one ?
if fix(sck(3:7)) eq itr then return,1	;return if OK
ty,'not on right track, trying to correct'
;not on the track? try to put it there again and re-enable record
;wait,.4
ty,'doing AC'
sq='AC'		if opcmd(sq) ne 1 then panic,'bad AC'
wait,.3
ty,'doing set_record_track'
set_record_track,itr
ty,op1read(10)
ty,'doing RM again'
sq='RM'+istring(1,5,2)+':'
if opcmd(sq) ne 1 then panic,'bad RM'
ty,op1read(2)
}
return,0		;must have failed if we get here
}

return,1
endfunc
;========================================================================
block safe_record
;6/30/92 more changes to handle badly functioning recorders
;also cleaned up a lot
;1/27/90 modified by R. Shine for a safer record
;this looks (and is) complicated, but doesn't take long if all goes OK
;
ok=1		;assume it will work
if enable_record(itr) ne 1 then {	;a problem, can't get on the track
	type,'attempt to record on WRONG track'
	type,'track should be',itr
	if mismatch_flag eq 1 then ok=2 else {
		type,'enter 0 to adjust or abort'
		type,'      1 to not record this frame'
		type,'      2 to not record this or future mismatches'
		type,'      3 to record here anyhow (better be sure!)'
		kay=''  read,kay
		if kay eq '2' then { ok=2  mismatch_flag=1 }
		if kay eq '0' then {
 t,'you can try to manually put the recorder on the right track and then enter-
 a 1, or enter a 0 now to abort'
 read,kay
 if kay eq '0' then  retall
 t,'now enter a 3 to really record (or a 1 to not record)'
 read,kay	}
		if kay eq '1' then ok=2
		if kay eq '3' then ok=1
}
}

;now either record or not depending on OK

if ok eq 2 then {	;ok=2 means don't record, but we have
			;to clear record mode
  sq='AC'    if opcmd(sq) ne 1 then panic,'bad AC'
}			;end of ok eq 2 conditional
if ok eq 1 then {	;actually record (finally)
  sq='GS'  if opcmd(sq) ne 1 then {	;didn't record?
   ty,'problem with GS for recording track',itr
   s=op1read(5)		ty,'response from recorder: ',s
;try one more time, must put back on correct track
   retryrec,itr
  } else { s=op1read(5)		ty,'readback after GS: ',s
   if num_elem(s) ge 2 then { if s(0:1) ne 'GS' then { ty,'no GS back ?'
    retryrec,itr }
    } else { ty,'funny return from GS'  retryrec,itr  }
  }
}
endblock
;==============================================================================
subr retryrec,itr
;used if record command seems to have failed, must be careful
ty,'bad record?, retry, track =',itr
;wait,.5
sq='AC'		if opcmd(sq) ne 1 then panic,'bad AC'
wait,.5
set_record_track,itr
wait,1.0
if enable_record(itr) ne 1 then {
  ty,'can''t get on track, probably was actually recorded'
  return
}
sq='GS'  if opcmd(sq) ne 1 then {	;didn't record?
   ty,'re-try:.problem with GS for recording track',itr
   s=op1read(5)		ty,'re-try: response from recorder: ',s
} else { s=op1read(5)		ty,'re-try: readback after GS: ',s
   if num_elem(s) ge 2 then { if s(0:1) ne 'GS' then ty,'re-try: no GS back ?'
    } else { ty,'re-try: funny return from GS' }
}

endsubr
;==============================================================================
subr panic,s
;start of a subroutine called when problems arise, allows optional exit or
;some sort of fix
;9/1/90 r. shine

if s eq 'bad RM' or s eq 'bad SR' or s eq 'bad NO' or s eq 'bad AC' then {
ty,'video disk problem, ',s,' command.'
ty,'You can manually set it and then continue'
ty,'enter 1 to continue or 0 to abort'
read,mess

if mess eq 0 then retall
return
}

if s eq 'bad time' then {
t,'the time for an image file is inconsistent with the *.ccd'
t,'file specified, you may be reading the wrong file or you forgot to'
t,'run, setup !'
xq=0
read,'enter 0 to stop or 1 to go on anyhow (better be sure!)',xq
if xq eq 0 then retall
}

if s eq 'dark file' then {
type,'the dark file definition is not consistent with $mtype'
type,'enter 1 to go on anyhow (?), 2 to just re-enter fnd name'
read,'or 0 to exit and fix problem',mess
if mess eq 2 then {
read,'re-enter ID for darks (e.g., dua1:[soup]21jun90m2.dark)',#fnd	}
if mess eq 0 then retall	}
endsubr
;========================================================================
block check_read
;check the tape read and do something if a problem
wait_for_tape,$itd
if !tape_status($itd-1) ne 1 then { type,'trouble with tape read'
type,'the status word is',!tape_status($itd-1)
xq=0
read,'enter 0 to quit, 1 to clear error, 2 to continue on another tape',xq
ncase xq
retall
tape_clear
{ dismount,$itd
type,'eject ana tape',$itd,' and insert next input tape'
yq=0	read,'enter 1 when ready',yq
;note that because buffers already switched, we read in x2, head2 and
;we must wait for completion
;for 1992 data, there is a filler at the beginning of the continuation
;tape that must be read it and discarded
asylpread,x2,head2,1	wait_for_tape,$itd	;filler to discard
asylpread,x2,head2,1	wait_for_tape,$itd  }
endcase
}
endblock
;==============================================================================
block check_write
;check the tape write and do something if a problem
wait_for_tape,$itdout
if !tape_status($itdout-1) ne 1 then { type,'trouble with tape write'
xq=0
read,'enter 0 to quit or 1 to clear error (no guarantees!)',xq
if xq eq 1 then tape_clear else retall		}
if out_count ge tape_limit then { t,'your output tape is nearly full'
t,'enter 0 to give up, 1 to increase your limit a little, or 2 to continue'
t,'on another tape'
read,xq
ncase xq
retall
{	t,'current limit is',tape_limit
	read,'enter amount to add to this limit',yq	tape_limit+=yq
	t,'new limit is    ',tape_limit	}
{	dismount,$itdout	t,'eject your output tape and insert new one'
	yq=0	read,'enter 1 when ready',yq
	out_count=0	}
endcase	
}	;end of full tape condition
endblock
;==============================================================================
subr unity_flat,f1
;fake gains for ruthless people
ncase $mtype-1
{ def_i,f1,512,512 }
{ def_i,f1,512,512 }
{ def_i,f1,1024,1024 }
endcase
f1=zero(f1)+word(16384)
endsubr
;==============================================================================
block setup
;assumes that definitions of essential names already done
catload,id_ccd
;note that this only handles the m1c, m2, and m1 cases
$mtype=1			;assume m1c
if sumx eq 2 then $mtype=2
if nx ge 1024 then $mtype=4
ncase $mtype-1
{ gext='.gainm1c' #fnd=#fndbase+'m1c.dark' }
{ gext='.gainm2'  #fnd=#fndbase+'m2.dark' }
{ gext='.gainm1'  #fnd=#fndbase+'m1.dark' }
{ if defined(#ixoff) eq 0 or defined(#iyoff) eq 0 then {
	t,'**** SETUP - offsets not defined for m1x case, STOP!' retall }
  sq=istring(#ixoff,3,2)+'_'+istring(#iyoff,3,2)  gext='.gainm1_'+sq
	#fdn=#fndbase+'M1_'+sq }
endcase
run gain_names
run track_info
;get flats and darks, verify that each actually exists
;first the darks, use exp_times array and sieve out exposures
xq=exp_times
repeat { iq=min(xq)
ty,'exposure time ',iq
et=istring(iq,4,2)
dark='D'+et
fzread,eval(dark),#fnd+et
xq=sieve(xq,xq ne iq) } until symclass(xq) eq 1
;now the flats
for i=1,nflat do {
s2='f'+istring(i,3,2)
s=eval('w'+istring(i,3,2))
if strpos(s,'fakeflat') lt 0 then {
 ;we accept some variations on the gain names because we are
 ;not sure about the wide/narrow status of the data, if we don't
 ;find a N version, we try for a W or something with neither
 if fzread(eval(s2),s) ne 1 then { sq=strreplace(s,'.gain','n.gain')
   if fzread(eval(s2),sq) ne 1 then { sq=strreplace(s,'.gain','w.gain')
    if fzread(eval(s2),sq) ne 1 then {
     ;if no such flat, we now use a fake one, put this in log
     openu,4,'dua1:[soup]flathistory92.txt'
     printf,4,' '   printf,4,'can''t find flat named ',s
     printf,4,'substituting a fake (all 1''s)'	close,4
     unity_flat,eval(s2)
 }}}
} else { unity_flat,eval(s2) }		;some gains are fakes, just unity
end	;of i=1,nflat loop
;the fake gain option is used whenever the name contains the string fakeflat
;use in desperate situations when you want a movie and/or data but don't have
;the flats
;now setup the flaw tables
if $mtype ne $mtype_old then {
ncase $mtype-1
{ flawsm1c }
{ flawsm2  }
{ flawsm1  }
{ flawsm1x }
endcase
}
$mtype_old=$mtype
;the typefile below was information on tailor
;typefile,'dua1:[soup]rawtt90f.txt'
endblock
;==============================================================================
block reduce
#vid_errors=0
et1=!elapsed_time
t1=!time
ct1=!cputime
lastexp=nexp		;this is the last image in the last loop
nrepeats=nframes/nexp	;nearest whole rep.
if nrepeats*nexp lt nframes then { lastexp=nframes-(nrepeats*nexp)
	nrepeats+=1 }
nvspace=nrepeats	;normal, could be larger for combined sets
irstart=1
istart=1
!tape_status($itd-1)=1		!tape_status($itdout-1)=1
if nrepeats ge 10 then sorted=1 else sorted=0
sorted=fix(sorted)	offset=0
mess=''
offset=fix(offset)-1	;the -1 to replace the -1 in ir-1
mismatch_flag=0			;handles action on mismatches
fve='problem talking to video disk, hit return to try again or 0 to stop'
booboo=0   !iosb_ast(0,($itdout-1))=1
IF WFLAG EQ 1 THEN BEGIN
run mogul	;edit the PLAYER movie command file
PRINT,'setting up recorder, if something goes wrong I suggest you abort job'
OP1CMD,'ON'
wait,1.0
OP1CMD,'CS'
wait,1.0
op1cmd,'DS'
END
;run dtsetup
;mods to use Grinnell
vdev,3		tvinit		tvdisp,1	tvzoom,0,255,255,3
!order=2	!tvwid=2	pdev,1
!scalemax=180	;too bright for player (?)
tveras
gamma,1.5	;for a bit more contrast
;open the history file
openu,4,'dua1:[soup]flathistory92.txt'
printf,4,''
printf,4,'flat field for ',id_ccd,' using ',#fnd,' and ',id_flat
printf,4,'nframes =',nframes,'  nexp =',nexp,'  nrepeats =',nrepeats
printf,4,'sequence =',strtrim(seqname)
close,4
;define the switch players (i.e., buffers), case on $mtype
;$mtype=3 for 1x1 full CCD =2 for 2x2  or =1 for 1x1 center of the CCD
ncase $mtype-1
{x1=zero(intarr(263194))	x2=x1	x3=x1  z=zero(bytarr(512,512)}
{x1=zero(intarr(1050+538*512))	x2=x1	x3=x1  z=zero(bytarr(512,512)}
{x1=zero(intarr(1050+1050*1024)) x2=x1	x3=x1  z=zero(bytarr(1024,1024)}
{x1=zero(intarr(263194))	x2=x1	x3=x1  z=zero(bytarr(512,512)}
endcase
head1=zero(bytarr(512))	head2=head1	head3=head1
;a note on how this is done, each of the 3 "activities" (read, process, write)
;uses its own symbols (x1,x2,x3 and head1 ...) but where these actually point
;is changed in a cyclic manner for each cycle
;now begin the cycle, first an isolated read
asylpread,x1,head1,1
;check the time with the one from catalog
s=smap(head1(268:278))
tod1=float(s(0:1))*3600.+60.*float(s(3:4))+float(s(6:10))
if abs(tod( (irstart-1)*nexp+istart-1 )-tod1) gt 0.1 then panic,'bad time'
;change identities
switch,x1,x2	switch,x1,x3
switch,head1,head2	switch,head1,head3
;not all switches were needed the first time
;now loop, but block out the read for the very last and the write for the first
;
twrite=0	;a write flag, always 0 for first image
nsynch=0
for ir=irstart,nrepeats do begin
if ir ne irstart then istart=1
if ir ne nrepeats then isend=nexp else isend=lastexp
for is=istart,isend do begin
ism=is-1	;useful

;begin the read activity
if (ir ne nrepeats) or (is ne isend) then {
asylpread,x1,head1,1	}

;get the track number, note sorted conditional
if sorted eq 1 then {
itr=ivstart+(ir+offset)*tdup(ism)+toffset(ism)+nvspace*tplace(ism)
} else { itr=ivstart+ism+(ir-1)*nexp }
itrmax=itr>itrmax	;save maximum
ty,'track #',itr
;compute rflag which tells us whether to record this image on video disk
img=lmap(head2(188:191))
rflag=wflag and (img ge booboo)		;note img begins with 0
if rflag eq 1 then set_record_track,itr		;moves video disk to track

;begin the write activity, unless first image or twflag=0
;the write img # is the former one from processing step
if twrite ne 0 then {
type,'writing img =',img-1,'  ir, is-1, nrepeats =',ir,ism,nrepeats
	 asyexcwrite,x3,head3	out_count+=1	} else {twrite=twflag}

;begin the processing activity, this uses x2 and head2
;a confirmation of image # to stop on synch errors resulting from misreads
;if img eq start_write then { twrite=1 }
if ism ne (img-nsynch)%nexp then {
	type,'problem with image sequencing !!'
	t,'ism, img%nexp',ism,img%nexp
	t,'enter 0 to abort or a synch correction (',img%nexp,' )  to continue'
	read,nsynch	if nsynch eq 0 then retall }
type,'processing img #',img
et=skipc(smap(head2(361:364)),' ')
dark='D'+et

;note that symbol name of dark array is constructed from value
;normally all darks are read in by SETUP but not always so check
if defined(eval(dark)) ne 1 then {fzread,eval(dark),#fnd+et}

st=smap(head2(256:278))+' '+smap(head2(392:403))+' '+et+'ms'
h3=head2(256:*)	h3=sieve(h3,h3 ne 0)
h3=smap(h3)+' flat fielded '+!date+' '+!time
zero,head2	head2(0)=bmap(h3)

flatname='f'+istring(flatindx(ism),3,2)
ccdflatmtrim,x2,eval(dark),eval(flatname),z
;tveras
bdeflaw,z
;dtmemwrite,z
;dtlab,upcase(st),50,4
tv,z
tvlab,upcase(st),50,4
;lpnortharrow,st
deflaw,x2

;if this is rep #2, store some samples
if ir eq 2 then {
if toffset(ism) eq 0 then {	;if ne 0, then a dup state
wname,seq_wave(ism),seq_off(ism),seq_pol(*,ism),name
name='dud3:[soup]'+id_ccd+name+'.sample'
ty,'sample name =',name
fcwrite,x2,name,smap(head2)
}
}

;change identities
switch,x1,x2	switch,x1,x3
switch,head1,head2	switch,head1,head3
wait,.1

if rflag eq 1 then run,safe_record		;records after checking
;because of buffer switching, we must wait for both tape I/O's to complete
;before issuing another read, do here and also check status of each tape
;operation and recover from end of volume problems for multi-tape movies
run,check_read
run,check_write
end	;of is loop
end	;of ir loop

;the last write activity
if twrite ne 0 then { type,'writing last image'
asyexcwrite,x3,head3	}
openu,4,'dua1:[soup]flathistory92.txt'
printf,4,'finished, some statistics'
is=(nrepeats-irstart)*nexp+lastexp-irstart+1	;total done
t2=!time
ct2=!cputime
et2=!elapsed_time
type,'start time = ',t1
type,'end time   = ',t2,'  ',!date
type,'cpu time   = ',ct2-ct1
type,'average elapsed time per image =',(et2-et1)/is
type,'average  CPU    time per image =',(ct2-ct1)/is
type,'video communication errors     =',#vid_errors
type,'last video track used =',itrmax
printf,4,'start time = ',t1
printf,4,'end time   = ',t2,'  ',!date
printf,4,'cpu time   = ',ct2-ct1
printf,4,'average elapsed time per image =',(et2-et1)/is
printf,4,'average  CPU    time per image =',(ct2-ct1)/is
printf,4,'first and last optical track =',ivstart, itrmax
printf,4,'video communication errors     =',#vid_errors
close,4
IF WFLAG EQ 1 THEN { wait,1.0  OP1CMD,'CS' }
LPREAD,X                                                 ;  by  KLS
LPREAD,X                                                 ;  by  KLS
ty,'                                               <<== == == == == == == == =='
endblock	;of block
;==============================================================================
block auto
;runs the show, gets needed information and then does a sequence of
;setup and reduce calls
;some things to initialize
$mtype_old=-1
out_count=0		;this is number of images output to tape
tape_limit=9000		;OK for compressed 512's
!crunch_slice=5
!ignore_tape_err=1
itrmax=1
;1992 specific
disk_flat='dua1:[soup.lp92]'
pcmd='lp92g12.cmd'
#fndbase='dua1:[soup.lp92]08may92'
id_flat='g92'
read,'enter input tape',$itd		$itd=fix($itd)
read,'enter output tape',$itdout	$itdout=fix($itdout)
read,'enter first video track to record on',ivstart
read,'enter tape ID number',tapenum
id_ccd_tape='le'+istring(tapenum,3,2)+'f'
read,'enter first and last file numbers',filea,fileb
skips=intarr(fileb-filea+1)
zero,skips
mess=''
read,'do you want to skip any of these files ? [Y/N]',mess
if num_elem(mess) ge 1 then if upcase(mess) eq 'Y' then {
mess=0
repeat {
read,'enter file # to skip (or 0 if you are done)',mess
if mess ge filea and mess le fileb then skips(mess-filea)=1
} until mess eq 0
}
repeat {typefile,'dua1:[soup]rawtt90c.txt'	;type instructions
read,wflag	wflag=fix(wflag)
ncase wflag
{wflag =0	twflag=0}
{wflag=1	twflag=1}
{wflag =0	twflag=1}
{wflag=1	twflag=0}
else { wflag=-1 }
endcase
} until wflag ge 0
for kfile=filea,fileb do {
if skips(kfile-filea) eq 0 then {
id_ccd=id_ccd_tape+istring(kfile,3,2)
run setup
run reduce
weof,$itdout
} else {
skipf,$itd
lpread,x	;skip over filler
}
ivstart=itrmax+1	;gaps cause synch flickers when browsing
}
endblock
;==============================================================================