DDEPop2.mod: Translation to Stony Brook Modula-2

Last updated: 15. 2.1998, 18:17

<*/NOWARN:F*>
MODULE DDEPop2;
(*---------------------------------------------
   DDEPOP2.C       --- DDEML Server for Population Data
                   (c) Charles Petzold, 1996
   DDEPop2.mod     --- Translation to Stony Brook Modula-2
                   (c) Peter Stadler,   1998
  ---------------------------------------------*)
%IF WIN32 %THEN
    <*/Resource:DDEPOP2.RES*>
%ELSE
%END

IMPORT Helper;
IMPORT WINUSER;
IMPORT WINGDI;
IMPORT WIN32;
IMPORT WINX;
IMPORT SYSTEM;
IMPORT DDEML;
IMPORT h2d_ddepop;
IMPORT Str;

CONST WM_USER_INITIATE = WINUSER.WM_USER + 1;
CONST ID_TIMER         = 1;
  szAppName      = "DdePop2";
  szTopic        = "US_Population";
VAR
  hInst          : WIN32.HINSTANCE;
  hwnd           : WIN32.HWND;
  wc             : WINUSER.WNDCLASSEX;
  msg            : WINUSER.MSG;
  idInst         : WIN32.DWORD;
  hszService     : DDEML.HSZ;
  hszTopic       : DDEML.HSZ;
(*********************************************************************)
PROCEDURE GetStateNumber (iFmt : WIN32.UINT; hszItem : DDEML.HSZ): INTEGER;
(*********************************************************************)
VAR
  szItem  : ARRAY[0..31] OF CHAR;
  i       : INTEGER;
BEGIN
     IF (iFmt # WINUSER.CF_TEXT) THEN
          RETURN -1;
     END;

     DDEML.DdeQueryString (idInst, hszItem, szItem, SIZE (szItem), 0);

     i := 0;
     LOOP
          IF (Str.Compare(szItem, h2d_ddepop.pop[i].szState^) = 0) THEN
               EXIT;
          END;
          INC(i);
          IF(i > h2d_ddepop.NUM_STATES-1) THEN
             EXIT;
          END;
     END;
     IF (i >= h2d_ddepop.NUM_STATES) THEN
          RETURN -1;
     END;

     RETURN i;
END GetStateNumber;

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE DdeCallback (iType       : WIN32.UINT;
(**********************************************************************)
                       iFmt        : WIN32.UINT;
                       hConv       : DDEML.HCONV;
                       hsz1        : WIN32.WPARAM;
                       hsz2        : WIN32.WPARAM;
                       hData       : WIN32.WPARAM;
                       dwData1     : WIN32.DWORD;
                       dwData2     : WIN32.DWORD) : DDEML.HDDEDATA [EXPORT];
VAR
  szBuffer :  ARRAY[0..31] OF CHAR;
  i        :  INTEGER;
BEGIN
     CASE (iType) OF
          | DDEML.XTYP_CONNECT :      (* hsz1 = topic                       *)
                                      (* hsz2 = service                     *)

               DDEML.DdeQueryString (idInst, hsz2, szBuffer, SIZE (szBuffer), 0);

               IF (Str.Compare(szBuffer, szAppName)#0) THEN
                    RETURN 0;
               END;

               DDEML.DdeQueryString (idInst, hsz1, szBuffer, SIZE (szBuffer), 0);

               IF (Str.Compare(szBuffer, szTopic)#0) THEN
                    RETURN 0;
               END;

               RETURN VAL(DDEML.HDDEDATA,TRUE);

          | DDEML.XTYP_ADVSTART :           (* hsz1 := topic                       *)
                                      (* hsz2 := item                        *)

                    (* Check for matching format and data item DO          *)

               i := GetStateNumber (iFmt, hsz2);
               IF (i = -1) THEN
                    RETURN 0;
               END;

               h2d_ddepop.pop[i].lPopLast := 0;
               WINUSER.PostMessage (hwnd, WINUSER.WM_TIMER, 0, 0h);

               RETURN VAL(DDEML.HDDEDATA,TRUE);

          | DDEML.XTYP_REQUEST :
                                      (* hsz1 := topic                       *)
                                      (* hsz2 := item                        *)

                    (* Check for matching format and data item             *)

               i := GetStateNumber (iFmt, hsz2);
               IF (i = -1) THEN
                    RETURN 0;
               END;

               WINUSER.wsprintf (szBuffer, "%ld\r"+"", h2d_ddepop.pop[i].lPop);

               RETURN DDEML.DdeCreateDataHandle (idInst, SYSTEM.ADR(szBuffer),
                                           LENGTH(szBuffer) + 1,
                                           0, hsz2, WINUSER.CF_TEXT, 0);

          | DDEML.XTYP_ADVREQ :
                                      (* hsz1 := topic                       *)
                                      (* hsz2 := item                        *)

                    (* Check for matching format and data item             *)

               i := GetStateNumber (iFmt, hsz2);
               IF (i = -1) THEN
                    RETURN 0;
               END;

               WINUSER.wsprintf (szBuffer, "%ld\r"+"", h2d_ddepop.pop[i].lPop);

               RETURN DDEML.DdeCreateDataHandle (idInst, SYSTEM.ADR(szBuffer),
                                           LENGTH(szBuffer) + 1,
                                           0, hsz2, WINUSER.CF_TEXT, 0);

          | DDEML.XTYP_ADVSTOP :            (* hsz1 := topic                       *)
                                            (* hsz2 := item                        *)

                    (* Check for matching format and data item DO          *)

               i := GetStateNumber (iFmt, hsz2);
               IF (i=-1) THEN
                    RETURN 0;
               END;

               RETURN VAL(DDEML.HDDEDATA,TRUE);
     ELSE

               RETURN 0;
     END;
END DdeCallback;
<*/POP*>

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE WndProc      (hwnd        : WIN32.HWND;
(**********************************************************************)
                       iMsg        : WIN32.UINT;
                       wParam      : WIN32.WPARAM;
                       lParam      : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
VAR
  hszItem         :  DDEML.HSZ;
  i               :  INTEGER;
BEGIN

     CASE (iMsg) OF
          | WM_USER_INITIATE :
               Helper.InitPops ();

               hszService := DDEML.DdeCreateStringHandle (idInst, szAppName, 0);
               hszTopic   := DDEML.DdeCreateStringHandle (idInst, szTopic,   0);

               DDEML.DdeNameService (idInst, hszService, 0, DDEML.DNS_REGISTER);
               RETURN 0;

          | WINUSER.WM_TIMER :

                    (* Calculate new current populations                       *)

               Helper.CalcPops ();

               FOR i := 0 TO h2d_ddepop.NUM_STATES-1  DO
                    IF (h2d_ddepop.pop[i].lPop # h2d_ddepop.pop[i].lPopLast) THEN
                         hszItem := DDEML.DdeCreateStringHandle (idInst,
                                                          h2d_ddepop.pop[i].szState^, 0);

                         DDEML.DdePostAdvise (idInst, hszTopic, hszItem);

                         DDEML.DdeFreeStringHandle (idInst, hszItem);

                         h2d_ddepop.pop[i].lPopLast := h2d_ddepop.pop[i].lPop;
                     END;
               END;
               RETURN 0;

          | WINUSER.WM_TIMECHANGE :

                    (* Calculate new current populations                       *)

               Helper.CalcPops ();

               FOR i := 0 TO h2d_ddepop.NUM_STATES-1  DO
                    IF (h2d_ddepop.pop[i].lPop # h2d_ddepop.pop[i].lPopLast) THEN
                         hszItem := DDEML.DdeCreateStringHandle (idInst,
                                                          h2d_ddepop.pop[i].szState^, 0);

                         DDEML.DdePostAdvise (idInst, hszTopic, hszItem);

                         DDEML.DdeFreeStringHandle (idInst, hszItem);

                         h2d_ddepop.pop[i].lPopLast := h2d_ddepop.pop[i].lPop;
                     END;
               END;
               RETURN 0;

          | WINUSER.WM_QUERYOPEN :
               RETURN 0;

          | WINUSER.WM_DESTROY :
               DDEML.DdeNameService (idInst, hszService, 0, DDEML.DNS_UNREGISTER);
               DDEML.DdeFreeStringHandle (idInst, hszService);
               DDEML.DdeFreeStringHandle (idInst, hszTopic);

               WINUSER.PostQuitMessage (0);
               RETURN 0;
     ELSE
               RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
     END;
END WndProc;
<*/POP*>

(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
  rc    :  CARDINAL;

BEGIN
  wc.cbSize        := SIZE(wc);
  wc.style         := 0;
  wc.lpfnWndProc   := WndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 0;
  wc.hInstance     := WINX.Instance;
  wc.hIcon         := WINUSER.LoadIcon (WINX.Instance,szAppName);
  wc.hCursor       := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
  wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
  wc.lpszMenuName  := NIL;
  wc.lpszClassName := SYSTEM.ADR(szAppName);
  wc.hIconSm       := WINUSER.LoadIcon (WINX.Instance,szAppName);
  rc := WINUSER.RegisterClassEx(wc);
  RETURN rc#0;
END InitApplication;

(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
  hwnd := WINUSER.CreateWindow (szAppName,
                        "DDEML Population Server: Translation to Stony Brook Modula-2",
                        WINUSER.WS_OVERLAPPEDWINDOW,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        NIL,
                        NIL,
                        WINX.Instance,
                        NIL);
   WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWMINNOACTIVE);
   WINUSER.UpdateWindow (hwnd);
               (* Initialize for using DDEML                            *)

     IF (DDEML.DdeInitialize (idInst, SYSTEM.CAST(DDEML.PFNCALLBACK,SYSTEM.ADR(DdeCallback)),
                        DDEML.CBF_FAIL_EXECUTES BOR DDEML.CBF_FAIL_POKES BOR
                        DDEML.CBF_SKIP_REGISTRATIONS BOR DDEML.CBF_SKIP_UNREGISTRATIONS, 0)=1) THEN
          WINUSER.MessageBox (hwnd, "Could not initialize server!",
                      szAppName, WINUSER.MB_ICONEXCLAMATION BOR WINUSER.MB_OK);

          WINUSER.DestroyWindow (hwnd);
          RETURN FALSE;
     END;

                (* Set the timer                                               *)

     WINUSER.SetTimer (hwnd, ID_TIMER, 5000, NIL);

               (* Start things going                                           *)

     WINUSER.SendMessage (hwnd, WM_USER_INITIATE, 0, 0h);

END InitMainWindow;


BEGIN
  IF InitApplication()  AND  InitMainWindow() THEN
    WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
      WINUSER.TranslateMessage(msg);
      WINUSER.DispatchMessage(msg);
    END;
               (* Clean up                                                     *)

    DDEML.DdeUninitialize (idInst);
    WINUSER.KillTimer (hwnd, ID_TIMER);
  END;
END DDEPop2.