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.