OpenEuphoria

1. Text scaling demo

• Posted by Patrick.Barnes at transgrid.com.au Jan 28, 2003
• 396 views

This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.

------_=_NextPart_000_01C2C71C.A1201040

Got a text scaling demo working, thought I'd share it with y'all.

It will fit the text perfectly inside a given rectangle, and it will support
strings with tab and newline characters, and automatically strip out carriage
return characters.

=======================
Patrick Barnes
Information Systems Group
201 Elizabeth St, Sydney
Patrick.Barnes at transgrid.com.au
Ext: 91-3583
Ph:(02) 9284-3583
Mob: 0410 751 044
=======================
Below for those people without attachments.
=======================
------------------------------------
--Title: Automatic text sizing demo
--Author: Patrick Barnes
--Date: 28 / 1 / 2003
------------------------------------
--This demo revolves around the
--procedure drawText. It will
--tokenize a given string into lines
--and add tabs to it, then size it
--to fit into a rectangle of given
--size and position.
------------------------------------
--Permission is freely granted for 
--anyone to use this library as they 
--see fit, save for misrepresenting 
--it's origin.
------------------------------------
--Thanks to: Pete Lomax for his
--binary search, Derek Parnell for
--win32lib.
------------------------------------


include win32lib.ew
without warning

constant win = create(Window, "Text scaling", 0, Default, Default, 400, 340, 0)

constant text = "This is a test of the automatic\ntext sizing system.\nChange
this text in the source code."
constant TABSIZE = 6
constant TAB = 9

atom dwin

--returns a sequence with the x,y size of the lines of text submitted
global function getMlTextExtent(integer win, sequence mtext)
	integer lnum, maxw
	lnum = length(mtext)
	maxw = 0
	for a = 1 to lnum do
		if getTextWidth(win, mtext[a]) > maxw then
			maxw = getTextWidth(win, mtext[a])
		end if
	end for
	return {maxw  , lnum*getTextHeight(win, "T")}
end function

--Will automatically size and draw the string itext (which may have '\n') to the
desired window.
--It will scale and position to fit inside the rectangle defined by {ulx, uly}
-> {lrx, lry}
--Font is a two-element sequence of the form { "Font name", Style }
global procedure drawText(integer win, sequence itext, integer ulx, integer uly,
integer lrx, integer lry, sequence font )
	sequence text, tsize, wsize, pos
	integer bsize, ssize, fsize
	atom ctr

	--Tokenize the text into lines.
	--*****************************
	if not length(itext) then --if no text, then don't bother
		return
elsif itext[length(itext)] = '\n' then --if the last char is a '\n' then get
rid of it.
		itext = itext[1..length(itext) - 1]
	end if

	text = {{}}
	ctr = 1

for a = 1 to length(itext) do --step through every letter, building up the
lines
		if itext[a] = TAB then
text[ctr] &= repeat(' ', remainder( TABSIZE * ( floor( length(text[ctr]) /
TABSIZE) + 1), length(text[ctr]) ) )
		elsif itext[a] = '\n' then
			text &= {{}}
			ctr += 1
		elsif itext[a] = '\r' then
			--ignore that character
		else text[ctr] &= itext[a]
		end if
	end for
	--Find the optimal font size for the window
	--*****************************************
	fsize = 8	--starting font size
	ssize = 1
	bsize = 0
	wsize = {lrx - ulx, lry - uly}
	while 1 do		--Thanks to Pete Lomax for his binary search.
		--find the size of that text
		setFont(win, font[1], fsize, font[2])	
		tsize = getMlTextExtent(win, text)
		--if it's bigger than the window...
		if tsize[1] >= wsize[1] or tsize[2] >= wsize[2] then
			bsize=fsize
			fsize=ssize+floor((fsize-ssize)/2)
			if fsize=ssize then
				exit
			end if
		else
			ssize=fsize
			if bsize=0 then
				fsize*=2
			else
				if fsize+1=bsize then exit end if
				fsize+=floor((bsize-fsize)/2)
			end if
		end if
	end while	--At this point fsize is the optimal text size.



	--Draw the text to the window
	--***************************
	pos = {ulx, uly}
		--draw the text on the window.

	setFont(win, font[1], fsize, font[2])	
	for a = 1 to length(text) do
			wPuts({win, pos[1], pos[2]}, text[a])
			pos[2] += getTextHeight(win, text[a])
	end for
end procedure
-------------------------------------------------------------------
procedure display(integer ID, integer Event, sequence params)
	sequence sz
	sz = getClientRect(win)
drawText(win, text, 50, 50, sz[3] - 50, sz[4] - 50, {"Times New Roman", Normal}
)
	drawRectangle(win, 0, 50, 50, sz[3] - 50, sz[4] - 50)
end procedure
setHandler(win, w32HPaint, routine_id("display") )
-------------------------------------------------------------------
procedure c(integer ID, integer Event, sequence params)
	sequence sz
	if params[1] != 27 then
		sz = getClientRect(win)
		setClientRect(win, sz[3]+5, sz[4]+5)
	else
		closeWindow(win)
	end if
end procedure
setHandler(win, w32HKeyDown, routine_id("c") )
-------------------------------------------------------------------
procedure resized(integer ID, integer Event, sequence params)
	repaintWindow(win)
end procedure
setHandler(win, w32HResize, routine_id("resized") )
-------------------------------------------------------------------
WinMain(win, Normal)
 <<textscaletest.exw>> 


***********************************************************************




***********************************************************************


------_=_NextPart_000_01C2C71C.A1201040
Content-Type: application/octet-stream;
	name="textscaletest.exw"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="textscaletest.exw"

------------------------------------
--Title: Automatic text sizing demo
--Author: Patrick Barnes
--Date: 28 / 1 / 2003
------------------------------------
--This demo revolves around the
--procedure drawText. It will
--tokenize a given string into lines
--and add tabs to it, then size it
--to fit into a rectangle of given
--size and position.
------------------------------------
--Permission is freely granted for=20
--anyone to use this library as they=20
--see fit, save for misrepresenting=20
--it's origin.
------------------------------------
--Thanks to: Pete Lomax for his
--binary search, Derek Parnell for
--win32lib.
------------------------------------


include win32lib.ew
without warning

constant win =3D create(Window, "Text scaling", 0, Default, Default, =
400, 340, 0)

constant text =3D "This is a test of the automatic\ntext sizing =
system.\nChange this text in the source code."
constant TABSIZE =3D 6
constant TAB =3D 9

atom dwin

--returns a sequence with the x,y size of the lines of text submitted
global function getMlTextExtent(integer win, sequence mtext)
    integer lnum, maxw
    lnum =3D length(mtext)
    maxw =3D 0
    for a =3D 1 to lnum do
        if getTextWidth(win, mtext[a]) > maxw then
            maxw =3D getTextWidth(win, mtext[a])
        end if
    end for
    return {maxw  , lnum*getTextHeight(win, "T")}
end function

--Will automatically size and draw the string itext (which may have =
'\n') to the desired window.
--It will scale and position to fit inside the rectangle defined by =
{ulx, uly} -> {lrx, lry}
--Font is a two-element sequence of the form { "Font name", Style }
global procedure drawText(integer win, sequence itext, integer ulx, =
integer uly, integer lrx, integer lry, sequence font )
    sequence text, tsize, wsize, pos
    integer bsize, ssize, fsize
    atom ctr

    --Tokenize the text into lines.
    --*****************************
    if not length(itext) then --if no text, then don't bother
        return
    elsif itext[length(itext)] =3D '\n' then --if the last char is a =
'\n' then get rid of it.
        itext =3D itext[1..length(itext) - 1]
    end if

    text =3D {{}}
    ctr =3D 1

    for a =3D 1 to length(itext) do --step through every letter, =
building up the lines
        if itext[a] =3D TAB then
            text[ctr] &=3D repeat(' ', remainder( TABSIZE * ( floor( =
length(text[ctr]) / TABSIZE) + 1), length(text[ctr]) ) )
        elsif itext[a] =3D '\n' then
            text &=3D {{}}
            ctr +=3D 1
        elsif itext[a] =3D '\r' then
            --ignore that character
        else text[ctr] &=3D itext[a]
        end if
    end for
    --Find the optimal font size for the window
    --*****************************************
    fsize =3D 8   --starting font size
    ssize =3D 1
    bsize =3D 0
    wsize =3D {lrx - ulx, lry - uly}
    while 1 do      --Thanks to Pete Lomax for his binary search.
        --find the size of that text
        setFont(win, font[1], fsize, font[2])  =20
        tsize =3D getMlTextExtent(win, text)
        --if it's bigger than the window...
        if tsize[1] >=3D wsize[1] or tsize[2] >=3D wsize[2] then
            bsize=3Dfsize
            fsize=3Dssize+floor((fsize-ssize)/2)
            if fsize=3Dssize then
                exit
            end if
        else
            ssize=3Dfsize
            if bsize=3D0 then
                fsize*=3D2
            else
                if fsize+1=3Dbsize then exit end if
                fsize+=3Dfloor((bsize-fsize)/2)
            end if
        end if
    end while   --At this point fsize is the optimal text size.



    --Draw the text to the window
    --***************************
    pos =3D {ulx, uly}
        --draw the text on the window.

    setFont(win, font[1], fsize, font[2])  =20
    for a =3D 1 to length(text) do
            wPuts({win, pos[1], pos[2]}, text[a])
            pos[2] +=3D getTextHeight(win, text[a])
    end for
end procedure
-------------------------------------------------------------------
procedure display(integer ID, integer Event, sequence params)
    sequence sz
    sz =3D getClientRect(win)
    drawText(win, text, 50, 50, sz[3] - 50, sz[4] - 50, {"Times New =
Roman", Normal} )
    drawRectangle(win, 0, 50, 50, sz[3] - 50, sz[4] - 50)
end procedure
setHandler(win, w32HPaint, routine_id("display") )
-------------------------------------------------------------------
procedure c(integer ID, integer Event, sequence params)
    sequence sz
    if params[1] !=3D 27 then
        sz =3D getClientRect(win)
        setClientRect(win, sz[3]+5, sz[4]+5)
    else
        closeWindow(win)
    end if
end procedure
setHandler(win, w32HKeyDown, routine_id("c") )
-------------------------------------------------------------------
procedure resized(integer ID, integer Event, sequence params)
    repaintWindow(win)
end procedure
setHandler(win, w32HResize, routine_id("resized") )
-------------------------------------------------------------------
WinMain(win, Normal)
------_=_NextPart_000_01C2C71C.A1201040--