Last updated: 18. 1.1998, 10:14
<* +M2EXTENSIONS *>
MODULE Justify1;
(*-----------------------------------------
JUSTIFY1.C --- Justified Type Program
(c) Charles Petzold, 1996
Justify1.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1998
-----------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
IMPORT ezfont;
IMPORT Str;
IMPORT Storage;
CONST LEFT = 0;
CONST RIGHT = 1;
CONST CENTER = 2;
CONST JUSTIFIED = 3;
TYPE
Line = ARRAY[0..50] OF CHAR;
Ruler = ARRAY[0..15] OF INTEGER;
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 = "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 : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
PROCEDURE DrawRuler ( hdc : Windows.HDC;
prc : Windows.PRECT);
VAR
i, j : INTEGER;
ptClient : ARRAY[0..1] OF Windows.POINT;
BEGIN
Windows.SaveDC (hdc);
(* Set Logical Twips mapping mode *)
Windows.SetMapMode (hdc, Windows.MM_ANISOTROPIC);
Windows.SetWindowExtEx (hdc, 1440, 1440, NIL);
Windows.SetViewportExtEx (hdc, Windows.GetDeviceCaps (hdc, Windows.LOGPIXELSX),
Windows.GetDeviceCaps (hdc, Windows.LOGPIXELSY), NIL);
(* Move the origin to a half inch from upper left *)
Windows.SetWindowOrgEx (hdc, -720, -720, NIL);
(* Find the right margin (quarter inch from right) *)
ptClient[0].x := prc^.right;
ptClient[0].y := prc^.bottom;
Windows.DPtoLP (hdc, ptClient, 1);
ptClient[0].x := ptClient[0].x- 360;
(* Draw the rulers *)
Windows.MoveToEx (hdc, 0, -360, NIL);
Windows.LineTo (hdc, ptClient[0].x, -360);
Windows.MoveToEx (hdc, -360, 0, NIL);
Windows.LineTo (hdc, -360, ptClient[0].y);
j := 0;
FOR i := 0 TO ptClient[0].x-1 BY 1440 DIV 16 DO
Windows.MoveToEx (hdc, i, -360, NIL);
Windows.LineTo (hdc, i, -360 - iRuleSize [j MOD 16]);
INC(j);
END;
j := 0;
FOR i := 0 TO ptClient[0].y-1 BY 1440 DIV 16 DO
Windows.MoveToEx (hdc, -360, i, NIL);
Windows.LineTo (hdc, -360 - iRuleSize [j MOD 16], i);
INC(j);
END;
Windows.RestoreDC (hdc, -1);
END DrawRuler;
PROCEDURE Justify (
hdc : Windows.HDC;
pText : Windows.PSTR;
prc : Windows.PRECT;
iAlign : INTEGER);
VAR
xStart, yStart, iBreakCount : INTEGER;
pBegin, pEnd : Windows.PSTR;
ppText : Windows.PSTR;
pEnd1 : Windows.PSTR;
size : Windows.SIZEL;
length : CARDINAL;
BEGIN
yStart := prc^.top;
REPEAT (* for each text line *)
iBreakCount := 0;
WHILE(pText^ = ' ') DO (* skip over leading blanks *)
pText := SYSTEM.ADDADR(pText,1);
END;
pBegin := pText;
LOOP (* until the line is known *)
pEnd := pText;
LOOP
IF (pText^# '') AND (pText^(*[1]*) # ' ') THEN
pText := SYSTEM.ADDADR(pText,1);
ELSE
pText := SYSTEM.ADDADR(pText,1);
EXIT;
END;
END;
IF ( pText^ = '') THEN
EXIT;
END;
(* for each space, calculate extents *)
INC(iBreakCount);
Windows.SetTextJustification (hdc, 0, 0);
length := SYSTEM.DIFADR(pText,pBegin);
Windows.GetTextExtentPoint32 (hdc, pBegin, length - 1, size);
IF(SYSTEM.CAST(INTEGER,size.cx) >= (prc^.right - prc^.left)) THEN
EXIT;
END;
END;
DEC(iBreakCount);
pEnd1 := SYSTEM.SUBADR(pEnd,1);
WHILE ( pEnd1^ = ' ') DO (* eliminate trailing blanks *)
pEnd := SYSTEM.SUBADR(pEnd,1);
pEnd1 := SYSTEM.SUBADR(pEnd,1);
DEC(iBreakCount);
END;
IF ( pText^ = '') OR (iBreakCount <= 0) THEN
pEnd := pText;
END;
Windows.SetTextJustification (hdc, 0, 0);
length := SYSTEM.DIFADR(pEnd,pBegin);
Windows.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) DIV 2;
| JUSTIFIED:
IF ( pText^ # '') AND (iBreakCount > 0) THEN
Windows.SetTextJustification (hdc,
prc^.right - prc^.left - size.cx,
iBreakCount);
END;
xStart := prc^.left;
ELSE
END;
length := SYSTEM.DIFADR(pEnd,pBegin);
Windows.TextOut (hdc, xStart, yStart, pBegin, length-1);
yStart := yStart + size.cy;
pText := pEnd;
UNTIL ( pText^='') OR (yStart >= prc^.bottom);
END Justify;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
hdc : Windows.HDC;
ps : Windows.PAINTSTRUCT;
rcClient : Windows.RECT;
BEGIN
CASE (iMsg) OF
| Windows.WM_PAINT:
hdc := Windows.BeginPaint (hwnd, ps);
Windows.GetClientRect (hwnd, rcClient);
DrawRuler (hdc, SYSTEM.ADR(rcClient));
rcClient.left := rcClient.left + Windows.GetDeviceCaps (hdc, Windows.LOGPIXELSX) DIV 2;
rcClient.top := rcClient.top + Windows.GetDeviceCaps (hdc, Windows.LOGPIXELSY) DIV 2;
rcClient.right := rcClient.right - Windows.GetDeviceCaps (hdc, Windows.LOGPIXELSX) DIV 4;
Windows.SelectObject (hdc, SYSTEM.CAST(Windows.HGDIOBJ,ezfont.EzCreateFont (hdc, "Times New Roman", 150, 0, 0, TRUE)));
Justify (hdc, SYSTEM.ADR(szText), SYSTEM.ADR(rcClient), ALIGN);
Windows.DeleteObject (Windows.SelectObject (hdc, Windows.GetStockObject (Windows.SYSTEM_FONT)));
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_DESTROY:
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
BEGIN
wc.cbSize := SIZE(wc);
wc.style := Windows.CS_HREDRAW + Windows.CS_VREDRAW;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := Windows.MyInstance();
wc.hIcon := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION);
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH, Windows.GetStockObject (Windows.WHITE_BRUSH));
wc.lpszMenuName := SYSTEM.ADR(szAppName);
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (NIL,Windows.IDI_APPLICATION);
rc := Windows.RegisterClassEx(wc);
RETURN rc #0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow (
szAppName, (* window class name *)
"Justified Type: Translation to XDS Modula-2",
(* window caption *)
Windows.WS_OVERLAPPEDWINDOW, (* window style *)
Windows.CW_USEDEFAULT, (* initial x position *)
Windows.CW_USEDEFAULT, (* initial y position *)
Windows.CW_USEDEFAULT, (* initial x size *)
Windows.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;
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END Justify1.