<*+M2EXTENSIONS *> <*-GENCTYPES*> <*+COMMENT*> <*-GENHISTORY*> <*-GENDEBUG*> <*-GENDATE*> <*-LINENO*> <*-CHECKINDEX*> <*-CHECKDNDEX*> <*+GENCDIV*> <*-GENKRC*> <*+NOOPTIMIZE*> <*-GENSIZE*> <*-ASSERT*> <*-CHECKNIL*> <*-COVERFLOW*> <*-IOVERFLOW*> <*-CHECKRANGE*> <*-CHECKSET*> <*-CHECKDIV*> <*-GENCONSTENUM*> MODULE srtmjoin; (* fill holes in srtm1 with another srtm1 *) FROM osi IMPORT NextArg, WrStr, WrStrLn, WrLn, Close, RdBin, WrBin, File, OpenRead, OpenWrite, WrHex, WrInt; PROCEDURE Err(text:ARRAY OF CHAR); BEGIN WrStrLn("repaire srtm file with another"); WrStrLn("srtmjoin: "); WrStr(text); WrStrLn(" error abort"); HALT END Err; PROCEDURE rw(h,l:CHAR):INTEGER; VAR a:INTEGER; BEGIN a:=ORD(h)*256+ORD(l); IF a>=32768 THEN a:=65536-a END; RETURN a END rw; VAR fn:ARRAY[0..4095] OF CHAR; f1,f2,fo:File; x,y,len1,len2:INTEGER; b1,b2,bo:ARRAY[0..3601*2-1] OF CHAR; mods, rem:CARDINAL; a, b:INTEGER; BEGIN NextArg(fn); f1:=OpenRead(fn); IF f1<0 THEN Err("file 1 open") END; NextArg(fn); f2:=OpenRead(fn); IF f2<0 THEN Err("file 2 open") END; NextArg(fn); fo:=OpenWrite(fn); IF fo<0 THEN Err("file 3 open") END; mods:=0; rem:=0; y:=0; REPEAT len1:=RdBin(f1, b1, SIZE(b1)); len2:=RdBin(f2, b2, SIZE(b2)); IF len1<0 THEN Err("file 1 read") END; IF len2<0 THEN Err("file 2 read") END; FOR x:=0 TO len1 DIV 2-1 DO a:=rw(b1[x*2],b1[x*2+1]); IF (a<-12000) OR (a>9000) THEN INC(mods); a:=rw(b2[x*2],b2[x*2+1]); IF (a<-12000) OR (a>9000) THEN INC(rem) END; END; IF a<0 THEN INC(a, 65536) END; bo[x*2]:=CHR(a DIV 256); bo[x*2+1]:=CHR(a MOD 256); END; WrBin(fo, bo, len1); INC(y); UNTIL (len1