<*+M2EXTENSIONS *> <*-CHECKDIV *> <*-CHECKRANGE *> <*-GENFRAME*> <*-COVERFLOW *> <*-IOVERFLOW*> <*-NOPTRALIAS*> <*-DOREORDER*> <*-PROCINLINE*> <*-GENPTRINIT*> <*+STORAGE *> <* IF __GEN_C__ THEN *> <*+M2EXTENSIONS *> <*+STORAGE *> <*-GENCTYPES*> <*+COMMENT*> <*-GENHISTORY*> <*-GENDEBUG*> <*-GENDATE*> <*-LINENO*> <*-CHECKINDEX*> <*-CHECKDINDEX*> <*-GENCDIV*> <*-GENKRC*> <*+NOOPTIMIZE*> <*-GENSIZE*> <*-ASSERT*> <*-CHECKNIL*> <*-COVERFLOW*> <*-IOVERFLOW*> <*-CHECKRANGE*> <*-CHECKSET*> <*-CHECKDIV*> <*-GENCONSTENUM*> <*-ASSERT*> <* ELSE *> <*HEAPLIMIT="100000000"*> <*+GENHISTORY*> <*+GENDEBUG*> <*-GENDATE*> <*+LINENO*> <*+CHECKINDEX*> <*+CHECKDNDEX*> <*+NOOPTIMIZE*> <*-GENSIZE*> <*-ASSERT*> <*-CHECKNIL*> <*-COVERFLOW*> <*-IOVERFLOW*> <*-CHECKRANGE*> <*-CHECKSET*> <*-CHECKDIV*> <*-GENCONSTENUM*> <* END *> MODULE srtmtag; (* subtract 10000m in srtm file if in png blue, 20000 if green, 30000 if black *) FROM SYSTEM IMPORT CARD16, INT16, CARD8, FILL, ADR, CAST; FROM osi IMPORT NextArg, WrStr, WrStrLn, Size, WrLn, Close, RdBin, WrBin, File, OpenRead, OpenWrite, Seek, WrHex, WrInt, WrFixed, ALLOCATE; FROM aprsstr IMPORT Append, Assign, Length; IMPORT pngread; CONST SRTM1=25934402; SRTM3=2884802; SRTM1XY=3601; SRTM3XY=1201; ATTRSUB=10000; ATTRNEG=1000; BYTESPERPIX=3; TYPE SET32=SET OF [0..31]; SET8 =SET OF [0..7]; PIX8=RECORD r8, g8, b8:CARD8 END; ROWS=ARRAY[0..SRTM1XY-1] OF PIX8; pROWS=POINTER TO ROWS; PNGBUF=ARRAY[0..SRTM1XY-1] OF pROWS; VAR fn, fnt, b:ARRAY[0..4095] OF CHAR; i, j, wc, ec, ssize, ixsize, eheader:CARDINAL; ar:CARD16; ai:INT16; f1:File; l,lat,long,ilat,ilong,ye,ys,xe,xs,xi,yi:INTEGER; doset:SET8; x,y,xx,yy,c, mods, rem:CARDINAL; col:ARRAY[0..2] OF CARD8; stati:ARRAY[0..7] OF CARDINAL; verb, modified, add:BOOLEAN; yr, yrr, xr, xrr:LONGREAL; ps:POINTER TO ARRAY OF ARRAY OF INT16; rows:PNGBUF; maxx, maxy, maxxbyte, res:INTEGER; bu:ARRAY[0..SRTM1XY-1] OF ARRAY[0..SRTM1XY*BYTESPERPIX-1] OF CHAR; PROCEDURE Err(text:ARRAY OF CHAR); BEGIN WrStr(text); WrStrLn(" error abort"); HALT END Err; PROCEDURE num(s-:ARRAY OF CHAR; p:CARDINAL):INTEGER; BEGIN IF (p>HIGH(s)) OR (s[p]<"0") OR (s[p]>"9") THEN Err("file name not a srtm file") END; RETURN ORD(s[p])-ORD("0") END num; PROCEDURE coltran(c-:ARRAY OF CHAR; p:CARDINAL):CARD8; VAR s,r,g,b:CARDINAL; BEGIN r:=ORD(c[p]); g:=ORD(c[p+1]); b:=ORD(c[p+2]); s:=(r+g+b) DIV 3; IF b*3>=4*s THEN RETURN 3 END; (* blue *) IF g*3>=4*s THEN RETURN 2 END; (* green *) -- IF r>=2*s THEN WrStr("r") END; (* red *) IF (s<70) & (ABS(VAL(INTEGER, s-b))<10) & (ABS(VAL(INTEGER, s-g))<10) THEN RETURN 1 END; (* black *) RETURN 0; END coltran; PROCEDURE chkmeta(a:INT16):CARDINAL; BEGIN RETURN VAL(CARDINAL, VAL(INTEGER, a)+(4*ATTRSUB+ATTRNEG)) DIV ATTRSUB END chkmeta; PROCEDURE resmeta(VAR a:INT16); BEGIN a:=VAL(INTEGER, VAL(CARDINAL, VAL(INTEGER, a)+(4*ATTRSUB+ATTRNEG)) MOD ATTRSUB) - ATTRNEG END resmeta; PROCEDURE setmeta(VAR a:INT16; t:INTEGER); BEGIN resmeta(a); INC(a, (t-4)*ATTRSUB); END setmeta; PROCEDURE showst(h-:ARRAY OF CHAR); VAR x:CARDINAL; BEGIN IF verb THEN WrStrLn(h); WrStr("error pixels:"); WrInt(stati[0]+stati[7], 1); WrStrLn(""); FOR x:=1 TO 6 DO IF stati[x]<>0 THEN WrStr("pixels typ:"); WrInt(x, 1); WrStr(" count: ");WrInt(stati[x], 1); WrStrLn(""); END; END; END; END showst; BEGIN verb:=TRUE; modified:=FALSE; add:=TRUE; doset:=SET8{}; NextArg(fn); IF fn[0]="-" THEN IF fn[1]="t" THEN doset:=SET8{}; NextArg(fn); i:=0; WHILE (i<=HIGH(fn)) & (fn[i]<>0C) DO l:=ORD(fn[i])-ORD("0"); IF (l<1) OR (l>6) OR (l=4) THEN Err("tags 12356") END; INCL(doset, l); INC(i); END; ELSIF fn[1]="h" THEN WrStrLn(""); WrStrLn("srtmtag [-t ] []"); WrStrLn("modify srtm-files by add/subtract multiples of 10000m to store attributes"); WrStrLn("-t manage layers 1(urban), 2(wood), 3(water), 5(?), 6(?) -t 123"); WrStrLn(" 4(original), no tags: inspect srtm file only"); WrStrLn(" 3601x3601 srtm1 or 1201x1201 srtm3 file"); WrStrLn(" 3601x3601 png image with tag colours"); WrStrLn(" no file: delete tags in srtmfile if in taglist"); HALT ELSE Err("usage [[-t ] []") END; NextArg(fn); END; f1:=OpenRead(fn); IF f1<0 THEN Err("srtm file open") END; i:=Size(f1); IF i=SRTM1 THEN ssize:=SRTM1XY ELSIF i=SRTM3 THEN ssize:=SRTM3XY; ELSE Err("file not srtem1/3 size") END; i:=Length(fn); IF i<11 THEN Err("file name not a srtm file") END; IF (fn[i-1]<>"t") OR (fn[i-2]<>"g") OR (fn[i-3]<>"h") OR (fn[i-4]<>".") THEN Err("file name not a srtm file") END; lat:=num(fn, i-9) + num(fn, i-10)*10; IF fn[i-11]="S" THEN lat:=-lat ELSIF fn[i-11]<>"N" THEN Err("file name not a srtm file") END; long:=num(fn, i-5) + num(fn, i-6)*10 + num(fn, i-7)*100; IF fn[i-8]="W" THEN long:=-long ELSIF fn[i-8]<>"E" THEN Err("file name not a srtm file") END; ilat:=90-(90-lat); ilong:=(180+long)-180; --WrInt(ilat, 10);WrInt(ilong, 10); WrStrLn("=ilat ilong"); NextArg(fnt); IF fnt[0]<>0C THEN IF verb THEN WrStr("open extent file "); WrStrLn(fnt) END; maxx:=SRTM1XY; maxy:=SRTM1XY; maxxbyte:=maxx*BYTESPERPIX; (* maxxbyte = maxx*4: switch on alpha channel *) FOR i:=0 TO HIGH(rows) DO rows[i]:=ADR(bu[i]) END; IF verb THEN WrStrLn(fnt) END; res:=pngread.readpng(fnt, rows, maxx, maxy, maxxbyte); IF res<0 THEN Err("png read") END; IF verb THEN WrInt(maxx, 1);WrStr("x");WrInt(maxy, 1); WrStrLn("=extent image") END; END; IF verb THEN WrStrLn("read srtm") END; NEW(ps, ssize, ssize); IF ps=NIL THEN Err("srtm image out of memory"); END; FILL(ADR(stati), 0C, SIZE(stati)); FOR y:=0 TO ssize-1 DO l:=RdBin(f1, ps^[y], SIZE(ps^[0])); IF lSRTM1XY) & (ssize<>SRTM3XY) THEN Err("not srtm size") END; FILL(ADR(stati), 0C, SIZE(stati)); IF fnt[0]<>0C THEN FOR y:=0 TO ssize-1 DO FOR x:=0 TO ssize-1 DO IF ssize<>SRTM1XY THEN xx:=x*3; yy:=y*3 ELSE xx:=x; yy:=y END; IF chkmeta(ps^[y][x]) IN SET8{1..6} THEN (* do not modify error pixels *) j:=coltran(bu[yy], xx*BYTESPERPIX); IF j IN doset THEN setmeta(ps^[y][x], j); IF j<=HIGH(stati) THEN INC(stati[j]) END; modified:=TRUE; END; END; END; END; END; showst("added:"); IF modified THEN IF verb THEN WrStrLn("write srtm") END; f1:=OpenWrite(fn); IF f1<0 THEN Err("srtm file write") END; FOR y:=0 TO ssize-1 DO FOR x:=0 TO ssize-1 DO ar:=ps^[y][x]; ps^[y][x]:=ar DIV 256+ar*256; (* reverse byte order *) END; WrBin(f1, ps^[y], SIZE(ps^[0])); END; Close(f1); END; -- WrStrLn(""); END srtmtag. (* gcc -o srtmtag Lib.o aprsstr.o filesize.o flush.o osi.o pngread.o srtmtag.o /usr/local/xds/lib/x86/libts.a /usr/local/xds/lib/x86/libxds.a -lm libpng.a libz.a *) (* Assign(fne, path); IF ilat<0 THEN Append(fne, "S") ELSE Append(fne, "N") END; Append(fne, CHR(ABS(ilat) DIV 10+48)); Append(fne, CHR(ABS(ilat) MOD 10+48)); IF ilong<0 THEN Append(fne, "W") ELSE Append(fne, "E") END; Append(fne, CHR(ABS(ilong) DIV 100 MOD 10+48)); Append(fne, CHR(ABS(ilong) DIV 10 MOD 10+48)); Append(fne, CHR(ABS(ilong) MOD 10+48)); Append(fne, ".png"); *) (* f2:=OpenRead(fnt); IF f2<0 THEN Err("extent file open") END; l:=RdBin(f2, b, 4096); IF l<4096 THEN Err("extent file read") END; i:=3; IF (b[0]<>"P") OR (b[1]<>"6") THEN Err("extent file image format") END; WHILE (i<4096) & (b[i]<" ") DO INC(i) END; WHILE (i<4096) & (b[i]="#") DO INC(i); WHILE (i<4096) & (b[i]>=" ") DO INC(i) END; WHILE (i<4096) & (b[i]<" ") DO INC(i) END; END; ix:=0; WHILE (i<4096) & (b[i]>="0") & (b[i]<="9") DO ix:=ix*10 + ORD(b[i]) - ORD("0"); INC(i) END; WHILE (i<4096) & (b[i]=" ") DO INC(i) END; iy:=0; WHILE (i<4096) & (b[i]>="0") & (b[i]<="9") DO iy:=iy*10 + ORD(b[i]) - ORD("0"); INC(i) END; INC(i); WHILE (i<4096) & (b[i]>" ") DO INC(i) END; (* skip gray levels *) INC(i); IF (ix<>SRTM1XY) OR (iy<>SRTM1XY) THEN Err("extent image size") END; --WrInt(i, 12); --WrInt(Size(f2), 12); ixsize:=ix*3; IF Size(f2)<>i + ixsize*iy THEN Err("extent file size"); END; NEW(pt, ix, iy); IF pt=NIL THEN Err("extent image out of memory"); END; *) (* x:=0; y:=0; c:=0; LOOP IF VAL(INTEGER,i)>=l THEN l:=RdBin(f2, b, SIZE(b)); i:=0 END; IF l<=0 THEN Err("extent image read error"); END; col[c]:=ORD(b[i]); INC(i); INC(c); IF c>=3 THEN pt^[y][x]:=coltran(col); INC(x); IF x>=ix THEN INC(y); x:=0; IF y>=iy THEN EXIT END; END; c:=0; END; END; *)