PoePoem.mod: Translation to Stony Brook Modula-2

Last updated: 15. 2.1998, 17:38

<*/NOWARN:F*>
MODULE PoePoem;
(*-------------------------------------------------
   POEPOEM.C       --- Demonstrates User-Defined Resource
                   (c) Charles Petzold, 1996
   PoePoem.mod     --- translation to Stony Brook Modula-2
                   (c) Peter Stadler,   1997
  -------------------------------------------------*)


%IF WIN32 %THEN
    <*/Resource:PoePoem.RES*>
%ELSE
%END
IMPORT h2d_PoePoem;
IMPORT WIN32;
IMPORT WINGDI;
IMPORT WINUSER;
IMPORT WINX;
IMPORT SYSTEM;

TYPE
  TEXT         = ARRAY[0..4000] OF CHAR;
  PTEXT        = POINTER TO TEXT;
VAR
  szAppName    : ARRAY[0..9] OF CHAR;
  szCaption    : ARRAY[0..34] OF CHAR;
  hInst        : WIN32.HINSTANCE;
  hwnd         : WIN32.HWND;
  msg          : WINUSER.MSG;
  wc           : WINUSER.WNDCLASSEX;

  pText        : PTEXT;
  hResource    : WIN32.HGLOBAL;
  hScroll      : WIN32.HWND;
  iPosition    : INTEGER;
  cxChar       : INTEGER;
  cyChar       : INTEGER;
  cyClient     : INTEGER;
  iNumLines    : INTEGER;
  xScroll      : INTEGER;

(*++++*****************************************************************)
PROCEDURE MaxInt (a,b : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
  IF(a>b) THEN
    RETURN a;
  ELSE
    RETURN b;
  END;
END MaxInt;
(*++++*****************************************************************)
PROCEDURE MinInt (a,b : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
  IF(a>b) THEN
    RETURN b;
  ELSE
    RETURN a;
  END;
END MinInt;


<*/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
   szPoemRes       :  ARRAY[0..14] OF CHAR;
   hdc             :  WIN32.HDC;
   ps              :  WINUSER.PAINTSTRUCT;
   rect            :  WIN32.RECT;
   tm              :  WINGDI.TEXTMETRIC;
   nH              :  INTEGER;
   i               :  CARDINAL;
BEGIN
     CASE (iMsg) OF
          | WINUSER.WM_CREATE :
               hdc := WINUSER.GetDC (hwnd);
               WINGDI.GetTextMetrics (hdc, tm);
               cxChar := tm.tmAveCharWidth;
               cyChar := tm.tmHeight + tm.tmExternalLeading;
               WINUSER.ReleaseDC (hwnd, hdc);

               xScroll := WINUSER.GetSystemMetrics (WINUSER.SM_CXVSCROLL);

               hScroll := WINUSER.CreateWindow ("scrollbar", "",
                              WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.SBS_VERT,
                              0, 0, 0, 0,
                              hwnd, SYSTEM.CAST(WIN32.HMENU,1), hInst, NIL);

               WINUSER.LoadString (hInst, h2d_PoePoem.IDS_POEMRES, szPoemRes, SIZE (szPoemRes));

               hResource := WIN32.LoadResource (hInst,
                           WIN32.FindResource (hInst, szPoemRes, "TEXT"));

               pText := SYSTEM.CAST(PTEXT,WIN32.LockResource (hResource));

               iNumLines := 0;
               FOR i := 0 TO LENGTH(pText^) DO
                  IF(pText^[i] = CHR(13)) AND(pText^[i+1]= CHR(10)) THEN
                    INC(iNumLines);
                 END;
               END;
               WINUSER.SetScrollRange (hScroll, WINUSER.SB_CTL, 0, iNumLines, FALSE);
               WINUSER.SetScrollPos   (hScroll, WINUSER.SB_CTL, 0, FALSE);
               RETURN 0;

          | WINUSER.WM_SIZE :
                IF(cyClient = VAL(INTEGER,WINUSER.HIWORD(lParam))) THEN
                   nH := 1;
                ELSE
                   nH := 0;
                END;
                WINUSER.MoveWindow (hScroll, VAL(INTEGER,WINUSER.LOWORD (lParam)) - xScroll, 0,
                    xScroll, nH, TRUE);
               WINUSER.SetFocus (hwnd);
               RETURN 0;

          | WINUSER.WM_SETFOCUS :
               WINUSER.SetFocus (hScroll);
               RETURN 0;

          | WINUSER.WM_VSCROLL :
               CASE (wParam) OF


                    | WINUSER.SB_TOP :
                         iPosition := 0;
                    | WINUSER.SB_BOTTOM :
                         iPosition := iNumLines;
                    | WINUSER.SB_LINEUP :
                         iPosition := iPosition - 1;
                    | WINUSER.SB_LINEDOWN :
                         iPosition := iPosition + 1;
                    | WINUSER.SB_PAGEUP :
                         iPosition := iPosition - cyClient DIV cyChar;
                    | WINUSER.SB_PAGEDOWN :
                         iPosition := iPosition + cyClient DIV cyChar;
                    | WINUSER.SB_THUMBPOSITION :
                         iPosition := WINUSER.LOWORD (lParam);
               ELSE
               END;
               iPosition := MaxInt (0, MinInt (iPosition, iNumLines));

               IF (iPosition # WINUSER.GetScrollPos (hScroll, WINUSER.SB_CTL)) THEN
                    WINUSER.SetScrollPos (hScroll, WINUSER.SB_CTL, iPosition, TRUE);
                    WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
               END;
               RETURN 0;

          | WINUSER.WM_PAINT :
               hdc := WINUSER.BeginPaint (hwnd, ps);

               pText := SYSTEM.CAST(PTEXT, WIN32.LockResource (hResource));

               WINUSER.GetClientRect (hwnd, rect);
               rect.left := rect.left + cxChar;
               rect.top  := rect.top + cyChar * (1 - iPosition);
               WINUSER.DrawText (hdc, pText^, -1, rect, WINUSER.DT_EXTERNALLEADING);

               WINUSER.EndPaint (hwnd, ps);
               RETURN 0;

          | WINUSER.WM_DESTROY :
               WIN32.FreeResource (hResource);
               WINUSER.PostQuitMessage (0);
               RETURN 0;
     ELSE
          RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
     END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)

BEGIN
  WINUSER.LoadString (WINX.Instance, h2d_PoePoem.IDS_APPNAME, szAppName, SIZE(szAppName));
  WINUSER.LoadString (WINX.Instance, h2d_PoePoem.IDS_CAPTION, szCaption, SIZE(szCaption));

  wc.cbSize        := SIZE(wc);
  wc.style         := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW;
  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);

  RETURN WINUSER.RegisterClassEx(wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
  hInst := WINX.Instance;
  hwnd := WINUSER.CreateWindow (szAppName,
                        szCaption,
                        WINUSER.WS_OVERLAPPEDWINDOW BOR WINUSER.WS_CLIPCHILDREN,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        NIL,
                        NIL,
                        WINX.Instance,
                        NIL);

  WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
  WINUSER.UpdateWindow (hwnd);
  RETURN TRUE;
END InitMainWindow;

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