<*+M2EXTENSIONS *>
<*+STORAGE *>
<*-GENFRAME*>
<*+NOPTRALIAS*>
<*CPU="PENTIUM"*>

IMPLEMENTATION MODULE maptool; (* aprs tracks on osm map by oe5dxl *)

IMPORT pngread, pngwrite;
FROM jpgdec IMPORT readjpg;
FROM osi IMPORT WrStr, WrStrLn, WrInt, FdValid, InvalidFd, File, Exists, Erase,
                RdBin, OpenWrite, WrBin, Close, OpenRead, DIRSEP, Seek, Rename,
                sqrt, sin, arctan, tan, ln, cos, pi, exp, WrFixed, floor, power,
                ALLOCATE, DEALLOCATE, time, DIRCONTEXT, OpenDir, ReadDirLine, CloseDir;
FROM xosi IMPORT StartProg, CheckProg, sethand, pulling, CURSORTYP, Eventloop;
--FROM TimeConv IMPORT time;
FROM SYSTEM IMPORT ADDRESS, FILL, ADR, INT16, INT8, CAST, MOVE, CARD8, CARD16, SHIFT, TSIZE;
--FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM aprspos IMPORT posvalid, distance, azimuth, EARTH, RAD, wgs84s, wgs84r;

FROM aprsdecode IMPORT initzoom, inittilex, inittiley, lums, finezoom, click,
     mappos, systime, verb, trunc, realtime, maploadpid, DEGSYM, COLTYP, POIINFOSIZE,
     mountains, pMOUNTAIN, AREASYMB, MULTILINE, GetMultiline, MAXMULTILINES, poifiles,
     DEFAULTPOISYMBOL, POIFILELINE, MAXPOIFILES;

FROM aprsstr IMPORT postoloc, loctopos, POSITION, IntToStr, FixToStr, Append, Length,
                    posinval, TimeToStr, StrToFix, TIME, cleanfilename, InStr, Assign,
                    Delstr, StrCmp;

FROM useri IMPORT confstr, conf2str, configon, CONFSET, reloadmap, downloadprogress,
                  debugmem, wrheap, localtime, SP1, SP9, xerrmsg, refresh, conf2int,
                  textautosize, killmenuid, conf2real, say, ColConfset, confstrings, xmouse;

FROM aprstext IMPORT postostr, DateLocToStr, TEXTCOLYEL, TEXTCOLVIO, TEXTCOLORA, TEXTCOLEND,
                     deganytopos;

FROM libsrtm IMPORT getsrtm, getsrtmlong, closesrtmfile, srtmdir, srtmmem, srtmmaxmem,
                    ATTRWATER, ATTRWOOD, ATTRURBAN;


CONST 
      LF=12C; 
      MAXCOL=30000;
      SYMN=192;                                                   (* number of symbols *)
      MAXSYMSIZE=32;                                              (* maximal symbol size *)
      MINSYMSIZE=16;
      MAPGETFN="gettiles";                                        (* tiles request filename *)

      MAXFONTY=24;
      MINFONTY=7;
      DEFAULTFONTY=12;
      MAXFONTX=12;
      MINFONTX=6;
      DEFAULTFONTX=8;
      FONTFN="font";
      FONTEXT=".png";
      SYMFN="symbols";
      SYMEXT=".png";

      PNGEXT=".png";
      JPGEXT=".jpg";
      CHARS=MAXCHAR-32;

      NOMAPR=100;                                                 (* have no map fill colour *)
      NOMAPG=120;
      NOMAPB=100;

      SRTMXY=3600;
      STRIPS=3;

      GAINS=360;                                                (* antenna diagram values *)

TYPE
     PIX8=RECORD r8, g8, b8:CARD8 END;
     PIX8A=RECORD r8, g8, b8, alpha:CARD8 END;                  (* colour pixel with alpha *)
     SET8=SET OF [0..7];
     ROWS=ARRAY[0..TILESIZE-1] OF PIX8;
     pROWS=POINTER TO ROWS;
     SET16=SET OF [0..15];
     PNGBUF=ARRAY[0..TILESIZE-1] OF pROWS;
     pPNGBUF=POINTER TO PNGBUF;
     FN=ARRAY[0..1023] OF CHAR;


(* srtm *)
    SRTMSTRIP=ARRAY[0..SRTMXY DIV STRIPS-1] OF INT16;
    pSRTMSTRIP=POINTER TO SRTMSTRIP;
    pSRTMTILE=POINTER TO SRTMTILE;
    SRTMTILE=RECORD
      typ   :CARD8;
      fd    :File;
      used  :ARRAY[0..STRIPS-1] OF ARRAY[0..SRTMXY-1] OF CARD8;
      strips:ARRAY[0..STRIPS-1] OF ARRAY[0..SRTMXY-1] OF pSRTMSTRIP;
    END;
    SRTMLAT=ARRAY[0..179] OF pSRTMTILE;
    pSRTMLAT=POINTER TO SRTMLAT;
    SRTMLONG=ARRAY[0..359] OF pSRTMLAT;
    SRTM30FD=ARRAY[0..8] OF ARRAY[0..3] OF RECORD
      fd:File;
      havefile:BOOLEAN;                                           (* have tried to open file *)
    END;
(* srtm *)
   

VAR
    symbols:ARRAY[0..MAXSYMSIZE*SYMN-1] OF ARRAY[0..MAXSYMSIZE-1] OF PIX8A;
    pngbuf :PNGBUF;
    font   :ARRAY[0..CHARS+1] OF RECORD
      char:ARRAY[0..MAXFONTY] OF ARRAY[0..MAXFONTX+1] OF CARD8;
      mask:ARRAY[0..MAXFONTY+2] OF SET16; 
      width:CARD8; 
    END;
    gammatab    :ARRAY[0..1023] OF CHAR;
    maploadstart:TIME;
    mapnamesbuf :ARRAY[0..4095] OF CHAR;                   (* tile name buffer *)
    mapnamesdone:CARD8;                                    (* tile names written to file *)
    lastmapreq  :TIME;                                     (* time of last map requested *)
    maploopcnt  :CARDINAL;                                 (* count same tile requests *)
    mapdelay    :TIME;                                     (* delay map load start on map moves *)

    srtmcache   :SRTMLONG;
    srtm30fd    :SRTM30FD;                                 (* open srtm30 files *)

    lastpoinum  :CARDINAL;
    lastyzoom   :INTEGER;
    diagram:RECORD
              on,
              cacheok,
              rotate      :BOOLEAN;
              lastele,
              mindB,
              maxdB,
              dBmul,
              logmul,
              lpower,
              mhz,
              azimuth,
              elevation,
              cachegain   :REAL;
              hgain,
              vgain       :ARRAY[0..GAINS-1] OF REAL;
            END;


PROCEDURE sqr(x:REAL):REAL;
BEGIN RETURN x*x END sqr;


PROCEDURE makegammatab;
VAR c:CARDINAL;
CONST GAMMA=1.0/2.2;
BEGIN
  gammatab[0]:=0C;
  FOR c:=1 TO HIGH(gammatab) DO gammatab[c]:=CHR(trunc(exp(ln(FLOAT(c)/1024.0)*GAMMA)*255.5)) END;
END makegammatab;


PROCEDURE clr(img:pIMAGE);
VAR x:CARDINAL;
BEGIN
  FOR x:=0 TO HIGH(img^) DO
    FILL(ADR(img^[x]), 0C, SIZE(img^[0]));
  END;
END clr;

PROCEDURE vistime(t:TIME):BOOLEAN;
BEGIN RETURN systime<t+VAL(TIME, lums.maxdim+lums.firstdim) END vistime;


PROCEDURE limpos(VAR pos:POSITION);
BEGIN
  IF pos.long>pi THEN pos.long:=pi ELSIF pos.long<-pi THEN pos.long:=-pi END;
  IF pos.lat>MAXLAT THEN pos.lat:=MAXLAT ELSIF pos.lat<-MAXLAT THEN pos.lat:=-MAXLAT END;
END limpos;

PROCEDURE startmapdelay;
BEGIN
  mapdelay:=conf2int(fDELAYGETMAP, 0, 0, 60, 0);
  lastmapreq:=realtime;
  maploopcnt:=0;                                        (* operator moves map *)
END startmapdelay;


PROCEDURE findinfo(nx, ny:INTEGER);
VAR d:INTEGER;
    i:CARDINAL;
BEGIN
  WITH click DO
    d:=ABS(x-nx)+ABS(y-ny);
--IF (d<=5) & (ops<>NIL) THEN WrInt(d, 3);WrInt(entries, 3);WrStrLn(ops^.call); END;
    IF (d<=min) & (ops<>NIL) THEN     (* ops to ignore cc text *) 
      IF min>0 THEN entries:=0 ELSIF entries>HIGH(table) THEN entries:=HIGH(table) END;
      min:=d; 
      i:=0;
      WHILE (i<entries) & (table[i].opf<>ops) DO INC(i) END; 
      table[i].opf:=ops; 
      table[i].pff:=pf;
      table[i].pff0:=pf0;
      table[i].typf:=typ;
      IF i>=entries THEN INC(entries) END;
    END; 
  END; 
END findinfo;

PROCEDURE area(img:pIMAGE; x0,y0,x1,y1:INTEGER; col:COLTYP; add:BOOLEAN);
VAR xx,yy,h:INTEGER;
BEGIN
  IF x0>x1 THEN h:=x0; x0:=x1; x1:=h END;
  IF y0>y1 THEN h:=y0; y0:=y1; y1:=h END;
  IF x0<0 THEN x0:=0 END;
  IF x1<0 THEN x1:=0 END;
  IF y0<0 THEN y0:=0 END;
  IF y1<0 THEN y1:=0 END;
  IF x0>VAL(INTEGER,HIGH(img^)) THEN x0:=HIGH(img^) END;
  IF x1>VAL(INTEGER,HIGH(img^)) THEN x1:=HIGH(img^) END;
  IF y0>VAL(INTEGER,HIGH(img^[0])) THEN y0:=HIGH(img^[0]) END;
  IF y1>VAL(INTEGER,HIGH(img^[0])) THEN y1:=HIGH(img^[0]) END;
  FOR yy:=y0 TO y1 DO
    FOR xx:=x0 TO x1 DO
      WITH img^[xx][yy] DO
        IF add THEN
          INC(r, col.r);
          INC(g, col.g);
          INC(b, col.b);
        ELSE
          r:=col.r;
          g:=col.g;
          b:=col.b;
        END;
      END;
    END;
  END;
END area;

PROCEDURE realzoom(zi:INTEGER; zf:REAL):REAL;
BEGIN RETURN FLOAT(zi)+zf-1.0 END realzoom;

PROCEDURE expzoom(z:INTEGER):REAL;
BEGIN RETURN FLOAT(CAST(CARDINAL,SHIFT(BITSET{0}, z))) END expzoom;


PROCEDURE latproj(l:REAL):REAL;
VAR c:REAL;
BEGIN
 c:=cos(l);
 IF c<=0.00001 THEN c:=0.00001 END;
 RETURN ln((sin(l)+1.0)/c)
END latproj;


PROCEDURE xytodeg(x, y:REAL; VAR pos:POSITION);
VAR zi:INTEGER;
    pixrad, zoom, ysf:REAL;
BEGIN
  zoom:=realzoom(initzoom, finezoom);
  ysf:=FLOAT(ysize);
  y:=ysf-y;
  IF y<0.0 THEN y:=0.0 ELSIF y>ysf THEN y:=ysf END;
  IF ABS(mappos.lat)>MAXLAT THEN posinval(pos); RETURN END;
  zi:=trunc(zoom);
  pixrad:=(pi*2.0)/((1.0+zoom-FLOAT(zi))*TILESIZE*expzoom(trunc(zoom)));
  pos.long:=mappos.long+pixrad*x;
  pos.lat :=2.0*arctan(exp(latproj(mappos.lat)-pixrad*y))-pi*0.5;
  limpos(pos);
END xytodeg;

PROCEDURE shiftmap(x, y, ysize:INTEGER; zoom:REAL; VAR pos:POSITION);
VAR zi:INTEGER;
    pixrad:REAL;
BEGIN
  zi:=trunc(zoom);
  pixrad:=(1.0+zoom-FLOAT(zi))*TILESIZE*expzoom(trunc(zoom));
  pos.long:=pos.long-(pi*2.0)/pixrad*VAL(REAL,x);
  pos.lat :=2.0*arctan(exp(latproj(pos.lat)+(pi*2.0)/pixrad*VAL(REAL,ysize-y)))-pi*0.5;
  limpos(pos);
END shiftmap;

PROCEDURE center(xsize, ysize:INTEGER; zoom:REAL; centpos:POSITION; VAR pos:POSITION);
VAR zi:INTEGER;
    pixrad:REAL;
BEGIN
  zi:=trunc(zoom);
  pixrad:=(1.0+zoom-FLOAT(zi))*TILESIZE*expzoom(trunc(zoom));
  pos.long:=centpos.long-(pi*2.0)/pixrad*VAL(REAL,xsize DIV 2);
  pos.lat :=2.0*arctan(exp(latproj(centpos.lat)+(pi*2.0)/pixrad*VAL(REAL,ysize DIV 2)))-pi*0.5;
  limpos(pos);
END center;


PROCEDURE mercator(lon, lat:REAL; zoom:INTEGER; VAR tilex, tiley:INTEGER; VAR x, y:REAL);
CONST TOL=0.0001;

VAR z:REAL;

BEGIN
  IF lat>MAXLAT THEN lat:=MAXLAT ELSIF lat<-MAXLAT THEN lat:=-MAXLAT END;
  IF lon>pi-TOL THEN lon:=pi-TOL ELSIF lon<-pi+TOL THEN lon:=-pi+TOL END;

  z:=expzoom(zoom);
  x:=(0.5+lon*(0.5/pi))*z;
  y:=(0.5-latproj(lat)*(0.5/pi))*z; 
  tilex:=trunc(x);
  tiley:=trunc(y);
  x:=(x-FLOAT(tilex))*TILESIZE; 
  y:=(y-FLOAT(tiley))*TILESIZE;

<* IF NOT __GEN_C__ THEN *>
EXCEPT
  WrStrLn("error in mercator");
  tilex:=0;
  tiley:=0;
  x:=0.0;
  y:=0.0; 
<* END *>

END mercator;

PROCEDURE mapxy(pos:POSITION; VAR x, y:REAL):INTEGER;
VAR tilex, tiley:INTEGER;
    xs, ys:REAL;
BEGIN
  IF posvalid(pos) THEN
    mercator(pos.long, pos.lat, initzoom, tilex, tiley, x, y);
    DEC(tilex, inittilex);
    DEC(tiley, inittiley);
    x:=(x+FLOAT(tilex*TILESIZE)-shiftx)*finezoom;
    y:=FLOAT(ysize)-(FLOAT(tiley*TILESIZE)+y-shifty)*finezoom;
--WrFixed(x, 5, 10); WrFixed(FLOAT(xsize), 5, 10); WrFixed(y, 5, 10); WrFixed(FLOAT(ysize), 5, 10); WrLn;
--doreorder error:    IF (x>=0.0) & (x<=FLOAT(xsize)) & (y>=0.0) & (y<=FLOAT(ysize)) THEN RETURN 0 END;
    xs:=FLOAT(xsize);
    ys:=FLOAT(ysize);
    IF (x>=0.0) & (x<=xs) & (y>=0.0) & (y<=ys) THEN RETURN 0 END;

  END;
  RETURN -1
END mapxy;


PROCEDURE zoominout(in, fine, allowrev, mouseismiddle:BOOLEAN);
VAR fz:REAL;
    mid:POSITION;
    maxz, mx, my:INTEGER;
BEGIN
  mx:=xsize DIV 2;
  my:=ysize DIV 2;
  IF mouseismiddle THEN mx:=xmouse.x; my:=ysize-xmouse.y; END;
  xytodeg(VAL(REAL,mx), VAL(REAL, my), mid);

  mid.lat:=mid.lat+FLOATERRCORR;        (* compensate position drift due to float precision *)

  IF fine THEN
    fz:=conf2real(fZOOMSTEP, 0, -1.0, 1.0, 0.1);
    IF NOT allowrev THEN fz:=ABS(fz) END;
    IF in THEN finezoom:=finezoom+fz ELSE finezoom:=finezoom-fz END;

    IF (finezoom<1.0) & (finezoom>1.0-fz*0.5) THEN finezoom:=1.0 END;
    IF finezoom<1.0 THEN
      IF initzoom>0 THEN 
        DEC(initzoom);
        finezoom:=2.0-fz;
      ELSE finezoom:=1.0 END;
    ELSIF finezoom>=2.0-fz*0.5 THEN
      INC(initzoom);
      finezoom:=1.0;
    END;
  ELSE
    IF in THEN
      INC(initzoom); 
      IF finezoom>1.75 THEN INC(initzoom) END; 
    ELSIF finezoom<1.25 THEN DEC(initzoom) END;
    finezoom:=1.0;
  END;

  maxz:=conf2int(fMAXZOOM, 0, 1, MAXZOOM, MAXZOOM);
  IF initzoom<MINZOOM THEN initzoom:=MINZOOM; finezoom:=1.0; 
  ELSIF initzoom>=maxz THEN initzoom:=maxz; finezoom:=1.0 END;

  shiftmap(mx, my, ysize, realzoom(initzoom, finezoom), mid);
  mappos:=mid;
END zoominout;


PROCEDURE pullmap(x, y, x0:INTEGER; init:BOOLEAN);
VAR top:POSITION;
    step:REAL;
    i:CARDINAL;
BEGIN
  y:=ysize-y;
  IF init THEN
    xytodeg(VAL(REAL,x), VAL(REAL,y), click.pullpos);
    sethand(cPULL4); pulling:=TRUE;
    lastyzoom:=y;
  ELSIF xsize-x0>10 THEN                           (* not mouse move on right margin so move map *)
    step:=FLOAT(initzoom)*0.1;
    IF step<0.1 THEN step:=0.1 ELSIF step>0.5 THEN step:=0.5 END; (* low zoom is more nonlinear *)
    FOR i:=0 TO 9 DO           (* iterate mouse position to new position my moving map cornern *)
      xytodeg(VAL(REAL,x), VAL(REAL,y), top);
      mappos.lat:=mappos.lat-(top.lat-click.pullpos.lat)*step;
      mappos.long:=mappos.long-(top.long-click.pullpos.long);
      limpos(mappos);
    END;
  ELSIF ABS(y-lastyzoom)>4 THEN                    (* minimal vertical move for next zoom step *)
    zoominout(y>lastyzoom, TRUE, TRUE, FALSE);
    lastyzoom:=y;
  END;
END pullmap;


PROCEDURE fresnel(a, b, lambda:REAL):REAL;
BEGIN IF lambda=0.0 THEN RETURN 0.0 ELSE RETURN sqrt(lambda*a*b/(a+b)) END; END fresnel;

PROCEDURE frescol(a:REAL; VAR r,g,b:CARD16);
CONST M=700;
BEGIN
  b:=M;
  r:=0;
  g:=100;
  IF a<=0.001 THEN r:=M; g:=0; b:=0;
  ELSIF a<0.999 THEN
    b:=0;
    IF a<0.5 THEN r:=M; g:=trunc(a*(M*2.0));
    ELSE g:=M; r:=trunc((1.0-a)*(M*2.0)) END;
  END;
END frescol;


PROCEDURE elevation(x0,y0,z0, x1,y1,z1:REAL; VAR e0, e1:REAL);
VAR a,b,c,s,r:REAL;
BEGIN
  e1:=0.0;
  e0:=0.0;

  a:=sqrt(x0*x0 + y0*y0 + z0*z0);
  b:=sqrt(x1*x1 + y1*y1 + z1*z1);
  x1:=x1-x0;
  y1:=y1-y0;
  z1:=z1-z0;
  c:=sqrt(x1*x1 + y1*y1 + z1*z1);

(* halbwinkelsatz *)
  s:=(a+b+c)*0.5;
  IF s=0.0 THEN RETURN END;
 
  r:=(s-a)*(s-b)*(s-c)/s;
  IF r<=0.0 THEN RETURN END;

  r:=sqrt(r);
  e1:=(360.0/pi)*arctan(r/(s-a))-90.0;
  e0:=(360.0/pi)*arctan(r/(s-b))-90.0;

<* IF NOT __GEN_C__ THEN *>
EXCEPT
<* END *>
END elevation;

PROCEDURE setsrtmcache;
BEGIN srtmmaxmem:=conf2int(fSRTMCACHE, 0, 0, 2000, 20)*1000000 END setsrtmcache;


PROCEDURE treealt(alt, treesize:REAL):REAL;
VAR w:REAL;
BEGIN
  IF alt>=1000.0 THEN w:=treesize*(2000.0-alt)/1000.0;
    IF w<0.0 THEN RETURN 0.0 END;

    RETURN w
  END;
  RETURN treesize
END treealt;


PROCEDURE geoprofile(image:pIMAGE; pos0, pos1:POSITION; lambda:REAL;
                     ant1nn:BOOLEAN; ant1, ant2:INTEGER; VAR dist, a1, a2, ele1, ele2:REAL):INTEGER;

  PROCEDURE ruler(m, x, y:REAL; over, right:BOOLEAN);     (* write meter to largest heigth *)
  VAR void:INT8;
      s:ARRAY[0..20] OF CHAR;
      c:COLTYP;
      l:CARDINAL;
  BEGIN
    IntToStr(VAL(INTEGER, m), 0, s); Append(s, "m");
    l:=Length(s)*lums.fontxsize;
    c.r:=400;
    c.g:=400;
    c.b:=400;
    IF right THEN x:=x-FLOAT(l) END;
    IF over THEN y:=y-FLOAT(lums.fontysize) END; 
    drawstr(image, s, floor(x), floor(y), 250, 0, c, void, 0, TRUE, FALSE);
  END ruler;

CONST SCALEHLINES=0.1;                                (* size of headroom lines to rf path size *)
      DOTSTEP=2;
      MAXDIST=1000000;
      HERR=-20000.0;
      ER=EARTH*1000.0;
      NOALT=30000;

TYPE pHTAB=POINTER TO HTAB;
     HTAB=RECORD
            next:pHTAB;
            tx,ty,alt:REAL;
          END;

VAR fs, fstep:INTEGER;
    x0,y0,z0, x1,y1,z1, dx,dy,dz, h, d, x,y, fres, maxfres, xo,yo, kf, nv, odist, refrac,
    fressum, fresmin, fullsum, dh, h0, h1, hmid, resol, a, wdif, xsh, ysh, xproj, yproj:REAL;
    pos (*, posf*):POSITION;
    blue, green, red:CARD16;
    phtab, pht, phmax:pHTAB;
    attr:CARD8;
    nn,nn2, trees:REAL;
BEGIN
  setsrtmcache;
  trees:=conf2real(fREFRACT, 1, 0.0, 100.0, 0.0);

  dist:=0.0;
  IF ant1nn THEN nn:=0.0;  (* ant1 is given in NN not over ground (m) *) 
  ELSE nn:=getsrtmlong(pos0.lat, pos0.long, 30, FALSE, resol, attr, NIL) END;
  IF nn<NOALT THEN a1:=nn+VAL(REAL, ant1) ELSE a1:=VAL(REAL, ant1) END;
  wgs84s(pos0.lat, pos0.long, a1*0.001, x0,y0,z0);
  nn2:=getsrtmlong(pos1.lat, pos1.long, 30, FALSE, resol, attr, NIL);
  IF nn2<NOALT THEN a2:=nn2+VAL(REAL, ant2) ELSE a2:=VAL(REAL, ant2) END;
  wgs84s(pos1.lat, pos1.long, a2*0.001, x1,y1,z1);
  elevation(x0,y0,z0, x1,y1,z1, ele1, ele2);
  x1:=x1-x0;
  y1:=y1-y0;
  z1:=z1-z0;
  dist:=sqrt(x1*x1 + y1*y1 + z1*z1)*1000.0;
  IF dist<1.0 THEN closesrtmfile; RETURN -3 END;

  IF (nn>=NOALT) OR (nn2>=NOALT) THEN closesrtmfile; RETURN -1 END;

  IF dist>MAXDIST THEN closesrtmfile; RETURN -2 END;

  refrac:=(ER - sqrt(ER*ER + dist*dist*0.25))*conf2real(fREFRACT, 0, -10.0, 10.0, 0.0)*4.0;
--WrFixed(refrac,3, 10); WrStrLn(" refra");
  odist:=0.7071/dist;                                      (* step 1/sqrt(2) of map resolution *)
  d:=0.0;  
  maxfres:=fresnel(dist*0.5, dist*0.5, lambda);
  IF maxfres=0.0 THEN maxfres:=1.0 END;
  xo:=0.0;
  yo:=0.0;
  fresmin:=1.0;

  nv:=azimuth(pos0, pos1)*(pi/180.0);

  phtab:=NIL;
  REPEAT
    fres:=fresnel(dist*d, dist*(1.0-d), lambda);
    dx:=x0 + x1*d;
    dy:=y0 + y1*d;
    dz:=z0 + z1*d;
    wgs84r(dx,dy,dz, pos.lat, pos.long, hmid);
    IF mapxy(pos, x, y)>=0 THEN
      hmid:=hmid*1000.0 - (d - d*d)*refrac;
      fressum:=0.0;
      fullsum:=0.0;
      fstep:=trunc(fres*0.5/resol);
      FOR fs:=-fstep TO fstep DO
        kf:=VAL(REAL, fs)*resol/20000000.0*pi;
        dh:=sqr(fres*0.5) - sqr(VAL(REAL, fs)*resol);
(*
        posf.lat:=pos.lat + kf*sin(nv);
        posf.long:=pos.long - kf*cos(nv);
        nn:=VAL(INTEGER, getsrtm(posf, 0, resol)+0.5);
        IF nn>=30000 THEN h:=HERR ELSE h:=VAL(REAL, nn) END; (* m over ground *)
*)
        nn:=getsrtmlong(pos.lat + kf*sin(nv), pos.long - kf*cos(nv), 30, FALSE, resol, attr, NIL);
        IF attr=ATTRWOOD THEN nn:=nn+treealt(nn, trees) END;
        IF nn>=30000.0 THEN h:=HERR ELSE h:=nn END;

        IF dh>0.0 THEN
          dh:=sqrt(dh);
          h0:=hmid - dh;
          h1:=hmid + dh;
--WrFixed(dh, 3, 10); WrFixed(h0, 3, 10); WrFixed(h1, 3, 10); WrStrLn(" dh");

          fullsum:=fullsum + (h1-h0);

--WrFixed(h, 3, 10); WrFixed(h0, 3, 10); WrStrLn(" hh0");

          IF h>h0 THEN h0:=h END;
          IF h1>h0 THEN fressum:=fressum + (h1-h0) END; 
        ELSE
          fullsum:=1.0;
          IF h<hmid THEN fressum:=1.0 END;                
        END;
      END;
      IF fullsum>0.0 THEN
        fressum:=fressum/fullsum;
        IF fressum<fresmin THEN fresmin:=fressum END;
--WrFixed(fullsum, 3, 10); WrFixed(fressum, 3, 10); WrStrLn(" ff");
        IF sqr(xo-x)+sqr(yo-y)>DOTSTEP*DOTSTEP THEN
          IF h=HERR THEN waypoint(image, x, y, 1.5, 500, 500, 500);    (* have no srtm *)
          ELSE
            frescol(fresmin, red, green, blue); 
            waypoint(image, x, y, 1.25+1.25*fres/maxfres, red, green, blue);

            ALLOCATE(pht, SIZE(pht^));           (* store headroom values for scaling later *)
            IF pht<>NIL THEN
              pht^.next:=phtab; phtab:=pht;
              pht^.alt:=hmid-FLOAT(nn);          (* meters over (or under) ground *)
              pht^.tx:=x; pht^.ty:=y;            (* pixel on screen *)
            END;
          END;
          xo:=x;
          yo:=y;
          fresmin:=1.0;
        END;

      END;
    END;

    d:=d+resol*odist;
--    IF srtmmem>=maxcache THEN purgesrtm(FALSE) END;

  UNTIL d>1.0;
  IF phtab<>NIL THEN
    phmax:=NIL;
    pht:=phtab;
    d:=MAX(REAL);
    a:=1.0;
    LOOP                                                 (* find maximum for scaling *)
      IF ABS(pht^.alt)>a THEN a:=ABS(pht^.alt) END;

      h:=ABS(FLOAT(HIGH(image^))*0.5-pht^.tx) + ABS(FLOAT(HIGH(image^[0]))*0.5-pht^.ty); 
      IF h<d THEN phmax:=pht; d:=h END;

      IF pht^.next=NIL THEN EXIT END;
      pht:=pht^.next;  
    END;
--WrFixed(a, 10,1);WrStrLn("m");

    d:=sqrt(1.0 + sqr(phtab^.tx-pht^.tx) + sqr(phtab^.ty-pht^.ty));   (* rftrack pixels on screen *)

    wdif:=sqr((pos0.long-pos1.long)*cos(pos0.lat)) + sqr(pos0.lat-pos1.lat); 
    IF wdif<>0.0 THEN
      wdif:=sqrt(wdif);                                               (* dist pos0-pos1 *) 
      wdif:=wdif*a/(d*SCALEHLINES);
      xproj:=(pos0.lat-pos1.lat)/wdif;                                (* 90 deg rotatationsvector *)
      yproj:=(pos0.long-pos1.long)*cos(pos0.lat)/wdif;                (* for headroom lines to track *) 
    ELSE xproj:=0.0; yproj:=0.0 END;
    WHILE phtab<>NIL DO
      a:=phtab^.alt;
      IF a<0.0 THEN red:=100; green:=0; blue:=0;                       (* no sight *)
      ELSE red:=0; green:=50; blue:=150 END;                          (* sight *)
      IF yproj<0.0 THEN a:=-a END;                                    (* no sight always upside *)
      xsh:=phtab^.tx+a*xproj;                                         (* rotate to normalvector *)
      ysh:=phtab^.ty-a*yproj;                                         (* rotate to normalvector *)
      IF (phtab=phmax) & (ABS(a)<10000) THEN                          (* max sight marker *)
        ruler(phtab^.alt, xsh, ysh, a*yproj>=0.0, a*xproj<0.0);
        red:=150;
        green:=200;
      END;
      vector(image, phtab^.tx, phtab^.ty, xsh, ysh, red,green,blue, 256, 0.0); (* headroom line *)
      waypoint(image, xsh, ysh, 1.5, red*3, green*3, blue*3);         (* thicken end of headroom line *)
      pht:=phtab;
      phtab:=phtab^.next;
      DEALLOCATE(pht, SIZE(pht^));
    END;
  END;
  RETURN 0;

END geoprofile;

PROCEDURE progress(startt:TIME; s-:ARRAY OF CHAR; perc:CARDINAL; final:BOOLEAN);
VAR rt:TIME;
    ss,ss1:ARRAY[0..100] OF CHAR;

BEGIN
  rt:=time();
  IF final OR (rt<>realtime) THEN
    realtime:=rt;
    IF final OR (startt+4<rt) THEN
      click.cmd:=0C;
      refresh:=TRUE;
      Assign(ss, s);
      IF NOT final THEN
        IntToStr(perc, 3, ss1); Append(ss, ss1); Append(ss, "% (ESC to abort)");
      END;
      textautosize(0, 0, 5, 6, "g", ss);
      Eventloop(1);
    END;
  END;
END progress;


PROCEDURE antdiagram(azi, ele:REAL):REAL;   (* interpolate gain table azi 0..359, ele -90..90 *)
VAR a:CARDINAL;
    gh, gvh, gv, f, e, azv, azx, elv, fh, fb:REAL;
BEGIN
  IF ele>90.0 THEN
    ele:=180.0-ele;
    azi:=azi+180.0;
  ELSIF ele<-90.0 THEN
    ele:=180.0+ele;
    azi:=azi+180.0;
  END;
  IF azi>=360.0 THEN azi:=azi-360.0 END;

  a:=TRUNC(azi);  f:=azi-FLOAT(a);
  gh:=diagram.hgain[a]*(1.0-f) + diagram.hgain[(a+1) MOD 360]*f;    (* interpolated hor *)

  azv:=ABS(azi*(1.0/180.0)-1.0);                                    (* front/back wight *)
  e:=ele+90.0;
  a:=TRUNC(e);  f:=e-FLOAT(a);
  gv:=diagram.vgain[a]*(1.0-f) + diagram.vgain[a+1]*f;              (* interpolate vert front *)
  gvh:=diagram.vgain[(360-a) MOD 360]*(1.0-f) + diagram.vgain[359-a]*f - diagram.vgain[270];
                                                                    (* vert back *)
  gv:=gv*azv + gvh*(1.0-azv);                                       (* front/back wighted vert *)

  gh:=gh*(1.0-ABS(ele*(1/90)));                                     (* vert wighted hor *)
  RETURN sqrt(gh*gh + gv*gv)        (* dB *)                        (* geometric hor vert sum *)
END antdiagram;


PROCEDURE readantenna(fn-:ARRAY OF CHAR; gain:REAL);
CONST TENOVERLOGTEN=4.342944819;
VAR fd:File;
    fb:ARRAY[0..10000] OF CHAR;
    b:ARRAY[0..100] OF CHAR;
    len, i, p, n:INTEGER;
    r:REAL;
BEGIN
  diagram.dBmul:=1.0/(diagram.maxdB-diagram.mindB);
  diagram.logmul:=TENOVERLOGTEN*diagram.dBmul;
  diagram.lpower:=(gain-(32.2-60.0)-ln(diagram.mhz)*TENOVERLOGTEN*2.0-diagram.mindB)*diagram.dBmul;
                                                      (* -60db till meters^2 not km distance *)
  fd:=OpenRead(fn);
  len:=0;
  IF NOT FdValid(fd) THEN
    fb:="Antenna Gain file ["; Append(fb, fn); Append(fb, "] not found"); say(fb, 5, "e");
  ELSE
    len:=RdBin(fd, fb, SIZE(fb));
    IF len<=0
    THEN fb:="Antenna Gain file ["; Append(fb, fn); Append(fb, "] not readable"); say(fb, 5, "e") END;
  END;

  p:=0;
  n:=0;
  FILL(ADR(diagram.hgain), 0C, SIZE(diagram.hgain));
  FILL(ADR(diagram.vgain), 0C, SIZE(diagram.vgain));
  REPEAT
    i:=0;
    WHILE (p<len) & (fb[p]<=" ") DO INC(p) END;
    WHILE (p<len) & (i<VAL(INTEGER, HIGH(b))) & (fb[p]>" ") DO
      b[i]:=fb[p];
      INC(i);
      INC(p);
    END;
    b[i]:=0C;
    IF (i>0) & StrToFix(r, b) THEN
      r:=ABS(r);
      IF r>200.0 THEN r:=200.0 END;
      IF diagram.rotate THEN
        IF n<GAINS THEN diagram.vgain[(n+GAINS DIV 4) MOD GAINS]:=r
        ELSE diagram.hgain[(GAINS-1)-(n+GAINS*7 DIV 4) MOD GAINS]:=r END;
      ELSIF n<GAINS THEN diagram.hgain[(GAINS-1)-n]:=r
      ELSE diagram.vgain[((180+GAINS*2)-n-1) MOD GAINS]:=r END;

    END;
    INC(n);
  UNTIL n>=GAINS*2;

  diagram.cacheok:=FALSE;
END readantenna;


PROCEDURE antgain(azi, alt, oomaxdist:REAL; VAR ddist:REAL):REAL;
VAR db, ele, dist:REAL;

BEGIN
  dist:=ddist/oomaxdist;
  ele:=alt/dist;
  IF diagram.cacheok & (ABS(ele-diagram.lastele)>ABS(ele)*0.01) THEN diagram.cacheok:=FALSE END;
  IF NOT diagram.cacheok THEN
    diagram.lastele:=ele;
    azi:=diagram.azimuth-azi;
    IF azi<0.0 THEN azi:=azi+360.0 END;
    ele:=arctan(ele)*(180.0/pi);
    ele:=ele-diagram.elevation*cos(azi*(pi/180.0));
    diagram.cachegain:=antdiagram(azi, ele)*diagram.dBmul;
    diagram.cacheok:=TRUE;
  END;
  db:=diagram.lpower - ln(dist*dist + alt*alt)*diagram.logmul;  (* with 0dBi antenna *)
  IF db<0.0 THEN ddist:=1000.0; RETURN 0.0 END;                 (* abort sigthline on distance loss *)

  db:=db-diagram.cachegain;                                     (* apply antenna diagram *)
  IF db<0.0 THEN db:=0.0 ELSIF db>1.0 THEN db:=1.0 END;
  RETURN db
END antgain;


PROCEDURE postfilter(image:pIMAGE; colnr:CARDINAL);  (* set missing pixels with median of neighbours *)
VAR x, y:CARDINAL;
    c:CARD16;
BEGIN
  FOR y:=1 TO HIGH(image^[0])-1 DO
    FOR x:=1 TO HIGH(image^)-1 DO
      IF colnr=0 THEN
        c:=    image^[x+1][y  ].r;
        INC(c, image^[x  ][y+1].r);
        INC(c, image^[x-1][y  ].r);
        INC(c, image^[x  ][y-1].r);
        image^[x][y].b:=c DIV 4;
      ELSE
        c:=    image^[x+1][y  ].g;
        INC(c, image^[x  ][y+1].g);
        INC(c, image^[x-1][y  ].g);
        INC(c, image^[x  ][y-1].g);
        image^[x][y].b:=c DIV 4;
      END;
    END;
  END;

  FOR y:=1 TO HIGH(image^[0])-1 DO
    FOR x:=1 TO HIGH(image^)-1 DO
      WITH image^[x][y] DO
        IF colnr=0 THEN IF b>r THEN r:=b END;
        ELSE IF b>g THEN g:=b END; END;
      END;
    END;
  END;
END postfilter;


PROCEDURE meterperpix(image:pIMAGE):REAL;
CONST PART=0.2;
VAR pos, pos1:POSITION;
    d,x,y:REAL;

BEGIN
  x:=FLOAT(HIGH(image^))*0.5;
  y:=FLOAT(HIGH(image^[0]))*0.5;
  d:=x*PART;
  xytodeg(x-d, y, pos);
  xytodeg(x+d, y, pos1);
  RETURN distance(pos, pos1)*500.0/d;   (* meter per pixel *)
END meterperpix;


PROCEDURE antparm(ab:CARDINAL);
VAR s:ARRAY[0..1000] OF CHAR;
    ant:CONFSET;
BEGIN
  IF ab=0 THEN ant:=fANT1 ELSE ant:=fANT2 END;
  conf2str(ant, 0, 4, TRUE, s);
  WITH diagram DO
    on:=s[0]<>0C;
    mindB:=conf2real(fFRESNELL, 1, -200.0, 200.0, -90.0);
    maxdB:=conf2real(fFRESNELL, 2, -200.0, 200.0, -60.0);
    mhz:=conf2real(fFRESNELL, 0, 0.1, 10000000.0, 2400.0);
    azimuth:=conf2real(ant, 1, -360.0, 360.0, 0.0);
    elevation:=conf2real(ant, 2, -90.0, 90.0, 0.0);
    rotate:=azimuth<0.0;
    azimuth:=ABS(azimuth);
    IF mindB+0.1>=maxdB THEN mindB:=maxdB-30.0 END;
    IF on THEN readantenna(s, conf2real(ant, 3, -100.0, 200.0, 57.0)) END;
  END;
END antparm;


PROCEDURE Radiorange(image:pIMAGE; txpos:POSITION; ant1, ant2:INTEGER;
                     smooth, colnr, qualnum:CARDINAL; VAR abort:BOOLEAN; refrac:REAL);

  VAR bri:CARD16;

  PROCEDURE setcol(VAR p:PIX);
  BEGIN
    IF colnr=0 THEN 
      IF bri>p.r THEN p.r:=bri END;
    ELSIF bri>p.g THEN p.g:=bri END;
  END setcol;

(*
  PROCEDURE setcol(VAR p:PIX);
  BEGIN
    IF colnr=0 THEN p.r:=bri ELSE p.g:=bri END;
  END setcol;
*)


CONST MAXSLANT=0.5;    (* shadow deepness to step relation *)
      FULLUM=1000.0;   (* full bright in image *)
      DISTHOP=6000;    (* m jump sightline linear interpolated *)
      PIXHOP=50000;    (* m jump pixels linear interpolated *)

VAR xp, yp, frame, far, qual, progr:CARDINAL;
    void:INTEGER;
    x0,y0,z0, x1,y1,z1, dx,dy,dz, x,y, xtx,ytx,
    nn, xi, yi, oodist, resol, resoltx, alt, altc, alt0, dalt, lum, osmooth, framestep, pixstep,
    px0, py0, dpnext, d, dd, dnext,rais, h, arx, atx, hs, sight, mperpix, ximag,
    dximag, yimag, dyimag, alt1, dm, refr, azi, hgnd, antdiff, trees:REAL;  

    pos, pos0, pos1, dpos, posc:POSITION;
    attr:CARD8;
    rt, startt:TIME;
    ss,ss1:ARRAY[0..100] OF CHAR; 

  PROCEDURE goonframe(x, tx, y, ty:REAL):REAL;
  BEGIN
    IF y<>ty THEN RETURN (1.0+ABS((x-tx)/(y-ty)))*framestep END;

    RETURN MAX(REAL)
  END goonframe;

BEGIN
  startt:=time();

  nn:=getsrtm(txpos, 0, resoltx); (* altitude of tx an map resolution in m here *)
  IF nn>=30000.0 THEN closesrtmfile; RETURN END;

  FILL(ADR(diagram), 0C, SIZE(diagram));
  antparm(colnr);

  setsrtmcache;

  atx:=nn + VAL(REAL, ant1);                                 (* ant1 over NN *)
  wgs84s(txpos.lat, txpos.long, atx*0.001, x0,y0,z0);

  arx:=VAL(REAL, ant2);                                      (* ant2 over ground *)
  antdiff:=arx-atx;
  xi:=0.0;
  yi:=0.0;
  void:=mapxy(txpos, xtx, ytx);
  frame:=0;
  mperpix:=meterperpix(image);                               (* meter per pixel *)
  IF mperpix<1.0 THEN closesrtmfile; RETURN END;

  IF qualnum=0 THEN
    framestep:=2.2;                                          (* pixel step along corner of image *)
    qual:=TRUNC(mperpix);
    smooth:=smooth*22 DIV 10;
  ELSIF qualnum=1 THEN
    framestep:=1.5;
    qual:=TRUNC(mperpix*0.5);
    smooth:=smooth*15 DIV 10;
  ELSE
    framestep:=1.0;
    qual:=TRUNC(mperpix*0.25);
  END;
  trees:=conf2real(fREFRACT, 1, 0.0, 100.0, 0.0);

  IF smooth>0 THEN osmooth:=FULLUM/FLOAT(smooth) ELSE osmooth:=FULLUM END;

  refr:=refrac*0.0785;
  progr:=0;
  LOOP
    xytodeg(xi, yi, pos);                                         (* screen frame pos *)
    IF (frame=0) & (ytx>0.0) OR (frame=2) & (ytx<FLOAT(ysize))
    OR (frame=1) & (xtx>0.0) OR (frame=3) & (xtx<FLOAT(xsize)) THEN

      wgs84s(pos.lat, pos.long, atx*0.001, x1,y1,z1);             (* screen frame xyz at ant1 alt *)
      IF diagram.on THEN
        azi:=azimuth(txpos, pos);                                 (* for antenna diagram *)
        diagram.cacheok:=FALSE;                                   (* so no need to check azi too *)
      END;
      dx:=x1-x0;
      dy:=y1-y0;
      dz:=z1-z0;
      oodist:=dx*dx + dy*dy + dz*dz;
      IF oodist>0.000001 THEN
        dm:=oodist*refr;                                          (* full dist^2 *)
        oodist:=0.001/sqrt(oodist);                               (* 1/sight line length in m *) 
        pixstep:=0.0;
        resol:=resoltx;
        d:=resol*oodist;
        rais:=-1000000000.0;                                      (* initial sightline angle **)  
        dnext:=0.0;
        dpnext:=0.0;

        REPEAT                                                    (* do one sight line *)
          IF d>=dnext THEN                                        (* next fixpoint in interpolate sight line pos *)  
            dnext:=d + DISTHOP*oodist;
            IF dnext>1.0 THEN dnext:=1.0 END;
            dd:=dnext-d;
            IF dd<>0.0 THEN
              wgs84r(x0 + dx*d, y0 + dy*d, z0 + dz*d, pos1.lat, pos1.long, alt1); alt1:=alt1*1000.0;
              wgs84r(x0 + dx*dnext, y0 + dy*dnext, z0 + dz*dnext, pos.lat, pos.long, alt); alt:=alt*1000.0;

              dpos.lat :=(pos.lat -pos1.lat)/dd;
              dpos.long:=(pos.long-pos1.long)/dd;
              dalt:=(alt-alt1)/dd;

              pos0.lat :=pos1.lat - dpos.lat*d;
              pos0.long:=pos1.long- dpos.long*d;
              alt0:=alt1 - dalt*d;
            END;
          END;
          pos.lat :=pos0.lat + dpos.lat*d;
          pos.long:=pos0.long+ dpos.long*d;
          alt:=alt0 + dalt*d - d*d*dm;

          hgnd:=getsrtmlong(pos.lat, pos.long, qual, FALSE, resol, attr, NIL);                        (* ground over NN in m *)
          IF hgnd<30000.0 THEN                                    (* srtm valid *)
            IF attr=ATTRWOOD THEN hgnd:=hgnd+treealt(hgnd, trees) END;

            h:=hgnd-alt;                                          (* m ground over searchpath *)
            hs:=rais*d;                                        (* h sight line m over searchpath *)  
            sight:=h+arx-hs;
            IF sight>0.0 THEN                                  (* rx antenna in sight *)

              IF d>=dpnext THEN                                (* next fixpoint in image pixel interpolation *)
                dpnext:=d + PIXHOP*oodist;
                IF dpnext>1.0 THEN dpnext:=1.0 END;
                dd:=dpnext-d;
                IF dd<>0.0 THEN
                  wgs84r(x0 + dx*d, y0 + dy*d, z0 + dz*d, pos1.lat, pos1.long, alt1);
                  wgs84r(x0 + dx*dpnext, y0 + dy*dpnext, z0 + dz*dpnext, pos.lat, pos.long, alt);
                  void:=mapxy(pos, x, y);
                  void:=mapxy(pos1, px0, py0);
                  dximag:=(x - px0)/dd;
                  dyimag:=(y - py0)/dd;
                  px0:=px0 - dximag*d;
                  py0:=py0 - dyimag*d;
                END;
              END;
              x:=px0 + dximag*d;
              y:=py0 + dyimag*d;

              IF (x>1.5) & (y>1.5) THEN                        (* room for large low res pixel *)
                IF pixstep=0.0 THEN pixstep:=mperpix*oodist*framestep END; 
                xp:=TRUNC(x);
                yp:=TRUNC(y);
                IF (xp<HIGH(image^)) & (yp<HIGH(image^[0])) THEN (* 1 pixel room for large low res pixel *)

                  lum:=sight*osmooth;                          (* luma is equal to riseing higth *)
                  IF lum>FULLUM THEN lum:=FULLUM END;
                  IF diagram.on THEN
                    lum:=lum*antgain(azi, hgnd+antdiff, oodist, d);
                    IF lum>FULLUM THEN lum:=FULLUM END;
                  END;

                  bri:=TRUNC(lum);
                  IF colnr=0 THEN image^[xp][yp].r:=bri
                  ELSE image^[xp][yp].g:=bri END;
                  IF qualnum<=1 THEN
                    bri:=TRUNC(lum*0.8);
                    setcol(image^[xp+1][yp]);
                    setcol(image^[xp][yp+1]);
                    setcol(image^[xp-1][yp+1]);
                    setcol(image^[xp][yp-1]);
                    IF qualnum=0 THEN
                      bri:=TRUNC(lum*0.5);
                      setcol(image^[xp-1][yp+1]);
                      setcol(image^[xp-1][yp-1]);
                      setcol(image^[xp+1][yp+1]);
                      setcol(image^[xp+1][yp-1]);
                    END;
                  END;
                END;
              END;
            END;
 
            IF h>hs THEN rais:=h/d END;                        (* this point has light on ground *)

            IF sight>-resol THEN  
              IF pixstep=0.0 THEN d:=d + resol*oodist ELSE d:=d + pixstep END;
            ELSIF resol>-sight*MAXSLANT THEN d:=d + resol*oodist
            ELSE d:=d - sight*oodist*MAXSLANT END;
          ELSE d:=d + resol*oodist END;

        UNTIL d>1.0;

      END; 
    END;                                                      (* go along next side of image *)

    CASE frame OF
      0:
        xi:=xi+goonframe(xi, xtx, yi, ytx);
        IF xi>=FLOAT(HIGH(image^)) THEN xi:=0.0; INC(frame) END;
     |1:
        yi:=yi+goonframe(yi, ytx, xi, xtx);
        IF yi>=FLOAT(HIGH(image^[0])) THEN yi:=FLOAT(HIGH(image^[0])); INC(frame) END;
     |2:
        xi:=xi+goonframe(xi, xtx, yi, ytx);
        IF xi>=FLOAT(HIGH(image^)) THEN xi:=FLOAT(HIGH(image^)); INC(frame) END;
    ELSE
        IF yi<0.0 THEN EXIT END;

        yi:=yi-goonframe(yi, ytx, xi, xtx);
    END;

    INC(progr, 100);
    ss:="Radiorange"; IF colnr<>0 THEN Append(ss, " 2") END;
    progress(startt, ss, progr DIV ((HIGH(image^[0])+HIGH(image^))*2), FALSE);
    IF NOT click.withradio THEN abort:=TRUE; EXIT END;

--    IF srtmmem>=maxcache THEN purgesrtm(FALSE) END;      (* cache grown too large *)

  END;    
  postfilter(image, colnr);                                    (* fill in missing pixels *)
  killmenuid(5);
END Radiorange;


PROCEDURE SimpleRelief(image:pIMAGE):BOOLEAN;
CONST MINH=1000;                                        (* to max all alt positiv *)
      MINHISTPIX=10;                                    (* min pixel in alt hist for max/min *) 
      DIFMIN=10000;
      MAXDIF=500000; 

VAR xp, yp, xi, qual, jump, sum:CARDINAL;
    resol, mperpix, mperpix2, hr, jr, jd, jm:REAL;  
    pos, pos1:POSITION;
    h, min, max, mul, dif, bri:INTEGER; 
    startt:TIME;
    ok:BOOLEAN;
    hist:ARRAY[0..9999] OF CARDINAL;
    lut:ARRAY[0..1023] OF PIX;

BEGIN

  startt:=time();
  setsrtmcache;
  FOR xi:=0 TO HIGH(lut) DO
    WITH lut[xi] DO
      IF xi<400 THEN r:=(400-xi)*900/400 ELSE r:=(xi-400)*900/624 END;
      IF xi<200 THEN g:=xi*900/200 ELSIF xi<640 THEN g:=(640-xi)*900/440 ELSE g:=(xi-640)*900/372 END;
      IF xi<320 THEN b:=0 ELSIF xi<640 THEN b:=(xi-320)*900/320 ELSE b:=900 END;
(*
      r:=xi;
      g:=xi;
      b:=xi; 
*)
    END;
  END;

  mperpix:=meterperpix(image);
  IF mperpix<0.5 THEN closesrtmfile; RETURN FALSE END;

  mperpix2:=sqrt(mperpix);
  qual:=trunc(mperpix*0.25);
  jump:=1+trunc(6000.0/mperpix);
  IF jump>10 THEN jump:=10 END;
  FILL(ADR(hist), 0C, SIZE(hist));

  yp:=0;
  ok:=FALSE;

  REPEAT
    xp:=0;
    xytodeg(0.0, FLOAT(yp), pos);
    LOOP
      xi:=xp;
      INC(xp, jump);
      IF xp>HIGH(image^) THEN xp:=HIGH(image^)+1 END;
      IF xi>=xp THEN EXIT END;

      jr:=FLOAT(xp-xi);
      xytodeg(FLOAT(xp), FLOAT(yp), pos1);
      pos1.lat:= (pos1.lat -pos.lat )/jr;
      pos1.long:=(pos1.long-pos.long)/jr;

      REPEAT
        hr:=getsrtm(pos, qual, resol);
        IF hr<10000.0 THEN
          h:=trunc(MINH+hr);                             (* ground over NN in m *)
          image^[xi][yp].r:=h; 

--        IF xi=0 THEN ho:=h END;
--        image^[xi][yp].g:=h-ho+10000;
--        ho:=h;

          IF (xi>0) & (yp>0) THEN
            image^[xi][yp].g:=h*3-VAL(INTEGER, image^[xi-1][yp].r)*2-VAL(INTEGER, image^[xi][yp-1].r)+10000; (* shadow *)
          ELSE image^[xi][yp].g:=0 END;


          IF h<=HIGH(hist) THEN INC(hist[h]) END;
          ok:=TRUE;
        END;
        pos.lat:= pos.lat +pos1.lat;
        pos.long:=pos.long+pos1.long;
        INC(xi);
      UNTIL xi>=xp;
    END;

--    IF srtmmem>=maxcache THEN purgesrtm(FALSE) END;      (* cache grown too large *)
    INC(yp);
    IF yp MOD 20=0 THEN progress(startt, "Geomap", yp*100 DIV HIGH(image^[0]), FALSE) END;
  UNTIL (yp>HIGH(image^[0])) OR NOT click.withradio;

  min:=0;
  sum:=0;
  WHILE (min<HIGH(hist)) & (sum<MINHISTPIX) DO INC(sum, hist[min]); INC(min) END;
  max:=HIGH(hist);
  sum:=0;
  WHILE (max>0) & (sum<MINHISTPIX) DO INC(sum, hist[max]); DEC(max) END;

  IF click.withradio & (max>0) THEN
    h:=max-min;
    IF h<10 THEN h:=10 END;
    bri:=conf2int(fGEOBRIGHTNESS, 0, 0, 100, 50);
    mul:=1000*(HIGH(lut)+1) DIV h;
--    difmul:=trunc(20000000.0/((FLOAT(h)*sqrt(mperpix))));   (* highpass level *)
--    difmul:=trunc(50000000.0/(sqrt(mperpix)*FLOAT(h)));   (* highpass level *)

    jm:=2.0*FLOAT(bri)/((FLOAT(h)*mperpix2));

    FOR yp:=0 TO HIGH(image^[0]) DO
      FOR xp:=0 TO HIGH(image^) DO
        h:=VAL(INTEGER, image^[xp][yp].r);
        IF h<>0 THEN
          DEC(h, min);
--          dif:=(VAL(INTEGER, image^[xp][yp].g)-DIFMIN)*difmul;
--          IF dif>MAXDIF THEN dif:=MAXDIF ELSIF dif<-MAXDIF THEN dif:=-MAXDIF END;
          IF h<10000 THEN h:=(h*mul) DIV 1024;
          ELSE h:=0 END;
          IF h<0 THEN h:=0 ELSIF h>HIGH(lut) THEN h:=HIGH(lut) END;
 
          WITH image^[xp][yp] DO
            jd:=1.0+(VAL(REAL, g)-10000.0)*jm;
            IF jd<0.4 THEN jd:=0.4 ELSIF jd>2.0 THEN jd:=2.0 END;
            jd:=jd*FLOAT(bri)*0.01;
            jr:=FLOAT(lut[h].r)*jd; IF jr<0.0 THEN jr:=0.0 END; r:=trunc(jr);
            jr:=FLOAT(lut[h].g)*jd; IF jr<0.0 THEN jr:=0.0 END; g:=trunc(jr);
            jr:=FLOAT(lut[h].b)*jd; IF jr<0.0 THEN jr:=0.0 END; b:=trunc(jr);
          END;
        END;
      END;
    END;
  ELSE clr(image) END;
  killmenuid(5);

  RETURN ok
END SimpleRelief;


--Panorama
(*
PROCEDURE normvector(var nx,ny,nz:real;face:facepo);
var cx,cy,cz:real;
begin
  with face^ do begin
    with edge3^ do begin
      cx:=x;
      cy:=y;
      cz:=z;
    end;
    nx:=(edge1^.y-cy)*(edge2^.z-cz) - (edge1^.z-cz)*(edge2^.y-cy);
    ny:=(edge1^.z-cz)*(edge2^.x-cx) - (edge1^.x-cx)*(edge2^.z-cz);
    nz:=(edge1^.x-cx)*(edge2^.y-cy) - (edge1^.y-cy)*(edge2^.x-cx);
  end;
END normvector;
*)


PROCEDURE raytrace(minqual, x0,y0,z0, dx,dy,dz:REAL; maxdist:REAL;
                   VAR dist, lum, h, alt, subpix:REAL; VAR pos:POSITION; refrac, trees:REAL);
CONST TESTDIST=30.0;
      ER=EARTH*1000.0;

VAR qual, resol, h0,h1,h2, xtt, ytt, lastsp, sp, minsp, deltah:REAL;
    attr:CARD8; 
BEGIN
  lum:=1.0;
  qual:=minqual;
  minsp:=0.0;
  IF dist=0.0 THEN lastsp:=0.0 ELSE lastsp:=MAX(REAL) END;


  deltah:=alt;
  wgs84r(x0 + dx*dist, y0 + dy*dist, z0 + dz*dist, pos.lat, pos.long, alt); alt:=alt*1000.0;
  deltah:=alt-deltah;
--WrStr("next:"); WrFixed(deltah, 2, 12);
  subpix:=0.0;


  REPEAT
    wgs84r(x0 + dx*dist, y0 + dy*dist, z0 + dz*dist, pos.lat, pos.long, alt);

    alt:=alt*1000.0 - dist*dist*refrac;
(*
IF mapxy(pos, xtt, ytt)>=-1 THEN
waypoint(testimg, xtt,ytt,1.0, 255,255,100); END;
*)


    h0:=getsrtmlong(pos.lat, pos.long, trunc(qual), FALSE, resol, attr, NIL);    (* ground over NN in m *)
--WrFixed(dist, 1,15); WrFixed(alt, 1,15); WrFixed(h, 1,15); WrStr(" =d alt h");

    IF h0<30000.0 THEN
      IF attr=ATTRWOOD THEN h:=h0+treealt(h0, trees) ELSE h:=h0 END;
      sp:=alt-h;
      IF sp>0.0 THEN
        qual:=sp*0.25;
        IF qual>250.0 THEN qual:=250.0 END;
--        IF dist>1.0 THEN qual:=qual*dist END;
        IF qual<minqual THEN qual:=minqual END;
        IF sp<lastsp THEN lastsp:=sp ELSIF minsp=0.0 THEN minsp:=lastsp END;
      ELSE                                                          (* hit earth *)
        h1:=getsrtmlong(pos.lat + TESTDIST/20000000.0*pi, pos.long, 1, FALSE, resol, attr, NIL); 
        h2:=getsrtmlong(pos.lat, pos.long + (TESTDIST/20000000.0*pi)/cos(pos.lat), 1, FALSE, resol, attr, NIL);
        lum:=cos(arctan((h1-h0)*(1.0/TESTDIST)))*cos(arctan((h2-h0)*(1.0/TESTDIST)));

        IF deltah<>0.0 THEN
          subpix:=minsp/deltah;
          IF subpix>1.0 THEN subpix:=1.0 END;
        END; 
--WrStr("subpix:"); WrFixed(subpix, 3, 7);

        RETURN
      END;

    ELSE qual:=resol END;                                           (* hole in srtm data *)
    dist:=dist + qual;
  UNTIL dist>maxdist;                                               (* we are in dust or heaven *)

  IF deltah<>0.0 THEN
    subpix:=minsp/deltah;
    IF subpix>1.0 THEN subpix:=1.0 END;
  END;
END raytrace;
(* antialiasing: search for peaks and set highest pixel smooth *)


PROCEDURE rotvector(VAR a,b:REAL; cw,sw:REAL);
VAR h:REAL;
BEGIN
  h:=a*cw+b*sw;
  b:=b*cw-a*sw;
  a:=h
END rotvector;


PROCEDURE Panofind(find:BOOLEAN; panpar-:PANOWIN; VAR res:REAL; VAR pos:POSITION);

CONST ERRALT=30000;
      FULLUM=1000.0;   (* full bright in image *)
      MAXHP=0.08;      (* vertical spatial luminance highpass *)

VAR xi, yi:CARDINAL;
    nn, void:INTEGER;
    azi0, x0,y0,z0, x1,y1,z1, dx,dy,dz, hr,hg,hb, lr,lg,lb, hc, hc1, maxdist, lasth, space,
    resol, resoltx, alt, azid, eled, ele0, slong, clong,xn,yn,zn, sazi, cazi, azi,
    d, oldh, atx, qual, lummul, dlum, lastlum, lum, llum, light, tree, wx, wy, slat,
    clat, or,og,ob,oor,oog,oob, refrac, trees:REAL;  
    pos0, pos1:POSITION;
    heaven:BOOLEAN;
    rt, startt:TIME;
    ss,ss1:ARRAY[0..100] OF CHAR; 
    col:COLTYP;
BEGIN
  setsrtmcache;
  startt:=time();

  IF NOT posvalid(panpar.eye) OR NOT posvalid(panpar.horizon)
  OR (getsrtm(panpar.horizon, 0, resoltx)>=ERRALT) THEN RETURN END;                                          (* no alt at horizon *)

  maxdist:=distance(panpar.eye, panpar.horizon)*1000.0;
  IF maxdist<100.0 THEN RETURN END;                           (* horizon too near *)

  
--azi0:=conf2real(fANT2, 0, -360.0, 360.0, 0.0)-90;
--maxdist:=FLOAT(conf2int(fANT2, 1, 1, 150, 20))*1000.0;
--WrFixed(yzoom, 4,15); WrFixed(maxdist, 4,15); WrStrLn("yzoom dist");
  IF NOT find THEN
    col.r:=conf2int(fCOLMARK1, 0, 0, 100, 0);
    col.g:=conf2int(fCOLMARK1, 1, 0, 100, 0);
    col.b:=conf2int(fCOLMARK1, 2, 0, 100, 100);
    hr:=FLOAT(col.r)*0.01;
    hg:=FLOAT(col.g)*0.01;
    hb:=FLOAT(col.b)*0.01;
    lummul:=FULLUM/maxdist;
  END;


  nn:=VAL(INTEGER, getsrtm(panpar.eye, 0, resoltx)); (* altitude of tx an map resolution in m here *)

  IF nn>=ERRALT THEN closesrtmfile; RETURN END;

  trees:=conf2real(fREFRACT, 1, 0.0, 100.0, 0.0);
  atx:=VAL(REAL, nn+panpar.eyealt);                                   (* ant1 over NN *)
  wgs84s(panpar.eye.lat, panpar.eye.long, atx*0.001, x0,y0,z0);


  azi:=azimuth(panpar.eye, panpar.horizon)*RAD;
  azi0:=(-panpar.angle*0.5)*RAD;
  azid:=panpar.angle*RAD/FLOAT(HIGH(panpar.image^)+1);
  eled:=azid/panpar.yzoom;
  ele0:=(panpar.elevation - panpar.angle*0.5/panpar.yzoom*FLOAT(HIGH(panpar.image^[0])+1)/FLOAT(HIGH(panpar.image^)+1))*RAD;  

  slat:=sin(-panpar.eye.lat);
  clat:=cos(-panpar.eye.lat);
  slong:=sin(-panpar.eye.long);
  clong:=cos(-panpar.eye.long);
  sazi:=sin(azi);
  cazi:=cos(azi);

--WrFixed(azi0/RAD, 4, 10); WrFixed(azid/RAD, 4, 10); WrStrLn(" adi0 azid");
--WrFixed(panpar.elevation*RAD/azid, 4, 12); WrStrLn(" adi0 azid");

  xi:=0;
  IF find THEN xi:=panpar.hx END;
  refrac:=conf2real(fREFRACT, 0, -10.0, 10.0, 0.0)*0.0000000785;
  REPEAT
--    wx:=panpar.angle*RAD*(FLOAT(xi)-FLOAT(HIGH(panpar.image^)+1)*0.5)/FLOAT(HIGH(panpar.image^)+1);
    wx:=azi0 + azid*FLOAT(xi);
    IF panpar.flatscreen THEN wx:=arctan(wx) END;
    yi:=0;
    IF find THEN yi:=VAL(INTEGER, HIGH(panpar.image^[0])+1)-panpar.hy END;
    d:=0.0;
    dlum:=0.0;
    lastlum:=0.0;
    heaven:=FALSE;
    REPEAT
      IF NOT heaven THEN
        wy:=ele0 + eled*FLOAT(yi);
        IF panpar.flatscreen THEN wy:=arctan(wy) END;
--IF xi=0 THEN WrFixed(wx/RAD, 2, 8); WrFixed(wy/RAD, 2, 8); WrStr(" wx wy"); END;
        zn:=cos(wx)*cos(wy);
        yn:=sin(wx);
        xn:=sin(wy);
        rotvector(yn,zn, cazi,sazi);

--IF xi=0 THEN WrFixed(xn, 2, 7); WrFixed(yn, 2, 7);  WrFixed(zn, 2, 7); END;
        rotvector(xn,zn, clat,slat);

        rotvector(xn,yn, clong,slong);
--IF (ABS(wy)>0.5) & (d>maxdist*0.1) THEN d:=d-maxdist*0.1 END; (* jump back if sight from above *)
        raytrace(5.0, x0,y0,z0, xn*0.001,yn*0.001,zn*0.001, maxdist, d, light, oldh, lasth, space, pos, refrac, trees);
        IF d>maxdist THEN heaven:=TRUE END;
        IF find THEN
          IF heaven THEN posinval(pos) END;
          RETURN

        END;
      ELSE light:=1.0 END;
      IF heaven THEN d:=maxdist*4.0*(1.25-FLOAT(yi)/FLOAT(HIGH(panpar.image^[0]))) END;


      lum:=d*0.2;

      llum:=(lum-lastlum)*20.0;
      IF llum>MAXHP*maxdist THEN llum:=MAXHP*maxdist END;
      IF llum>dlum THEN dlum:=llum END;
      lastlum:=lum;


IF NOT heaven THEN    
      tree:=1600.0-oldh;
      IF tree<0.0 THEN tree:=0.0 ELSIF tree>600.0 THEN tree:=600.0 END;
      tree:=tree*(0.95/600.0)*(1.0-d/maxdist);
--      tree:=tree*(0.95/600.0);

--WrFixed(light, 5,2); WrStr(" ");
      light:=light-0.65;
      IF light<0.0 THEN
        light:=light*(-2.0);
        IF light>1.0 THEN light:=1.0 END;
        light:=1.0 + light  (**(1.0-d/maxdist)*);
        light:=light*(1.7-tree); 
        lr:=lum*light*1.4 + dlum;
        lg:=lum*light*1.1 + dlum;
        lb:=lum*light*0.8 + dlum;
      ELSE
        lr:=lum*(1.7-tree*1.3) + dlum;
        lg:=lum*(1.7-tree*0.8) + dlum;
        lb:=lum*(1.7-tree*1.7) + dlum;
      END;
      IF lr>maxdist THEN lr:=maxdist END;
      IF lg>maxdist THEN lg:=maxdist END;
      IF lb>maxdist THEN lb:=maxdist END;
      lr:=lr*lummul;
      lg:=lg*lummul;
      lb:=lb*lummul;
END;
      lum:=lum+dlum;
      IF lum>maxdist THEN lum:=maxdist END;
      lum:=lum*lummul;

      dlum:=dlum*0.84;

      WITH panpar.image^[xi][yi] DO
        IF heaven THEN                                                 (* heaven *)
--          hc:=VAL(REAL, 2*yi)/VAL(REAL, HIGH(panpar.image^[0]))-1.0;
--          hc:=(ele0 + eled*FLOAT(yi))*6.0;
          hc:=(FLOAT(yi)+panpar.elevation*RAD/azid)*2.0/VAL(REAL, HIGH(panpar.image^[0]))-1.0;

          IF hc<0.0 THEN hc:=0.0 ELSIF hc>1.0 THEN hc:=1.0 END;
          hc1:=1.0-hc;
          r:=trunc(lum*hc1 + lum*hr*hc);
          g:=trunc(lum*hc1 + lum*hg*hc);
          b:=trunc(lum*hc1 + lum*hb*hc);
        ELSE
          r:=trunc(lr); g:=trunc(lg); b:=trunc(lb);
        END;
 
        or:=FLOAT(r);
        og:=FLOAT(g);
        ob:=FLOAT(b);

        IF yi>1 THEN
          r:=trunc(or*space + oor*(1.0-space));
          g:=trunc(og*space + oog*(1.0-space));
          b:=trunc(ob*space + oob*(1.0-space));
        END;
        oor:=or;
        oog:=og;
        oob:=ob;


      END; 
      INC(yi);
    UNTIL yi>HIGH(panpar.image^[0]);


--WrInt(xi, 5); WrFixed(pos.lat*180.0/pi, 4,8); WrFixed(pos.long*180.0/pi, 4,8); WrStrLn(" xi lat long az");
    INC(xi);
  UNTIL xi>HIGH(panpar.image^);
--  killmenuid(5);
END Panofind;

PROCEDURE Panorama(testimg:pIMAGE; panpar-:PANOWIN; VAR abort:BOOLEAN);
VAR res:REAL;
    pos:POSITION;
BEGIN
  Panofind(FALSE, panpar, res, pos);
END Panorama;


PROCEDURE findpanopos(panpar-:PANOWIN; VAR pos:POSITION; VAR dist:REAL; VAR alt:INTEGER);
VAR res,resol:REAL;
BEGIN
  Panofind(TRUE, panpar, res, pos);
  IF posvalid(pos) THEN
    alt:=VAL(INTEGER, getsrtm(pos, 0, resol) + 0.5);
    dist:=distance(panpar.eye, pos);
  END;
--WrFixed(res, 1, 10); WrStrLn("=d");


END findpanopos;


(*
find exact earth point with cross point of trace and earth line
yzoom xzoom(deg) ypan xpan(deg) maxdist ant mousepos show-marker2 sun-xy snow-alt heaven-col
cursor ^ v < > + -

no interpolate in search mode
antialiasing measure scanline to peack distance
start rescan next y with same d
soft change wood-rock
*)

--Panorama


PROCEDURE xytoloc(mpos:POSITION; VAR s:ARRAY OF CHAR); (* lat/long + locator string of pos *)
VAR h:ARRAY[0..100] OF CHAR;
    nn:INTEGER;
    resol:REAL;
    attr:CARD8;
BEGIN
--  xytodeg(VAL(REAL,x), VAL(REAL,y), mpos);
  postostr(mpos, "3", s); Append(s, " "+TEXTCOLORA);
  postostr(mpos, "1", h); Append(s, h);  Append(s, " "+TEXTCOLEND);
  FixToStr(mpos.lat/RAD, 6, h); Append(s, h);  Append(s, " ");
  FixToStr(mpos.long/RAD, 6, h); Append(s, h);  Append(s, " "+TEXTCOLORA);

  limpos(mpos);
  postoloc(h, mpos); Append(s, h); Append(s, TEXTCOLEND);
  nn:=VAL(INTEGER, getsrtmlong(mpos.lat,mpos.long, 30, FALSE, resol, attr, NIL)+0.5); 
  IF nn<30000 THEN
    IntToStr(nn, 0, h);
    Append(s, " ");
    Append(s, h);
    Append(s, "m");
    IF attr=ATTRWATER THEN Append(s, "W");
    ELSIF attr=ATTRWOOD THEN Append(s, "T");
    ELSIF attr=ATTRURBAN THEN Append(s, "U") END;
  END;

  IF (*(click.marktime=0) &*) posvalid(click.markpos) THEN
    FixToStr(distance(click.markpos, mpos), 4, h);
    Append(s, " "+TEXTCOLORA);
    Append(s, h);
    Append(s, "km ");
    FixToStr(azimuth(click.markpos, mpos), 2, h);
    Append(s, h);
    Append(s, DEGSYM+TEXTCOLEND);
  END;

END xytoloc;

PROCEDURE instr(VAR i:CARDINAL; k:CARDINAL; a-, b-:ARRAY OF CHAR):CARDINAL;
VAR j,i0:CARDINAL;
BEGIN
  j:=k;
  i0:=i;
  LOOP
    IF (i>HIGH(a)) OR (a[i]=0C) THEN RETURN j END;       (* j=0 is no * before *)

    IF (j>HIGH(b)) OR (b[j]=0C) OR (b[j]="*") THEN
      IF (b[j]="*") THEN RETURN j ELSE RETURN 0 END;
    END;
    IF (b[j]<>"?") & (CAP(a[i])<>CAP(b[j])) THEN
      IF k=0 THEN RETURN 0 END;                          (* no * so search from begin *)

      INC(i0);
      i:=i0;
      j:=k; 
    ELSE
      INC(j);
      INC(i);
    END;
  END;
END instr;

PROCEDURE cmpwild(a-, b-:ARRAY OF CHAR):BOOLEAN;
VAR i, j:CARDINAL;
BEGIN
  i:=0;
  j:=0;
  LOOP
    IF (j>HIGH(b)) OR (b[j]=0C) THEN RETURN TRUE END;

    IF b[j]="*" THEN INC(j) END;
    IF (j>HIGH(b)) OR (b[j]=0C) THEN RETURN TRUE END;     (* * at end fits to rest *)

    j:=instr(i, j, a, b);
    IF j=0 THEN RETURN FALSE END;

    IF (i>HIGH(a)) OR (a[i]=0C) THEN RETURN (j>HIGH(b)) OR (b[j]=0C) OR (b[j]="*") END; 

    IF (j>HIGH(b)) OR (b[j]=0C) THEN RETURN FALSE END;
  END;
END cmpwild;


PROCEDURE cmppoi(p:pMOUNTAIN; s-:ARRAY OF CHAR):BOOLEAN;
BEGIN RETURN (p<>NIL) & (cmpwild(p^.name, s) OR (p^.pinfo<>NIL) & cmpwild(p^.pinfo^, s)) END cmppoi;

PROCEDURE cleanfind(VAR s:ARRAY OF CHAR); (* make caps and remove multi * or *? *)
VAR i, j:CARDINAL;
BEGIN
  i:=0;
  j:=0;
  WHILE (i<=HIGH(s)) & (s[i]<>0C) DO
    s[j]:=CAP(s[i]);
    IF s[i]="*" THEN
      WHILE (i+1<=HIGH(s)) & (s[i+1]<>0C) & ((s[i+1]="?") OR (s[i+1]="*")) DO INC(i) END;
    END;
    INC(i);
    INC(j);
  END;
END cleanfind;


PROCEDURE POIname(VAR mpos:POSITION; VAR s:ARRAY OF CHAR; VAR info:ARRAY OF CHAR); (* get name of nearest POI *)
CONST MOUNTAINDIST=10.0;
      RESOL=0.00000001;
VAR h:ARRAY[0..100] OF CHAR;
    dd, d, infodist:REAL;
    pm:pMOUNTAIN;
    sidx:CARDINAL;

    stk:ARRAY[FALSE..TRUE] OF RECORD
      samepos:CARDINAL;
      mindist:REAL;
      samepostack:ARRAY[0..19] OF pMOUNTAIN;
    END;
BEGIN
  Assign(info, "");
  pm:=mountains;
  WITH stk[FALSE] DO
    mindist:=(MOUNTAINDIST*256.0)*power(2.0, -realzoom(initzoom, finezoom));
    IF mindist>MOUNTAINDIST THEN mindist:=MOUNTAINDIST END;
    infodist:=mindist*0.25;                                         (* neerer to poi to show info *)
    samepos:=0;
  END;
  stk[TRUE]:=stk[FALSE];
  WHILE pm<>NIL DO
    WITH pm^ DO
      IF (ABS(pos.lat-mpos.lat)<MOUNTAINDIST/20000.0*pi)
      & (ABS(pos.long-mpos.long)<MOUNTAINDIST/20000.0*pi) THEN      (* prefiltering *)
        WITH stk[poifiles[pm^.index].on] DO                         (* poi with symbol *)
          d:=distance(pos, mpos);
          dd:=d-mindist;
          IF dd<=RESOL THEN                                         (* nearer as all before *)
            IF dd<-RESOL THEN samepos:=0; mindist:=d END;           (* not same dist as the before *) 
            samepostack[samepos]:=pm;
            IF samepos<HIGH(samepostack) THEN INC(samepos) END;
          END;
        END;
      END;
      pm:=next;
    END;
  END;

  WITH stk[stk[TRUE].samepos>0] DO                            (* prefer poi with symbol in radius*)
    IF samepos>0 THEN                                         (* more than 1 poi at same pos *) 
      sidx:=samepos*trunc(azimuth(mpos, samepostack[0]^.pos)) DIV 360;        (* choose poi out of angle to mouse *)
      IF sidx>=samepos THEN sidx:=samepos-1 END;
      WITH samepostack[sidx]^ DO
        Assign(s, name);
        IF alt>0 THEN
          Append(s, " ");
          IntToStr(alt,0,h); Append(s, h);Append(s, "m");
        END;
        IF (pinfo<>NIL) & (mindist<=infodist) THEN Assign(info, pinfo^)
        ELSE click.bubblinfo:="" END;
        mpos:=pos;
      END;
    ELSE s[0]:=0C END;
  END;
END POIname;


PROCEDURE POIfindfrom(VAR mpos:POSITION; all:BOOLEAN; s:ARRAY OF CHAR); (* get position of POI name *)
VAR cnt:CARDINAL;
    pm, pmax:pMOUNTAIN;
BEGIN
  pm:=mountains;
  pmax:=NIL;
  cleanfind(s);
  cnt:=0;
  LOOP
    IF pm=NIL THEN EXIT END;
    WITH pm^ DO
      IF (cnt>=lastpoinum) & (all OR poifiles[pm^.index].on) & cmppoi(pm, s) THEN pmax:=pm; EXIT END;       (* start from last time *)
      INC(cnt);
      pm:=next;
    END;
  END;
  IF pmax<>NIL THEN
    mpos:=pmax^.pos;
    click.bubblpos:=pmax^.pos;
    Assign(click.bubblstr, pmax^.name);
    IF pmax^.pinfo<>NIL THEN Assign(click.bubblinfo, pmax^.pinfo^) ELSE click.bubblinfo:="" END;
    click.lastpoi:=lastpoinum=0;
    lastpoinum:=cnt+1;                                       (* next time goon from this entry *)
  ELSE posinval(mpos) END;
END POIfindfrom;

PROCEDURE POIfind(VAR mpos:POSITION; all:BOOLEAN; s-:ARRAY OF CHAR); (* get position of POI name *)
BEGIN
  IF lastpoinum=0 THEN POIfindfrom(mpos, all, s);            (* first try start from 0 *)
  ELSE
    POIfindfrom(mpos, all, s);                               (* find next *)
    IF NOT posvalid(mpos) THEN
      lastpoinum:=0;
      POIfindfrom(mpos, all, s);                             (* else try again from start *) 
    END;
  END;
END POIfind;


PROCEDURE Colset(VAR c:COLTYP; w:CHAR);
BEGIN
  c.r:=256;
  c.g:=256;
  c.b:=256;
  IF    w="Y" THEN c.b:=0
  ELSIF w="R" THEN c.b:=0; c.g:=0;
  ELSIF w="G" THEN c.r:=0; c.b:=0;
  ELSIF w="B" THEN c.r:=0; c.g:=100;
  ELSIF w="O" THEN c.b:=0; c.g:=150;
  ELSIF w="V" THEN c.g:=0;
  ELSIF w="L" THEN c.r:=160;
  ELSIF w="0" THEN c.r:=255; c.g:=40;  c.b:=10;
  ELSIF w="1" THEN c.r:=240; c.g:=120; c.b:=10;
  ELSIF w="2" THEN c.r:=240; c.g:=190; c.b:=10;
  ELSIF w="3" THEN c.r:=240; c.g:=250; c.b:=10;
  ELSIF w="4" THEN c.r:=110; c.g:=250; c.b:=10;
  ELSIF w="5" THEN c.r:=10;  c.g:=250; c.b:=50;
  ELSIF w="6" THEN c.r:=10;  c.g:=190; c.b:=220;
  ELSIF w="7" THEN c.r:=10;  c.g:=90;  c.b:=255;
  ELSIF w="8" THEN c.r:=140; c.g:=5;   c.b:=255;
  ELSIF w="9" THEN c.r:=250; c.g:=5;   c.b:=200;
  END;
END Colset; 

PROCEDURE addcol(VAR pixel:PIX; rr,gg,bb,f:INTEGER);
VAR fh:INTEGER;
BEGIN
  WITH pixel DO
    fh:=r+rr*f DIV 256;
    IF fh<0 THEN fh:=0 ELSIF fh>MAXCOL THEN fh:=MAXCOL END;
    r:=fh;
    fh:=g+gg*f DIV 256;           
    IF fh<0 THEN fh:=0 ELSIF fh>MAXCOL THEN fh:=MAXCOL END;
    g:=fh;
    fh:=b+bb*f DIV 256;           
    IF fh<0 THEN fh:=0 ELSIF fh>MAXCOL THEN fh:=MAXCOL END;
    b:=fh;
  END;
END addcol;


PROCEDURE waypoint(image:pIMAGE; x,y,r:REAL; rr,gg,bb:INTEGER);
VAR xi, yi, tx, ty, ri:INTEGER;
    fx, fy, mx, my, h:REAL;
BEGIN
  x:=x-0.5;
  y:=y-0.5;
  IF (x>r) & (x<FLOAT(HIGH(image^)+1)-r) & (y>r) & (y<FLOAT(HIGH(image^[0])+1)-r) THEN
    ri:=trunc(r)+1;
    tx:=trunc(x);
    fx:=x-FLOAT(tx);
    ty:=trunc(y);
    fy:=y-FLOAT(ty);

    FOR yi:=-ri TO ri DO
      FOR xi:=-ri TO ri DO
        mx:=FLOAT(xi)-fx;
        my:=FLOAT(yi)-fy;
        h:=mx*mx+my*my;
        IF h>0.0 THEN h:=sqrt(h) END;
        h:=r-h;
        IF h>0.0 THEN
          IF h>1.0 THEN h:=1.0 END;
          addcol(image^[tx+xi][ty+yi],rr,gg,bb,trunc(h*256.0));
        END;
      END;
    END;
  END;
END waypoint;


PROCEDURE vector(image:pIMAGE; x0,y0,x1,y1:REAL; rr,gg,bb:INTEGER; width:CARDINAL; glow:REAL);
CONST K=65536;
      KF=256;
VAR h, r, w1, w2, ro:REAL;
    xi, yi, yie, ya, yb, n, n0, e0, de0, e1, iw2, f1:CARDINAL;
    k, frr, fbb, fgg:INTEGER;
    flip, mirror, mirr:BOOLEAN;
BEGIN
(*scissoring*)
  mirr:=y0>y1;
  IF x0>x1 THEN h:=x1; x1:=x0; x0:=h; h:=y1; y1:=y0; y0:=h; mirror:=TRUE ELSE mirror:=FALSE END;

  IF (x0>=FLOAT(HIGH(image^)-1)) OR (x1<=0) THEN RETURN END;                 (* hor out *)

  IF x0<=0 THEN y0:=y0 + (y1-y0)*x0/(x0-x1); x0:=1.0  END;
  IF x1>=FLOAT(HIGH(image^)-1) 
  THEN 
    y1:=y0 + (y1-y0)*(FLOAT(HIGH(image^)-1)-x0)/(x1-x0);
    x1:=FLOAT(HIGH(image^)-1);
  END;

  IF y0<=0.0 THEN
    IF y1<=0.0 THEN RETURN END;                                       (* bottom out *)

    x0:=x0 + (x1-x0)*y0/(y0-y1);
    y0:=1.0;
  ELSIF y0>=FLOAT(HIGH(image^[0])-1) THEN
    IF y1>=FLOAT(HIGH(image^[0])-1) THEN RETURN END;                            (* top out *)

    x0:=x0 + (x1-x0)*(FLOAT(HIGH(image^[0])-1)-y0)/(y1-y0);
    y0:=FLOAT(HIGH(image^[0])-1);
  END;
  IF y1<=0.0 THEN
    x1:=x1 + (x1-x0)*y1/(y0-y1);
    y1:=1.0;
  ELSIF y1>=FLOAT(HIGH(image^[0])-1) THEN
    x1:=x0 + (x1-x0)*(FLOAT(HIGH(image^[0])-1)-y0)/(y1-y0);
    y1:=FLOAT(HIGH(image^[0])-1);
  END;
(*scissoring*)

  IF x0<2.0 THEN x0:=2.0 END;
  IF x0>FLOAT(HIGH(image^)-1) THEN x0:=FLOAT(HIGH(image^)-1) END;
  IF y0<2.0 THEN y0:=2.0 END;
  IF y0>FLOAT(HIGH(image^[0])-1) THEN y0:=FLOAT(HIGH(image^[0])-1) END;
  IF x1<2.0 THEN x1:=2.0 END;
  IF x1>FLOAT(HIGH(image^)-1) THEN x1:=FLOAT(HIGH(image^)-1) END;
  IF y1<2.0 THEN y1:=2.0 END;
  IF y1>FLOAT(HIGH(image^[0])-1) THEN y1:=FLOAT(HIGH(image^[0])-1) END;

  w1:=FLOAT(width)/512.0;
  IF x1-x0<ABS(y1-y0) THEN h:=x0; x0:=y0; y0:=h; h:=x1; x1:=y1; y1:=h; flip:=TRUE ELSE flip:=FALSE END;
  IF x0>x1 THEN h:=y1; y1:=y0; y0:=h; h:=x1; x1:=x0; x0:=h; mirror:=NOT mirror END;
  IF x1=x0 THEN RETURN END;

  h:=(y1-y0)/(x1-x0);
  ro:=sqrt(1.0+h*h);
  w2:=w1*ro;
  iw2:=trunc(w2*K);
  r:=w1*sin(arctan(h));
  xi:=trunc(x0-ABS(r));
  w1:=(y0-h*ABS(r)-w2-0.5)*K;
  IF w1<0.0 THEN ya:=0 ELSE ya:=trunc(w1) END;
(*
  ya:=TRUNC((y0-h*ABS(r)-w2-0.5)*K);
*)
  e0:=iw2*2;
  yb:=ya+e0;
  IF ABS(r)>0.1 THEN de0:=trunc(FLOAT(e0)/(ABS(r)*2.0)) ELSE de0:=e0 END;
  k:=VAL(INTEGER, h*K);
  n:=trunc(x1-FLOAT(xi)+ABS(r) );
  mirr:=y0>y1;

  IF click.dryrun THEN ya:=(ya+yb) DIV 2 END;
  glow:=glow/ro;
  e1:=0;
  n0:=n;

  WHILE n>0 DO
    IF click.dryrun THEN
      yi:=ya DIV K;
      IF flip THEN findinfo(yi-1, xi); findinfo(yi, xi); findinfo(yi+1, xi);
      ELSE findinfo(xi, yi-1);findinfo(xi, yi); findinfo(xi, yi+1); END;
    ELSE 
      IF mirror THEN h:=FLOAT(n) ELSE h:=FLOAT(n0-n) END;
      IF h<glow THEN 
        h:=h/glow; 
        frr:=trunc(FLOAT(rr)*(1.125-h)* 6.0 ); 
        fgg:=trunc(FLOAT(gg)*h);
        fbb:=trunc(FLOAT(bb)*h);
      ELSE
        frr:=rr;
        fbb:=bb;
        fgg:=gg;
      END;


      IF mirr THEN
        IF e0>de0 THEN
          yie:=yb-e0;
          DEC(e0, de0);
        ELSE yie:=yb END;

        IF n<=trunc(ABS(r)*2.0) THEN INC(ya, de0) END;
        yi:=ya;
      ELSE
        IF e0>de0 THEN
          yi:=ya+e0;
          DEC(e0, de0);
        ELSE yi:=ya END;

        IF n<=trunc(ABS(r)*2.0) THEN DEC(yb, de0) END;
        yie:=yb;
      END; 

      f1:=256-yi MOD K DIV 256;
      yi:=yi DIV K*K; 
      REPEAT
        IF flip THEN addcol(image^[yi DIV K][xi], frr,fgg,fbb, f1)
        ELSE addcol(image^[xi][yi DIV K], frr,fgg,fbb, f1) END;
        INC(yi, K);
        f1:=256;
      UNTIL yi>=yie;
      f1:=(K+yie-yi) MOD K DIV 256;
      IF flip THEN addcol(image^[yi DIV K][xi], frr,fgg,fbb, f1)
      ELSE addcol(image^[xi][yi DIV K], frr,fgg,fbb, f1) END;
--      INC(yb, k);
        yb:=VAL(INTEGER, yb)+k;
    END;
--    INC(ya, k);
      ya:=VAL(INTEGER, ya)+k;
    INC(xi);
    DEC(n); 
  END;

<* IF NOT __GEN_C__ THEN *>

EXCEPT
  RETURN
<* END *>
END vector;

PROCEDURE setmark(image:pIMAGE; pos:POSITION; hard:BOOLEAN);
VAR i, d:INTEGER;
    x, y:REAL;
    col:COLTYP;
BEGIN
  IF posvalid(pos) & (mapxy(pos, x, y)>=0) THEN
    d:=lums.fontysize DIV 3;
    col.r:=0; col.g:=1000; col.b:=1000;
    IF hard THEN col.r:=1000; col.b:=0 END;
    FOR i:=-6 TO 6 DO
      IF i<>0 THEN
        waypoint(image, x+FLOAT(i*d), y, FLOAT(lums.fontysize)*0.12, col.r,col.g,col.b);
        waypoint(image, x, y+FLOAT(i*d), FLOAT(lums.fontysize)*0.12, col.r,col.g,col.b);
      END;
    END;
  END;
END setmark;


PROCEDURE drawchar(img:pIMAGE; ch:CHAR; x0r,y0r:REAL; VAR inc:INTEGER;
                   bri, contrast:CARDINAL; col:COLTYP; dryrun:BOOLEAN);
CONST ALPHA=255;
      WHITE=1023;
VAR x, y, x0, y0, xx, yy, fine:INTEGER;
    fx, fy, c, cf, cn:CARDINAL;
    dimmlev:REAL;

  PROCEDURE dim(x, y:INTEGER);
  VAR lum:REAL;
  BEGIN
    IF (x<0) OR (x>=VAL(INTEGER,HIGH(img^))) OR (y<0) OR (y>=VAL(INTEGER,HIGH(img^[0]))) THEN RETURN END;

    WITH img^[x][y] DO 
      lum:=FLOAT(VAL(CARDINAL,r)*87 + VAL(CARDINAL,g)*140 + VAL(CARDINAL,b)*28);
      IF lum>dimmlev THEN
        lum:=dimmlev/lum; 
        r:=trunc(FLOAT(r)*lum);   
        g:=trunc(FLOAT(g)*lum);
        b:=trunc(FLOAT(b)*lum);
      END;
    END;
  END dim;

BEGIN
  IF (ch>=" ") & (x0r>=0.0) & (y0r>=0.0) THEN
    cn:=ORD(ch)-ORD(" ");
    IF cn>HIGH(font) THEN cn:=0 END;

    dimmlev:=256*80.0;
    IF contrast=1 THEN dimmlev:=FLOAT(VAL(CARDINAL, col.r*87 + col.g*140 + col.b*28)*bri)*0.002 END;
    x0:=trunc(x0r);
    y0:=trunc(y0r);
    fx:=trunc((x0r-FLOAT(x0))*256.0);
    fy:=trunc((y0r-FLOAT(y0))*256.0);
    fine:=ORD((fx<>0) OR (fy<>0));

    WITH font[cn] DO
      IF (contrast>0) & NOT dryrun THEN 
        FOR y:=0 TO VAL(INTEGER, lums.fontysize-1) DO
          FOR x:=0 TO 15 DO
(*
            IF hicontrast & (mask[y]<>SET16{}) OR (x IN mask[y]) THEN dim(x0+x, y0+y) END;
*)
            IF x IN mask[y] THEN dim(x0+x+fine, y0+y) END;
          END;
        END; 
      END;
      FOR y:=0 TO VAL(INTEGER, lums.fontysize-3) DO
        yy:=y0 + y + 1;
        FOR x:=0 TO HIGH(font[0].char[0]) DO
          xx:=x0 + x + 1;
          c:=char[y][x]*bri DIV 256;
          IF (c>0) & (xx>=0) & (xx+1<VAL(INTEGER,HIGH(img^)))
          & (yy>=0) & (yy+1<VAL(INTEGER,HIGH(img^[0]))) THEN
            IF dryrun THEN findinfo(xx, yy);
            ELSE
              cf:=c*(256-fx)*(256-fy) DIV 65536;
              WITH img^[xx][yy] DO
                INC(r, cf*col.r DIV 256);
                INC(g, cf*col.g DIV 256);
                INC(b, cf*col.b DIV 256);
                IF ODD(g+col.g) THEN DEC(g) END;                     (* even is invert enable *)
              END;
              IF fine<>0 THEN                                        (* save cpu *) 
                cf:=c*(fx)*(256-fy) DIV 65536;
                WITH img^[xx+1][yy] DO
                  INC(r, cf*col.r DIV 256);
                  INC(g, cf*col.g DIV 256);
                  INC(b, cf*col.b DIV 256);
                END;
                cf:=c*(256-fx)*(fy) DIV 65536;
                WITH img^[xx][yy+1] DO
                  INC(r, cf*col.r DIV 256);
                  INC(g, cf*col.g DIV 256);
                  INC(b, cf*col.b DIV 256);
                END;
                cf:=c*(fx)*(fy) DIV 65536;
                WITH img^[xx+1][yy+1] DO
                  INC(r, cf*col.r DIV 256);
                  INC(g, cf*col.g DIV 256);
                  INC(b, cf*col.b DIV 256);
                END;
              END;
            END;
          END;
        END;
      END;
      inc:=width+1;
    END;
  END;
END drawchar;

PROCEDURE charwidth(ch:CHAR):CARDINAL;
VAR cn:CARDINAL;
BEGIN
  IF ch>=" " THEN
    cn:=ORD(ch)-ORD(" ");
    IF cn>HIGH(font) THEN cn:=0 END;
    RETURN font[cn].width+1
  END;
  RETURN 0
END charwidth;

PROCEDURE drawsym(image:pIMAGE; tab,sym:CHAR; mirror:BOOLEAN; x0r,y0r:REAL; bri:CARDINAL);
CONST MINVIS=3;
      MAXVIS=250;

VAR x, y, x0, y0, xi, sx:INTEGER;
    br1a, br0a, br1b, br0b, br1c, br0c, br1d, br0d, br2a, br2b, br2c, br2d, b, sr,sg,sb:CARDINAL;
    col:COLTYP;
    fx, fy:CARDINAL;
    
BEGIN
  IF bri=0 THEN RETURN END;

  sx:=VAL(INTEGER, sym)-VAL(INTEGER," ");
  IF (sx<=0) OR (sx>=96) OR (x0r<-FLOAT(lums.symsize)) 
  OR (y0r<-FLOAT(lums.symsize)) OR (x0r>FLOAT(HIGH(image^)+lums.symsize))
  OR (y0r>FLOAT(HIGH(image^[0])+lums.symsize)) THEN RETURN END;      (* symbol not inside image*)

  IF tab<>"/" THEN INC(sx, 96) END;
  sx:=sx*VAL(INTEGER, lums.symsize);
  IF bri>255 THEN bri:=255 END;

  x0:=VAL(INTEGER,x0r);
  y0:=VAL(INTEGER,y0r);
  IF x0<0 THEN fx:=0 ELSE fx:=trunc((x0r-FLOAT(x0))*256.0) END;      (* subpixel position *)
  IF y0<0 THEN fy:=0 ELSE fy:=trunc((y0r-FLOAT(y0))*256.0) END;
  DEC(x0, lums.symsize DIV 2); 
  DEC(y0, lums.symsize DIV 2);

  br0a:=bri*(256-fx)*(256-fy) DIV 65536;
  IF (fx<>0) OR (fy<>0) THEN                                    (* save cpu *)
    br0b:=bri*fx*(256-fy) DIV 65536;
    br0c:=bri*(256-fx)*fy DIV 65536;
    br0d:=bri*fx*fy DIV 65536;
  END;

  FOR y:=0 TO VAL(INTEGER, lums.symsize)-1 DO
    FOR x:=0 TO VAL(INTEGER, lums.symsize)-1 DO
      IF (x0+x>=0) & (y0+y>=0) & (x+x0+1<VAL(INTEGER,HIGH(image^)))
      & (y+y0+1<VAL(INTEGER,HIGH(image^[0]))) THEN
        IF mirror THEN xi:=VAL(INTEGER, lums.symsize)-1-x+sx ELSE xi:=x+sx END;
        WITH symbols[xi][y] DO
          IF alpha>=MINVIS THEN
            IF click.dryrun THEN findinfo(x+x0, y+y0);
            ELSE
              sr:=VAL(CARDINAL, r8)*4;
              sg:=VAL(CARDINAL, g8)*4;
              sb:=VAL(CARDINAL, b8)*4; 
--              sa:=VAL(CARDINAL, visable);
              br2a:=br0a*alpha DIV 256;
              br1a:=256-br2a;
              WITH image^[x+x0][y+y0] DO
                r:=(r*br1a + sr*br2a) DIV 256;
                g:=(g*br1a + sg*br2a) DIV 256;
                b:=(b*br1a + sb*br2a) DIV 256;
              END;

              IF (fx<>0) OR (fy<>0) THEN                        (* save cpu *)
                br2b:=br0b*alpha DIV 256;
                br1b:=256-br2b;
                br2c:=br0c*alpha DIV 256;
                br1c:=256-br2c;
                br2d:=br0d*alpha DIV 256;
                br1d:=256-br2d;
                WITH image^[x+x0+1][y+y0] DO
                  r:=(r*br1b + sr*br2b) DIV 256;
                  g:=(g*br1b + sg*br2b) DIV 256;
                  b:=(b*br1b + sb*br2b) DIV 256;
                END;
                WITH image^[x+x0][y+y0+1] DO
                  r:=(r*br1c + sr*br2c) DIV 256;
                  g:=(g*br1c + sg*br2c) DIV 256;
                  b:=(b*br1c + sb*br2c) DIV 256;
                END;
                WITH image^[x+x0+1][y+y0+1] DO
                  r:=(r*br1d + sr*br2d) DIV 256;
                  g:=(g*br1d + sg*br2d) DIV 256;
                  b:=(b*br1d + sb*br2d) DIV 256;
                END;
              END;
            END;
          END;
        END;
      END;
    END;
  END;
  IF (tab>="0") & (tab<="9") OR (tab>="A") & (tab<="Z") OR (tab>="a") & (tab<="z") THEN
    Colset(col, "W");
    drawchar(image, tab, x0r-FLOAT(lums.fontxsize DIV 2+1),
             y0r-FLOAT(lums.fontysize)*0.5-1.5, sx, bri*2, 1, col, click.dryrun);
  END;
END drawsym;


PROCEDURE drawareasym(image:pIMAGE; pm:POSITION; area:AREASYMB; bri:CARDINAL);

CONST FILLLUM=30;

  PROCEDURE lim(x:REAL; m:CARDINAL):CARDINAL;
  VAR r:CARDINAL;
  BEGIN
    IF x<=0.0 THEN RETURN 0 END;

    r:=trunc(x);
    IF r>m THEN RETURN m END;

    RETURN r
  END lim;  


VAR ret:INTEGER;
    p0, p1:POSITION;
    x0, y0, x1, y1, xh, xhh, yh, xho:REAL;
    xi0, yi0, xi1, yi1, i, xm:CARDINAL;
    fill,oct:BOOLEAN;   
    r,g,b:CARDINAL;


  PROCEDURE arc;
  VAR lum:CARDINAL;
  BEGIN
    IF xhh>-1.0 THEN
      IF oct THEN
        xhh:=1.0-sqr((FLOAT(i)-x1)/(x1-x0));
        IF xhh<=0.0 THEN xhh:=0.0 END;
        xhh:=ABS(FLOAT(yi0)-y0-yh)-(y1-y0)*0.5*sqrt(xhh);
      ELSE xhh:=ABS(x1-FLOAT(i))-xh END;
      xhh:=(1.5-ABS(xhh+1.5))*(256.0/1.5);
    END;
    IF xhh>0.0 THEN
      IF click.dryrun THEN findinfo(i,yi0) END;
      lum:=trunc(xhh);  
    ELSE
      IF fill THEN lum:=FILLLUM ELSE lum:=0 END;      (* fill *)
    END; 
    addcol(image^[i][yi0], r,g,b, lum);
  END arc;

BEGIN
  CASE area.color MOD 8 OF
    0:r:=128; g:=128; b:=128;                 (* we have no black so make gray *)
   |1:r:=0; g:=0; b:=255;  
   |2:r:=0; g:=255; b:=0;
   |3:r:=0; g:=255; b:=255;
   |4:r:=255; g:=0; b:=0;
   |5:r:=255; g:=0; b:=255;
   |6:r:=255; g:=255; b:=0;
   |7:r:=255; g:=255; b:=255;
  ELSE
  END;
  IF area.color>=8 THEN r:=r DIV 2; g:=g DIV 2; b:=b DIV 2 END;
  r:=r*bri DIV 64;
  g:=g*bri DIV 64;
  b:=b*bri DIV 64;


  IF (area.typ="1") OR (area.typ="6") THEN                    (* line *) 
    p0.lat :=pm.lat +area.dpos.lat;
    p0.long:=pm.long-area.dpos.long;
    p1.lat :=pm.lat -area.dpos.lat;
    p1.long:=pm.long+area.dpos.long;
    ret:=mapxy(p0, x0, y0);
    ret:=mapxy(p1, x1, y1);
    vector(image, x0,y0,x1,y1, r,g,b, 300, 0.0);

  ELSIF (area.typ="4") OR (area.typ="9") THEN                 (* box *)
    p0.lat :=pm.lat +area.dpos.lat;
    p0.long:=pm.long-area.dpos.long;
    p1.lat :=p0.lat;
    p1.long:=pm.long+area.dpos.long;
    ret:=mapxy(p0, x0, y0);
    ret:=mapxy(p1, x1, y1);
    vector(image, x0,y0,x1,y1, r,g,b, 200, 0.0);
    p0.lat :=pm.lat -area.dpos.lat;
    p0.long:=pm.long+area.dpos.long;
    ret:=mapxy(p0, x0, y0);
    vector(image, x0,y0,x1,y1, r,g,b, 200, 0.0);
    p1.lat :=pm.lat -area.dpos.lat;
    p1.long:=pm.long-area.dpos.long;
    ret:=mapxy(p1, x1, y1);
    vector(image, x0,y0,x1,y1, r,g,b, 200, 0.0);
    p0.lat :=pm.lat +area.dpos.lat;
    p0.long:=pm.long-area.dpos.long;
    ret:=mapxy(p0, x0, y0);
    vector(image, x0,y0,x1,y1, r,g,b, 200, 0.0);
    IF area.typ="9" THEN                                      (* fill *) 
      p0.lat :=pm.lat -area.dpos.lat;
      p0.long:=pm.long-area.dpos.long;
      p1.lat :=pm.lat +area.dpos.lat;
      p1.long:=pm.long+area.dpos.long;
      ret:=mapxy(p0, x0, y0);
      ret:=mapxy(p1, x1, y1);
      xi0:=lim(x0, HIGH(image^));
      xi1:=lim(x1, HIGH(image^));
      yi0:=lim(y0, HIGH(image^[0]));
      yi1:=lim(y1, HIGH(image^[0]));
      WHILE yi0<yi1 DO
        FOR i:=xi0 TO xi1 DO addcol(image^[i][yi0], r,g,b, FILLLUM) END;
        INC(yi0);
      END;
    END;

  ELSIF (area.typ="3") OR (area.typ="8") THEN                 (* triangle *)
    p0.lat :=pm.lat +area.dpos.lat;
    p0.long:=pm.long;
    p1.lat :=pm.lat -area.dpos.lat;;
    p1.long:=pm.long-area.dpos.long;
    ret:=mapxy(p0, x0, y0);
    ret:=mapxy(p1, x1, y1);
    vector(image, x0,y0,x1,y1, r,g,b, 200, 0.0);
    p1.long:=pm.long+area.dpos.long;
    ret:=mapxy(p1, x1, y1);
    vector(image, x0,y0,x1,y1, r,g,b, 200, 0.0);
    p0.lat :=pm.lat -area.dpos.lat;
    p0.long:=pm.long-area.dpos.long;
    ret:=mapxy(p0, x0, y0);
    vector(image, x0,y0,x1,y1, r,g,b, 200, 0.0);
    IF area.typ="8" THEN                                      (* fill *)
      p0.lat :=pm.lat -area.dpos.lat;
      p0.long:=pm.long-area.dpos.long;
      p1.lat :=pm.lat +area.dpos.lat;
      p1.long:=pm.long;
      ret:=mapxy(p0, x0, y0);
      ret:=mapxy(p1, x1, y1);
      xhh:=y1-y0;
      IF xhh<>0.0 THEN
        yi0:=lim(y0, HIGH(image^[0]));
        yi1:=lim(y1, HIGH(image^[0]));
        xhh:=(x1-x0)/xhh;
        WHILE yi0<yi1 DO
          xh:=xhh*(y1-FLOAT(yi0));
          FOR i:=lim(x1-xh, HIGH(image^)) TO lim(x1+xh, HIGH(image^)) DO
            addcol(image^[i][yi0], r,g,b, FILLLUM);
          END;
          INC(yi0);
        END;
      END;
    END;


  ELSIF (area.typ="0") OR (area.typ="2") OR (area.typ="5") OR (area.typ="7") THEN  (* circle ellipse *)
    p0.lat :=pm.lat -area.dpos.lat;
    p0.long:=pm.long-area.dpos.long;
    p1.lat :=pm.lat +area.dpos.lat;
    p1.long:=pm.long;
    ret:=mapxy(p0, x0, y0);
    ret:=mapxy(p1, x1, y1);
    IF (area.typ="0") OR (area.typ="5") THEN x0:=x1-(y1-y0)*0.5 END;   (* circle *)
    yi0:=lim(y0+0.5, HIGH(image^[0]));
    yi1:=lim(y1+0.5, HIGH(image^[0]));
    yh:=(y1-y0)*0.5;
    xho:=0.0;
    fill:=(area.typ="5") OR (area.typ="7");
    IF (yh<>0) & (x0<>x1) THEN 
      WHILE yi0<yi1 DO
        xh:=1.0-sqr((y0+yh-FLOAT(yi0))/yh);
        IF xh<=0.0 THEN xh:=0.0 END;
        xh:=(x1-x0)*sqrt(xh);
      
        oct:=ABS(xh-xho)>=1.0;
        xho:=xh;

        xm:=lim(x1+0.5, HIGH(image^));
        xhh:=0.0;
        FOR i:=lim(x1-xh+0.5, HIGH(image^))+1 TO xm DO arc END;
        xhh:=0.0;
        FOR i:=lim(x1+xh+0.5, HIGH(image^))-1 TO xm+1 BY -1 DO arc END;
        INC(yi0);
      END;
    END; 

  END;

END drawareasym;


PROCEDURE dashvec(image:pIMAGE; x0,y0,x1,y1:REAL; r,g,b:CARDINAL; double:REAL; len, wid:CARDINAL);

VAR x, y, k, m0, m1, l, dx, dy:REAL;
    i,d:CARDINAL;
BEGIN
  x:=x1-x0;
  y:=y1-y0;
  k:=x*x+y*y;
  IF k=0 THEN RETURN END;

  k:=sqrt(k);
  dx:=double*y/k;
  dy:=-double*x/k;                                            (* rotate vector 90 deg for double dash *)
  l:=FLOAT(len);
  IF k<100.0 THEN l:=l*0.8 ELSIF k<50.0 THEN l:=l*0.5 END;    (* shrink dash size with line length *)
  d:=1+trunc(k/l) DIV 2*2;
  k:=1.0/FLOAT(d);
  FOR i:=0 TO d-1 BY 2 DO
    m0:=k*FLOAT(i);
    m1:=k*FLOAT(i+1);    
    vector(image, x0 + x*m0, y0 + y*m0, x0 + x*m1, y0 + y*m1, r,g,b, wid, 0.0);
    IF double<>0.0 THEN
      vector(image, x0 + x*m0+dx, y0 + y*m0 + dy, x0 + x*m1 + dx, y0 + y*m1 + dy, r,g,b, wid, 0.0);
    END;
  END
END dashvec;

PROCEDURE policolor(c, bri:CARDINAL; VAR r,g,b:CARDINAL); (* colour for poliline object *)
BEGIN
  c:=c MOD 4;
  r:=0; g:=0; b:=0;
  CASE c OF
    0:r:=255;
   |1:r:=170; g:=180;
   |2:g:=50; b:=400;
   |3:g:=230;
  ELSE
  END;
  r:=r*bri DIV 64;
  g:=g*bri DIV 64;
  b:=b*bri DIV 64;
END policolor;

PROCEDURE fillpoligon(image:pIMAGE; pm:POSITION; md-:MULTILINE; bri:CARDINAL);
VAR i,j,nv,nc,hachuresize:CARDINAL;
    rf,gf,bf:CARDINAL;
    x, maxx, minx, maxy, miny:INTEGER; 
    ret:INTEGER;
    vert:ARRAY[0..MAXMULTILINES] OF RECORD xi, yi:INTEGER END;
    cross:ARRAY[0..MAXMULTILINES] OF INTEGER;
    p:POSITION;
    xr, yr:REAL;
    done:BOOLEAN;
BEGIN
  IF (md.filltyp<"2") OR (md.filltyp>"9") THEN RETURN END;

  i:=ORD(md.filltyp)-ORD("2");
  IF i<4 THEN hachuresize:=0; bri:=bri DIV 6 ELSE hachuresize:=3; bri:=bri DIV 2 END;
  policolor(i, bri, rf,gf,bf);

  maxx:=MIN(INTEGER);
  maxy:=MIN(INTEGER);
  minx:=MAX(INTEGER);
  miny:=MAX(INTEGER);
  nv:=md.size+1;                                                  (* always a poligon *)
  IF (nv<4) OR (nv>HIGH(vert)) THEN RETURN END;

  i:=0;
  WHILE i<nv DO
    j:=i MOD md.size;
    p.lat :=pm.lat +md.vec[j].lat;
    p.long:=pm.long+md.vec[j].long;
    WITH vert[i] DO
      ret:=mapxy(p, xr, yr);
      xi:=VAL(INTEGER,xr);
      yi:=VAL(INTEGER,yr);
      IF xi>maxx THEN maxx:=xi END;
      IF xi<minx THEN minx:=xi END;
      IF yi>maxy THEN maxy:=yi END;
      IF yi<miny THEN miny:=yi END;
    END;
    INC(i);
  END; 
  IF miny<0 THEN miny:=0 END;
  IF maxy>VAL(INTEGER, HIGH(image^[0])) THEN maxy:=HIGH(image^[0]) END;
  IF minx<0 THEN minx:=0 END;
  IF maxx>VAL(INTEGER, HIGH(image^)) THEN maxx:=HIGH(image^) END;

  IF hachuresize>0 THEN                                    (* modify hachure with image size *)     
    x:=maxx-minx+maxy-miny;
    IF x>0 THEN INC(hachuresize, trunc(0.35*sqrt(FLOAT(x)))) END;
  END;

  WHILE maxy>miny  DO
    nc:=0;
    i:=0;
    WHILE i<nv-1 DO                                        (* find all crossings to scanline *)  
      IF (vert[i].yi>maxy)<>(vert[i+1].yi>maxy) THEN       (* vector crosses scanline *)
        x:=vert[i].xi + VAL(INTEGER, VAL(REAL,vert[i+1].xi - vert[i].xi)
        *VAL(REAL,vert[i].yi - maxy)/VAL(REAL,vert[i].yi - vert[i+1].yi));
        IF x<minx THEN x:=minx ELSIF x>maxx THEN x:=maxx END;
        cross[nc]:=x;
        INC(nc);
      END;
      INC(i);
    END;

    IF (nc>=2) & NOT ODD(nc) THEN                          (* should always be even *)

      REPEAT                                               (* sort crossings from left to right *) 
        i:=0;
        done:=TRUE;
        WHILE i<nc-1 DO
          IF cross[i]>cross[i+1] THEN x:=cross[i]; cross[i]:=cross[i+1]; cross[i+1]:=x; done:=FALSE END;
          INC(i);
        END;
      UNTIL done; 

--      done:=TRUE;
      j:=1;
      FOR x:=cross[0] TO cross[nc-1] DO 
        WHILE x=cross[j] DO done:=NOT done; INC(j) END;
        IF done & ((hachuresize=0) OR (VAL(CARDINAL, maxy+x) MOD hachuresize=0)) THEN
          WITH image^[x][maxy] DO INC(r,rf); INC(g,gf); INC(b,bf) END; 
        END;
      END;

    END;
    DEC(maxy);
  END; 

END fillpoligon;

PROCEDURE drawpoligon(image:pIMAGE; pm:POSITION; md-:MULTILINE; tab, sym:CHAR; bri:CARDINAL);
VAR ret:INTEGER;
    p:POSITION;
    x0, y0, x1, y1:REAL;
    i,j:CARDINAL;
    r,g,b,col,widt,sz:CARDINAL;

BEGIN
  IF (md.linetyp<"a") OR (md.size<=1) THEN RETURN END;

  col:=ORD(md.linetyp)-ORD("a");
  policolor(col DIV 3 MOD 4, bri, r,g,b);
  i:=0;
  widt:=300;
  IF md.filltyp>"1" THEN widt:=160 END;
  sz:=md.size+ORD(md.filltyp<>"1");                      (* closed poligon *)
  WHILE i<sz DO
    j:=i MOD md.size;
    p.lat :=pm.lat +md.vec[j].lat;
    p.long:=pm.long+md.vec[j].long;
    ret:=mapxy(p, x1, y1);

    IF i>0 THEN
      CASE col MOD 3 OF
        0:vector(image, x0,y0,x1,y1, r,g,b, widt, 0.0);
       |1:dashvec(image, x0,y0,x1,y1, r,g,b, 0.0, 8, widt);
       |2:dashvec(image, x0,y0,x1,y1, r,g,b, 2.5, 6, 200);
      ELSE
      END;
    END;
    x0:=x1;
    y0:=y1;
    INC(i);
  END; 
  IF (i>0) & (md.filltyp="1") THEN drawsym(image, tab,sym, FALSE, x0,y0, bri) END;

  fillpoligon(image, pm, md, bri);
END drawpoligon;

PROCEDURE drawpoliobj(image:pIMAGE);
VAR cs:ARRAY[0..250] OF CHAR;
    ml:MULTILINE;
    center:POSITION;
    i:CARDINAL;
BEGIN
  confstr(fRBPOS, cs);
  deganytopos(cs, center);
  IF NOT posvalid(center) THEN RETURN END;

  confstr(fRBCOMMENT, cs);
  GetMultiline(cs, i, ml);
  confstr(fRBSYMB, cs);

  drawpoligon(image, center, ml, cs[0], cs[1], 250);

END drawpoliobj;

PROCEDURE findmultiline(pos:POSITION; VAR foundpos:POSITION):BOOLEAN;
VAR cs:ARRAY[0..250] OF CHAR;
    ml:MULTILINE;
    center:POSITION;
    i, mini:CARDINAL;
    mind, d:REAL;
BEGIN
  confstr(fRBPOS, cs);
  deganytopos(cs, center);
  IF NOT posvalid(center) THEN RETURN FALSE END;

  confstr(fRBCOMMENT, cs);
  GetMultiline(cs, i, ml);
  mind:=MAX(REAL);
  mini:=ml.size;
  i:=0;
  WHILE i<ml.size DO
    d:=ABS(ml.vec[i].lat+center.lat-pos.lat) + ABS(ml.vec[i].long+center.long-pos.long);
    IF d<mind THEN mind:=d; mini:=i END;
    INC(i)
  END;
  IF mini<ml.size THEN
    foundpos.lat :=ml.vec[mini].lat +center.lat;
    foundpos.long:=ml.vec[mini].long+center.long;
    click.polilinecursor:=mini;
    RETURN TRUE

  END;
  RETURN FALSE
END findmultiline;


PROCEDURE OptTextPlace(img:pIMAGE; s:ARRAY OF CHAR; VAR xt, yt:INTEGER);
CONST HY=MAXFONTY;
      MARGIN=2;

VAR i, cn:CARDINAL;
    wid, x, y, yh, cont, lr, lg, lb, min, (*max,*) ymin, n, fonty:INTEGER;
    ct:ARRAY[0..HY*3-1] OF INTEGER;

BEGIN
  fonty:=lums.fontysize-3;
  IF (xt<0) OR (xt>=VAL(INTEGER,HIGH(img^))) OR (yt<-fonty)
  OR (yt>=VAL(INTEGER,HIGH(img^[0]))+fonty) THEN RETURN END;
  i:=0;
  wid:=0;
  WHILE (i<=HIGH(s)) & (s[i]<>0C) DO
    IF s[i]>=" " THEN
      cn:=ORD(s[i])-ORD(" ");
      IF cn>HIGH(font) THEN cn:=0 END;
      INC(wid, font[cn].width);
    END;
    INC(i);
  END;

  min:=MAX(INTEGER);
  n:=0;
  FOR y:=0 TO 3*fonty-1 DO
    yh:=yt+y-fonty;
    IF (yh>=MARGIN) & (yh<VAL(INTEGER,HIGH(img^[0])+1)-MARGIN) THEN (* never place text outside drawable *)
      cont:=0;
      lr:=0; lg:=0; lb:=0; 
      FOR x:=xt TO xt+wid-1 DO
        IF x<VAL(INTEGER,HIGH(img^)-1) THEN
          WITH img^[x][yh] DO
            INC(cont, ABS(r-lr)+ABS(g-lg)+ABS(b-lb));
            lr:=r; lg:=g; lb:=b;
          END;
        END;
      END;
    ELSE cont:=wid*32768 END;  

    
    IF (y<fonty) OR (y>=fonty*2) THEN cont:=cont*400 DIV 256 END;

    ct[y]:=cont; 
    INC(n, cont);
    IF y>=fonty THEN
      DEC(n, ct[y-fonty]);
      IF n<min THEN min:=n; ymin:=y END;
    END;
  END;

  INC(yt, ymin-fonty*2);
END OptTextPlace;


PROCEDURE drawstr(image:pIMAGE; s-:ARRAY OF CHAR; xr, yr:REAL; bri, contrast:CARDINAL;
                  col:COLTYP; VAR pos:INT8; slide:CARDINAL; fixpos,dryrun:BOOLEAN);
VAR i:CARDINAL;
    dy, inc, x, y:INTEGER;
BEGIN
  IF bri=0 THEN RETURN END;

  IF slide>0 THEN
    IF fixpos THEN yr:=yr+VAL(REAL, pos);
    ELSE
      y:=VAL(INTEGER, yr);
      x:=VAL(INTEGER, xr);
      dy:=y;
      OptTextPlace(image, s, x, y);
      y:=y DIV 2*2 + 1;                   (* not odd lines for better 420 color conversion *)
      pos:=y-dy;
      xr:=VAL(REAL, x);
      yr:=VAL(REAL, y); 
    END;
  END;
  i:=0;
  WHILE (i<=HIGH(s)) & (s[i]<>0C) DO
    drawchar(image, s[i], xr,yr, inc, bri, contrast, col, dryrun);
    xr:=xr+FLOAT(inc);
--    xr:=xr + lums.fontxsize;
    INC(i);
  END;
END drawstr;

PROCEDURE drawstri(image:pIMAGE; s-:ARRAY OF CHAR; xr, yr:INTEGER; bri, contrast:CARDINAL;
                   col:COLTYP; proportional,dryrun:BOOLEAN);
VAR i:CARDINAL;
    inc:INTEGER;
    c:CHAR; 
BEGIN
  i:=0;
  LOOP
    IF i>HIGH(s) THEN EXIT END;

    c:=s[i];
    IF c=0C THEN EXIT END;

    IF (c>=SP1) & (c<=SP9) THEN INC(xr, ORD(c)-(ORD(SP1)-1))          (* microspaces *)  
    ELSE
      drawchar(image, s[i], FLOAT(xr), FLOAT(yr), inc, bri, contrast, col, dryrun);
      IF proportional THEN INC(xr,inc) ELSE INC(xr, lums.fontxsize) END;
    END;  
    INC(i);
  END;
END drawstri;


PROCEDURE drawarrow(image:pIMAGE; x0, y0, len, ang:REAL; wind, bri:CARDINAL; col:COLTYP);
CONST L=7;
      WS=20;             (* wind fethers per kmh *) 
      MAXWIND=250;       (* limit to nonsense windspeed *)
      LW=8;
      WW=4;
      A=0.12;
      W=-1.25;
VAR r,g,b, wi:INTEGER;
    x1, y1, s, c, l, s1, c1:REAL;
BEGIN
--WrInt(wind, 10);WrStrLn("=w");
  s:=sin(ang);
  c:=cos(ang);
  r:=bri*col.r DIV 256;
  g:=bri*col.g DIV 256;
  b:=bri*col.b DIV 256;
  IF wind=0 THEN
    vector(image, x0, y0, x0-(len-5.0)*s, y0+(len-5.0)*c, r,g,b, 25*lums.symsize, 0.0);
    x1:=x0-len*s;
    y1:=y0+len*c;
    l:=len-L;
    vector(image, x1, y1, x0-l*sin(ang+A), y0+l*cos(ang+A), r,g,b, 14*lums.symsize, 0.0);
    vector(image, x1, y1, x0-l*sin(ang-A), y0+l*cos(ang-A), r,g,b, 14*lums.symsize, 0.0);
  ELSE
    len:=len+FLOAT(WW*wind DIV WS);
    vector(image, x0, y0, x0-len*s, y0+len*c, r,g,b, 16*lums.symsize, 0.0);
    s1:=sin(ang+W);
    c1:=cos(ang+W);
    wi:=wind;
    IF wi<WS THEN wi:=WS ELSIF wi>MAXWIND THEN wi:=MAXWIND END;
    REPEAT
      x1:=x0-len*s (*-s1*);
      y1:=y0+len*c (*+c1*);
      l:=FLOAT(LW);
      IF wi<WS THEN l:=LW*VAL(REAL,wi)/WS END; 
      vector(image, x1, y1, x1-l*s1, y1+l*c1, r,g,b, 16*lums.symsize, 0.0);
      DEC(wi, WS);
      len:=len-WW;
    UNTIL wi<=0; 


  END;
END drawarrow;

PROCEDURE poisactiv():BOOLEAN;
VAR i:CARDINAL;
BEGIN
  i:=0;
  WHILE (i<=HIGH(poifiles)) & NOT poifiles[i].on DO INC(i) END;
  RETURN i<=HIGH(poifiles)
END poisactiv;

PROCEDURE drawpois(image:pIMAGE); (* draw poi symbols with fitting category *)
VAR bri, i:CARDINAL;
    col:COLTYP;
    rightdown, leftup:POSITION;
    x,y:REAL;
    pm:pMOUNTAIN;
    void:INT8;
    fs:ARRAY[0..100] OF CHAR;

BEGIN
  IF NOT poisactiv() THEN RETURN END;                              (* normal state, quick done *)

  confstr(fPOIFILTER, fs);
  cleanfind(fs);
  xytodeg(VAL(REAL,xsize), 0.0, rightdown);
  xytodeg(0.0, VAL(REAL,ysize), leftup);
  ColConfset(col, fCOLOBJTEXT);
  bri:=lums.sym*256 DIV 1000;
  pm:=mountains;
  WHILE pm<>NIL DO
    WITH pm^ DO
      IF poifiles[pm^.index].on
      & (pos.lat>rightdown.lat) & (pos.lat<leftup.lat)
      & (pos.long<rightdown.long) & (pos.long>leftup.long)
      & (mapxy(pos, x, y)>=0)
      & ((fs="") OR cmppoi(pm, fs)) THEN
        drawsym(image, poifiles[pm^.index].symbol[0], poifiles[pm^.index].symbol[1], FALSE, x,y, bri);
        IF lums.text>0 THEN 
          drawstr(image, name, floor(x+FLOAT(lums.symsize DIV 2-1)), floor(y-FLOAT(lums.fontysize DIV 2)),
          lums.text, 1, col, void, 4, FALSE, FALSE);
        END;
      END; 
      pm:=next;
    END;
  END;
END drawpois;


PROCEDURE cc(img:pIMAGE; from, to:TIME);
VAR col:COLTYP;
    s,h:ARRAY[0..1023] OF CHAR;
    pos:INT8;
BEGIN
  click.ops:=NIL;
  IF lums.map>0 THEN s:="Maps:(c)www.openstreetmap.org" ELSE s:="" END;
  IF (HIGH(img^)>=399) OR (lums.map=0) THEN
--    Append(s, " Time:");
    Append(s, " ");
    DateLocToStr(from, h); Append(s,h);
    IF to<>0 THEN
      Append(s, "-");
      TimeToStr((to+localtime()) MOD 86400, h); Append(s,h);
    END;
  END;
  Colset(col, "G");
  Append(s, " Zoom:"); FixToStr(FLOAT(initzoom)-0.995+finezoom, 3, h); Append(s,h);
  drawstr(img, s, 5.0, FLOAT(HIGH(img^[0])-lums.fontysize-30), 300, 0, col, pos, 3, FALSE, click.dryrun);
END cc;


PROCEDURE ruler(img:pIMAGE);

CONST RULERY=10;
      RULERX0=20;
      MINBRI=256;

  PROCEDURE mapbri(x0,x1,y:INTEGER):CARDINAL;
  VAR x,g:INTEGER;
  BEGIN
    IF (x0>=xsize) OR (x1>=xsize) OR (y>=ysize) THEN RETURN 0 END;
    g:=0;
    FOR x:=x0 TO x1 DO IF g<img^[x][y].g THEN g:=img^[x][y].g END END;
    RETURN g
  END mapbri;


VAR lpos, rpos:POSITION;
    h,s:ARRAY[0..100] OF CHAR;
    r, d, e:REAL;
    m, w, rulerx1:CARDINAL;
    pos:INT8;
    bri:CARDINAL;
    col:COLTYP;
BEGIN
  rulerx1:=lums.fontxsize*50;
  IF (VAL(INTEGER,rulerx1)>xsize) OR (initzoom<6) THEN RETURN END;

  xytodeg(VAL(REAL,RULERX0), VAL(REAL,RULERY), lpos);
  xytodeg(VAL(REAL,rulerx1), VAL(REAL,RULERY), rpos);
  d:=1000.0*distance(lpos, rpos);
  IF d=0.0 THEN RETURN END;

  r:=d;
  m:=1;
  WHILE r>=10.0 DO r:=r*0.1; m:=m*10 END;
  e:=r;
  IF r>=5.0 THEN r:=5.0 ELSIF r>=2.0 THEN r:=2.0 ELSE r:=1.0 END;
  e:=r/e*FLOAT(rulerx1-RULERX0);
  bri:=mapbri(RULERX0, RULERX0+TRUNC(e), RULERY);
  col.r:=0;
  col.g:=120+bri;
  col.b:=100+bri;
  vector(img, FLOAT(RULERX0), FLOAT(RULERY), FLOAT(RULERX0)+e, FLOAT(RULERY), col.r,col.g,col.b, lums.fontysize*20, 0.0);
  vector(img, FLOAT(RULERX0), FLOAT(RULERY)-3, FLOAT(RULERX0), FLOAT(RULERY+3), col.r,col.g,col.b, lums.fontysize*20, 0.0);
  vector(img, FLOAT(RULERX0)+e, FLOAT(RULERY)-3, FLOAT(RULERX0)+e, FLOAT(RULERY+3), col.r,col.g,col.b, lums.fontysize*20, 0.0);
  m:=m*trunc(r);
  w:=m;
  IF w>=1000 THEN w:=w DIV 1000 END;
  IntToStr(w, 1, h);
  IF m>=1000 THEN Append(h, "km") ELSE Append(h, "m") END;
  Colset(col, "G");
  Append(h, " ["); FixToStr(FLOAT(initzoom)-0.95+finezoom, 2, s); Append(h,s); Append(h, "]");
  drawstr(img, h, floor(FLOAT(RULERX0)+e*0.5-FLOAT(lums.fontxsize)*3.5), FLOAT(RULERY), bri+250, 0, col, pos, 0, TRUE, click.dryrun);
END ruler;


PROCEDURE shine(image:pIMAGE; lum:INTEGER);
CONST VIS=80.0;
      PEAK=1000.0;

VAR x,y,max:INTEGER;
    f,c,rr,gg,bb:CARDINAL;
    done:BOOLEAN;
    ex:REAL; 

  PROCEDURE smoo(x:INTEGER):INTEGER;
  BEGIN IF x<=0 THEN RETURN x ELSE RETURN trunc(exp(ln(FLOAT(x)/VIS)*ex)*VIS) END; END smoo;

--BEGIN RETURN trunc(FLOAT(x)/FLOAT(max)*5000.0) END smoo;
 
BEGIN
  max:=trunc(VIS)+1;
  FOR y:=0 TO VAL(INTEGER,HIGH(image^[0])) DO
    FOR x:=0 TO VAL(INTEGER,HIGH(image^)) DO 
      WITH image^[x][y] DO IF g>max THEN max:=g END; END;
    END;
  END;
  ex:=ln(PEAK/VIS)/ln(FLOAT(max)/VIS);
  IF ex>1.5 THEN ex:=1.5 END;

--WrInt(max, 10);WrFixed(ex, 3,10);WrLn;

  FOR y:=0 TO VAL(INTEGER,HIGH(image^[0])) DO
    FOR x:=0 TO VAL(INTEGER,HIGH(image^)) DO
      WITH image^[x][y] DO
        r:=smoo(r);
        g:=smoo(g);
        b:=smoo(b);
      END;
    END;
  END;

  REPEAT
    done:=TRUE;
    FOR y:=2 TO VAL(INTEGER,HIGH(image^[0])-2) DO
      FOR x:=2 TO VAL(INTEGER,HIGH(image^)-2) DO
        WITH image^[x][y] DO
          c:=r DIV 2;
          IF g>c THEN c:=g END;
          IF b>c THEN c:=b END;
          IF c>=256 THEN
            rr:=0;
            gg:=0;
            bb:=0;
            f:=65535 DIV c;
            c:=r*f DIV 256;
            IF r>c THEN rr:=(r-c) DIV 10 END;
            r:=c;
            c:=g*f DIV 256;
            IF g>c THEN gg:=(g-c) DIV 12 END;
            g:=c;
            c:=b*f DIV 256;
            IF b>c THEN bb:=(b-c) DIV 12 END;
            b:=c;
            WITH image^[x-1][y-1] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x-1][y  ] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x-1][y+1] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x+1][y-1] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x+1][y  ] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x+1][y+1] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x  ][y+1] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x  ][y-1] DO INC(r, rr); INC(g, gg); INC(b, bb) END;
            WITH image^[x-2][y  ] DO INC(r, rr DIV 2); INC(g, gg DIV 2 ); INC(b, bb DIV 2) END;           
            WITH image^[x+2][y  ] DO INC(r, rr DIV 2); INC(g, gg DIV 2 ); INC(b, bb DIV 2) END;           
            WITH image^[x  ][y-2] DO INC(r, rr DIV 2); INC(g, gg DIV 2 ); INC(b, bb DIV 2) END;           
            WITH image^[x  ][y+2] DO INC(r, rr DIV 2); INC(g, gg DIV 2 ); INC(b, bb DIV 2) END;           

            done:=FALSE;
          END;
        END;
      END;
    END;
  UNTIL done;

  FOR y:=0 TO VAL(INTEGER,HIGH(image^[0])) DO
    FOR x:=0 TO VAL(INTEGER,HIGH(image^)) DO
      WITH image^[x][y] DO
        r:=r*lum DIV 512;
        g:=g*lum DIV 512;
        b:=b*lum DIV 512;
      END;
    END;
  END;
END shine;

PROCEDURE makebw(p:pIMAGE);
VAR x,y,w:CARDINAL;
BEGIN
  FOR y:=0 TO HIGH(p^[0]) DO
    FOR x:=0 TO HIGH(p^) DO 
      WITH p^[x][y] DO
        w:=(VAL(CARDINAL,r)*340 + VAL(CARDINAL,g)*550 + VAL(CARDINAL,b)*110) DIV 1000;
        r:=w;
        g:=w;
        b:=w; 
      END;
    END; 
  END;
END makebw;


(*
PROCEDURE lim(n:CARDINAL):CARD16;
BEGIN IF n>MAX(CARD16) THEN RETURN MAX(CARD16) ELSE RETURN n END; END lim;
*)


PROCEDURE addpix(VAR s, a:PIX);
BEGIN
(*
   h:=s.r + a.r; IF h>MAX(CARD16) THEN s.r:=MAX(CARD16) ELSE s.r:=h END;
   h:=s.g + a.g; IF h>MAX(CARD16) THEN s.g:=MAX(CARD16) ELSE s.g:=h END;
   h:=s.b + a.b; IF h>MAX(CARD16) THEN s.b:=MAX(CARD16) ELSE s.b:=h END;
*)
   INC(s.r, a.r);
   INC(s.g, a.g);
   INC(s.b, a.b);
END addpix;


PROCEDURE addmap(image, map:pIMAGE);
VAR x,y:INTEGER;
BEGIN
  FOR x:=0 TO VAL(INTEGER,HIGH(image^)) DO
    FOR y:=0 TO VAL(INTEGER,HIGH(image^[0])) DO 
      addpix(image^[x][y], map^[x][y]);
(*
      image^[x+xsize*y].r:=lim(map^[x+xsize*y].r + image^[x+xsize*y].r);
      image^[x+xsize*y].g:=lim(map^[x+xsize*y].g + image^[x+xsize*y].g);
      image^[x+xsize*y].b:=lim(map^[x+xsize*y].b + image^[x+xsize*y].b);
*)
    END;
  END;
END addmap;


PROCEDURE mapname(x, y, zoom:INTEGER; VAR fn, reqn:ARRAY OF CHAR);
VAR hh:ARRAY[0..20] OF CHAR;
    path:ARRAY[0..1000] OF CHAR;
BEGIN
    fn[0]:=0C;
    confstr(fOSMDIR, path);
    Append(fn, path);
    Append(fn, DIRSEP);
    Append(fn, lums.mapname);  
    Append(fn, DIRSEP);
--WrInt(zoom,6);WrInt(x,6);WrInt(y,6);WrStrLn(" zoom x y");
    IntToStr(zoom, 1, hh);
    Append(fn, hh);
    Append(fn, DIRSEP);
--    Append(fn, hh);

    reqn[0]:=0C;
    Append(reqn, lums.mapname);
    Append(reqn," ");
    Append(reqn, hh);
    Append(reqn," ");
(*
    IntToStr(x, 1, hh);

    Append(fn,"-");
    Append(fn, hh);
    Append(fn,"-");
*)
     IntToStr(x, 1, hh);
     Append(fn, hh);
     Append(fn, DIRSEP);

    Append(reqn, hh);
    Append(reqn," ");

    IntToStr(y, 1, hh);  
    Append(fn, hh);
--    Append(fn,".png");
    Append(reqn,hh);
    Append(reqn, LF);
END mapname;


PROCEDURE squaredelay(c:CARDINAL):CARDINAL;
VAR n:CARDINAL;
BEGIN
  n:=1;
  WHILE c>0 DO INC(n,n); DEC(c) END;
  RETURN n-1;
END squaredelay;


PROCEDURE decodetile(fn-:ARRAY OF CHAR; ppngbuf:pPNGBUF; maxx, maxy, maxxbyte:INTEGER):BOOLEAN;
VAR s:ARRAY[0..99] OF CHAR;
<* IF TARGET_FAMILY="WIN32" THEN *>    
    ret:INTEGER;
<* END *>
BEGIN
  Assign(s, fn); Append(s, PNGEXT);
  IF ppngbuf<>NIL THEN
    IF (pngread.readpng(s, ppngbuf^, maxx, maxy, maxxbyte)>=0)               (* normal png in .png *)
    OR (readjpg(s, ppngbuf^, maxx, maxy, maxxbyte)>=0) THEN RETURN TRUE END; (* jpg hided in .png *)
  ELSIF Exists(s) THEN RETURN TRUE END;

  Assign(s, fn); Append(s, JPGEXT);

  IF ppngbuf<>NIL THEN 
<* IF TARGET_FAMILY="WIN32" THEN *>
    ret:=readjpg(s, ppngbuf^, maxx, maxy, maxxbyte);      (* jpg in .jpg *)                       
    IF ret=-499 THEN say("[jpegm.dll] missing - no Maps in jpeg", 3, "e") END;
    RETURN ret>=0
<* ELSE *>
    RETURN readjpg(s, ppngbuf^, maxx, maxy, maxxbyte)>=0; (* jpg in .jpg *)
<* END *>
  END;
  RETURN Exists(s)
END decodetile;

(*
PROCEDURE existsimg(fn-:ARRAY OF CHAR):BOOLEAN;
VAR s:ARRAY[0..99] OF CHAR;
BEGIN
  Assign(s, fn); Append(s, PNGEXT);
  IF Exists(s) THEN RETURN TRUE END;
  Assign(s, fn); Append(s, JPGEXT);
  RETURN Exists(s)
END existsimg;
*)

PROCEDURE reqmap(wfn:ARRAY OF CHAR; byop:BOOLEAN);  (* append filename of missing tiles to file, 0C is flush *)

CONST MAPLOADPROGSTARTDELAY=10;
      MINSPACE=80;

VAR s,h:ARRAY[0..999] OF CHAR;
    fd:File;
    lb:CARDINAL;
BEGIN
--WrStr(">");WrStr(wfn);
  IF NOT byop THEN mapdelay:=0 END;
  IF mapnamesdone=1 THEN                                (* filled buffer written *)
    mapnamesdone:=0;
    IF NOT Exists(MAPGETFN) THEN                        (* a maploader is at work *)
      IF byop & (wfn[0]<>0C) & (InStr(mapnamesbuf, wfn)>=0) THEN mapnamesdone:=2 ELSE maploopcnt:=0 END;
    END;
    mapnamesbuf[0]:=0C;
  END;

  IF (maploopcnt<5) OR (mapnamesbuf[0]=0C) THEN Append(mapnamesbuf, wfn) END; (* store 1 line if looping *)
  lb:=Length(mapnamesbuf);
  IF (lb>0) & ((wfn[0]=0C) OR (lb+MINSPACE>=SIZE(mapnamesbuf))) THEN  (* namebuffer full or flush *)

--WrInt(maploopcnt, 10); WrInt(mapdelay, 10); WrInt(realtime-lastmapreq, 10); WrInt(realtime, 15); WrInt(lastmapreq, 15); WrStrLn(" delay");  
    IF lastmapreq + mapdelay + squaredelay(maploopcnt)<=realtime THEN

      IF mapnamesdone=2 THEN                                           (* looping mapload *)
        IF maploopcnt>=4 THEN textautosize(0, 0, 5, 10, "e", "get no map from downloader") END;
        IF maploopcnt<8 THEN INC(maploopcnt) END;
      END; 

      fd:=OpenWrite(MAPGETFN);
      IF FdValid(fd) THEN
        WrBin(fd, mapnamesbuf, lb);
        Close(fd);
        IF verb THEN WrStr("try:");WrInt(maploopcnt, 1); WrStrLn(" written gettiles:"); WrStr(mapnamesbuf) END;
        lastmapreq:=realtime;
        mapdelay:=0; 

        IF maploadstart+MAPLOADPROGSTARTDELAY<realtime THEN   (* delay for new start *)
--WrStrLn("cp");
          IF maploadpid.runs THEN CheckProg(maploadpid) END;
          IF NOT maploadpid.runs THEN                         (* start map load task *) 
--WrStrLn("ps");
            confstr(fGETMAPS, s);                                      (* maploader program name *)
            IF s[0]<>0C THEN
              confstr(fOSMDIR, h);
              IF h[0]<>0C THEN Append(s, ' -r "'); Append(s, h) ; Append(s, '"') END;  (* add -r rootdir *)
              StartProg(s, maploadpid);
              IF maploadpid.runs THEN 
                maploadstart:=realtime;
                say("Start Mapdownload", 3, "g");
              ELSE h:="can not start "; Append(h, s); xerrmsg(h); refresh:=TRUE END; 
            END;
          END;
        ELSIF maploadstart>realtime THEN maploadstart:=0 END;      (* if clock jumped back *)

      ELSE WrStrLn("cannot write "+MAPGETFN) END;
    ELSIF lastmapreq>realtime THEN lastmapreq:=realtime END;       (* systime gone backward *)
    mapnamesdone:=1;
  END;
END reqmap;


PROCEDURE loadmap(map:pIMAGE; tx,ty,zoom:INTEGER; fzoom, shftx, shfty:REAL;
                  VAR done, blown:BOOLEAN; blow, dryrun:BOOLEAN);
  PROCEDURE zoommap;
  VAR x, y, y0, rr, gg, bb, mul, mum, yi, yim:INTEGER;
      r:REAL;
      tr:CARDINAL;
  BEGIN
    y0:=VAL(INTEGER,HIGH(map^[0])+1)-VAL(INTEGER, FLOAT(HIGH(map^[0])+1)/fzoom);
    FOR x:=HIGH(map^) TO 0 BY -1 DO
      r:=FLOAT(x)/fzoom;
      tr:=trunc(r);
      mul:=VAL(INTEGER, 256.0*(r-FLOAT(tr)));
      mum:=256-mul;
      FOR y:=HIGH(map^[0]) TO y0 BY -1 DO
        WITH map^[tr+1][y] DO
          rr:=r*mul;
          gg:=g*mul;
          bb:=b*mul;
        END;
        WITH map^[tr][y] DO
          INC(rr, r*mum);
          INC(gg, g*mum);
          INC(bb, b*mum);
        END;
        WITH map^[x][y] DO r:=rr DIV 256; g:=gg DIV 256; b:=bb DIV 256 END;
      END;
    END;
    FOR y:=0 TO VAL(INTEGER,HIGH(map^[0])) DO
      r:=FLOAT(VAL(INTEGER,HIGH(map^[0]))-y)/fzoom;
--      yi:=VAL(INTEGER,HIGH(map^[0]))-VAL(INTEGER, r); 
--      tr:=TRUNC(r);
      tr:=trunc(r);
      yi:=HIGH(map^[0])-tr;
      mul:=VAL(INTEGER, 256.0*(r-FLOAT(tr)));
      mum:=256-mul;
      IF yi>0 THEN yim:=yi-1 ELSE yim:=0 END;
      FOR x:=0 TO VAL(INTEGER,HIGH(map^)) DO
        WITH map^[x][yim] DO
          rr:=r*mul;
          gg:=g*mul;
          bb:=b*mul;
        END;
        WITH map^[x][yi] DO
          INC(rr, r*mum);
          INC(gg, g*mum);
          INC(bb, b*mum);
        END;
        WITH map^[x][y] DO r:=rr DIV 256; g:=gg DIV 256; b:=bb DIV 256 END;
      END;
    END;
  END zoommap;


  PROCEDURE loadtile(h-, wfn-:ARRAY OF CHAR; dx,dy:INTEGER; doubx, douby:CARDINAL):BOOLEAN;
  VAR x,y, xx, yy, ix, iy:INTEGER;  

    PROCEDURE col(c:INTEGER):CARD16;
    BEGIN RETURN VAL(CARDINAL, lums.maplumcorr[c])*VAL(CARDINAL, lums.map) DIV 1024 END col;

  BEGIN
    IF dryrun THEN
      IF decodetile(h, NIL, 0, 0, 0) THEN RETURN TRUE ELSE done:=FALSE; RETURN FALSE END;
    END;
    IF map=NIL THEN RETURN FALSE END;

    IF verb THEN WrStr("open>");WrStr(h);WrStrLn("<") END;
    IF NOT decodetile(h, ADR(pngbuf), TILESIZE, TILESIZE, TILESIZE*3) OR reloadmap THEN  
      IF wfn<>"" THEN 
        IF configon(fGETMAPS) OR mappack.run OR reloadmap THEN reqmap(wfn, NOT reloadmap) END;
        done:=FALSE;
      END; 
      FOR y:=dy TO dy+TILESIZE-1 DO
        FOR x:=dx TO dx+TILESIZE-1 DO 
          IF (x>=0) & (x<VAL(INTEGER,HIGH(map^)+1)) & (y>=0) & (y<VAL(INTEGER,HIGH(map^[0])+1)) THEN
            WITH map^[x][y] DO r:=NOMAPR; g:=NOMAPG; b:=NOMAPB; END;
          END;
        END;
      END;
      RETURN FALSE;

    END;

    IF doubx>0 THEN                                       (* use half zoom tile and double size *) 
      IF douby=1 THEN yy:=0; y:=TILESIZE-1; iy:=-1 ELSE yy:=TILESIZE DIV 2; y:=0; iy:=1 END;
      REPEAT
        IF doubx=1 THEN xx:=0; x:=TILESIZE-1; ix:=-1 ELSE xx:=TILESIZE DIV 2; x:=0; ix:=1 END; 
        REPEAT 
          pngbuf[y]^[x]:=pngbuf[yy+y DIV 2]^[xx+x DIV 2];
          INC(x, ix);
        UNTIL (x<0) OR (x>TILESIZE-1);
        INC(y, iy);
      UNTIL (y<0) OR (y>TILESIZE-1);
    END;

    FOR y:=0 TO TILESIZE-1 DO
      yy:=TILESIZE-1-y+dy;
      FOR x:=0 TO TILESIZE-1 DO
        xx:=x+dx;
        IF (xx>=0) & (xx<VAL(INTEGER,HIGH(map^)+1)) & (yy>=0) & (yy<VAL(INTEGER,HIGH(map^[0])+1)) THEN
          WITH map^[xx][yy] DO
            r:=col(pngbuf[y]^[x].r8);
            g:=col(pngbuf[y]^[x].g8);
            b:=col(pngbuf[y]^[x].b8);
          END;
        END;
      END;
    END;
    RETURN TRUE
  END loadtile;

VAR x, y, maxtil, dx, dy, xh, yh:INTEGER;
    fnn, wfn:ARRAY[0..4095] OF CHAR;
    ok:BOOLEAN;
BEGIN
  done:=TRUE;
  blown:=FALSE;
--  FILL(map, 0C, SIZE(PIX)*xsize*ysize);

  maxtil:=trunc(expzoom(zoom))-1;
  yh:=VAL(INTEGER, FLOAT(HIGH(map^[0]))/fzoom+shfty) DIV TILESIZE;
  xh:=VAL(INTEGER, FLOAT(HIGH(map^))/fzoom+shftx) DIV TILESIZE;
--  IF ((tx+1>=maxtil) OR (ty+1>=maxtil)) & NOT dryrun THEN clr(map) END;
--  FOR y:=0 TO VAL(INTEGER, FLOAT(HIGH(map^[0]))/fzoom+shfty) DIV TILESIZE DO
--    FOR x:=0 TO VAL(INTEGER, FLOAT(HIGH(map^))/fzoom+shftx) DIV TILESIZE DO

  IF ((tx+xh>maxtil) OR (ty+yh>maxtil)) & NOT dryrun THEN clr(map) END;
  FOR y:=0 TO yh DO
    FOR x:=0 TO xh DO
      IF (tx+x<=maxtil) & (ty+y<=maxtil) THEN
        mapname(tx+x, ty+y, zoom, fnn, wfn);
        dx:=x*TILESIZE-VAL(INTEGER,shftx);
        dy:=VAL(INTEGER,HIGH(map^[0])+1)-TILESIZE-y*TILESIZE+VAL(INTEGER,shfty);
        IF NOT loadtile(fnn, wfn, dx, dy, 0, 0) & (zoom>4) & NOT dryrun & blow THEN
          mapname((tx+x) DIV 2, (ty+y) DIV 2, zoom-1, fnn, wfn);
          ok:=loadtile(fnn, "", dx, dy, (tx+x) MOD 2+1, (ty+y) MOD 2+1);
          IF ok THEN blown:=TRUE END;                       (* we have inserted a blown up tile *)
        END;
      END;
    END;
  END;
  IF NOT dryrun THEN
    IF fzoom>1.0 THEN zoommap END;
    IF mapnamesbuf[0]<>0C THEN 
      reqmap("", NOT reloadmap);                              (* flush buffer *)
    ELSE Erase(MAPGETFN, ok) END;                             (* forget whipe over requests *)
  END; 
  reloadmap:=FALSE;
END loadmap;


PROCEDURE IsMapLoaded():BOOLEAN;
BEGIN RETURN NOT maploadpid.runs OR NOT Exists(MAPGETFN) END IsMapLoaded;


PROCEDURE MapPackageJob(dryrun:BOOLEAN);

  PROCEDURE inc(VAR x, y, z:INTEGER):BOOLEAN;
  VAR tx0, tx1, ty0, ty1:INTEGER;

    PROCEDURE margin;
    VAR maxtil:INTEGER;
        px, py:REAL;
    BEGIN
      WITH mappack DO
        mercator(leftup.long, leftup.lat, z, tx0, ty0, px, py);
        mercator(rightdown.long, rightdown.lat, z, tx1, ty1, px, py);
        maxtil:=trunc(expzoom(z))-1;
        IF tx0>maxtil THEN tx0:=maxtil END;
        IF tx1>maxtil THEN tx1:=maxtil END;
        IF ty0>maxtil THEN ty0:=maxtil END;
        IF ty1>maxtil THEN ty1:=maxtil END;
      END;
    END margin;
    
  BEGIN
    IF z=0 THEN
      z:=1;
      margin;
      x:=tx0;
      y:=ty0;
    ELSE
      margin;
      INC(x);
      IF x>tx1 THEN
        x:=tx0;
        INC(y);
        IF y>ty1 THEN
          INC(z);
          IF z>mappack.tozoom THEN RETURN FALSE END;

          margin;
          x:=tx0;
          y:=ty0;
        END;
      END;
    END;
    RETURN TRUE
  END inc;

  PROCEDURE checktile(fn:ARRAY OF CHAR):BOOLEAN;
  BEGIN RETURN decodetile(fn, ADR(pngbuf), TILESIZE, TILESIZE, TILESIZE*3) END checktile;


CONST MAXREQ=10;
      MAXRETRYS=10;
VAR x, y, z   :INTEGER;
    fn, rfn   :ARRAY[0..4095] OF CHAR;
    s,s1      :ARRAY[0..99] OF CHAR;
    rcnt, mapc:CARDINAL;
    startt    :TIME;
    done      :BOOLEAN;  
BEGIN
  WITH mappack DO
    
    IF dryrun THEN

      mapc:=0;
      REPEAT INC(mapc) UNTIL NOT inc(tx, ty, zoom);
      zoom:=0;                                                   (* reinit counters *) 

      startt:=time();
      click.chkmaps:=TRUE;
      REPEAT
        IF zoom>0 THEN                                           (* zoom 0 is init *)
          mapname(tx, ty, zoom, fn, rfn);
          IF NOT decodetile(fn, NIL, 0, 0, 0) THEN 
            INC(needcnt);
--            IF needcnt>MAXLOOKUP THEN overflow:=TRUE END;      (* to long calculation time *)
          END;
          INC(mapscnt);
        END;
        done:=NOT inc(tx, ty, zoom);
        IF done OR (mapscnt MOD 16=15) THEN
          s:="Checked Maps:";
          IntToStr(mapscnt, 0, s1); Append(s, s1);
          Append(s, "  missing:");
          IntToStr(needcnt, 0, s1); Append(s, s1);
          progress(startt, s, 100*mapscnt DIV mapc, done);
        END;
      UNTIL done OR NOT click.chkmaps;
      IF NOT click.chkmaps THEN mappack.needcnt:=0 END;          (* aborted *)
      RETURN

    ELSIF NOT run THEN RETURN END;

    IF delay+1<retrys*retrys THEN INC(delay); RETURN END;        (* increasing delay *)

    delay:=0;

    IF IsMapLoaded() THEN                                        (* check what have *)
--WrStrLn("gettiles deleted");
      LOOP
        IF zoom>0 THEN                                           (* zoom 0 is init *)
          mapname(tx, ty, zoom, fn, rfn);
          IF NOT checktile(fn) THEN
            IF retrys<MAXRETRYS THEN EXIT END;

            INC(givups);
          END;
          INC(donecnt); 
          retrys:=0;
        END; 
        IF NOT inc(tx, ty, zoom) THEN 
          run:=FALSE;
          downloadprogress;                                      (* say end of job *)
          RETURN

        END;                                                     (* all done *)
      END;
      downloadprogress;
      rcnt:=0;
      x:=tx;
      y:=ty;
      z:=zoom;
      REPEAT
        mapname(x, y, z, fn, rfn);
        IF NOT checktile(fn) THEN
          reqmap(rfn, FALSE);
          INC(rcnt);
        END;
      UNTIL NOT inc(x, y, z) OR (rcnt>=MAXREQ);                  (* last map *)
      reqmap("", FALSE);                                         (* flush request buffer *) 
      IF retrys>0 THEN INC(retrysum) END;
      INC(retrys);
    END;
  END;

END MapPackageJob;


PROCEDURE StartMapPackage(lu, rd:POSITION; tillzoom:INTEGER; dryrun:BOOLEAN);
BEGIN
  
  FILL(ADR(mappack), 0C, SIZE(mappack));
  WITH mappack DO
    leftup:=lu;
    rightdown:=rd;
    tozoom:=tillzoom;
    run:=NOT dryrun;
  END;
  IF dryrun THEN MapPackageJob(TRUE) END;

END StartMapPackage;


PROCEDURE sinc(x:REAL; w:CARDINAL):REAL;          (* sin(x)/x with windown *)
CONST PI=3.1415926535;
VAR r,c:REAL; 
BEGIN
  IF ABS(x)<0.001 THEN RETURN 1.0 END;
  c:=x/FLOAT(w);
--  IF c>0.5 THEN c:=0.5 ELSIF c<-0.5 THEN c:=-0.5 END;
  r:=x*PI;
--  RETURN sin(r)/r*(0.54+0.46*cos(PI*c));                              (* hamming *)
  RETURN sin(r)/r*(0.42-0.5*cos(PI*2*(c+0.5))+0.08*cos(PI*4*(c+0.5)));  (* blackmann *)

END sinc;

PROCEDURE sinc1(x:REAL; w:CARDINAL):REAL;          (* sin(x)/x with windown *)
CONST PI=3.1415926535;
VAR r,c:REAL;
BEGIN
  IF ABS(x)<0.001 THEN RETURN 1.0 END;
  c:=x/FLOAT(w);
  IF c>0.5 THEN c:=0.5 ELSIF c<-0.5 THEN c:=-0.5 END;
  r:=x*PI;
  RETURN sin(r)/r*(0.54+0.46*cos(PI*c));                              (* hamming *)
--  RETURN sin(r)/r*(0.42-0.5*cos(PI*2*(c+0.5))+0.08*cos(PI*4*(c+0.5)));  (* blackmann *)

END sinc1;


PROCEDURE loadsym(defy:INTEGER; VAR msg:ARRAY OF CHAR);
CONST
      ALPHAWHITE=230;                                      (* brihgtness tolerance of alpha value*)
      FIRLEN=9;
      FINESTEPS=32;                                        (* fir interpolation steps *)
      COLOURS=4;                                           (* with alpha channel *)
      MAXINSIZE=48;                                        (* max input symbol size *)
      BYTESPERPIX=4;

TYPE ROWS=ARRAY[0..MAXINSIZE*SYMN-1] OF PIX8A;
     pROWS=POINTER TO ROWS;
     
VAR x, y, sym, insize, outsize, col, fi, tr, firlen, alphax:CARDINAL;
    rows:ARRAY[0..MAXINSIZE-1] OF pROWS;
    maxx, maxy, maxxbyte, res:INTEGER;
    bu:POINTER TO ARRAY[0..MAXINSIZE-1] OF ARRAY[0..MAXINSIZE*SYMN*BYTESPERPIX-1] OF CHAR;
    fn,fnn:ARRAY[0..1023] OF CHAR;
    
    sum, mag, mr, r, fr:REAL;
    c:CARD8;
    fir:ARRAY[0..COLOURS-1] OF ARRAY[0..MAXINSIZE+FIRLEN*2-1] OF REAL;
    sa:ARRAY[0..COLOURS-1] OF ARRAY[0..MAXINSIZE+FIRLEN*2-1] OF ARRAY[0..MAXSYMSIZE-1] OF REAL;
    firtab:ARRAY[0..FIRLEN*2*FINESTEPS-1] OF REAL;
BEGIN
  lums.symsize:=16;
  FILL(ADR(symbols), 0C, SIZE(symbols));
  ALLOCATE(bu, SIZE(bu^));
  IF bu=NIL THEN WrStrLn("symbols load out of memory"); RETURN END;

  FOR y:=0 TO HIGH(rows) DO rows[y]:=ADR(bu^[y][0]) END;

  defy:=defy*VAL(INTEGER, lums.fontsymbolpercent) DIV 100;
  IF defy>MAXSYMSIZE THEN defy:=MAXSYMSIZE END;
  IF defy<MINSYMSIZE THEN defy:=MINSYMSIZE END;

  fi:=defy;
  REPEAT
    fn:=SYMFN;
    IF fi>1 THEN
      IntToStr(fi, 0, fnn); Append(fn, fnn);
      fi:=1;
    ELSE fi:=0 END;
    Append(fn, SYMEXT);
    maxx:=MAXINSIZE*SYMN;
    maxy:=MAXINSIZE;    
    maxxbyte:=maxx*BYTESPERPIX;                (* maxxbyte = maxx*4: switch on alpha channel *)
    WrStr("try symbols file:"); WrStrLn(fn);
    res:=pngread.readpng(fn, rows, maxx, maxy, maxxbyte);
  UNTIL (res>=0) OR (fi=0);


  IF res>=0 THEN
    insize:=(maxx+1) DIV SYMN;
    IF insize<=MAXINSIZE THEN
      outsize:=defy;

      alphax:=0;
      c:=rows[0]^[0].alpha;
      FOR y:=0 TO VAL(CARDINAL, maxy-1) DO                   (* test if there is any alpha channel info *) 
        FOR x:=0 TO VAL(CARDINAL, maxx-1) DO
          IF c<>rows[y]^[x].alpha THEN INC(alphax) END;
          c:=rows[y]^[x].alpha;
        END;
      END;
      IF (rows[0]^[0].alpha>0) & (rows[0]^[0].g8>128) THEN alphax:=0 END;  (* use white as transparent *)

      mag:=FLOAT(outsize)/FLOAT(insize);
      mr:=mag;
      firlen:=FIRLEN;
      IF mr>1.0 THEN mr:=1.0; firlen:=2 END;

      FOR x:=0 TO HIGH(firtab) DO                            (* generate fir table *)
        firtab[x]:=mr*sinc((VAL(REAL,VAL(INTEGER,x)-VAL(INTEGER,firlen*FINESTEPS))*(1.0/FINESTEPS)), firlen*2);
      END;

      FILL(ADR(fir), 0, SIZE(fir));
      FOR sym:=0 TO SYMN-1 DO
        
        FILL(ADR(sa), 0, SIZE(sa));
        FOR y:=0 TO insize-1 DO
          FOR x:=0 TO insize-1 DO
            WITH rows[y]^[x+sym*insize] DO
              fir[0][x+firlen]:=FLOAT(r8); 
              fir[1][x+firlen]:=FLOAT(g8);
              fir[2][x+firlen]:=FLOAT(b8);

              c:=alpha;
              IF alphax=0 THEN                               (* use white as alpha *)
                c:=0;
                IF (r8<ALPHAWHITE) OR (g8<ALPHAWHITE) OR (b8<ALPHAWHITE) THEN c:=255 END; 
              END;
              fir[3][x+firlen]:=FLOAT(c);
            END;
          END;
          FOR x:=0 TO outsize-1 DO
            r:=FLOAT(x)/mag;
            tr:=trunc(r);
            fr:=(r-FLOAT(tr))*FINESTEPS;
            FOR col:=0 TO COLOURS-1 DO
              IF outsize<>insize THEN
                sum:=0.0;
                FOR fi:=0 TO firlen*2-1  DO 
                  sum:=sum + firtab[trunc(FLOAT(firlen)*FINESTEPS+VAL(REAL,VAL(INTEGER,fi)
                                      -VAL(INTEGER,firlen))*FINESTEPS*mr-fr)] * fir[col][fi+tr];
                END;
              ELSE sum:=fir[col][firlen+x] END;
              sa[col][y+firlen][x]:=sum;
            END;
          END;
        END;
        FOR x:=0 TO outsize-1 DO
          FOR y:=0 TO outsize-1 DO
            r:=FLOAT(y)/mag;
            tr:=trunc(r);
            fr:=(r-FLOAT(tr))*FINESTEPS; 
            FOR col:=0 TO COLOURS-1 DO
              IF outsize<>insize THEN
                sum:=0.0;
                FOR fi:=0 TO firlen*2-1 DO 
                  sum:=sum + firtab[trunc(FLOAT(firlen)*FINESTEPS+VAL(REAL,VAL(INTEGER,fi)
                                      -VAL(INTEGER,firlen))*FINESTEPS*mr-fr)] * sa[col][fi+tr][x];
                END;
              ELSE sum:=sa[col][firlen+y][x] END;
              IF sum<=0.0 THEN c:=0 ELSIF sum>=255.9 THEN c:=255 ELSE c:=trunc(sum) END;
              WITH symbols[x+sym*outsize][outsize-1-y] DO
                IF col=0 THEN r8:=c ELSIF col=1 THEN g8:=c
                ELSIF col=2 THEN b8:=c ELSE alpha:=c END;
              END; 
            END;
          END;
        END;
      END; 

      lums.symsize:=outsize;
      Append(msg, " ["); Append(msg, fn); Append(msg, "]");
    ELSE
      WrStr(fn); WrStrLn(" symbols too big error "); WrInt(lums.symsize, 1); WrStrLn("");
      lums.symsize:=16;
    END;
  ELSE
    WrStr(fn); WrStrLn(" file read error "); WrInt(res, 1); WrStrLn("");
    Append(msg, " Symbolfile read Error");
  END;

  DEALLOCATE(bu, SIZE(bu^));
END loadsym;


PROCEDURE loadfont;
CONST MAXY=32;                            (* font image max y size *)
      MAXX=(CHARS+2)*MAXFONTX;            (* font image max x size *)  
      GARBAGE=1000;                       (* sum of pixels outside y font image *)     
      FIRLEN=3;
      FINESTEPS=64;                       (* fir interpolation steps *)

TYPE ROWS=ARRAY[0..MAXX-1] OF CHAR;
     pROWS=POINTER TO ROWS;

VAR c, x, y, xshift, y0, y1, i, higth, width, charx, minwidth:CARDINAL;
    m:SET16;
    maxx, maxy, maxxbyte, res, wi, wj:INTEGER; 
    rows:ARRAY[0..MAXY-1] OF pROWS; 
    bu:ARRAY[0..MAXY-1] OF ARRAY [0..MAXX-1] OF CHAR;
    xhist:ARRAY[0..MAXFONTX-1] OF CARDINAL;
    yhist:ARRAY[0..MAXY-1] OF CARDINAL;
    fir:ARRAY[0..MAXY+FIRLEN*2] OF REAL;
    sum, yr, ym, yt:REAL;
    nin, ytt:CARDINAL;
    fn, fnn:ARRAY[0..1024] OF CHAR;
    firtab:ARRAY[0..FIRLEN*2*FINESTEPS-1] OF REAL;

BEGIN
  fontloadmsg:="";
  higth:=conf2int(fFONTSIZE, 0, MINFONTY, MAXFONTY, DEFAULTFONTY);
  width:=conf2int(fFONTSIZE, 1, 0, MAXFONTX, 0);
  IF width=0 THEN conf2str(fFONTSIZE, 0, 1, TRUE, fn) ELSE fn:="" END;
  lums.fontsymbolpercent:=conf2int(fFONTSIZE, 2, 50, 200, 140);
  FILL(ADR(font), 0C, SIZE(font));
  lums.fontysize:=higth+3;
  lums.fontxsize:=MINFONTX;

  FOR y:=0 TO HIGH(rows) DO rows[y]:=ADR(bu[y][0]) END;

(*
  i:=width;
  LOOP
    IF fn[0]<>0C THEN
      res:=rdfont();
      IF res>=0 THEN EXIT END;           (* full filename in config *)

    END;
    fn:=FONTFN;
    IF i>0 THEN IntToStr(i, 0, fnn); Append(fn, fnn); END;  (* width defined *)
    Append(fn, FONTEXT);
    res:=rdfont();
    IF (res>=0) OR (i=0) THEN EXIT END;

    fn:="";
    i:=0;
  END;
*)

  IF fn[0]<>0C THEN wj:=0 ELSE wj:=-1 END;
  wi:=width; 
  LOOP
    IF wj<>0 THEN                                                      (* filename not defined *) 
      fn:=FONTFN;
      IF wi>=MINFONTX THEN IntToStr(wi, 0, fnn); Append(fn, fnn); END; (* width defined *)
      Append(fn, FONTEXT);
    END;

    WrStr("try fontfile:"); WrStrLn(fn);
    maxx:=MAXX;
    maxy:=MAXY;
    maxxbyte:=maxx;
    res:=pngread.readpng(fn, rows, maxx, maxy, maxxbyte);
    IF res>=0 THEN EXIT END;
 
    IF wj=0 THEN wj:=-1 END;                                           (* search down first *)  
    IF wi<MINFONTX-1 THEN
      wj:=1;
      wi:=width+1;
      IF wi<MINFONTX-1 THEN wi:=MINFONTX-1 END;                        (* search up *)
    ELSE wi:=wi+wj END;
    IF wi>MAXFONTX THEN EXIT END;                                      (* giving up - no font *) 

  END;
  IF res<0 THEN 
    WrInt(res, 1);
    WrStrLn(" fontfile read error ");
--    WrStrLn(fn);
    RETURN

  END;

  IF (maxx<CHARS*MINFONTX) OR (maxx>MAXX) THEN
    WrInt(maxx, 1);
    WrStr(" x-size fontfile error");
    WrStrLn(fn);
    RETURN

  END;

  IF (maxy<1) OR (maxy>MAXY) THEN
    WrInt(maxy, 1);
    WrStr(" y-size fontfile error");
    WrStrLn(fn);
    RETURN

  END;

  charx:=(maxx+1) DIV CHARS;                         (* guess char width in font file *)
  IF width<=charx THEN lums.fontxsize:=charx;            (* x defined manual *)
  ELSIF width>=MINFONTX THEN lums.fontxsize:=width ELSE lums.fontxsize:=MINFONTX END;

  FOR x:=0 TO charx-1 DO xhist[x]:=0 END;
  FOR y:=0 TO MAXY-1 DO yhist[y]:=0 END;
  FOR x:=0 TO VAL(CARDINAL, maxx-1) DO     (* make column histogram to find char position in font file *)
    FOR y:=0 TO VAL(CARDINAL, maxy-1) DO 
      INC(xhist[x MOD charx], ORD(rows[y]^[x]));
      INC(yhist[y], ORD(rows[y]^[x]));
    END;
  END;

  c:=MAX(CARDINAL);
  FOR x:=0 TO charx-1 DO 
    IF xhist[x]<c THEN c:=xhist[x]; xshift:=x END;          (* find space between chars *)
  END;
  
  y0:=0;
  y1:=0;
  FOR y:=0 TO MAXY-1 DO                                     (* find y position and size *)
    IF yhist[y]>GARBAGE THEN
      IF y0=0 THEN y0:=y END;
      y1:=y;
    END;
  END;
  IF y1<y0+4 THEN WrStrLn(" font too small error"); RETURN END;
  nin:=y1-y0+1;


  ym:=FLOAT(higth)/FLOAT(nin);
  yr:=ym;
  IF yr>1.0 THEN yr:=1.0 END;
  FOR x:=0 TO HIGH(firtab) DO                                        (* generate fir table *)
    firtab[x]:=sinc1((VAL(REAL,VAL(INTEGER,x)-FIRLEN*FINESTEPS)*(1.0/FINESTEPS)), FIRLEN);
  END;


  FOR y:=0 TO HIGH(fir) DO fir[y]:=0.0 END;
  FOR x:=0 TO CHARS*charx-1 DO
    FOR y:=0 TO nin-1 DO fir[y+FIRLEN]:=FLOAT(ORD(rows[y0+y]^[x+xshift])) END;

    FOR y:=0 TO higth-1 DO
      IF higth<>nin THEN

        sum:=0.0;
        yt:=FLOAT(y)/ym;
        ytt:=TRUNC(yt);
        FOR i:=0 TO FIRLEN*2-1 DO
          sum:=sum + yr*firtab[trunc(FIRLEN*FINESTEPS+VAL(REAL,VAL(INTEGER,i)-FIRLEN)*FINESTEPS*yr
                               -FINESTEPS*(yt-FLOAT(ytt)))]
                               *fir[i+ytt];
        END;
      ELSE sum:=fir[y+FIRLEN] END;
      IF sum<=0.0 THEN c:=0 ELSIF sum>255.9 THEN c:=255 ELSE c:=trunc(sum) END;
      font[x DIV charx].char[higth-y][x MOD charx]:=c;
    END;
  END;

  lums.fontysize:=higth+3;

  FOR c:=0 TO HIGH(font) DO                         (* build contrast mask *)
    WITH font[c] DO
      width:=lums.fontxsize DIV 2;
      FOR y:=0 TO higth DO
        FOR x:=0 TO lums.fontxsize+1 DO
          IF char[y][x]>=90 THEN   (* 128 *)
            IF c<>0 THEN
              m:=SHIFT(SET16{0..lums.fontxsize-2}, VAL(INTEGER,x)-1)*SET16{1..lums.fontxsize+1};
              mask[y]:=mask[y]+m;
              IF y+1<=HIGH(mask) THEN mask[y+1]:=mask[y+1]+m END;
              IF y+2<=HIGH(mask) THEN mask[y+2]:=mask[y+2]+m END;
            END;
            IF x>width THEN width:=x END;
          END;
        END;
      END;
    END;
  END; 

  fontloadmsg:="[";
  Append(fontloadmsg, fn);
  Append(fontloadmsg, "] ");
  IntToStr(lums.fontysize-3, 0, fnn); Append(fontloadmsg, fnn); Append(fontloadmsg, "x"); 
  IntToStr(lums.fontxsize, 0, fnn); Append(fontloadmsg, fnn); Append(fontloadmsg, " Font Loaded");

  loadsym(lums.fontysize, fontloadmsg);
  
END loadfont;

PROCEDURE saveppm(fn:ARRAY OF CHAR; image:pIMAGE; xsize, ysize:INTEGER; tmp:BOOLEAN):INTEGER;

CONST BMPHLEN=54;

VAR fd:File;
    h:ARRAY[0..255] OF CHAR; 
    x, y:INTEGER;
    b:ARRAY[0..32767] OF CHAR;
    len:CARDINAL;
    pngimg:pngwrite.PNGPIXMAP;
    ret:INTEGER;
    ofn:ARRAY[0..4095] OF CHAR;

  PROCEDURE numh(n, pos, size:CARDINAL);
  VAR i:CARDINAL;
  BEGIN
    FOR i:=0 TO size-1 DO
      h[pos+i]:=CHR(n MOD 256);
      n:=n DIV 256;
    END;
  END numh;   

  PROCEDURE wr(c:CARD16);
  BEGIN
    IF c<=HIGH(gammatab) THEN b[len]:=gammatab[c] ELSE b[len]:=377C END;
    INC(len);
    IF len>HIGH(b) THEN WrBin(fd, b, len); len:=0 END;
  END wr; 

  PROCEDURE pngc(c:CARD16):CARD8;
  BEGIN IF c<=HIGH(gammatab) THEN RETURN ORD(gammatab[c]) ELSE RETURN 255 END END pngc;

BEGIN
  cleanfilename(fn);
  Assign(ofn, fn);
  IF tmp THEN Append(fn, "~") END;
  fd:=OpenWrite(fn);
  IF NOT FdValid(fd) THEN
--    WrStr(fn); WrStrLn(" not writeable");
    RETURN -1
  END;

  len:=Length(ofn);                                               (* check fn if ppm or bmp *)
  IF (len>=4) & (ofn[len-4]=".") & (CAP(ofn[len-3])="B") 
  & (CAP(ofn[len-2])="M") & (CAP(ofn[len-1])="P") THEN             (* make BMP *) 
    FILL(ADR(h), 0C, SIZE(h));
    h[0]:="B";
    h[1]:="M";
    numh(((xsize*3+4) DIV 4*4)*ysize+BMPHLEN, 2, 4);             (* file len pad lines to x4 byte *)
    numh(54, 10, 4);                                             (* headerlen *)
    numh(40, 14, 4);                                             (* DWORD   biSize *)
    numh(xsize, 18, 4);                                          (* LONG    biWidth *)
    numh(ysize, 22, 4);                                          (* LONG    biHeight *)
    numh(1, 26, 2);                                              (* WORD    biPlanes *)
    numh(24, 28, 2);                                             (* WORD    biBitCount *)
    numh(0, 30, 4);                                              (* DWORD   biCompression *)
    WrBin(fd, h, BMPHLEN); 
    len:=0;
    FOR y:=0 TO ysize-1 DO
      FOR x:=0 TO xsize-1 DO
        WITH image^[x][y] DO wr(b); wr(g); wr(r) END;
      END;
      WHILE len MOD 4<>0 DO wr(0) END;                           (* pad to modulo 4 *)
    END;
    IF len>0 THEN WrBin(fd, b, len) END;
    Close(fd);
    ret:=0;

  ELSIF (len>=4) & (ofn[len-4]=".") & (CAP(ofn[len-3])="P")
  & (CAP(ofn[len-2])="N") & (CAP(ofn[len-1])="G") THEN             (* make PNG *)

    ret:=-1;
    Close(fd);
    ALLOCATE(pngimg.image, xsize*ysize*3);
    IF pngimg.image<>NIL THEN
      FOR y:=0 TO ysize-1 DO
        FOR x:=0 TO xsize-1 DO
          WITH image^[x][ysize-1-y] DO
            WITH pngimg.image^[x+y*xsize] DO red:=pngc(r); green:=pngc(g); blue:=pngc(b) END;
          END;
        END;
      END;
      pngimg.width:=xsize;
      pngimg.height:=ysize;
      ret:=pngwrite.writepng(fn, pngimg);
      DEALLOCATE(pngimg.image, xsize*ysize*3);
    ELSE WrStrLn("png write out of memory") END;

  ELSE                                                           (* ppm header *)
    h:="P6"+LF; WrBin(fd, h, Length(h));
    IntToStr(xsize, 1, h); WrBin(fd, h, Length(h));
    h:=" "; WrBin(fd, h, Length(h));
    IntToStr(ysize, 1, h); WrBin(fd, h, Length(h));
    h:=LF+"255"+LF; WrBin(fd, h, Length(h));
    len:=0;
    FOR y:=ysize-1 TO 0 BY -1 DO
      FOR x:=0 TO xsize-1 DO
        WITH image^[x][y] DO wr(r); wr(g); wr(b) END;
      END;
    END;
    IF len>0 THEN WrBin(fd, b, len) END;
    Close(fd);
    ret:=0;
  END;

  IF tmp THEN Rename(fn, ofn) END;
  RETURN ret
END saveppm;


PROCEDURE allocpngbuf;
VAR i:CARDINAL; 
BEGIN
  FOR i:=0 TO HIGH(pngbuf) DO 
    NEW(pngbuf[i]); debugmem.req:=SIZE(pngbuf[0]); INC(debugmem.screens, debugmem.req);
    IF pngbuf[i]=NIL THEN WrStrLn("pngbuf out of memory"); wrheap; HALT END;
  END;
END allocpngbuf;


PROCEDURE rdmountains(fn:ARRAY OF CHAR; add:BOOLEAN; idx:CARDINAL; VAR cnt:CARDINAL); (* import csv file with mountain name, pos, altitude *)
VAR p,len,r, sl, si, line:INTEGER;
    fd:File;
    pm:pMOUNTAIN;
    pos:POSITION;
    alt:REAL;
    b:ARRAY[0..4095] OF CHAR;
    s:ARRAY[0..1023] OF CHAR;
    text:ARRAY[0..POIINFOSIZE] OF CHAR;
    com, lat, long, name:ARRAY[0..99] OF CHAR;
    done, errs:BOOLEAN;

  PROCEDURE getch():CHAR;
  BEGIN
    IF p>=len THEN
      len:=RdBin(fd, b, SIZE(b));
      IF len<=0 THEN RETURN 0C END;

      p:=0; 
    END;
    INC(p);
    RETURN b[p-1]
  END getch;

  PROCEDURE getword(VAR s:ARRAY OF CHAR):INTEGER;
  VAR i:CARDINAL;
      inqu:BOOLEAN;
  BEGIN
    i:=0;
    inqu:=FALSE;
    LOOP
      s[i]:=getch();
      IF s[i]=0C THEN RETURN -1 END;

      IF s[i]=LF THEN s[i]:=0C; RETURN 0 END;

      IF NOT inqu & (s[i]=",") THEN s[i]:=0C; RETURN 1 END;

      IF s[i]='"' THEN inqu:=NOT inqu
      ELSIF (i<HIGH(s)) & (s[i]>=" ") & (s[i]<200C)THEN INC(i) END;
    END;
  END getword; 


BEGIN
  cnt:=0;
  IF NOT add THEN                                          (* delete data *)
    WHILE mountains<>NIL DO
      pm:=mountains;
      IF pm^.pinfo<>NIL THEN 
        sl:=Length(pm^.pinfo^) + 1;
        DEALLOCATE(pm^.pinfo, sl);
        DEC(debugmem.poi, sl);
      END; 
      mountains:=pm^.next;
      DEALLOCATE(pm, SIZE(pm^));
      DEC(debugmem.poi, SIZE(pm^));
    END; 
  END;

  fd:=OpenRead(fn);
  IF NOT FdValid(fd) THEN RETURN END;

  errs:=FALSE;
  line:=1;
  p:=0;
  len:=0;
  LOOP   
    done:=FALSE;       
    r:=getword(com);
    IF r>0 THEN
      r:=getword(name);
      IF r>0 THEN
        r:=getword(text);
        IF r>0 THEN
          r:=getword(lat);
          IF r>0 THEN
            r:=getword(long);
            IF r>=0 THEN done:=TRUE END; 
            IF r>0 THEN
              r:=getword(s);
              IF (r<0) OR NOT StrToFix(alt, s) THEN alt:=0.0 END;  
              WHILE r>0 DO r:=getword(s) END;
            ELSE alt:=0.0 END;
          END;
        END;
      END;
    END;
    IF r<0 THEN EXIT END;

    IF com[0]<>"#" THEN
      IF done & (name[0]<>0C) & StrToFix(pos.lat, lat)
      & StrToFix(pos.long, long) & posvalid(pos) THEN
        ALLOCATE(pm, SIZE(pm^));
        IF pm=NIL THEN EXIT END;

        INC(debugmem.poi, SIZE(pm^));
        Assign(pm^.name, name);
        Assign(pm^.category, com);
        pm^.pos.lat:= pos.lat * RAD;
        pm^.pos.long:=pos.long* RAD;
        IF (alt<-1000.0) OR (alt>9999.0) THEN alt:=0.0 END;
        sl:=Length(text);
        IF sl>0 THEN
          IF sl>=HIGH(text) THEN sl:=HIGH(text) END;
          text[sl]:=0C;
          INC(sl);
          ALLOCATE(pm^.pinfo, sl);
          IF pm^.pinfo=NIL THEN EXIT END;

          INC(debugmem.poi, sl);
          MOVE(ADR(text), pm^.pinfo, sl);
          FOR si:=0 TO sl-1 DO
            IF pm^.pinfo^[si]="," THEN pm^.pinfo^[si]:=LF END;
          END;
        ELSE pm^.pinfo:=NIL END;
        pm^.alt:=trunc(alt);
        pm^.next:=mountains;
        pm^.index:=idx;
        mountains:=pm;
        INC(cnt);
      ELSE
        IF NOT errs THEN
          WrStr("POI File lines incomplete <"); WrStr(fn); WrStr("> ");
          errs:=TRUE;
        END;
        WrInt(line,1); WrStr(" ");
      END;
    END;
    INC(line); 
  END;
  IF errs THEN WrStrLn("") END;
  Close(fd);
END rdmountains;


PROCEDURE getpoisym(VAR sym:ARRAY OF CHAR; name-:ARRAY OF CHAR);
VAR i,j:CARDINAL;
    s, sy:ARRAY[0..999] OF CHAR;
BEGIN
  i:=0;
  LOOP
    confstrings(fPOISMBOLS, i, TRUE, s);
    IF s[0]=0C THEN EXIT END;

    sy:=s;
    Delstr(s, 0, 2);
    IF StrCmp(s, name) THEN
      sym[0]:=sy[0]; sym[1]:=sy[1];
      EXIT

    END; 
    INC(i);
  END;
END getpoisym;


PROCEDURE strgt(a-, b-:ARRAY OF CHAR):BOOLEAN;
VAR i:CARDINAL;
BEGIN
  i:=0;
  REPEAT
    IF a[i]>b[i] THEN RETURN FALSE END;
    IF a[i]<b[i] THEN RETURN TRUE END;

    INC(i);
  UNTIL (i>HIGH(a)) OR (i>HIGH(b)) OR (a[i]=0C) OR (b[i]=0C);
  RETURN FALSE
END strgt;


PROCEDURE readpoifiles;
TYPE DIRENT=RECORD
              fullname:ARRAY[0..4095] OF CHAR;
              name:ARRAY[0..255] OF CHAR;
            END;

VAR pdir :DIRCONTEXT;
    fn, path:ARRAY[0..4095] OF CHAR;
    add, done:BOOLEAN;
    filenum, dn, cnt, di:CARDINAL;
    i:INTEGER;
    pl:DIRENT;
    fullnames:ARRAY[0..MAXPOIFILES] OF DIRENT;
BEGIN
  FILL(ADR(poifiles), 0C, SIZE(poifiles));
  confstr(fOSMDIR, path);
  Append(path, DIRSEP+"poi");

  IF OpenDir(path, pdir)>=0 THEN

    Append(path, DIRSEP);

    dn:=0;
    LOOP
      ReadDirLine(fn, pdir);
      IF (fn[0]=0C) OR (dn>HIGH(fullnames)) THEN EXIT END;

      IF fn[0]<>"." THEN                                         (* not "." ".." files *)
        Assign(fullnames[dn].fullname, path); Append(fullnames[dn].fullname, fn);
        i:=InStr(fn, ".");
        IF i>=0 THEN fn[i]:=0C END;                              (* name without extention *)
        Assign(fullnames[dn].name, fn);
        INC(dn);
      END;
    END;
    CloseDir(pdir);

--sort poi file on name
    REPEAT       (* bubble sort *)
      i:=1;
      done:=TRUE;
      WHILE i<VAL(INTEGER, dn) DO
        IF strgt(fullnames[i-1].name, fullnames[i].name) THEN
          pl:=fullnames[i-1];
          fullnames[i-1]:=fullnames[i];
          fullnames[i]:=pl;
          done:=FALSE;
        END;
        INC(i);
      END;
    UNTIL done;

    filenum:=0;
    add:=FALSE; 
    FOR i:=0 TO VAL(INTEGER, dn)-1 DO
--WrStrLn(fullnames[i].fullname);
      rdmountains(fullnames[i].fullname, add, filenum, cnt);
      IF cnt>0 THEN                                            (* only files with content *)
        add:=TRUE;
        poifiles[filenum].count:=cnt; 
        Assign(poifiles[filenum].name, fullnames[i].name);
        poifiles[filenum].symbol:=DEFAULTPOISYMBOL;            (* default poi symbol *)        
        getpoisym(poifiles[filenum].symbol, poifiles[filenum].name); 
        INC(filenum);
      END;
    END;
  END;

END readpoifiles; 


BEGIN
  maploadpid.runs:=FALSE;
  maploadstart:=0;
--  loadfont;
  makegammatab;
  allocpngbuf;  
  mapnamesbuf[0]:=0C;
  mapnamesdone:=0;
  maploopcnt:=0;
  lastmapreq:=0;
  mapdelay:=0;
  lastpoinum:=0;
--  ALLOCATE(srtmmiss, 1);                        (* make empty tile for fast nofile hint *)
--  initsrtm;
  srtmdir:="";
END maptool.