Last updated: 4. 3.1998, 23:36
<*/NOWARN:F*>
<* +M2EXTENSIONS *>
MODULE Justify1;
(*-----------------------------------------
JUSTIFY1.C --- Justified Type Program
(c) Charles Petzold, 1996
Justify1.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1998
-----------------------------------------*)
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINX;
IMPORT WINGDI;
IMPORT SYSTEM;
IMPORT ezfont;
IMPORT Str;
IMPORT Storage;
CONST LEFT = 0;
CONST RIGHT = 1;
CONST CENTER = 2;
CONST JUSTIFIED = 3;
TYPE
Ruler = ARRAY[0..15] OF INTEGER;
Text = ARRAY[0..1200] OF CHAR;
CONST
iRuleSize = Ruler { 360, 72, 144, 72, 216, 72, 144, 72, 288, 72, 144, 72, 216, 72, 144, 72 };
CONST ALIGN = JUSTIFIED;
CONST szAppName = "Justify1";
CONST szText = Text{
"Call me Ishmael. Some years ago -- never mind"+" "+
"how long precisely -- having little or no money"+" "+
"in my purse, and nothing particular to interest"+" "+
"me on shore, I thought I would sail about a"+" "+
"little and see the watery part of the world. It"+" "+
"is a way I have of driving off the spleen, and"+" "+
"regulating the circulation. Whenever I find"+" "+
"myself growing grim about the mouth; whenever"+" "+
"it is a damp, drizzly November in my soul;"+" "+
"whenever I find myself involuntarily pausing"+" "+
"before coffin warehouses, and bringing up the"+" "+
"rear of every funeral I meet; and especially"+" "+
"whenever my hypos get such an upper hand of me,"+" "+
"that it requires a strong moral principle to"+" "+
"prevent me from deliberately stepping into the"+" "+
"street, and methodically knocking people's hats"+" "+
"off -- then, I account it high time to get to sea"+" "+
"as soon as I can. This is my substitute for"+" "+
"pistol and ball. With a philosophical flourish"+" "+
"Cato throws himself upon his sword; I quietly"+" "+
"take to the ship. There is nothing surprising"+" "+
"in this. If they but knew it, almost all men in"+" "+
"their degree, some time or other, cherish very"+" "+
"nearly the same feelings towards the ocean with"+" "+
"me."};
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
(*****************************************************************************)
PROCEDURE DrawRuler ( hdc : WIN32.HDC;
prc : WIN32.PRECT);
(*****************************************************************************)
VAR
i, j : INTEGER;
ptClient : WIN32.POINT;
BEGIN
WINGDI.SaveDC (hdc);
(* Set Logical Twips mapping mode *)
WINGDI.SetMapMode (hdc, WINGDI.MM_ANISOTROPIC);
WINGDI.SetWindowExtEx (hdc, 1440, 1440, WINX.NIL_SIZE);
WINGDI.SetViewportExtEx (hdc, WINGDI.GetDeviceCaps (hdc, WINGDI.LOGPIXELSX),
WINGDI.GetDeviceCaps (hdc, WINGDI.LOGPIXELSY), WINX.NIL_SIZE);
(* Move the origin to a half inch from upper left *)
WINGDI.SetWindowOrgEx (hdc, -720, -720, WINX.NIL_POINT);
(* Find the right margin (quarter inch from right) *)
ptClient.x := prc^.right;
ptClient.y := prc^.bottom;
WINGDI.DPtoLP (hdc, ptClient, 1);
ptClient.x := ptClient.x- 360;
(* Draw the rulers *)
WINGDI.MoveToEx (hdc, 0, -360, WINX.NIL_POINT);
WINGDI.LineTo (hdc, ptClient.x, -360);
WINGDI.MoveToEx (hdc, -360, 0, WINX.NIL_POINT);
WINGDI.LineTo (hdc, -360, ptClient.y);
j := 0;
FOR i := 0 TO ptClient.x-1 BY 1440 DIV 16 DO
WINGDI.MoveToEx (hdc, i, -360, WINX.NIL_POINT);
WINGDI.LineTo (hdc, i, -360 - iRuleSize [j MOD 16]);
INC(j);
END;
j := 0;
FOR i := 0 TO ptClient.y-1 BY 1440 DIV 16 DO
WINGDI.MoveToEx (hdc, -360, i, WINX.NIL_POINT);
WINGDI.LineTo (hdc, -360 - iRuleSize [j MOD 16], i);
INC(j);
END;
WINGDI.RestoreDC (hdc, -1);
END DrawRuler;
(*****************************************************************************)
PROCEDURE Justify (
hdc : WIN32.HDC;
pText : WIN32.PSTR;
prc : WIN32.PRECT;
iAlign : INTEGER);
(*****************************************************************************)
VAR
xStart, yStart, iBreakCount : INTEGER;
pBegin, pEnd : WIN32.PSTR;
pEnd1 : WIN32.PSTR;
size : WIN32.SIZEL;
length : CARDINAL;
BEGIN
yStart := prc^.top;
REPEAT (* for each text line *)
iBreakCount := 0;
WHILE(pText^[0] = ' ') DO (* skip over leading blanks *)
pText := SYSTEM.ADDADR(pText,1);
END;
pBegin := pText;
LOOP (* until the line is known *)
pEnd := pText;
LOOP
IF (pText^[0]# '') AND (pText^[1] # ' ') THEN
pText := SYSTEM.ADDADR(pText,1);
ELSE
pText := SYSTEM.ADDADR(pText,1);
EXIT;
END;
END;
IF ( pText^[0] = '') THEN
EXIT;
END;
(* for each space, calculate extents *)
INC(iBreakCount);
WINGDI.SetTextJustification (hdc, 0, 0);
length := SYSTEM.DIFADR(pText,pBegin);
WINGDI.GetTextExtentPoint32 (hdc, pBegin^, length-1, size);
IF(VAL(INTEGER,size.cx) >= (prc^.right - prc^.left)) THEN
EXIT;
END;
END;
DEC(iBreakCount);
pEnd1 := SYSTEM.SUBADR(pEnd,1);
WHILE ( pEnd1^[0] = ' ') DO (* eliminate trailing blanks *)
pEnd := SYSTEM.SUBADR(pEnd,1);
pEnd1 := SYSTEM.SUBADR(pEnd,1);
DEC(iBreakCount);
END;
IF ( pText^[0] = '') OR (iBreakCount <= 0) THEN
pEnd := pText;
END;
WINGDI.SetTextJustification (hdc, 0, 0);
length := SYSTEM.DIFADR(pEnd,pBegin);
WINGDI.GetTextExtentPoint32 (hdc, pBegin^, length, size);
CASE (iAlign) OF (* use alignment for xStart *)
| LEFT:
xStart := prc^.left;
| RIGHT:
xStart := prc^.right - size.cx;
| CENTER:
xStart := (prc^.right + prc^.left - size.cx) / 2;
| JUSTIFIED:
IF ( pText^[0] # '') AND (iBreakCount > 0) THEN
WINGDI.SetTextJustification (hdc,
prc^.right - prc^.left - size.cx,
iBreakCount);
END;
xStart := prc^.left;
ELSE
END;
length := SYSTEM.DIFADR(pEnd,pBegin);
WINGDI.TextOut (hdc, xStart, yStart, pBegin^, length);
yStart := yStart + size.cy;
pText := pEnd;
UNTIL (pText^[0]="") OR (yStart >= prc^.bottom);
END Justify;
<*/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
hdc : WIN32.HDC;
ps : WINUSER.PAINTSTRUCT;
rcClient : WIN32.RECT;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_PAINT:
hdc := WINUSER.BeginPaint (hwnd, ps);
WINUSER.GetClientRect (hwnd, rcClient);
DrawRuler (hdc, SYSTEM.ADR(rcClient));
rcClient.left := rcClient.left + WINGDI.GetDeviceCaps (hdc, WINGDI.LOGPIXELSX) DIV 2;
rcClient.top := rcClient.top + WINGDI.GetDeviceCaps (hdc, WINGDI.LOGPIXELSY) DIV 2;
rcClient.right := rcClient.right - WINGDI.GetDeviceCaps (hdc, WINGDI.LOGPIXELSX) DIV 4;
WINGDI.SelectObject (hdc, SYSTEM.CAST(WIN32.HGDIOBJ,ezfont.EzCreateFont (hdc, "Times New Roman", 150, 0, 0, TRUE)));
Justify (hdc, SYSTEM.ADR(szText), SYSTEM.ADR(rcClient), ALIGN);
WINGDI.DeleteObject (WINGDI.SelectObject (hdc, WINGDI.GetStockObject (WINGDI.SYSTEM_FONT)));
WINUSER.EndPaint (hwnd, ps);
RETURN 0;
| WINUSER.WM_DESTROY:
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 := WINUSER.CS_HREDRAW + WINUSER.CS_VREDRAW;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := WINX.Instance;
wc.hIcon := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
wc.lpszMenuName := SYSTEM.ADR(szAppName);
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (NIL,WINUSER.IDI_APPLICATION^);
rc := WINUSER.RegisterClassEx(wc);
RETURN rc #0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (
szAppName, (* window class name *)
"Justified Type: Translation to Stony Brook Modula-2",
(* window caption *)
WINUSER.WS_OVERLAPPEDWINDOW, (* window style *)
WINUSER.CW_USEDEFAULT, (* initial x position *)
WINUSER.CW_USEDEFAULT, (* initial y position *)
WINUSER.CW_USEDEFAULT, (* initial x size *)
WINUSER.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
wc.hInstance, (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
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 Justify1.