Program ProcCD5(Input, Output) ;
{ Crop image area; apply Dark and Flat processing }
Uses
   WinAPI, { No - it's not Windows. It's BP7.0 32-bit stuff }
   X_U, { My routines for 32-bit addressing }
   FITSX_U; { Random assortment of FITS read/write stuff }
Const
  InDir   = 'D:\' ; { Runs under DOS; Windows thinks it is F:\ }
  OutDir  = 'C:\BP\TASS\CD5\' ;
  DarkName1 = 'C:\BP\TASS\CD5\H3RDARK.FTS' ; { Produced by Dark }
  FlatName1 = 'C:\BP\TASS\CD5\H3RFLAT.FTS' ;
  DarkName2 = 'C:\BP\TASS\CD5\H4RDARK.FTS' ; { Produced by Flat }
  FlatName2 = 'C:\BP\TASS\CD5\H4RFLAT.FTS' ;
  DarkVal  = -32768 + 4097; { Matches existing DummyDrk: MKIII Star uses }
{ dummy vectors DummyDrk and FlatDum on pre-processed data }
{ Analysis area }
  Min2 : Integer   =    2 ;
  Max2 : Integer   = 2033 ;
  Min1 : Integer   =    6 ;
  Max1 : Integer   = 2037 ;
Var
  Data, Dark, Flat : FITSInfoT ; { FITS control structures }
  N2_M, N1_M : Longint ; { Actual sizes of cropped image   }

Procedure Process(InName : String) ;
{ Apply Dark and Flat corrections }
Var
  I2, I1 : Longint ;
  T, D, F : Single ;
Begin
  Writeln('Reading Data ', InName) ;
  ReadSome(Data, InDir + InName, Min1, N1_M, Min2, N2_M) ;
  For I2 := 0 To N2_M-1 Do For I1 := 0 To N1_M-1 Do Begin
    T := IPtr(Data.Image, I2*N1_M+I1)^ ;
    D := IPtr(Dark.Image, I2*N1_M+I1)^ ;
    F := IPtr(Flat.Image, I2*N1_M+I1)^ ; { NOTE not same as MKIII }
    T := (T - D)*(1 + F/32768) + DarkVal ; { Do the sums in floating point }
    If (T >  32767) Then T := 32767 ; { Protect against off-scale }
    If (T < -32768) Then T := -32768 ;
    IPtr(Data.Image, I2*N1_M+I1)^ := Round(T) ;
  End ;
{ The control structure contains the original header information     }
{ which does not apply to the clipped image actually read: update it }
  Data.NAxis1 := N1_M ;
  Data.NAxis2 := N2_M ;
  SetHeadCardI(Data.Head^.Hdr[3], 'NAXIS1', N1_M) ;
  SetHeadCardI(Data.Head^.Hdr[4], 'NAXIS2', N2_M) ;
{ ... and otherwise play around with the header information            }
{ This is all ad-hoc stuff; the remnants of extensive experimentation! }
{ Not all changes are still relevant                                   }
  SetHeadCardS(Data.Head^.Hdr[7], 'DEC', '''06:48:22.3''') ;
  SetHeadCardS(Data.Head^.Hdr[8], 'CDELT1', '-2.0676E-3') ;
  SetHeadCardS(Data.Head^.Hdr[9], 'CDELT2', '2.0749E-3') ;
  SetHeadCardS(Data.Head^.Hdr[11], 'CRVAL1', '6.8062') ;
  Writeln('Writing Data') ;
  WriteFITS(Data, OutDir + InName) ;
End ;

{ MAIN PROGRAM }
Begin
{ Compute sizes }
  N2_M := Max2 - Min2 + 1 ;
  N1_M := Max1 - Min1 + 1 ;
  Writeln('Reading Dark') ;
  ReadStrip(Dark, DarkName1, 0, N1_M, 0, N2_M) ;
  Writeln('Reading Flat') ;
  ReadStrip(Flat, FlatName1, 0, N1_M, 0, N2_M) ;
  Process('H3R1438.878') ;
  Process('H3R1438.882') ;
  Process('H3R1438.886') ;
  Process('H3R1438.890') ;
  Process('H3R1438.895') ;
  Process('H3R1438.899') ;
  Process('H3R1438.903') ;
  Process('H3R1439.870') ;
  Process('H3R1439.875') ;
  Process('H3R1439.880') ;
  Process('H3R1439.885') ;
  Process('H3R1439.891') ;
  Process('H3R1439.896') ;
  Process('H3R1439.901') ;
  Process('H3R1440.871') ;
  Process('H3R1440.875') ;
  Process('H3R1440.879') ;
  Process('H3R1440.884') ;
  Process('H3R1440.888') ;
  Process('H3R1440.892') ;
  Process('H3R1440.897') ;
  Process('H3R1442.863') ;
  Process('H3R1442.867') ;
  Process('H3R1442.871') ;
  Process('H3R1442.876') ;
  Process('H3R1442.880') ;
  Process('H3R1442.885') ;
  Process('H3R1442.889') ;
  Process('H3R1446.853') ;
  Process('H3R1446.858') ;
  Process('H3R1446.862') ;
  Process('H3R1446.866') ;
  Process('H3R1446.871') ;
  Process('H3R1446.875') ;
  Process('H3R1446.880') ;
  Writeln('Reading Dark') ;
  ReadSome(Dark, DarkName2, 0, N1_M, 0, N2_M) ;
  Writeln('Reading Flat') ;
  ReadSome(Flat, FlatName2, 0, N1_M, 0, N2_M) ;
  Process('H4R1438.878') ;
  Process('H4R1438.882') ;
  Process('H4R1438.886') ;
  Process('H4R1438.890') ;
  Process('H4R1438.895') ;
  Process('H4R1438.899') ;
  Process('H4R1438.903') ;
  Process('H4R1439.870') ;
  Process('H4R1439.875') ;
  Process('H4R1439.880') ;
  Process('H4R1439.885') ;
  Process('H4R1439.891') ;
  Process('H4R1439.896') ;
  Process('H4R1439.901') ;
  Process('H4R1440.871') ;
  Process('H4R1440.875') ;
  Process('H4R1440.879') ;
  Process('H4R1440.884') ;
  Process('H4R1440.888') ;
  Process('H4R1440.892') ;
  Process('H4R1440.897') ;
  Process('H4R1442.863') ;
  Process('H4R1442.867') ;
  Process('H4R1442.871') ;
  Process('H4R1442.876') ;
  Process('H4R1442.880') ;
  Process('H4R1442.885') ;
  Process('H4R1442.889') ;
  Process('H4R1446.853') ;
  Process('H4R1446.858') ;
  Process('H4R1446.862') ;
  Process('H4R1446.866') ;
  Process('H4R1446.871') ;
  Process('H4R1446.875') ;
  Process('H4R1446.880') ;
End. { ProcCD5 }