program CMPF
* Program to compare two files side by side to indicate
* similarities and differences.
***

deffun Convert(From,To,In)
deffun Upcase(Target)
      gosub GetFileNames
      gosub OpenFiles
      gosub ReadRecords
      gosub CondenseRecords
      gosub OpenOutput
      gosub CompareRecords
      gosub CloseOutput
      return

GetFileNames:
      Parms = upcase(convert(" ",@FM,trim(@SENTENCE)))
      FileNameA = Parms<2>
      if not(FileNameA) then
         crt "Usage: CMPF FileNameA RecordNameA FileNameB RecordNameB LPTR"
         crt "       - LPTR sends output to IDM08 printer."
         crt "         default is to the screen."
         stop
      end
      RecordNameA = Parms<3>
      FileNameB = Parms<4>
      RecordNameB = Parms<5>
      LPTR = Parms<6>
      return

OpenFiles:
      OpenErrors = ""
      open "",FileNameA to FileA else OpenErrors := FileA:" "
      open "",FileNameB to FileB else OpenErrors := FileB:" "
      if OpenErrors then
         stop 'Unable to open the following files: ':OpenErrors:"  (cmpf)"
      end
      return

ReadRecords:
      read RecordA from FileA, RecordNameA else
         stop "Unable to read ":RecordNameA:" from ":FileNameA:"  (cmpf)"
      end
      read RecordB from FileB, RecordNameB else
         stop "Unable to read ":RecordNameB:" from ":FileNameB:"  (cmpf)"
      end
      LineA = 1
      LineB = 1
      RangeA = dcount(RecordA,@FM)
      RangeB = dcount(RecordB,@FM)
      return

CondenseRecords:
      CRecordA = Upcase(Convert(" ","",RecordA))
      CRecordB = Upcase(Convert(" ","",RecordB))
      return

OpenOutput:
      LPTR = LPTR eq "LPTR"
      if LPTR then
        Width = 65
        execute "SETPTR ,145,71,0,0,,BRIEF,BANNER CMPF,NOTIFY,FORM IDM08"
        printer on
        gosub LandOn
        crt "CMPF output is being spooled to IDM08."
      end else
        Width = 32
      end
      NameA = FileNameA:">":RecordNameA
      NameB = FileNameB:">":RecordNameB
      if len(NameA) gt Width then
         NameA = NameA[1,Width-3]:"..."
      end
      if len(NameB) gt Width then
         NameB = NameB[1,Width-3]:"..."
      end
      hdg = "CMPF'GTG'Page  'PL'"
      hdg := "     "
      hdg := fmt(NameA,"L#":Width):"<<>>"
      hdg := "     "
      hdg := fmt(NameB,"L#":Width)
      heading hdg
      return

CompareRecords:
      loop
         if CRecordA<1> eq CRecordB<1> then
            gosub FlushSame
         end else
            Flushed = @FALSE
            for Idx = 1 to 50
               CObjectA = field(CRecordA,@FM,Idx,3)
               CObjectB = field(CRecordB,@FM,Idx,3)
               gosub FindNextAinB
               gosub FindNextBinA
               begin case
                  case (AintoB lt BintoA) and (Idx eq 1)
                     gosub FlushB
                     Flushed = @TRUE
                  case (BintoA lt AintoB) and (Idx eq 1)
                     gosub FlushA
                     Flushed = @TRUE
                  case (AintoB lt 9999999) or (BintoA lt 9999999)
                     if (BintoA eq 9999999) then BintoA = Idx - 1
                     if (AintoB eq 9999999) then AintoB = Idx - 1
                     gosub FlushDiff
                     gosub FlushA
                     gosub FlushB
                     Flushed = @TRUE
                     exit
               end case
            next Idx
            if not(Flushed) then
               AintoB = 1
               BintoA = 1
               gosub FlushA
               gosub FlushB
            end
            if LPTR then
               if not(mod(LineA,10)) or not(mod(LineB,10)) then
                  crt "*":
               end
            end
         end
         if (RecordA eq "") or (RecordB eq "") then exit
      repeat
      if RecordA then
         BintoA = dcount(RecordA,@FM)
         gosub FlushA
      end
      if RecordB then
         AintoB = dcount(RecordB,@FM)
         gosub FlushB
      end
      return

CloseOutput:
      print "*EOF"
      if LPTR then
         gosub LandOff
         printer off
         printer close
         crt
      end
      return

FlushSame:
      pl = ""
      pl := ("0000":LineA)[4]:" "
      pl := fmt(RecordA<1>,"L#":Width):"    "
      pl := ("0000":LineB)[4]:" "
      pl := fmt(RecordB<1>,"L#":Width)
      LineA += 1
      LineB += 1
      del RecordA<1>
      del CRecordA<1>
      del RecordB<1>
      del CRecordB<1>
      print pl
      return

FlushDiff:
      if AintoB eq 0 or BintoA eq 0 or AintoB eq 9999999 or BintoA eq 9999999 then return
      Min = AintoB
      if Min gt BintoA then Min = BintoA
      for i = 1 to Min
         pl = ""
         pl := ("0000":LineA)[4]:" "
         pl := fmt(RecordA<1>,"L#":Width):" <> "
         pl := ("0000":LineB)[4]:" "
         pl := fmt(RecordB<1>,"L#":Width)
         LineA += 1
         LineB += 1
         del RecordA<1>
         del CRecordA<1>
         del RecordB<1>
         del CRecordB<1>
         print pl
      next i
      AintoB -= Min
      BintoA -= Min
      return

FindNextAinB:
      AintoB = dcount(CRecordB[1,index(@FM:CRecordB:@FM,@FM:CObjectA:@FM,1)],@FM)
      if AintoB le 1 then
         AintoB = 9999999
      end else
         AintoB -= 1
      end
      return

FindNextBinA:
      BintoA = dcount(CRecordA[1,index(@FM:CRecordA:@FM,@FM:CObjectB:@FM,1)],@FM)
      if BintoA le 1 then
         BintoA = 9999999
      end else
         BintoA -= 1
      end
      return

FlushA:
      if BintoA eq 0 then return
      for i = 1 to BintoA
         pl = ""
         pl := ("0000":LineA)[4]:" "
         pl := fmt(RecordA<1>,"L#":Width):" <  "
         LineA += 1
         del RecordA<1>
         del CRecordA<1>
         print pl
      next i
      return

FlushB:
      if AintoB eq 0 then return
      for i = 1 to AintoB
         pl = "     "
         pl := space(Width):"  > "
         pl := ("0000":LineB)[4]:" "
         pl := fmt(RecordB<1>,"L#":Width)
         LineB += 1
         del RecordB<1>
         del CRecordB<1>
         print pl
      next i
      return

LandOn:
      Esc = char(27)
      print "=U":"D":"K=":Esc
      print Esc:"+P"
      print Esc:"+1Titan10iso-P"
      print Esc:"+2XCP14iso-L"
      print Esc:"m510,0,0,3,660"
      print Esc:"2"
      return

LandOff:
      print Esc:"1"
      print Esc:"m660,10,10,20,510"
      return
   end