<*+M2EXTENSIONS *>
<*+STORAGE *>
<*-GENFRAME*>
<*-PROCINLINE*>
<*+DOREORDER*>
<*+NOPTRALIAS*>
<*+GENCDIV*>
<*CPU="PENTIUM"*>
<*NEW DEBUG*>
<*-DEBUG*>

IMPLEMENTATION MODULE xosi; (* graphical os interface linux/win32 *)

<* IF TARGET_FAMILY="UNIX" THEN *>

IMPORT keysym;
--FROM InOut IMPORT WriteLn, WriteString;
--FROM fcntl IMPORT creat, open;
--FROM IOChan IMPORT ChanId;
--FROM RealIO IMPORT WriteFixed;

FROM unistd IMPORT fork, execv, argv_t, close;
FROM signal IMPORT kill, SIGTERM;
FROM wait IMPORT waitpid, WNOHANG;
FROM beep IMPORT cbell;

FROM SYSTEM IMPORT ADR, CAST, CARD8, CARD16, INT16, SHIFT, ADDRESS, ADDADR, BYTE, WORD, FILL;

FROM X IMPORT Window, ExposureMask, ButtonPressMask, KeyPressMask,
  ButtonPress, KeyPress, Expose, KeySym, ZPixmap, None, PointerMotionMask,
  Button1, Button2, Button3, Button4, Button5, MotionNotify, SelectionClear, ClientMessage,
  KeyRelease, KeyReleaseMask, Pixmap, Cursor, Button1Mask, Button2Mask,
  ButtonReleaseMask, ButtonRelease, StructureNotifyMask, ConfigureNotify, PropModeReplace,
  KBBellPitch, KBBellDuration, Atom, CurrentTime, SelectionNotify, SelectionRequest;

IMPORT Xutil, Xlib, cursorfont;
FROM Select IMPORT selectrwt, fdclr, fdsetr, fdsetw, issetr, issetw;

FROM aprsdecode IMPORT udpsocks, tcpsocks, udpin, tcpin, tcpout, tcpclose, 
                       pTCPSOCK, rxidle, lastlooped, IGATEMAXDELAY, quit,
                       lums, initzoom, finezoom, WITHX11;

FROM aprsstr IMPORT IntToStr, Append, Length, FixToStr;
FROM useri IMPORT keychar, mouseleftdown, mouserightdown, mousemiddle, resizewin,
                  refreshwin, mousemove, timerevent, CMDFZOOMOUT, CMDFZOOMIN,
                  mouserelease, debugmem, wrheap, clrcpmarks,
                  CURSDOWN,CURSLEFT,CURSUP,CURSRIGHT,CURSDEL,CURSBS,
                  CURSPAGEUP,CURSPAGEDOWN,CURSHOME,CURSEND,CURSINS;

FROM osi IMPORT WrStr, WrLn, WrStrLn, WrInt, ln, exp, DIRSEP, time, ALLOCATE, DEALLOCATE;

IMPORT pastewrapper;

CONST XAATOM=4;
      XASTRING=31;

TYPE
     XPIX16=CARD16;
     XPIX32=CARDINAL;
     SET8=SET OF [0..7];
     SET16=SET OF [0..15];

     XWIN=RECORD
       myhint : Xutil.XSizeHints;
       win    : Window; (* My window *)
       pvis   : Xlib.PtrVisual;
       ximage0: Xlib.PtrXImage;
       redmask, greenmask, bluemask:BITSET;
       redshift, greenshift, blueshift:INTEGER;
       Black, White,
       bitperpixel:CARDINAL;
       gc     : Xlib.GC;
       pixmap : Pixmap;
       screen : INTEGER; (* Default screen number *)
       screenp: Xlib.PtrScreen;
       fontinfo:Xlib.XFontStruct;
       xsizen, ysizen:CARDINAL;
     END;

VAR
    xbuf016:POINTER TO ARRAY OF XPIX16;

    xbuf0size:INTEGER; 
    xbufxsize, xbufysize:CARDINAL;

    mainwin: XWIN;
    dis    : Xlib.PtrDisplay; (* Connection to the X server *)
    disfd  : INTEGER;
    event  : Xlib.XEvent;
    mykey  : KeySym;
    mystat : Xutil.XComposeStatus;

    timesum: CARDINAL;
    cursor : Cursor; 
    cursorset:BOOLEAN;
    selection,
    selectionb,
    targetsatom,
    textatom,
    UTF8,
    wclose :Atom;

PROCEDURE Gamma(c:CARDINAL; g:REAL):CARDINAL;
BEGIN
  IF c=0 THEN RETURN 0 END; 
  IF c<1024 THEN RETURN TRUNC(exp(ln(FLOAT(c)/1024.0)/g)*255.5) END;
  RETURN 255

<* IF NOT __GEN_C__ THEN *>

EXCEPT
  WrStrLn("error in Gamma TRUNC() ");
  RETURN 0
<* END *>
END Gamma;

PROCEDURE Gammatab(g:REAL);
VAR i,ga:CARDINAL;
BEGIN
  WITH mainwin DO
    FOR i:=0 TO HIGH(gammalut) DO 
      ga:=Gamma(i, g);
      WITH gammalut[i] DO
        r:=SHIFT(CAST(BITSET, ga), redshift  )*redmask;
        g:=SHIFT(CAST(BITSET, ga), greenshift)*greenmask;
        b:=SHIFT(CAST(BITSET, ga), blueshift )*bluemask;
      END;
    END;
  END;
END Gammatab;


PROCEDURE WrHeadline;
BEGIN
  IF dis<>NIL THEN Xlib.XStoreName(dis, mainwin.win, headmh) END;
END WrHeadline;


PROCEDURE MaxBit(colmask:BITSET):INTEGER;
VAR i:INTEGER;
BEGIN
  i:=31;
  WHILE (i>0) & NOT (i IN colmask) DO DEC(i) END;
  RETURN i+1
END MaxBit;


PROCEDURE allocxbufw(VAR w:XWIN; xsizeh, ysizeh:CARDINAL);
VAR s,h:ARRAY[0..255] OF CHAR;
BEGIN
IF WITHX11 THEN

--WrInt(xsizeh, 1);WrStr(" x ");WrInt(ysizeh, 1); WrLn;

  WITH w DO
    xbufxsize:=xsizeh;
    xbufysize:=ysizeh;

    IF ximage0<>NIL THEN 
      DEC(debugmem.screens, xbuf0size); DEALLOCATE(xbuf016, xbuf0size);
      xbuf016:=NIL;
      ximage0^.data:=NIL;
      Xutil.XDestroyImage(ximage0^);                    (* xbuf0 deallocated too *)
    END;
    xbuf0size:=SIZE(XPIX16)*ysizeh*xsizeh;
    IF bitperpixel>16 THEN xbuf0size:=xbuf0size*2 END;
    ALLOCATE(xbuf016, xbuf0size);  debugmem.req:=xbuf0size; INC(debugmem.screens, debugmem.req);
    IF xbuf016=NIL THEN WrStrLn("initx: out of memory"); wrheap; HALT END;
    ximage0:=Xlib.XCreateImage(dis, pvis, bitperpixel, ZPixmap, 0, xbuf016, xsizeh, ysizeh, 32, 0);
    IF ximage0=NIL THEN WrStrLn("XCreateImage returns NIL"); HALT END;
  
(*
    s:="aprsmap by oe5dxl ";
    IntToStr(xsizeh, 1, h); Append(s, h);
    Append(s, "x");
    IntToStr(ysizeh, 1, h); Append(s, h);
    Xlib.XStoreName(dis, win, s);
*)
    headmh[0]:=0C;
--    WrHeadline;
  END;
END

END allocxbufw;


PROCEDURE allocxbuf(xsize, ysize:CARDINAL);
BEGIN
  allocxbufw(mainwin, xsize, ysize);
END allocxbuf;


PROCEDURE MakeMainWin(winname, iconname:ARRAY OF CHAR; xsizeh, ysizeh:CARDINAL):INTEGER;

BEGIN
  WITH mainwin DO
    myhint.height:=ysizeh;
    myhint.width:=xsizeh;
    myhint.x:=1;
    myhint.y:=1;
    myhint.flags:=Xutil.PPosition + Xutil.PSize;

 (* Connect to the X server *)
    dis:=Xlib.XOpenDisplay("");
    IF dis=NIL THEN WrStrLn("Couldnt open display"); RETURN -1 END;

   screen:=Xlib.DefaultScreen(dis);

 (* Create a window *)

    win:=Xlib.XCreateSimpleWindow(dis, Xlib.DefaultRootWindow(dis),
          myhint.x, myhint.y, myhint.width, myhint.height, 1, 0, 0);
    IF win=0 THEN WrStrLn("Couldnt open window"); RETURN -1 END;

    wclose:=Xlib.XInternAtom(dis, "WM_DELETE_WINDOW", FALSE);
    Xlib.XSetWMProtocols(dis, win, ADR(wclose), 1);


    pvis:=Xlib.DefaultVisual(dis, 0);
    IF pvis=NIL THEN WrStrLn("no visual"); RETURN -1 END;

    Xutil.XSetStandardProperties(dis, win, winname, iconname, None, NIL, 0, myhint);

    redmask:=CAST(BITSET, pvis^.red_mask);
    greenmask:=CAST(BITSET, pvis^.green_mask);
    bluemask:=CAST(BITSET, pvis^.blue_mask);
    redshift:=MaxBit(redmask)-8;
    greenshift:=MaxBit(greenmask)-8;
    blueshift:=MaxBit(bluemask)-8;
    bitperpixel:=Xlib.XDefaultDepth(dis, screen);

    ximage0:=NIL;
    allocxbufw(mainwin, xsizeh, ysizeh);


    Xlib.XSelectInput(dis, win, ExposureMask + ButtonPressMask + KeyPressMask 
    + ButtonReleaseMask + PointerMotionMask + KeyReleaseMask + StructureNotifyMask);


    Xlib.XMapWindow(dis, win);
(* Bring the window to the front *)
--    Xlib.XMapRaised(dis, win);


    disfd:=Xlib.ConnectionNumber(dis);
    pulling:=FALSE;
    cursorset:=FALSE;
    RETURN 0
  END;
END MakeMainWin;


PROCEDURE closewin;
BEGIN
IF WITHX11 THEN
  Xlib.XCloseDisplay(dis);
END
END closewin;


PROCEDURE InitX(winname, iconname:ARRAY OF CHAR; xsizeh, ysizeh:CARDINAL):INTEGER;
BEGIN
  xbuf016:=NIL;
IF WITHX11 THEN
  IF MakeMainWin(winname, iconname, xsizeh, ysizeh)<0 THEN RETURN -1 END;
END;
  Shift:=FALSE;
  Ctrl:=FALSE;
  RETURN 0
END InitX;


PROCEDURE getscreenbuf(VAR adr:ADDRESS; VAR xsize, ysize, incadr:CARDINAL);
BEGIN
  adr:=xbuf016;
  xsize:=xbufxsize;
  ysize:=xbufysize;
  IF mainwin.bitperpixel<=16 THEN incadr:=2 ELSE incadr:=4 END;
END getscreenbuf;


PROCEDURE rgbtoscreen;
BEGIN
IF WITHX11 THEN
  Xlib.XPutImage(dis, mainwin.win, Xlib.DefaultGC(dis, 0), mainwin.ximage0, 0, 0, 0, 0, xbufxsize, xbufysize);
END
END rgbtoscreen;


PROCEDURE beep(lev:INTEGER; hz:CARDINAL; ms:CARDINAL);
VAR val:Xlib.XKeyboardControl;
BEGIN
IF WITHX11 THEN
  IF (hz>0) & (ms>0) THEN
    IF (cbell(hz, ms)<0) & (dis<>NIL) THEN
      val.bell_pitch:=hz;
      val.bell_duration:=ms DIV 2;
      Xlib.XChangeKeyboardControl(dis, VAL(CARDINAL, KBBellPitch+KBBellDuration), ADR(val));
      Xlib.XBell(dis, lev);
    END;
  END;
END

END beep;

PROCEDURE Umlaut(VAR c:ARRAY OF CHAR);                     (* umlaut converter *)
BEGIN
  CASE ORD(c[0]) OF
    228: c[0]:="a"; c[1]:="e"; c[2]:=0C;
   |246: c[0]:="o"; c[1]:="e"; c[2]:=0C;
   |252: c[0]:="u"; c[1]:="e"; c[2]:=0C;
   |196: c[0]:="A"; c[1]:="e"; c[2]:=0C;
   |214: c[0]:="O"; c[1]:="e"; c[2]:=0C;
   |220: c[0]:="U"; c[1]:="e"; c[2]:=0C;
   |223: c[0]:="s"; c[1]:="s"; c[2]:=0C;
  ELSE END;
END Umlaut;

PROCEDURE paste;
VAR
(*
    pb:POINTER TO ARRAY[0..1000000] OF CHAR;
    len:INTEGER;
    cmd:CHAR;
*)
    i:INTEGER;
    cw:Window;
    pa:Atom;
BEGIN
IF WITHX11 THEN

(*
  pb:=Xlib.XFetchBytes(dis, len);
  IF pb<>NIL THEN
    FOR i:=0 TO len-1 DO 
      cmd:=pb^[i];
      keychar(cmd, TRUE, FALSE);
    END;
  END; 
*)
  cw:=Xlib.XGetSelectionOwner(dis, 1);
  IF cw<>0 THEN
    pa:=Xlib.XInternAtom(dis, "STRING", FALSE);
    i:=Xlib.XConvertSelection(dis, 1, pa, pa, mainwin.win, CurrentTime);
  END;

END
END paste;

PROCEDURE cutpaste;
BEGIN
IF WITHX11 THEN

  targetsatom:=Xlib.XInternAtom(dis, "TARGETS", FALSE);
  textatom:=Xlib.XInternAtom(dis, "TEXT", FALSE);
  UTF8:=Xlib.XInternAtom(dis, "UTF8_STRING", TRUE);
  IF UTF8=None THEN UTF8:=XASTRING END;
  selection:=Xlib.XInternAtom(dis, "CLIPBOARD", FALSE);
  selectionb:=Xlib.XInternAtom(dis, "PRIMARY", FALSE);
  Xlib.XSetSelectionOwner(dis, selection, mainwin.win, 0);
  Xlib.XSetSelectionOwner(dis, selectionb, mainwin.win, 0);
--if (XGetSelectionOwner (display, selection) != window) return;
END
END cutpaste;


PROCEDURE sendcopypasteevent(xreq:Xlib.XSelectionRequestEvent);
VAR ev:Xlib.XSelectionEvent;
    ret:INTEGER;
    utf8:POINTER TO ARRAY[0..10] OF CARD8;
(*
    cpp:RECORD
          CASE :BOOLEAN OF
           FALSE:  text:POINTER TO ARRAY[0..MAX(INTEGER)-1] OF CHAR;
           |TRUE: textb:POINTER TO ARRAY OF CARD8;
          END;
        END;
*)
    cpp:POINTER TO ARRAY OF CARD8;
    R:INTEGER;
BEGIN
IF WITHX11 THEN

  IF (xreq.selection<>selection) & (xreq.selection<>selectionb) THEN RETURN END;
  FILL(ADR(ev), 0C, SIZE(ev));
  R:=0;
  ev.type:=SelectionNotify;
  ev.display:=xreq.display;
  ev.requestor:=xreq.requestor;
  ev.selection:=xreq.selection;
  ev.time:=xreq.time;
  ev.target:=xreq.target;
  ev.property:=xreq.property;
  cpp:=ADR(cutbuffer.text);
  utf8:=ADR(UTF8);
  IF ev.target=targetsatom THEN R:=Xlib.XChangeProperty(ev.display, ev.requestor, ev.property, XAATOM, 32, PropModeReplace, utf8^, 1);
  ELSIF (ev.target=XASTRING) OR (ev.target=textatom) THEN R:=Xlib.XChangeProperty(ev.display, ev.requestor, ev.property, XASTRING, 8, PropModeReplace, cpp^, cutbuffer.cutlen);
  ELSIF ev.target=UTF8 THEN R:=Xlib.XChangeProperty(ev.display, ev.requestor, ev.property, UTF8, 8, PropModeReplace, cpp^, cutbuffer.cutlen);
  ELSE ev.property:=None END;
  IF NOT ODD(R DIV 2) THEN Xlib.XSendEvent(ev.display, ev.requestor, 0, 0, ADR(ev)) END;
END
END sendcopypasteevent;


PROCEDURE setxwinsize(x, y:INTEGER);
BEGIN
IF WITHX11 THEN
  Xlib.XMoveResizeWindow(dis, mainwin.win, 0,0,x,y);
END
END setxwinsize;

PROCEDURE maximize;
VAR xwa:Xlib.XWindowAttributes;
BEGIN
IF WITHX11 THEN

  Xlib.XGetWindowAttributes(dis, Xlib.DefaultRootWindow(dis), xwa);
  resizewin(xwa.width, xwa.height, TRUE);
END

END maximize;

PROCEDURE sethand(t:CURSORTYP);
VAR curs: INTEGER;
BEGIN
IF WITHX11 THEN

  IF t<>cOFF THEN
    IF NOT cursorset THEN
      CASE t OF
        cPULL4        :curs:=cursorfont.XC_fleur;
       |cPULLLEFT     :curs:=cursorfont.XC_left_side;
       |cPULLRIGHT    :curs:=cursorfont.XC_right_side;
       |cPULLUP       :curs:=cursorfont.XC_top_side;
       |cPULLDOWN     :curs:=cursorfont.XC_bottom_side;
       |cPULLLEFTUP   :curs:=cursorfont.XC_top_left_corner;
       |cPULLRIGHTDOWN:curs:=cursorfont.XC_bottom_right_corner;
      ELSE curs:=cursorfont.XC_left_ptr END;

      cursor:=Xlib.XCreateFontCursor(dis, curs);
      Xlib.XDefineCursor(dis, mainwin.win, cursor);
      cursorset:=TRUE;
    END;
  ELSIF cursorset THEN
    Xlib.XUndefineCursor(dis, mainwin.win);
    Xlib.XFreeCursor(dis, cursor);
    cursorset:=FALSE;
  END;
END

END sethand;


PROCEDURE checkbuttons;           (* check mouse buttons if lost events *)
VAR r, c:Window;
    x, y, wx, wy:INTEGER;
    m:CARDINAL;
BEGIN
IF WITHX11 THEN

  IF pulling & Xlib.XQueryPointer (dis, mainwin.win, r, c, x, y, wx, wy, m)
  & (CAST(BITSET,m)*(Button1Mask+Button2Mask)=BITSET{}) THEN sethand(cOFF) END;
END
END checkbuttons;

PROCEDURE xevent;
VAR h:ARRAY[0..255] OF CHAR;
    attr:Xlib.XWindowAttributes;
    res: INTEGER;
    cmd:CHAR;

    ii:INTEGER;
    nc, nn:CARDINAL;
    atom1:Atom;
    pstr:Xlib.PAUChar;
BEGIN
IF WITHX11 THEN

  WHILE Xlib.XPending(dis)<>0 DO

    Xlib.XNextEvent(dis, event);

--IF event.type<>6 THEN WrInt(event.type, 10); WrStrLn(" event") END;
    CASE event.type OF
      | ButtonPress: 
        CASE event.xbutton.button OF
          Button1: 
(*
                   IF Shift THEN
                     Pull(event.xmotion.x, event.xmotion.y, 0);
                     sethand;
                   ELSE mouseleft(event.xmotion.x, event.xmotion.y) END;
*)
                   mouseleftdown(event.xmotion.x, event.xmotion.y);
                   
         |Button2: (*paste;*)

                   mousemiddle(event.xmotion.x, event.xmotion.y);
         |Button3: mouserightdown(event.xmotion.x, event.xmotion.y);
         |Button4: keychar(CMDFZOOMIN, FALSE, TRUE);
         |Button5: keychar(CMDFZOOMOUT, FALSE, TRUE);
        ELSE END;

      | KeyPress: 
        cmd:=0C;
        res:=Xutil.XLookupString(event.xkey, ADR(h), SIZE(h), mykey, mystat);
        IF res = 1 THEN cmd:=h[0];
        ELSIF res=0 THEN
          IF mykey=keysym.XK_Down THEN cmd:=CURSDOWN
          ELSIF mykey=keysym.XK_Left THEN cmd:=CURSLEFT
          ELSIF mykey=keysym.XK_Up THEN cmd:=CURSUP
          ELSIF mykey=keysym.XK_Page_Up THEN cmd:=CURSPAGEUP
          ELSIF mykey=keysym.XK_Page_Down THEN cmd:=CURSPAGEDOWN
          ELSIF mykey=keysym.XK_Right THEN cmd:=CURSRIGHT
          ELSIF mykey=keysym.XK_BackSpace THEN cmd:=CURSBS
          ELSIF mykey=keysym.XK_Delete THEN cmd:=CURSDEL
          ELSIF mykey=keysym.XK_Home THEN cmd:=CURSHOME
          ELSIF mykey=keysym.XK_End THEN cmd:=CURSEND
          ELSIF mykey=keysym.XK_Insert THEN cmd:=CURSINS
          ELSIF mykey=keysym.XK_F11 THEN maximize
          ELSIF (mykey=keysym.XK_Shift_L) OR (mykey=keysym.XK_Shift_R) THEN Shift:=TRUE
          ELSIF (mykey=keysym.XK_Control_L) OR (mykey=keysym.XK_Control_R) THEN Ctrl:=TRUE
          END;
        END;
        IF cmd=CHR(22) THEN paste ELSIF cmd<>0C THEN keychar(cmd, FALSE, FALSE) END;

      | KeyRelease:
        res:=Xutil.XLookupString(event.xkey, ADR(h), SIZE(h), mykey, mystat);
        IF res=0 THEN
          IF (mykey=keysym.XK_Shift_L) OR (mykey=keysym.XK_Shift_R) THEN Shift:=FALSE
          ELSIF (mykey=keysym.XK_Control_L) OR (mykey=keysym.XK_Control_R) THEN Ctrl:=FALSE END;
        END;

      | ConfigureNotify:
        Xlib.XGetWindowAttributes(dis, mainwin.win, attr);
        resizewin(attr.width, attr.height, FALSE);

      | Expose: IF newxsize=0 THEN refreshwin END;

      | MotionNotify: 
--          Pull(event.xmotion.x, event.xmotion.y, 1);

          mousemove(event.xmotion.x, event.xmotion.y);
      | ButtonRelease: 
          mouserelease;
--        pulloff;

      | SelectionNotify:
          pastewrapper.pasteget(dis, mainwin.win, event.xselection.property, nn, pstr);
          IF ADDRESS(pstr)<>NIL THEN 
            FOR res:=0 TO VAL(INTEGER, nn)-1 DO 
              cmd:=CHR(pstr^[res]);
              IF (cmd>=" ") & (cmd<=201C) THEN keychar(cmd, TRUE, FALSE) END;
            END;
            Xlib.XFree(ADDRESS(pstr)); 
          END;

      | SelectionRequest: sendcopypasteevent(event.xselectionrequest);

      | SelectionClear: clrcpmarks;

      | ClientMessage:
        IF CAST(CARDINAL, event.xclient.data.l[0]) = wclose THEN
          quit:=TRUE;
          WrStrLn("Main Window Close");     (* window close event *)
        END;

    ELSE END;

  END;
END
END xevent;


PROCEDURE addsock(fd:INTEGER; wtoo:BOOLEAN);                (* insert socket in fdset for select *)
BEGIN
  IF fd>=0 THEN
    fdsetr(fd);
    IF wtoo THEN fdsetw(fd) END;
  END;
END addsock;


PROCEDURE CheckProg(VAR chpid:PROCESSHANDLE);
VAR stat, ret:INTEGER;
BEGIN 
  IF chpid.runs THEN
    ret:=waitpid(chpid.pid, stat, WNOHANG);
    IF ret=chpid.pid THEN chpid.exitcode:=stat END;
    IF ret<0 THEN chpid.runs:=FALSE END;
  END;
END CheckProg;


PROCEDURE StartProg(name:ARRAY OF CHAR; VAR chpid:PROCESSHANDLE);
CONST ARGS=100;
      QUOTT='"';

VAR  e, stat, res: INTEGER;
     pgmname:ARRAY[0..1024] OF CHAR;
     argt:ARRAY[0..ARGS-1] OF ARRAY[0..1024] OF CHAR;
     args:POINTER TO argv_t;
     arga:ARRAY[0..ARGS-1] OF ADDRESS;
     quot:BOOLEAN;     
     i, j, len, a:CARDINAL;
BEGIN
--WrStr("start: "); WrStrLn(name);
  chpid.pid:=fork();
  IF chpid.pid=0 THEN                                          (* child *)
    len:=Length(name);
    i:=0;
    j:=0;
    quot:=FALSE;
    WHILE (i<len) & (quot OR (name[i]>" ")) DO
      IF name[i]=QUOTT THEN quot:=NOT quot;
      ELSIF j<HIGH(pgmname) THEN pgmname[j]:=name[i]; INC(j); END;
      INC(i);
    END;
    pgmname[j]:=0C;
--WrStr(" <<<");WrStr(pgmname);WrStrLn(">>>");
--  WHILE (i<len) & (name[i]>" ") DO INC(i) END;               (* end of program name *)
    
    quot:=FALSE;
    WHILE (i>0) & (name[i-1]<>DIRSEP) DO
      IF name[i]=QUOTT THEN quot:=NOT quot END;
      DEC(i);
    END;                                                       (* program name without path *)
    FOR a:=0 TO HIGH(arga) DO
      WHILE (i<len) & (name[i]=" ") DO INC(i) END;
      j:=0;
      WHILE (i<len) & (quot OR (name[i]>" ")) DO 
        IF name[i]=QUOTT THEN quot:=NOT quot;
        ELSIF j<HIGH(argt[0]) THEN argt[a][j]:=name[i]; INC(j); END;
        INC(i);
      END;
      argt[a][j]:=0C; 
--WrInt(a, 5);  WrStr(" <<");WrStr(argt[a]);WrStrLn(">>");
 
      IF j>0 THEN arga[a]:=ADR(argt[a]) ELSE arga[a]:=NIL END;
    END;
--WrStrLn("child start");
    args:=ADR(arga);
    e:=execv(pgmname, args^);
--WrStrLn("child end");
    HALT;

  ELSE chpid.runs:=chpid.pid>=0 END;                          (* ok or fork error *)                                       (* parent *)
END StartProg;

PROCEDURE StopProg(VAR chpid:PROCESSHANDLE);
BEGIN
--WrInt(chpid.pid, 9);WrStrLn(" closepid");
  IF chpid.runs THEN kill(chpid.pid, SIGTERM) END;
END StopProg;


PROCEDURE Eventloop(timeout:CARDINAL);
VAR acttcp, acttmp : pTCPSOCK;
    ret, i:INTEGER;
    ts, tus:CARDINAL;
    t:CARDINAL;
BEGIN

  fdclr;                                                                      (* clear select bitset *)

  FOR i:=0 TO HIGH(udpsocks) DO addsock(udpsocks[i].fd, FALSE) END;  (* set udp ports *)
  addsock(disfd, FALSE);                                                      (* x11 fd *)

  acttcp:=tcpsocks;
  WHILE acttcp<>NIL DO
    addsock(acttcp^.fd, acttcp^.tlen>0);                                      (* set tcp ports *)
    acttcp:=acttcp^.next;
  END;

  ts:=0;
  tus:=timeout;
  ret:=selectrwt(ts, tus);
  INC(timesum, timeout-tus);

  IF timesum>=timeout THEN
    timerevent;
--    IF headmh[0]<>0C THEN WrHeadline END;
    timesum:=0;
  END;
--  IF issetr(disfd) THEN xevent END;                                         (* kbd, mouse *)
  xevent;
  checkbuttons;


  t:=time();
  IF lastlooped+IGATEMAXDELAY<t THEN rxidle:=0 ELSE INC(rxidle) END;
  lastlooped:=t;


  FOR i:=0 TO HIGH(udpsocks) DO 
    IF (udpsocks[i].fd>=0) & issetr(udpsocks[i].fd) THEN udpin(i) END; 
  END;

  acttcp:=tcpsocks;
  WHILE acttcp<>NIL DO  
    IF (acttcp^.fd>=0) & issetw(acttcp^.fd) THEN ret:=tcpout(acttcp) END;
    IF (acttcp^.fd>=0) & issetr(acttcp^.fd) THEN tcpin(acttcp) END;
    IF acttcp^.fd<0 THEN                                                      (* connection lost *)

      tcpclose(acttcp, TRUE);                          
      IF acttcp=tcpsocks THEN tcpsocks:=tcpsocks^.next;
      ELSE
        acttmp:=tcpsocks;
        WHILE acttmp^.next<>acttcp DO acttmp:=acttmp^.next END;
        acttmp^.next:=acttcp^.next;
      END;
      DEC(debugmem.mon, SIZE(acttcp^)); DEALLOCATE(acttcp, SIZE(acttcp^));
      acttcp:=tcpsocks;
    ELSE acttcp:=acttcp^.next END;  
  END;


END Eventloop;

BEGIN


<* ELSIF TARGET_FAMILY="WIN32" THEN *>


FROM InOut IMPORT WriteLn, WriteString;
FROM IOChan IMPORT ChanId;
FROM RealIO IMPORT WriteFixed;
FROM SYSTEM IMPORT ADR, CAST, INT16, CARD8, SHIFT, ADDRESS, ADDADR, BYTE, FILL;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM Select IMPORT selectrwt, fdclr, fdsetr, fdsetw, issetr, issetw;
FROM RealMath IMPORT ln, exp;
FROM aprsdecode IMPORT udpsocks, tcpsocks, udpin, tcpin, tcpout, tcpclose,
                       pTCPSOCK, lastlooped, rxidle, IGATEMAXDELAY, quit;

FROM aprsstr IMPORT IntToStr, Append, Length, StrToCard;
FROM useri IMPORT keychar, mouseleftdown, mouserightdown, resizewin,
                  mousemove, timerevent, CMDFZOOMOUT, CMDFZOOMIN,
                  mousemiddle, wrheap, mouserelease, clrcpmarks,
                  CURSDOWN,CURSLEFT,CURSUP,CURSRIGHT,CURSDEL,CURSBS,
                  CURSENTER,CURSPAGEUP,CURSPAGEDOWN,CURSHOME,CURSEND,CURSINS;

FROM osi IMPORT WrStr, WrLn, WrStrLn, WrInt, File, RdBin, FdValid,
                WrBin, Close, OpenRead, SOCKET, udpsend, CloseSock, openudp;

IMPORT FIO;
FROM Lib IMPORT ParamCount, ParamStr;
FROM Windows    IMPORT HWND,UINT,WPARAM,LPARAM,LRESULT,HBRUSH, CALLBACK, HDC, WM_CREATE,
                       WM_CLOSE,WM_DESTROY, CS_SET, CS_OWNDC, MB_SYSTEMMODAL,
                       IDI_APPLICATION,IDC_ARROW,COLOR_WINDOW,SW_SHOWNORMAL,
                       WS_EX_CLIENTEDGE,WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,
                       WNDCLASS,MSG, WM_PAINT, PAINTSTRUCT,EndPaint, BeginPaint,
                       BITMAPV4HEADER, BITMAPINFOHEADER, LOWORD, HIWORD,
                       DestroyWindow,PostQuitMessage,DefWindowProc,
                       RegisterClass,CreateWindowEx, CreateWindow,SendMessage,
                       ShowWindow,UpdateWindow, GetModuleHandle,SetDIBitsToDevice,DIB_RGB_COLORS,
                       GetMessage,TranslateMessage,DispatchMessage,
                       WM_LBUTTONDOWN,WM_RBUTTONDOWN,WM_MBUTTONDOWN,WM_MBUTTONUP,
                       WM_MOUSEMOVE,WM_TIMER,WM_CHAR,WM_KEYDOWN,WM_KEYUP,WM_MOUSEWHEEL,
                       WM_LBUTTONUP,WM_RBUTTONUP,KillTimer,LoadCursor,LoadImage,CreateSolidBrush,
                       RGB,BI_RGB,GetDC,ReleaseDC, MessageBox, SetTimer, GetCurrentDirectory,
                       GetClientRect, RECT, WM_SIZE, SetWindowText,
                       WSAAsyncSelect,FD_CONNECT,FD_CLOSE,FD_READ,FD_WRITE, WS_MAXIMIZE,
                       IDC_HAND, SetCursor, HCURSOR, WSAGetLastError, SW_SHOWMAXIMIZED,
                       STARTUPINFO, PROCESS_INFORMATION, CreateProcess, NORMAL_PRIORITY_CLASS,
                       GetExitCodeProcess, CloseHandle, MessageBeep, Beep, MB_SET,
                       MB_OK, MB_ICONASTERISK, MB_ICONEXCLAMATION, HANDLE, GetClipboardData,
                       GlobalLock, CloseClipboard, CF_TEXT, HGLOBAL, GlobalUnlock, OpenClipboard,
                       STARTF_USESHOWWINDOW, SHOW_OPENNOACTIVATE, WORD, SW_SHOWNOACTIVATE,
                       TerminateProcess, GetAsyncKeyState, VK_LBUTTON, VK_RBUTTON,
                       VK_MBUTTON, WM_SETCURSOR, LR_LOADFROMFILE, STM_SETIMAGE, IMAGE_ICON,
                       WM_INITDIALOG, LoadIcon, GetSystemMetrics, SM_CXSMICON, SM_CYSMICON,
                       LR_DEFAULTCOLOR, WM_SETICON, WM_DESTROYCLIPBOARD, 
                       IDC_SIZEALL,IDC_SIZEWE,IDC_SIZENS,IDC_SIZENWSE,
                       TCHAR, EmptyClipboard, GlobalAlloc, GMEM_MOVEABLE,
                       SetClipboardData;

FROM WinSock IMPORT closesocket, p_hostent, gethostbyname, WSAStartup, WSADATA,
                    socket, sockaddr_in, AF_INET, SOCK_STREAM, IPPROTO_TCP,
                    sockaddr, ioctlsocket, htons, htonl, sendto;

FROM TimeConv IMPORT time;

CONST ClassName = "myWindowClass";
      WM_SOCKET=104;       
VAR
    xbufrgb:POINTER TO ARRAY[0..100000000] OF CARD8;

    xbuf0size: INTEGER; 
    xbufxsize,
    xbufysize: CARDINAL;
    hwndg    : HWND;
    dibh     : BITMAPINFOHEADER;
    argc,   
    lasttime : CARDINAL;
    wc       : WNDCLASS;
    Msg      : MSG;
    timerid  : UINT;
    normalcurs:HCURSOR;
    cursorset,
    timerelapsed:BOOLEAN;
    debugfd: SOCKET;

<* IF DEBUG THEN *>
    hdebug:ARRAY[0..999] OF CHAR;

PROCEDURE wrdebug(s:ARRAY OF CHAR);
VAR  ret:INTEGER;
BEGIN
  IF CAST(INTEGER,debugfd)<0 THEN debugfd:=openudp() END;
  IF CAST(INTEGER,debugfd)<0 THEN RETURN END;

  ret:=udpsend(debugfd, s, Length(s), 7000, 192*1000000H+168*10000H+1*100H+24);
END wrdebug;

<* END *>

PROCEDURE Gamma(c:CARDINAL; g:REAL):CARDINAL;
BEGIN
  IF c=0 THEN RETURN 0 END; 
  IF c<1024 THEN RETURN TRUNC(exp(ln(FLOAT(c)/1024.0)/g)*255.5) END;
  RETURN 255
EXCEPT
  WrStrLn("error in Gamma TRUNC() ");
  RETURN 0
END Gamma;

PROCEDURE Gammatab(g:REAL);
VAR i,ga:CARDINAL;
BEGIN
  FOR i:=0 TO HIGH(gammalut) DO gammalut[i]:=Gamma(i, g) END;
END Gammatab;

(*
PROCEDURE WrHeadline;
VAR s, h:ARRAY[0..60] OF CHAR;
BEGIN
  IF hwndg<>NIL THEN
    IF headmh[0]<" " THEN
      s:="aprsmap by oe5dxl ";
      IntToStr(xbufxsize, 1, h); Append(s, h);
      Append(s, "x");
      IntToStr(xbufysize, 1, h); Append(s, h);
      Append(s," Map:["); Append(s, lums.mapname);
      Append(s, "] Zoom:");
      FixToStr(FLOAT(initzoom)-0.95+finezoom, 2, h); Append(s,h);
      SetWindowText(hwndg, s);
    ELSE SetWindowText(hwndg, headmh) END;
    headmh[0]:=0C;
  END;
END WrHeadline;
*)

PROCEDURE WrHeadline;
BEGIN
  IF hwndg<>NIL THEN SetWindowText(hwndg, headmh) END;
END WrHeadline;


PROCEDURE closewin;
VAR res:INTEGER;
BEGIN
END closewin;


PROCEDURE allocxbuf(xsizeh, ysizeh:CARDINAL);
VAR s,h:ARRAY[0..255] OF CHAR;
BEGIN

--WrInt(xsizeh, 1);WrStr(" x ");WrInt(ysizeh, 1); WrLn;

  xbufxsize:=xsizeh;
  xbufysize:=ysizeh;

  IF xbufrgb<>NIL THEN
    DEALLOCATE(xbufrgb, xbuf0size);
    xbufrgb:=NIL;
  END;
  xbuf0size:=ysizeh*xsizeh*BYTEPIXEL;
  ALLOCATE(xbufrgb, xbuf0size);
  IF xbufrgb=NIL THEN WrStrLn("initx: out of memory"); wrheap; HALT END;
  headmh[0]:=0C;
--  WrHeadline(hwndg);

END allocxbuf;

PROCEDURE drawwin(hwnd : HWND);
VAR  dc: HDC;
 i:CARDINAL;
BEGIN

   dibh.biSize:=SIZE(dibh);
   dibh.biWidth:=xbufxsize;
   dibh.biHeight:=xbufysize;
   dibh.biPlanes:=1;
   dibh.biBitCount:=BYTEPIXEL*8;
   dibh.biCompression:=BI_RGB;
   dibh.biSizeImage:=xbuf0size;
   dibh.biClrUsed:=0;
   dibh.biClrImportant:=0;

   dc := GetDC(hwnd);
   SetDIBitsToDevice(dc, 0, 0, xbufxsize, xbufysize, 0, 0, 0, xbufysize, xbufrgb^, dibh, DIB_RGB_COLORS);
   ReleaseDC(hwnd, dc);

END drawwin;


PROCEDURE Mousecard(lpmaram:LPARAM; hi:BOOLEAN):CARDINAL;
VAR i:INT16;
BEGIN
  IF hi THEN i:=CAST(INT16,HIWORD(lpmaram)) ELSE i:=CAST(INT16,LOWORD(lpmaram)) END;
  IF i<0 THEN i:=0 END;
  RETURN i
END Mousecard;

PROCEDURE getsize(hwnd:HWND; VAR x, y:CARDINAL);
VAR rect : RECT;
BEGIN
  GetClientRect(hwnd, rect);
  x:=rect.right-rect.left;
  y:=rect.bottom-rect.top;
END getsize;

PROCEDURE setxwinsize(x, y:INTEGER);
BEGIN
END setxwinsize;


PROCEDURE resize(hwnd:HWND);
VAR rect : RECT;
--    s, h:ARRAY[0..99] OF CHAR;
    x, y:CARDINAL;
BEGIN
  getsize(hwnd, x, y);
  resizewin(x, y, FALSE);
(*
  s:="aprsmap by oe5dxl ";
  IntToStr(x, 1, h); Append(s, h);
  Append(s, "x");
  IntToStr(y, 1, h); Append(s, h);
*)
--  WrHeadline(hwnd);
END resize;

(*
PROCEDURE sethand(t:CURSORTYP);
BEGIN
--WrInt(ORD(on), 5);WrStrLn(" sh");
  IF on THEN normalcurs:=LoadCursor(NIL, IDC_HAND);
  ELSE normalcurs:=LoadCursor(NIL, IDC_ARROW) END;
  pulling:=on;
END sethand;
*)

PROCEDURE setcurs;
VAR oldcurs:HCURSOR;
BEGIN
  oldcurs:=SetCursor(normalcurs);
END setcurs;


PROCEDURE sethand(t:CURSORTYP);
BEGIN
  IF t<>cOFF THEN
--    IF NOT cursorset THEN
      CASE t OF
        cPULL4        :normalcurs:=LoadCursor(NIL, IDC_HAND);
       |cPULLLEFT     :normalcurs:=LoadCursor(NIL, IDC_SIZEWE);
       |cPULLRIGHT    :normalcurs:=LoadCursor(NIL, IDC_SIZEWE);
       |cPULLUP       :normalcurs:=LoadCursor(NIL, IDC_SIZENS);
       |cPULLDOWN     :normalcurs:=LoadCursor(NIL, IDC_SIZENS);
       |cPULLLEFTUP   :normalcurs:=LoadCursor(NIL, IDC_SIZENWSE);
       |cPULLRIGHTDOWN:normalcurs:=LoadCursor(NIL, IDC_SIZENWSE);
      ELSE (*normalcurs:=LoadCursor(NIL, IDC_ARROW)*) END;
      cursorset:=TRUE;
--    END;
--  ELSIF cursorset THEN
  ELSE 
    normalcurs:=LoadCursor(NIL, IDC_ARROW);
    cursorset:=FALSE;
  END;
  setcurs;
END sethand;


PROCEDURE [CALLBACK] WndProc(hwnd:HWND; msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
BEGIN
  hwndg:=hwnd;

  CASE msg OF
      WM_CREATE  :
    | WM_PAINT   :
--WrStrLn("wp");
                   hwndg:=hwnd;
                   drawwin(hwnd);
                   RETURN DefWindowProc(hwnd, msg, wParam, lParam);
    | WM_CLOSE   : DestroyWindow(hwnd);
                   quit:=TRUE;
    | WM_DESTROY : PostQuitMessage(0);
                   quit:=TRUE;
    | WM_LBUTTONDOWN: 
--WrInt(Mousecard(lParam, FALSE), 10);
--WrInt(Mousecard(lParam, TRUE), 10);
--WrStrLn("ml");

                   mouseleftdown(Mousecard(lParam, FALSE), Mousecard(lParam, TRUE));
    | WM_RBUTTONDOWN:
                   mouserightdown(Mousecard(lParam, FALSE), Mousecard(lParam, TRUE));

    | WM_MBUTTONDOWN:
                   mousemiddle(Mousecard(lParam, FALSE), Mousecard(lParam, TRUE));

    | WM_MBUTTONUP, WM_LBUTTONUP, WM_RBUTTONUP:
                   mouserelease;

    | WM_MOUSEMOVE:
                   IF pulling & (GetAsyncKeyState(VK_LBUTTON)>=0)
                              & (GetAsyncKeyState(VK_MBUTTON)>=0)
                              & (GetAsyncKeyState(VK_RBUTTON)>=0) THEN mouserelease END;
                   setcurs;
                   mousemove(Mousecard(lParam, FALSE), Mousecard(lParam, TRUE));

    | WM_MOUSEWHEEL: 
                   IF CAST(INTEGER,wParam)>=0 THEN keychar(CMDFZOOMIN, FALSE, TRUE);
                   ELSE keychar(CMDFZOOMOUT, FALSE, TRUE) END;
    | WM_TIMER:
                   IF lasttime>=10000 THEN timerevent END;
                   timerelapsed:=TRUE;
    | WM_CHAR:

--IntToStr(wParam, 1, hdebug); wrdebug(hdebug); wrdebug("char"+12C);

                   IF wParam<256 THEN
                     IF CHR(wParam)=CHR(22) THEN paste;
                     ELSE keychar(CHR(wParam), FALSE, FALSE) END;
                   END;
    | WM_KEYDOWN:
      CASE wParam OF
        16: Shift:=TRUE;
       |17: Ctrl:=TRUE;
       |18: Ctrl:=FALSE;
       |40: keychar(CURSDOWN, FALSE, FALSE); 
       |37: keychar(CURSLEFT, FALSE, FALSE);
       |38: keychar(CURSUP, FALSE, FALSE);
       |39: keychar(CURSRIGHT, FALSE, FALSE);
       |46: keychar(CURSDEL, FALSE, FALSE);
       |33: keychar(CURSPAGEUP, FALSE, FALSE);
       |34: keychar(CURSPAGEDOWN, FALSE, FALSE);
       |35: keychar(CURSEND, FALSE, FALSE);
       |36: keychar(CURSHOME, FALSE, FALSE);
       |45: keychar(CURSINS, FALSE, FALSE);
       |187: IF Ctrl THEN keychar("+", FALSE, FALSE) END;
       |189: IF Ctrl THEN keychar("-", FALSE, FALSE) END;
      ELSE END;

    | WM_KEYUP:
                   IF wParam=16 THEN Shift:=FALSE
                   ELSIF (wParam=17) OR (wParam=18)  THEN Ctrl:=FALSE END;

    | WM_SIZE:        resize(hwnd);

(*
    | WM_SETCURSOR:                                          (* check for lost buttonrelease *)
                   IF pulling & (GetAsyncKeyState(VK_LBUTTON)>=0)
                              & (GetAsyncKeyState(VK_MBUTTON)>=0)
                              & (GetAsyncKeyState(VK_RBUTTON)>=0) THEN mouserelease END;
                   setcurs;
*)
(*
    | WM_SOCKET:

WrInt(lParam MOD 10000H, 1);
WrStrLn(" socket call");

      CASE lParam MOD 10000H OF
        FD_CONNECT:
       |FD_CLOSE:
       |FD_READ:
       |FD_WRITE:
      ELSE END; 
*)  
(*
    | WM_INITDIALOG:
hicon:=CAST(HANDLE, LoadIcon(GetModuleHandle(NIL), "MAIN_ICON"));
hicon1:=LoadImage(GetModuleHandle(NIL), "MAIN_ICON", IMAGE_ICON, GetSystemMetrics(SM_CXSMICON), 
GetSystemMetrics(SM_CYSMICON), LR_DEFAULTCOLOR);
SendMessage(hwnd, WM_SETICON, 0, CAST(LPARAM, hicon1));
SendMessage(hwnd, WM_SETICON, 1, CAST(LPARAM, hicon));
*)


    | WM_DESTROYCLIPBOARD: clrcpmarks;

    ELSE RETURN DefWindowProc(hwnd, msg, wParam, lParam);
  END;
  RETURN 0;
END WndProc;


PROCEDURE InitX(winname, iconname:ARRAY OF CHAR; xsizeh, ysizeh:CARDINAL):INTEGER;
CONST INIX=300;
      INIY=200;

VAR res   : INTEGER;
    wc    : WNDCLASS;
    hwnd  : HWND;
    Msg   : MSG;
    xs, ys:CARDINAL;
BEGIN
  (* Step 1: Registering the Window Class *)
  wc.style         := CS_OWNDC;
  wc.lpfnWndProc   := WndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 0;
  wc.hInstance     := GetModuleHandle(NIL);
  wc.hIcon         := NIL;
  normalcurs:=LoadCursor(NIL, IDC_ARROW);
--  normalcurs:=LoadCursor(wc.hInstance, MAKEINTRESOURCE(230));
  wc.hCursor       := normalcurs;
  wc.hbrBackground := CreateSolidBrush(RGB(0,0,0));
  wc.lpszMenuName  := NIL;
  wc.lpszClassName := ADR(ClassName);

  allocxbuf(xsizeh, ysizeh);
  IF RegisterClass(wc)=0 THEN RETURN -1 END;

  (* Step 2: Creating the Window *)

  hwnd := CreateWindow((*WS_EX_CLIENTEDGE,*) ClassName,
                         winname, WS_OVERLAPPEDWINDOW+WS_MAXIMIZE,
                         CW_USEDEFAULT, CW_USEDEFAULT, INIX, INIY,
                         NIL, NIL, GetModuleHandle(NIL), NIL);
  IF hwnd = NIL THEN RETURN -1 END;

  getsize(hwnd, xs, ys);
  IF xsizeh>xs THEN xsizeh:=xs END;
  IF ysizeh>ys THEN ysizeh:=ys END;
  IF (xsizeh<xs) OR (ysizeh<ys) THEN                    (* open not maximized *)
    hwnd := CreateWindow((*WS_EX_CLIENTEDGE,*) ClassName,
                           winname, WS_OVERLAPPEDWINDOW,
                           CW_USEDEFAULT, CW_USEDEFAULT, INIX, INIY,
                           NIL, NIL, GetModuleHandle(NIL), NIL);
    IF hwnd = NIL THEN RETURN -1 END;

    getsize(hwnd, xs, ys);
    hwnd := CreateWindow((*WS_EX_CLIENTEDGE,*) ClassName,
                           winname, WS_OVERLAPPEDWINDOW,
                           CW_USEDEFAULT, CW_USEDEFAULT, xsizeh+INIX-xs, ysizeh+INIY-ys,
                           NIL, NIL, GetModuleHandle(NIL), NIL);
    IF hwnd = NIL THEN RETURN -1 END;

    ShowWindow(hwnd, SW_SHOWNORMAL);
  ELSE ShowWindow(hwnd, SW_SHOWMAXIMIZED) END;

  UpdateWindow(hwnd);

  resize(hwnd);
  timerid:=SetTimer(hwnd, 500, 500, NIL);
  Shift:=FALSE;
  Ctrl:=FALSE;

  RETURN 0

END InitX;


PROCEDURE getscreenbuf(VAR adr:ADDRESS; VAR xsize, ysize, incadr:CARDINAL);
BEGIN
  adr:=xbufrgb;
  xsize:=xbufxsize;
  ysize:=xbufysize;
  incadr:=3;
END getscreenbuf;


PROCEDURE rgbtoscreen;
BEGIN
  IF hwndg<>NIL THEN SendMessage(hwndg, WM_PAINT, 0, 0) END;
END rgbtoscreen;

PROCEDURE beep(lev:INTEGER; hz:CARDINAL; ms:CARDINAL);
BEGIN
  IF (hz>=37) & (hz<=32767) THEN
    IF (ms>0) THEN Beep(hz, ms);
    ELSE 
      IF hz<500 THEN MessageBeep(MB_OK);
      ELSIF hz<1000 THEN MessageBeep(MB_ICONASTERISK)
      ELSE MessageBeep(MB_ICONEXCLAMATION) END;
    END;
  END; 
END beep;

(*
PROCEDURE getpwd(VAR dir:ARRAY OF CHAR);
BEGIN
  GetCurrentDirectory(HIGH(dir), dir);
--WrStrLn(dir);
END getpwd;
*)

PROCEDURE Umlaut(VAR c:ARRAY OF CHAR);                     (* umlaut converter *)
BEGIN
  CASE ORD(c[0]) OF
    228: c[0]:="a"; c[1]:="e"; c[2]:=0C;
   |246: c[0]:="o"; c[1]:="e"; c[2]:=0C;
   |252: c[0]:="u"; c[1]:="e"; c[2]:=0C;
   |196: c[0]:="A"; c[1]:="e"; c[2]:=0C;
   |214: c[0]:="O"; c[1]:="e"; c[2]:=0C;
   |220: c[0]:="U"; c[1]:="e"; c[2]:=0C;
   |223: c[0]:="s"; c[1]:="s"; c[2]:=0C;
  ELSE END;
END Umlaut;


PROCEDURE paste;
VAR pb:POINTER TO ARRAY[0..10000] OF CHAR;
    hnd:HANDLE;
    i:CARDINAL;
    cmd:CHAR;
BEGIN
  IF (hwndg<>NIL) & OpenClipboard(hwndg) THEN
    hnd:=GetClipboardData(CF_TEXT);
    IF hnd<>NIL THEN
      pb:=ADDRESS(GlobalLock(HGLOBAL(hnd)));
      IF pb<>NIL THEN
--        WrStr(pb^);
        i:=0;
        LOOP
          cmd:=pb^[i];
          IF (cmd=0C) OR (i>=HIGH(pb^)) THEN EXIT END;
          keychar(cmd, TRUE, FALSE);
          INC(i);
        END;
        GlobalUnlock(HGLOBAL(hnd));
      END;
    END;
    CloseClipboard;
  END; 
END paste;

PROCEDURE cutpaste;
VAR pb:POINTER TO ARRAY[0..MAX(INTEGER) DIV 2-1] OF TCHAR;
    hcopy:HANDLE;
    i,j:CARDINAL;
    c:TCHAR;
BEGIN
  IF (cutbuffer.cutlen>0) & (hwndg<>NIL) & OpenClipboard(hwndg) THEN
    EmptyClipboard();

    j:=0;                                                             (* count lf *)
    FOR i:=0 TO cutbuffer.cutlen-1 DO 
      IF cutbuffer.text^[i]=CHR(10) THEN INC(j) END;
    END;
    hcopy:=HANDLE(GlobalAlloc(GMEM_MOVEABLE, (cutbuffer.cutlen+j+1)*SIZE(TCHAR)));

    IF hcopy<>NIL THEN
      pb:=ADDRESS(GlobalLock(HGLOBAL(hcopy)));

      j:=0;
      FOR i:=0 TO cutbuffer.cutlen-1 DO 
        c:=cutbuffer.text^[i];
        IF c=CHR(10) THEN                                             (* make CRLF from LF *)
          pb^[j]:=CHR(13);
          INC(j);
        END;
        pb^[j]:=c;
        INC(j);
      END;
      pb^[j]:=0C;

      GlobalUnlock(HGLOBAL(hcopy));
      SetClipboardData(CF_TEXT, hcopy); 
    END;
    CloseClipboard;
  END;
END cutpaste;

PROCEDURE xevent;
BEGIN
END xevent;


PROCEDURE addsock(fd:INTEGER; wtoo:BOOLEAN);                (* insert socket in fdset for select *)
BEGIN
(*
  IF fd>=0 THEN
    fdsetr(fd);
    IF wtoo THEN fdsetw(fd) END;
  END;
*)
END addsock;

PROCEDURE StartProg(name:ARRAY OF CHAR; VAR chpid:PROCESSHANDLE);
VAR startinfo:STARTUPINFO;
    procinfo :PROCESS_INFORMATION;
BEGIN
--WrStr("start: "); WrStrLn(name);
  FILL(ADR(startinfo), 0C, SIZE(startinfo));
  startinfo.cb:=SIZE(startinfo);
  startinfo.dwFlags:=STARTF_USESHOWWINDOW;
  startinfo.wShowWindow:=VAL(WORD, SW_SHOWNOACTIVATE);
  chpid.runs:=CreateProcess(NIL, ADR(name), NIL, NIL, FALSE, NORMAL_PRIORITY_CLASS,
                            NIL, NIL, startinfo, procinfo);
  chpid.pid:=procinfo.hProcess;
  CloseHandle(procinfo.hThread);
END StartProg;

PROCEDURE CheckProg(VAR chpid:PROCESSHANDLE);
VAR stat:CARDINAL;
BEGIN
  IF chpid.runs THEN 
    chpid.runs:=GetExitCodeProcess(chpid.pid, stat) & (stat=259);
    IF NOT chpid.runs THEN chpid.exitcode:=stat; CloseHandle(chpid.pid) END;
  END;
END CheckProg;

PROCEDURE StopProg(VAR chpid:PROCESSHANDLE);
VAR n:CARDINAL;
BEGIN
  n:=0;
  WHILE (chpid.runs) & (n<100) DO
    TerminateProcess(chpid.pid, 0);
    CheckProg(chpid);     
    INC(n);
  END;
END StopProg;


PROCEDURE Eventloop(timeout:CARDINAL);
VAR    Msg  : MSG;
       res, i:INTEGER;
       rb:BOOLEAN;
       acttcp, acttmp : pTCPSOCK;
       t:CARDINAL;
BEGIN
--WrInt(timeout, 1); WrLn;
--  IF timeout<10000 THEN timeout:=10000 END;

--  IF timeout<>lasttime THEN                                 (* timer changes *)
    IF timeout>=10000 THEN
      rb:=KillTimer(hwndg, timerid);
      t:=timeout;
      IF t>100000 THEN t:=100000 END;
      timerid:=SetTimer(hwndg, t DIV 500, t DIV 500, NIL);
      IF timerelapsed THEN timerevent; timerelapsed:=FALSE END;
    END;
    lasttime:=timeout;
--  END;

  IF GetMessage(Msg, NIL, 0, 0) THEN
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  ELSE quit:=TRUE END;


  t:=time();
  IF lastlooped+IGATEMAXDELAY<t THEN rxidle:=0 ELSE INC(rxidle) END;
  lastlooped:=t;

  FOR i:=0 TO HIGH(udpsocks) DO udpin(i) END;  (* set udp ports *)

  acttcp:=tcpsocks;
  WHILE acttcp<>NIL DO
    IF acttcp^.tlen>0 THEN 
      IF tcpout(acttcp)<0 THEN
        IF acttcp^.windoofwatch=0 THEN acttcp^.windoofwatch:=time();
        ELSIF acttcp^.windoofwatch+10<time() THEN acttcp^.fd:=CAST(SOCKET,-1) END;
      END; 
    END;
    tcpin(acttcp);

    IF CAST(INTEGER, acttcp^.fd)<0 THEN                                 (* connection lost *)
      tcpclose(acttcp, TRUE);
      IF acttcp=tcpsocks THEN tcpsocks:=tcpsocks^.next;
      ELSE
        acttmp:=tcpsocks;
        WHILE acttmp^.next<>acttcp DO acttmp:=acttmp^.next END;
        acttmp^.next:=acttcp^.next;
      END;
      DEALLOCATE(acttcp, SIZE(acttcp^));
      acttcp:=tcpsocks;
    ELSE acttcp:=acttcp^.next END;
  END;

--  IF headmh[0]<>0C THEN WrHeadline END;

(*
IF tcpsocks<>NIL THEN tcpout(tcpsocks) END;
IF tcpsocks<>NIL THEN tcpin(tcpsocks) END; 
*)

END Eventloop;


BEGIN
  hwndg:=NIL;
  xbufrgb:=NIL;
  timerid:=0;
  lasttime:=0;
  argc:=0;
  pulling:=FALSE;
  timerelapsed:=FALSE;
  debugfd:=CAST(SOCKET, -1);
<* END *>

  headmh[0]:=0C;
  cutbuffer.text:=NIL;

END xosi.

(* timerevent with time not select timeout, gateconn with timer*)
(*
# crlf in files
# image size + framesize
# set timer only if time change
copy/paste
# create
# save bmp not ppm
# no cfg at start?
# hints + mouseqth
# resize
# window title x y
link png
# show x y of inside window
# screenshot y size -2
# start xy size wrong
32bit pixel=x11
*)