Change font size / Maintain screen size.

[Pete]

This is a simple demo for SCREEN 0, but someone could work up a graphics counterpart easily enough...

Code: (Select All)

SCREEN 0
fontsize% = 16
style$ = "monospace"
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf"
font& = _LOADFONT(fontpath$, fontsize%, style$)
_FONT font&
ww = 600: wh = 350
WIDTH ww \ _FONTWIDTH, wh \ _FONTHEIGHT
PALETTE 7, 63: COLOR 0, 7: CLS
_FONT font&
_SCREENMOVE 0, 0
PRINT "Press ctrl + to increase font size or ctrl - to decrease."
DO
    _LIMIT 30
    c = _KEYHIT
    IF c THEN
        SELECT CASE c
            CASE -189
                IF fontsize% > 9 THEN fontsize% = fontsize% - 2
            CASE -187
                IF fontsize% < 31 THEN fontsize% = fontsize% + 2
        END SELECT
    END IF
    IF oldf% AND fontsize% <> oldf% THEN
        _SCREENHIDE: _FONT 8
        _FREEFONT font&
        font& = _LOADFONT(fontpath$, fontsize%, style$)
        _FONT font&
        _SCREENSHOW
        fw% = _FONTWIDTH: fh% = _FONTHEIGHT
        WIDTH ww / fw%, wh / fh%
        PALETTE 7, 63: COLOR 0, 7: CLS
        _FONT font&
        _SCREENMOVE 0, 0
        PRINT "Font size changed to:"; fontsize%, "width ="; _WIDTH
        _KEYCLEAR
    END IF
    oldf% = fontsize%
LOOP

It's a bit of a trick to capture ctrl combos with some keys like + and -. I used inp(96) as it is one of the easiest. The actual trigger happens when the + or - key is released, and nothing registers when either is pressed.

The routine can be expanded to use $RESIZE:ON but the user would need to decide what changes as the screen size changes. Probably the most popular use would be a fixed number of characters across the screen, so when resize increases the widt, the width statement adjusts to the size, and the font size adjusts to as close to the same number of characters across the screen. To do a perfect operation would also require the development of a margin system.

EDIT: Addressed memory leak, thanks Steve!

Pete

[SMcNeill]

Your program is doomed to fail. It's gonna crash and burn horribly after being used for a while. Just watch it's memory usage go up, up, up, up, and up more, in task manager.

You're endlessly loading resources -- fonts at various sizes, in this example -- and never freeing them. You've got a memory leak at work here that will eventually either crash your program, or else make your OS slow down to a crawl and become unstable.

My advice? Since your fontsize is going from 9 to 31, just load the font into an array at startup and use that array without having to worry about ever freeing or loading resources after that.

DIM font(9 TO 31) As Long
For I = 9 TO 31 STEP 2
font(i) = _LOADFONT(fontpath$, i, fontstyle$)
NEXT

Then just call your _FONT font(fontsize). No endless loading of resources necessary, nor any need to free them.

[bplus]

I think I did that in GUI.

[MasterGy]

a while ago I figured out a way to speed up the display of texts. unfortunately, if we use _printstring , it is very slow. This writes to the screen in a software way and will be very slow to process. I figured out that if we map the characters to image in advance, it will take up space in the memory, but it will be very fast. in hardware mode (33) very fast!

it is easy to use

Code: (Select All)

Dim Shared font_collection(9, 99, 1): Screen _NewImage(800, 600, 32)
Const font_sh = 32 'font installed 32(software) or 33(hardware) using

'font_install font_index , font location, color
font_install 0, Environ$("SYSTEMROOT") + "\fonts\arial.ttf", _RGBA32(255, 0, 0, 255), 50
font_install 1, Environ$("SYSTEMROOT") + "\fonts\lucon.ttf", _RGBA32(0, 255, 0, 255), 50






'printtype x_position,    y_position,     fontsize,     text$       text$: to determine the index of the installed letter at the beginning   "#fontindex#........."
'if x_position is -1, then text write to center

printtype 20, 20, 50, "#0#this is 0 index font"
printtype -1, 100, 20, "#1#this is 1 index font (to center)"



Sub font_install (f_index, f$, col&, fs)
    sh = Int(fs * .08): af = _LoadFont(f$, fs): k$ = "'+0123456789.?!=:>()<%/-,ABCDEFGHIJKLMNOPQRSTVXYZUWabcdefghijklmnopqrstvxyzuw "
    For ac = 0 To Len(k$) - 1: ac$ = Mid$(k$, ac + 1, 1): _Font af
        temp2 = _NewImage(_PrintWidth(ac$) + sh, fs + sh, 32): _Dest temp2: Cls , 0: _Font af
        Color _RGBA32(20, 20, 20, _Alpha32(col&)), 0: _PrintString (sh, sh), ac$
        Color col&, 0: _PrintString (0, 0), ac$
        font_collection(f_index, ac + 1, 0) = _CopyImage(temp2, font_sh): _FreeImage temp2
    font_collection(f_index, ac + 1, 1) = Asc(ac$): Next ac: font_collection(f_index, 0, 0) = af
End Sub


Sub printtype (px, py, f_size, t$)
    ReDim text_raw(299, 4) As Long: actual_x = px: f_index = 0: tr_c = 0
    Do Until ac = Len(t$): ac = ac + 1: ac$ = Mid$(t$, ac, 1)
        If ac$ = "#" Then
            f_index = Val(Mid$(t$, ac + 1, 1)): ac = ac + 2
        Else
            find = -1: For t = 1 To 99: If Asc(ac$) = font_collection(f_index, t, 1) Then find = t: Exit For
            Next t
            If find <> -1 Then
                af = font_collection(f_index, find, 0): xsize = Int(f_size / _Height(af) * _Width(af))
                text_raw(tr_c, 0) = af: text_raw(tr_c, 1) = actual_x: text_raw(tr_c, 2) = xsize + actual_x
                tr_c = tr_c + 1: actual_x = actual_x + xsize
            End If
        End If
    Loop: If px = -1 Then mv = (_Width(mon) - actual_x) / 2 + 1
    For t = 0 To tr_c - 1: tx = text_raw(t, 0): _PutImage (text_raw(t, 1) + mv, py)-(text_raw(t, 2) + mv, py + f_size), tx: Next t: text_large = actual_x
End Sub

[Pete]

Your program is doomed to fail.  It's gonna crash and burn horribly after being used for a while.  Just watch it's memory usage go up, up, up, up, and up more, in task manager.

You're endlessly loading resources -- fonts at various sizes, in this example -- and never freeing them.  You've got a memory leak at work here that will eventually either crash your program, or else make your OS slow down to a crawl and become unstable.

My advice?  Since your fontsize is going from 9 to 31, just load the font into an array at startup and use that array without having to worry about ever freeing or loading resources after that.

DIM font(9 TO 31) As Long
For I = 9 TO 31 STEP 2
  font(i) = _LOADFONT(fontpath$, i, fontstyle$)
NEXT

Then just call your _FONT font(fontsize).  No endless loading of resources necessary, nor any need to free them.

I noticed that too, The _DELAY helped prevent crashing, but if removed and keys tapped rapidly, I'd get a crash in about 10 tries!
I was wondering if the _FREEFONT statement was faulty or since I haven't used it in a few years if I'd forgotten something about it. I went back to a WP routine and found _FONT 16: _FREEFONT FONT&. _FONT 16? Went to the wiki and read the part where you need to change the font before you can free a font. Makes sense, sort of a prisoner swap. Anyway, put that in and solved the memory leak.

I thought about using arrays, too. I would have been more excited if I could also use arrays to pre-configure the window sizes. Yes, I could just set up a database of font widths and heights, but it would be nice for the resources to pull those values. I believe that means calling them, which again temporarily changes the window size. What I'm looking for, holy grail-wise, is a way to make the window never move or change size during a font size change. That's difficult to accomplish.

I do want to give the array method a whirl and compare the results to see if it provides a better path forward. I'll post back later today with an update, thanks!

Pete

[Pete]

I'd like the array method, better. If we don't have to swap and remove fonts, it's less jittery on screen size changes.

Code: (Select All)

SCREEN 0
fontsize% = 16
style$ = "monospace"
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf"
DIM font(8 TO 32) AS LONG
FOR i = 8 TO 32 STEP 2
    font(i) = _LOADFONT(fontpath$, i, style$)
NEXT
_FONT font(fontsize%)
ww = 600: wh = 350
WIDTH ww \ _FONTWIDTH, wh \ _FONTHEIGHT
PALETTE 7, 63: COLOR 0, 7: CLS
_FONT font(fontsize%)
_SCREENMOVE 0, 0

PRINT "Press ctrl + to increase font size or ctrl - to decrease."
DO
    _LIMIT 30
    c = _KEYHIT
    IF c THEN
        SELECT CASE c
            CASE -189
                IF fontsize% > 9 THEN fontsize% = fontsize% - 2
            CASE -187
                IF fontsize% < 31 THEN fontsize% = fontsize% + 2
        END SELECT
    END IF
    IF oldf% AND fontsize% <> oldf% THEN
        _FONT font(fontsize%)
        fw% = 0: fh% = 0
        DO
            fw% = _FONTWIDTH: fh% = _FONTHEIGHT
            IF fw% <> 0 AND fh% <> 0 THEN EXIT DO
            _DELAY .1
        LOOP
        WIDTH ww / fw%, wh / fh%
        PALETTE 7, 63: COLOR 0, 7: CLS
        _FONT font(fontsize%)
        DO: LOOP UNTIL _SCREENEXISTS: _SCREENMOVE 0, 0
        PRINT "Font size changed to:"; fontsize%, "width ="; _WIDTH
        _KEYCLEAR
    END IF
    oldf% = fontsize%
LOOP

It's like the old invention saying goes, "Necessity is a mother."

Pete

[MasterGy]

I'd like the array method, better. If we don't have to swap and remove fonts, it's less jittery on screen size changes.

Code: (Select All)

SCREEN 0
fontsize% = 16
style$ = "monospace"
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf"
DIM font(8 TO 32) AS LONG
FOR i = 8 TO 32 STEP 2
    font(i) = _LOADFONT(fontpath$, i, style$)
NEXT
_FONT font(fontsize%)
ww = 600: wh = 350
WIDTH ww \ _FONTWIDTH, wh \ _FONTHEIGHT
PALETTE 7, 63: COLOR 0, 7: CLS
_FONT font(fontsize%)
_SCREENMOVE 0, 0

PRINT "Press ctrl + to increase font size or ctrl - to decrease."
DO
    _LIMIT 30
    c = _KEYHIT
    IF c THEN
        SELECT CASE c
            CASE -189
                IF fontsize% > 9 THEN fontsize% = fontsize% - 2
            CASE -187
                IF fontsize% < 31 THEN fontsize% = fontsize% + 2
        END SELECT
    END IF
    IF oldf% AND fontsize% <> oldf% THEN
        _FONT font(fontsize%)
        fw% = 0: fh% = 0
        DO
            fw% = _FONTWIDTH: fh% = _FONTHEIGHT
            IF fw% <> 0 AND fh% <> 0 THEN EXIT DO
            _DELAY .1
        LOOP
        WIDTH ww / fw%, wh / fh%
        PALETTE 7, 63: COLOR 0, 7: CLS
        _FONT font(fontsize%)
        DO: LOOP UNTIL _SCREENEXISTS: _SCREENMOVE 0, 0
        PRINT "Font size changed to:"; fontsize%, "width ="; _WIDTH
        _KEYCLEAR
    END IF
    oldf% = fontsize%
LOOP

It's like the old invention saying goes, "Necessity is a mother."

Pete

I'm just recommending it. Don't use too much x = _loadfont . Not even if you free him. even if it wouldn't cause a memory leak, it's still very slow because of _printstring. I've experimented with it a lot and I'm bored. I found it best to "install" each letter and as an image in any size. Another advantage. You cannot use _printstring in hardware mode. Text output will be slow. If you include _display and use the font as a hardware image, it will be safer and much faster

[Pete]

WELL RATS!!!!!!

Guys, I'd like to use the array method, but I did about an hour of auto testing and wrote something bare bones to illustrate that method does have a memory problem. This code crashed in about 10-minutes...

Code: (Select All)

fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf"
fontstyle$ = "monospace"
DIM font(10 TO 32) AS LONG
FOR i = 10 TO 32 STEP 2
    font(i) = _LOADFONT(fontpath$, i, fontstyle$)
NEXT
WIDTH 30, 25
IF _SCREENEXISTS THEN _SCREENMOVE 0, 0
adj = 2: a = 10: b = 32
DO
    _LIMIT 30
    FOR i = a TO b STEP adj
        _FONT font(i)
        PRINT i; font(i)
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN END
    NEXT
    adj = -adj: SWAP a, b
LOOP

@SMcNeill

I know you mentioned there was no need to free the fonts with an array model, so what do you think is the cause behind the memory build up here? Is it is just some over-use situation from rapid repetitive screen / font changing, or a leak?

Pete

[bplus]

WELL RATS!!!!!!

Guys, I'd like to use the array method, but I did about an hour of auto testing and wrote something bare bones to illustrate that method does have a memory problem. This code crashed in about 10-minutes...

Code: (Select All)

fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf"
fontstyle$ = "monospace"
DIM font(10 TO 32) AS LONG
FOR i = 10 TO 32 STEP 2
    font(i) = _LOADFONT(fontpath$, i, fontstyle$)
NEXT
WIDTH 30, 25
IF _SCREENEXISTS THEN _SCREENMOVE 0, 0
adj = 2: a = 10: b = 32
DO
    _LIMIT 30
    FOR i = a TO b STEP adj
        _FONT font(i)
        PRINT i; font(i)
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN END
    NEXT
    adj = -adj: SWAP a, b
LOOP

@SMcNeill

I know you mentioned there was no need to free the fonts with an array model, so what do you think is the cause behind the memory build up here? Is it is just some over-use situation from rapid repetitive screen / font changing, or a leak?

Pete

I ran it for over 11 minutes and CPU averaged 50% the whole time, it'd creep up and then drop back to 48%.

The high usage did get the fan running and I will be billing you a % of my electric bill.

[Pete]

@bplus

How about this more involved model?

Code: (Select All)

SCREEN 0
fontsize% = 16
style$ = "monospace"
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf"
DIM font(8 TO 32) AS LONG
FOR i = 8 TO 32 STEP 2
    font(i) = _LOADFONT(fontpath$, i, style$)
NEXT
_FONT font(fontsize%)
ww = 600: wh = 350
WIDTH ww \ _FONTWIDTH, wh \ _FONTHEIGHT
PALETTE 7, 63: COLOR 0, 7: CLS
_FONT font(fontsize%)
_SCREENMOVE 0, 0

PRINT "Press ctrl + to increase font size or ctrl - to decrease."
DO
    _LIMIT 30
    c = _KEYHIT
    IF c THEN
        SELECT CASE c
            CASE -189
                IF fontsize% > 9 THEN fontsize% = fontsize% - 2
            CASE -187
                IF fontsize% < 31 THEN fontsize% = fontsize% + 2
        END SELECT
    END IF
    oldf% = fontsize%
    IF adj = 0 THEN adj = 2
    fontsize% = fontsize% + adj
    IF fontsize% = 32 THEN
        adj = -2
    ELSE
        IF fontsize% = 8 THEN adj = 2
    END IF
    IF oldf% AND fontsize% <> oldf% THEN
        _FONT font(fontsize%)
        fw% = 0: fh% = 0
        DO
            fw% = _FONTWIDTH: fh% = _FONTHEIGHT
            IF fw% <> 0 AND fh% <> 0 THEN EXIT DO
            _DELAY .1
        LOOP
        WIDTH ww / fw%, wh / fh%
        PALETTE 7, 63: COLOR 0, 7: CLS
        _FONT font(fontsize%)
        DO: LOOP UNTIL _SCREENEXISTS: _SCREENMOVE 0, 0
        PRINT "Font size changed to:"; fontsize%, "width ="; _WIDTH
        _KEYCLEAR
    END IF
    WHILE _MOUSEINPUT: WEND
    IF _MOUSEBUTTON(1) THEN END
LOOP

Pete