Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Handle letters dynamically
#1
   

You often need to place text in games.
Unfortunately, _printstring and _printwidth are significantly slow.

I have always used printing by either using the letters based on a font set or transforming an existing sentence into a hardware image.
Since I always had ideas when displaying the text, I always had to adapt the long-used solutions.

Now I tried to create a universal solution so that I no longer have to deal with this.

First you need a newimage,,32 image that uses the display. So that the screen is not SCREEN 0. After.

Let's define the most important parameters of font management!
'm_fontsettings'
with this, we determine which characters will be used to mark the beginning and end of the commands in the print string in the future, as well as determine whether the hardware letter-image creation engine generates software (32) or hardware (33) images.


Let's create fonts!
There are two options. When defining a letter with a color, or when with an image-texture.

-------------------------------------------------- -------------------------------------------------- ------------------------------
We create a font with 'm_fontadd' - color
for example
m_fontadd 0, "youngfrankexpand.ttf", _RGBA32(238, 194, 194, 255), _RGBA32(255, 0, 0, 100), 10, 150, 1, 1

parameters in order:
1.index
2.ttf file location
3. letter color (feel free to use the alpha value if you want a transparent letter)
The color of the shadow of letter 4 (if you don't want a shadow, then alpha should be 0, or simply write 0 here)
Shifting the shadow of the 5th letter. moves the shadow to the right and down relative to the letter by that many pixels
6. letter size/quality. here we define the quality of the hardware creation of the letter. The height of the image where the letter image is created.
7. is the multiplier of the horizontal size of the letter. by default 1, then we get the look of the original font. The letter can be stretched (eg 1.1 or more) or compressed (0.9 or less).
8. letter spacing. horizontal spread of letter spacing. 1 if we want the natural appearance. You can stretch the letter spacing with gaps (for example, 1.1 or more) or compress them (0.9 or less).

-------------------------------------------------- -------------------------------------------------- ------------------------------------------
'm_fontaddpic' - we create a font with an image texture
for example

m_fontaddpic 2, "youngfrankexpand.ttf", qb64logo, 255, 5, _RGBA32(0, 0, 0, 180), 10, 200, 2, 1

parameters:
1.index
2.ttf file location
3.'handle', a software (32) existing image, for example 'qb64logo = _LoadImage("qb64logo.jpg", 32)'
4. the alpha value of the image
5. the image size multiplier. Inserts a mosaic image from the image into the letter. The higher the number, the smaller the texture will be.
6. The color of the shadow  (if we don't want a shadow, then alpha should be 0, or simply write 0 here)
7. Shifting the shadow of letter 7. moves the shadow to the right and down relative to the letter by that many pixels
8. letter size/quality. here we define the quality of the hardware creation of the letter. The height of the image where the letter image is created.
9. is the multiplier of the horizontal size of the letter. by default 1, then we get the look of the original font. The letter can be stretched (eg 1.1 or more) or compressed (0.9 or less).
10. letter spacing. horizontal spread of letter spacing. 1 if we want the natural appearance. You can stretch the letter spacing with gaps (for example, 1.1 or more) or compress them (0.9 or less).


With this system, we can define any number of fonts.




Use, display

-------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -----
Any placement

m_printstring 1, 200, "<fh80><fi0>mid<fh30><fi1>mini<fh200>BIG", 1, 0

parameters:
1.X position
2.Y position
3.TEXT-STRING-COMMAND
4. rotation 0=from the left edge of the image 1=from the center of the image 2=from the right edge of the image
5. magnitude of rotation. A value of 0 means no rotation

-------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ----

Placement in the horizontal center of the screen

m_printstring_center 300, "<fi1><fh80>welcome<fh50> here (Center)", 0, 0

parameters:
1.Y position
2.TEXT-STRING-COMMAND
3. rotation from where? 0/1/2 (see above)
4. amount of rotation (see above)

-------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ---
Aligns to the right side of the screen

m_printstring_right 700, "<fi2><fh100>QB64 logo", 20, 1, .1

parameters:
1. Y position
2. TEXT-STRING-COMMAND
3. margin - leaves this many pixels near the right edge of the screen
4. rotation from where? 0/1/2 (see above)
5. amount of rotation (see above)


-------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ------
TEXT-STRING-COMMAND

In this string, we can pass the text to be displayed and the commands.

Commands: if possible, indicate at the beginning of the string which font and which size we want to print!
<fh80> - Switch to font 80! (fh = font height)
<fi1> - Switch to the font with index 1! (fi=pound index)

The texts to be displayed are placed in the section between the commands.

Example:
m_printstring 1, 200, "<fh80><fi0>mid<fh30><fi1>mini<fh200>BIG", 1, .2

What this command does is display this in column 1, line 200 of the screen:
Change to pixel size 80, change to font index 0 and write 'mid', then change to pixel size 30 and change to font index 1 and write 'mini', then change 200- as pixel size and write 'BIG', and rotate all of this from the center of the text to 0.2 radian degrees!

-------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -----

When we have defined a TEXT-STRING-COMMAND, we have the option of querying its size.

x$ = "<fh80><fi0>mid<fh30><fi1>mini<fh200>BIG"
pixelsize length = m_printwhidht (x$)
pixelSize height = m_printheight (x$)

The height naturally returns the size of the largest font size used.


-------------------------------------------------- -------------------------------------------------- ------------------------------
some thoughts about the system:

-when you create a font, the program stores its characteristics. Later, when we need to display a character, it checks to see if you have already taken a hardware image of it. If you don't have it yet, make it. This is good because it saves memory. It only creates a character when we use it. For example, when displaying the text 'Hello', it takes a hardware image only 4 times. The letter 'l' is only read out for the second time. This solution is very fast and saves memory.

-When we use a TEXT-STRING-COMMAND, any display subroutine or size query function (m_printwidth,m_printheight) is forced to assemble, prepare, build for the location of the characters. If the same TEXT-STRING-COMMAND is used several times, the program will not calculate it again. Lots of time saved.

- Important! when we enter a coordinate, it does not indicate the upper left corner of the text (like _printstring) !!! Each coordinate point starts from the lower left corner of the text!


Attached Files
.zip   m_fontst.zip (Size: 62.04 KB / Downloads: 23)
Reply
#2
Quote:First you need a newimage,,32 image that uses the display. So that the screen is not SCREEN 0...
DIE VARMINT!


Pete Big Grin
Reply
#3
Okay, I had a chance to play around with it a bit. It reminded me of something similar I did in my Halloween app. Similar, but not nearly as involved. So what I did was change the background to a bright white screen and used the Windows lucon fonts. I had to fiddle around a lot with the settings to get the hardware text looking mostly like the SCREEN 0 text. It's close and maybe it could be tweaked to exact.

One oddity I did find is that when I removed all the other printstring sub statements, it didn't print anything. What I noticed is that for some reason it requires at least (2) printstring sub statements to work. See the example code, below. Just REM out the second printstring sub call statement, leaving only the one above it, and you will see a blank screen when the program runs. I suspect that's a bug of some sort.

I'd like to spend some time working up a WP routine, either in graphics or a hybrid of sorts. I actually have made a WP hybrid, but that's just for buttons on popup windows and not for the text display, itself. Anyway, I have to consider ways of working out a process that is at least as fast was SCREEN 0 and your approach may just be the answer. There is a lot involved with scaling, underling, italicizing, colorization, and cursor shape and blinking. Of course I could always set side half a day and just learn to be an expert in Windows API programing. Dream eam eam... Dream, dream, dream...

Code: (Select All)
myfont$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.

DIM SHARED m_fnt(99, 199), m_trw(999), m_fntset(3), m_lasttext$
sc = _NEWIMAGE(350, 350 / 2, 32): SCREEN sc:
_SCREENMOVE _MIDDLE
_DISPLAYORDER _HARDWARE

'make background
temp = _NEWIMAGE(_WIDTH, _HEIGHT, 32): _DEST temp
FOR x = 0 TO _WIDTH: FOR y = 0 TO _HEIGHT: t = 0: PSET (x, y), _RGB32(255, 255, 255): NEXT y, x
bground = _COPYIMAGE(temp, 33): _FREEIMAGE temp

m_fontsettings "<", ">", 33
m_fontadd 1, myfont$, _RGBA32(0, 0, 0, 190), _RGBA32(255, 255, 255, 0), 0, 1500, .97, 1.26

_DEST sc
DO: _LIMIT 30

    _PUTIMAGE , bground

    m_printstring 40, 60, "<fh11><fi1>QB64 Hardware Text", 1, 0

    ' If some other second m_printstring statement isn't included like this one below, it will fail to print the message, above.
    m_printstring_center 300, "<fi1><fh16>", 0, 0 ' Eliminated the print character so nothing gets printed here.

    _DISPLAY
LOOP UNTIL _KEYDOWN(27)


'$INCLUDE: 'mfonts.bi'


Pete
If eggs are brain food, Biden has his scrambled.

Reply
#4
Thank you very much for taking care of it Pete! It really didn't work well. (the position of the constructed character string was deleted in all cases, but it only built a new one if it received a new character string. Therefore, if we only repeated 1 text, it was deleted) I corrected this, in principle it now works normally.

I plan to add the option to place text in the X1Y1X2Y2 box in a line-excluded manner. (which can be rotated)

Did you intentionally enter a height of 1500 pixels for the test? It's gigantic, an awful lot. It takes a few seconds for the program to start. Consider that to create a single character, you create a hardware image of about 1500x1500 pixels. You specified FH11 as the size when printing, so it is ideal to set the font size in 'font_add' to about this size.

Here is the correct mfonts.bi file.
Thanks again!

Code: (Select All)
Sub m_fontsettings (a$, b$, x): m_fntset(0) = Asc(a$): m_fntset(1) = Asc(b$): m_fntset(2) = x: End Sub

Sub m_fontadd (i, f$, c As _Integer64, c2 As _Integer64, shmove, fs, xmulti, spfnt)
    m_fnt(i, 0) = fs
    m_fnt(i, 1) = _LoadFont(f$, fs)
    m_fnt(i, 2) = _Red32(c)
    m_fnt(i, 3) = _Green32(c)
    m_fnt(i, 4) = _Blue32(c)
    m_fnt(i, 5) = _Alpha32(c)
    m_fnt(i, 6) = xmulti
    m_fnt(i, 7) = 0
    m_fnt(i, 10) = _Red32(c2)
    m_fnt(i, 11) = _Green32(c2)
    m_fnt(i, 12) = _Blue32(c2)
    m_fnt(i, 13) = _Alpha32(c2)
    m_fnt(i, 14) = shmove
    m_fnt(i, 15) = spfnt
End Sub

Sub m_fontaddpic (i, f$, pic_handle, pic_alpha, pic_multi, c2 As _Integer64, shmove, fs, xmulti, spfnt)
    m_fnt(i, 0) = fs
    m_fnt(i, 1) = _LoadFont(f$, fs)
    m_fnt(i, 2) = pic_handle
    m_fnt(i, 3) = -1
    m_fnt(i, 4) = pic_alpha
    m_fnt(i, 5) = pic_multi
    m_fnt(i, 6) = xmulti
    m_fnt(i, 7) = 0
    m_fnt(i, 10) = _Red32(c2)
    m_fnt(i, 11) = _Green32(c2)
    m_fnt(i, 12) = _Blue32(c2)
    m_fnt(i, 13) = _Alpha32(c2)
    m_fnt(i, 14) = shmove
    m_fnt(i, 15) = spfnt
End Sub



Function m_printwidth (t$): concatenation (t$): printwidth = m_trw(1): End Function
Function m_printheight (t$): concatenation (t$): printheight = m_trw(2): End Function
Sub m_printstring_center (py, t$, r1, r2): concatenation (t$): ps (_Width - m_trw(1)) / 2 + 1, py, r1, r2: End Sub
Sub m_printstring_right (py, t$, marg, r1, r2): concatenation (t$): ps _Width - marg - m_trw(1), py, r1, r2: End Sub
Sub rotate_2d (x, y, ang): x1 = x * Cos(ang) - y * Sin(ang): y1 = x * Sin(ang) + y * Cos(ang): x = x1: y = y1: End Sub





Sub m_printstring (px, py, t$, r1, r2): m_trw(0) = 0: concatenation (t$): ps px, py, r1, r2: End Sub

Sub ps (sx, sy, r1, r2)
    ReDim r(1), t(4, 1)
    t(4, 0) = sx: t(4, 1) = sy
    r(0) = m_trw(1) / 2 * r1
    r(1) = -m_trw(2) / 2

    For t = 0 To m_trw(0) - 1
        si = 20 + t * 6
        t(0, 0) = m_trw(si + 1): t(0, 1) = m_trw(si + 2): t(1, 0) = m_trw(si + 3): t(1, 1) = m_trw(si + 2)
        t(2, 0) = m_trw(si + 1): t(2, 1) = m_trw(si + 4): t(3, 0) = m_trw(si + 3): t(3, 1) = m_trw(si + 4)

        If Sgn(r2) Then
            For t1 = 0 To 3: t(t1, 0) = t(t1, 0) - r(0): t(t1, 1) = t(t1, 1) - r(1): rotate_2d t(t1, 0), t(t1, 1), r2
            t(t1, 0) = t(t1, 0) + r(0): t(t1, 1) = t(t1, 1) + r(1): Next t1
        End If

        For t1 = 0 To 7: t2 = Int(t1 * .5): t3 = t1 And 1: t(t2, t3) = t(t2, t3) + t(4, t3): Next t1
        w = _Width(m_trw(si)) - 1: h = _Height(m_trw(si)) - 1
        _MapTriangle (0, 0)-(w, 0)-(0, h), m_trw(si) To(t(0, 0), t(0, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))
        _MapTriangle (w, h)-(w, 0)-(0, h), m_trw(si) To(t(3, 0), t(3, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))

    Next t
End Sub

Sub concatenation (t$)


    If t$ = m_lasttext$ Then Exit Sub
    m_lasttext$ = t$
    m_trw(0) = 0


    ind = 0: tr_c = 0: f_size = 10
    Do Until ac >= Len(t$): ac = ac + 1: ac$ = Mid$(t$, ac, 1)
        If ac$ = Chr$(m_fntset(0)) Then

            vh = InStr(ac + 1, t$, Chr$(m_fntset(1))): If vh = 0 Then Print "syntax error in text command": End
            v = Val(Mid$(t$, ac + 3, vh - ac - 3))
            Select Case LCase$(Mid$(t$, ac + 1, 2))
                Case "fi": ind = v
                Case "fh": f_size = v
            End Select
            ac = vh
        Else
            find = -1
            If Sgn(m_fnt(ind, 7)) Then
                For t = 20 To 20 + m_fnt(ind, 7) * 5
                    If Asc(ac$) = m_fnt(ind, t) Then find = t: Exit For
                Next t
            End If

            If find = -1 Then
                find = 20 + m_fnt(ind, 7) * 5
                savedest = _Dest
                _Font m_fnt(ind, 1)
                sh = m_fnt(ind, 14)
                pwac = _PrintWidth(ac$)
                temp2 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)

                m_fnt(ind, find + 2) = 1 / (m_fnt(ind, 0) + sh) * (pwac + sh) * m_fnt(ind, 6) 'accel
                m_fnt(ind, find + 3) = 1 / m_fnt(ind, 0) * (m_fnt(ind, 0) + sh) * 1.2 'accel
                m_fnt(ind, find + 4) = 1 / m_fnt(ind, 0) * pwac * m_fnt(ind, 6) * m_fnt(ind, 15) 'accel

                _Dest temp2: Cls , 0
                _Font m_fnt(ind, 1)
                Color _RGBA32(m_fnt(ind, 10), m_fnt(ind, 11), m_fnt(ind, 12), m_fnt(ind, 13)), 0
                _PrintString (sh, sh), ac$

                If m_fnt(ind, 3) = -1 Then
                    temp11 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)
                    _Dest temp11

                    sy = m_fnt(ind, 5) * _Width(m_fnt(ind, 2))
                    sx = sy / _Height * _Width

                    _MapTriangle (0, 0)-(sx, 0)-(0, sy), m_fnt(ind, 2) To(0, 0)-(_Width, 0)-(0, _Height)
                    _MapTriangle (sx, sy)-(sx, 0)-(0, sy), m_fnt(ind, 2) To(_Width, _Height)-(_Width, 0)-(0, _Height)

                    _SetAlpha m_fnt(ind, 4)
                    temp10 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)

                    _Dest temp10
                    Cls , _RGB32(0, 0, 0)
                    _Font m_fnt(ind, 1)
                    Color _RGB32(255, 255, 255)
                    _PrintString (0, 0), ac$
                    _SetAlpha 0, _RGB32(255, 255, 255) To _RGB32(1, 1, 1)
                    _Dest temp11
                    _PutImage , temp10
                    _ClearColor _RGB32(0, 0, 0)
                    _Dest temp2

                    _PutImage , temp11
                    _FreeImage temp10
                    _FreeImage temp11
                Else
                    Color _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4)), 0
                    _PrintString (0, 0), ac$
                    _SetAlpha m_fnt(ind, 5), _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4))
                End If

                m_fnt(ind, find + 1) = _CopyImage(temp2, m_fntset(2))
                _FreeImage temp2
                m_fnt(ind, find) = Asc(ac$)
                _Dest savedest
                m_fnt(ind, 7) = m_fnt(ind, 7) + 1
               
            End If

            si = m_trw(0) * 6 + 20
            m_trw(si) = m_fnt(ind, find + 1) 'text
            m_trw(si + 1) = actual_x
            m_trw(si + 2) = -f_size
            m_trw(si + 3) = m_trw(si + 1) + f_size * m_fnt(ind, find + 2)
            m_trw(si + 4) = m_trw(si + 2) + f_size * m_fnt(ind, find + 3)
            m_trw(si + 5) = ac$ = " "
            actual_x = m_trw(si + 1) + f_size * m_fnt(ind, find + 4)
            m_trw(0) = m_trw(0) + 1

        End If
        If f_size > f_sizemax Then f_sizemax = f_size
    Loop
    m_trw(1) = actual_x
    m_trw(2) = f_sizemax

End Sub

Reply
#5
Hmm, I still can't get it to print when only one text printing job is coded. I included the new .bi file in the code below. Run it and you should see a blank screen. Unremark the second _printstring statement, and it will print the message.

Code: (Select All)
myfont$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.

DIM SHARED m_fnt(99, 199), m_trw(999), m_fntset(3), m_lasttext$
sc = _NEWIMAGE(350, 350 / 2, 32): SCREEN sc:
_SCREENMOVE _MIDDLE
_DISPLAYORDER _HARDWARE

'make background
temp = _NEWIMAGE(_WIDTH, _HEIGHT, 32): _DEST temp
FOR x = 0 TO _WIDTH: FOR y = 0 TO _HEIGHT: t = 0: PSET (x, y), _RGB32(255, 255, 255): NEXT y, x
bground = _COPYIMAGE(temp, 33): _FREEIMAGE temp

m_fontsettings "<", ">", 33
m_fontadd 1, myfont$, _RGBA32(0, 0, 0, 190), _RGBA32(255, 255, 255, 0), 0, 400, .97, 1.26

_DEST sc
DO: _LIMIT 30

    _PUTIMAGE , bground

    m_printstring 40, 60, "<fh11><fi1>QB64 Hardware Text", 1, 0

    REM m_printstring_center 300, "<fi1><fh16>", 0, 0 ' Unremark this line to get it to work.

    _DISPLAY
LOOP UNTIL _KEYDOWN(27)


SUB m_fontsettings (a$, b$, x): m_fntset(0) = ASC(a$): m_fntset(1) = ASC(b$): m_fntset(2) = x: END SUB

SUB m_fontadd (i, f$, c AS _INTEGER64, c2 AS _INTEGER64, shmove, fs, xmulti, spfnt)
    m_fnt(i, 0) = fs
    m_fnt(i, 1) = _LOADFONT(f$, fs)
    m_fnt(i, 2) = _RED32(c)
    m_fnt(i, 3) = _GREEN32(c)
    m_fnt(i, 4) = _BLUE32(c)
    m_fnt(i, 5) = _ALPHA32(c)
    m_fnt(i, 6) = xmulti
    m_fnt(i, 7) = 0
    m_fnt(i, 10) = _RED32(c2)
    m_fnt(i, 11) = _GREEN32(c2)
    m_fnt(i, 12) = _BLUE32(c2)
    m_fnt(i, 13) = _ALPHA32(c2)
    m_fnt(i, 14) = shmove
    m_fnt(i, 15) = spfnt
END SUB

SUB m_fontaddpic (i, f$, pic_handle, pic_alpha, pic_multi, c2 AS _INTEGER64, shmove, fs, xmulti, spfnt)
    m_fnt(i, 0) = fs
    m_fnt(i, 1) = _LOADFONT(f$, fs)
    m_fnt(i, 2) = pic_handle
    m_fnt(i, 3) = -1
    m_fnt(i, 4) = pic_alpha
    m_fnt(i, 5) = pic_multi
    m_fnt(i, 6) = xmulti
    m_fnt(i, 7) = 0
    m_fnt(i, 10) = _RED32(c2)
    m_fnt(i, 11) = _GREEN32(c2)
    m_fnt(i, 12) = _BLUE32(c2)
    m_fnt(i, 13) = _ALPHA32(c2)
    m_fnt(i, 14) = shmove
    m_fnt(i, 15) = spfnt
END SUB



FUNCTION m_printwidth (t$): concatenation (t$): printwidth = m_trw(1): END FUNCTION
FUNCTION m_printheight (t$): concatenation (t$): printheight = m_trw(2): END FUNCTION
SUB m_printstring_center (py, t$, r1, r2): concatenation (t$): ps (_WIDTH - m_trw(1)) / 2 + 1, py, r1, r2: END SUB
SUB m_printstring_right (py, t$, marg, r1, r2): concatenation (t$): ps _WIDTH - marg - m_trw(1), py, r1, r2: END SUB
SUB rotate_2d (x, y, ang): x1 = x * COS(ang) - y * SIN(ang): y1 = x * SIN(ang) + y * COS(ang): x = x1: y = y1: END SUB





SUB m_printstring (px, py, t$, r1, r2): m_trw(0) = 0: concatenation (t$): ps px, py, r1, r2: END SUB

SUB ps (sx, sy, r1, r2)
    REDIM r(1), t(4, 1)
    t(4, 0) = sx: t(4, 1) = sy
    r(0) = m_trw(1) / 2 * r1
    r(1) = -m_trw(2) / 2

    FOR t = 0 TO m_trw(0) - 1
        si = 20 + t * 6
        t(0, 0) = m_trw(si + 1): t(0, 1) = m_trw(si + 2): t(1, 0) = m_trw(si + 3): t(1, 1) = m_trw(si + 2)
        t(2, 0) = m_trw(si + 1): t(2, 1) = m_trw(si + 4): t(3, 0) = m_trw(si + 3): t(3, 1) = m_trw(si + 4)

        IF SGN(r2) THEN
            FOR t1 = 0 TO 3: t(t1, 0) = t(t1, 0) - r(0): t(t1, 1) = t(t1, 1) - r(1): rotate_2d t(t1, 0), t(t1, 1), r2
            t(t1, 0) = t(t1, 0) + r(0): t(t1, 1) = t(t1, 1) + r(1): NEXT t1
        END IF

        FOR t1 = 0 TO 7: t2 = INT(t1 * .5): t3 = t1 AND 1: t(t2, t3) = t(t2, t3) + t(4, t3): NEXT t1
        w = _WIDTH(m_trw(si)) - 1: h = _HEIGHT(m_trw(si)) - 1
        _MAPTRIANGLE (0, 0)-(w, 0)-(0, h), m_trw(si) TO(t(0, 0), t(0, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))
        _MAPTRIANGLE (w, h)-(w, 0)-(0, h), m_trw(si) TO(t(3, 0), t(3, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))

    NEXT t
END SUB

SUB concatenation (t$)


    IF t$ = m_lasttext$ THEN EXIT SUB
    m_lasttext$ = t$
    m_trw(0) = 0


    ind = 0: tr_c = 0: f_size = 10
    DO UNTIL ac >= LEN(t$): ac = ac + 1: ac$ = MID$(t$, ac, 1)
        IF ac$ = CHR$(m_fntset(0)) THEN

            vh = INSTR(ac + 1, t$, CHR$(m_fntset(1))): IF vh = 0 THEN PRINT "syntax error in text command": END
            v = VAL(MID$(t$, ac + 3, vh - ac - 3))
            SELECT CASE LCASE$(MID$(t$, ac + 1, 2))
                CASE "fi": ind = v
                CASE "fh": f_size = v
            END SELECT
            ac = vh
        ELSE
            find = -1
            IF SGN(m_fnt(ind, 7)) THEN
                FOR t = 20 TO 20 + m_fnt(ind, 7) * 5
                    IF ASC(ac$) = m_fnt(ind, t) THEN find = t: EXIT FOR
                NEXT t
            END IF

            IF find = -1 THEN
                find = 20 + m_fnt(ind, 7) * 5
                savedest = _DEST
                _FONT m_fnt(ind, 1)
                sh = m_fnt(ind, 14)
                pwac = _PRINTWIDTH(ac$)
                temp2 = _NEWIMAGE(pwac + sh, m_fnt(ind, 0) + sh, 32)

                m_fnt(ind, find + 2) = 1 / (m_fnt(ind, 0) + sh) * (pwac + sh) * m_fnt(ind, 6) 'accel
                m_fnt(ind, find + 3) = 1 / m_fnt(ind, 0) * (m_fnt(ind, 0) + sh) * 1.2 'accel
                m_fnt(ind, find + 4) = 1 / m_fnt(ind, 0) * pwac * m_fnt(ind, 6) * m_fnt(ind, 15) 'accel

                _DEST temp2: CLS , 0
                _FONT m_fnt(ind, 1)
                COLOR _RGBA32(m_fnt(ind, 10), m_fnt(ind, 11), m_fnt(ind, 12), m_fnt(ind, 13)), 0
                _PRINTSTRING (sh, sh), ac$

                IF m_fnt(ind, 3) = -1 THEN
                    temp11 = _NEWIMAGE(pwac + sh, m_fnt(ind, 0) + sh, 32)
                    _DEST temp11

                    sy = m_fnt(ind, 5) * _WIDTH(m_fnt(ind, 2))
                    sx = sy / _HEIGHT * _WIDTH

                    _MAPTRIANGLE (0, 0)-(sx, 0)-(0, sy), m_fnt(ind, 2) TO(0, 0)-(_WIDTH, 0)-(0, _HEIGHT)
                    _MAPTRIANGLE (sx, sy)-(sx, 0)-(0, sy), m_fnt(ind, 2) TO(_WIDTH, _HEIGHT)-(_WIDTH, 0)-(0, _HEIGHT)

                    _SETALPHA m_fnt(ind, 4)
                    temp10 = _NEWIMAGE(pwac + sh, m_fnt(ind, 0) + sh, 32)

                    _DEST temp10
                    CLS , _RGB32(0, 0, 0)
                    _FONT m_fnt(ind, 1)
                    COLOR _RGB32(255, 255, 255)
                    _PRINTSTRING (0, 0), ac$
                    _SETALPHA 0, _RGB32(255, 255, 255) TO _RGB32(1, 1, 1)
                    _DEST temp11
                    _PUTIMAGE , temp10
                    _CLEARCOLOR _RGB32(0, 0, 0)
                    _DEST temp2

                    _PUTIMAGE , temp11
                    _FREEIMAGE temp10
                    _FREEIMAGE temp11
                ELSE
                    COLOR _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4)), 0
                    _PRINTSTRING (0, 0), ac$
                    _SETALPHA m_fnt(ind, 5), _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4))
                END IF

                m_fnt(ind, find + 1) = _COPYIMAGE(temp2, m_fntset(2))
                _FREEIMAGE temp2
                m_fnt(ind, find) = ASC(ac$)
                _DEST savedest
                m_fnt(ind, 7) = m_fnt(ind, 7) + 1

            END IF

            si = m_trw(0) * 6 + 20
            m_trw(si) = m_fnt(ind, find + 1) 'text
            m_trw(si + 1) = actual_x
            m_trw(si + 2) = -f_size
            m_trw(si + 3) = m_trw(si + 1) + f_size * m_fnt(ind, find + 2)
            m_trw(si + 4) = m_trw(si + 2) + f_size * m_fnt(ind, find + 3)
            m_trw(si + 5) = ac$ = " "
            actual_x = m_trw(si + 1) + f_size * m_fnt(ind, find + 4)
            m_trw(0) = m_trw(0) + 1

        END IF
        IF f_size > f_sizemax THEN f_sizemax = f_size
    LOOP
    m_trw(1) = actual_x
    m_trw(2) = f_sizemax

END SUB

I adjusted the 1500 to 400. I was playing with the values quite a bit to get a feel for the range, which is quite extensive.

Pete
Reply
#6
ok i found the main bug


Code: (Select All)
myfont$ = Environ$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.

Dim Shared m_fnt(99, 199), m_trw(999), m_fntset(3), m_lasttext$
sc = _NewImage(350, 350 / 2, 32): Screen sc:
_ScreenMove _Middle
_DisplayOrder _Hardware

'make background
temp = _NewImage(_Width, _Height, 32): _Dest temp
For x = 0 To _Width: For y = 0 To _Height: t = 0: PSet (x, y), _RGB32(255, 255, 255): Next y, x
bground = _CopyImage(temp, 33): _FreeImage temp

m_fontsettings "<", ">", 33
m_fontadd 1, myfont$, _RGBA32(0, 0, 0, 190), _RGBA32(255, 255, 255, 0), 0, 400, .97, 1.26

_Dest sc
Do: _Limit 30

    _PutImage , bground

    m_printstring 40, 60, "<fi1><fh11>QB64 Hardware Text", 1, 0

    'm_printstring_center 100, "<fi1><fh16>111", 0, 0 ' Unremark this line to get it to work.

    _Display
Loop Until _KeyDown(27)


Sub m_fontsettings (a$, b$, x): m_fntset(0) = Asc(a$): m_fntset(1) = Asc(b$): m_fntset(2) = x: End Sub

Sub m_fontadd (i, f$, c As _Integer64, c2 As _Integer64, shmove, fs, xmulti, spfnt)
    m_fnt(i, 0) = fs
    m_fnt(i, 1) = _LoadFont(f$, fs)
    m_fnt(i, 2) = _Red32(c)
    m_fnt(i, 3) = _Green32(c)
    m_fnt(i, 4) = _Blue32(c)
    m_fnt(i, 5) = _Alpha32(c)
    m_fnt(i, 6) = xmulti
    m_fnt(i, 7) = 0
    m_fnt(i, 10) = _Red32(c2)
    m_fnt(i, 11) = _Green32(c2)
    m_fnt(i, 12) = _Blue32(c2)
    m_fnt(i, 13) = _Alpha32(c2)
    m_fnt(i, 14) = shmove
    m_fnt(i, 15) = spfnt
End Sub

Sub m_fontaddpic (i, f$, pic_handle, pic_alpha, pic_multi, c2 As _Integer64, shmove, fs, xmulti, spfnt)
    m_fnt(i, 0) = fs
    m_fnt(i, 1) = _LoadFont(f$, fs)
    m_fnt(i, 2) = pic_handle
    m_fnt(i, 3) = -1
    m_fnt(i, 4) = pic_alpha
    m_fnt(i, 5) = pic_multi
    m_fnt(i, 6) = xmulti
    m_fnt(i, 7) = 0
    m_fnt(i, 10) = _Red32(c2)
    m_fnt(i, 11) = _Green32(c2)
    m_fnt(i, 12) = _Blue32(c2)
    m_fnt(i, 13) = _Alpha32(c2)
    m_fnt(i, 14) = shmove
    m_fnt(i, 15) = spfnt
End Sub



Function m_printwidth (t$): concatenation (t$): m_printwidth = m_trw(1): End Function
Function m_printheight (t$): concatenation (t$): m_printheight = m_trw(2): End Function
Sub m_printstring_center (py, t$, r1, r2): concatenation (t$): ps (_Width - m_trw(1)) / 2 + 1, py, r1, r2: End Sub
Sub m_printstring_right (py, t$, marg, r1, r2): concatenation (t$): ps _Width - marg - m_trw(1), py, r1, r2: End Sub
Sub rotate_2d (x, y, ang): x1 = x * Cos(ang) - y * Sin(ang): y1 = x * Sin(ang) + y * Cos(ang): x = x1: y = y1: End Sub





Sub m_printstring (px, py, t$, r1, r2): concatenation (t$): ps px, py, r1, r2: End Sub

Sub ps (sx, sy, r1, r2)
    ReDim r(1), t(4, 1)
    t(4, 0) = sx: t(4, 1) = sy
    r(0) = m_trw(1) / 2 * r1
    r(1) = -m_trw(2) / 2

    For t = 0 To m_trw(0) - 1
        si = 20 + t * 6
        t(0, 0) = m_trw(si + 1): t(0, 1) = m_trw(si + 2): t(1, 0) = m_trw(si + 3): t(1, 1) = m_trw(si + 2)
        t(2, 0) = m_trw(si + 1): t(2, 1) = m_trw(si + 4): t(3, 0) = m_trw(si + 3): t(3, 1) = m_trw(si + 4)

        If Sgn(r2) Then
            For t1 = 0 To 3: t(t1, 0) = t(t1, 0) - r(0): t(t1, 1) = t(t1, 1) - r(1): rotate_2d t(t1, 0), t(t1, 1), r2
            t(t1, 0) = t(t1, 0) + r(0): t(t1, 1) = t(t1, 1) + r(1): Next t1
        End If

        For t1 = 0 To 7: t2 = Int(t1 * .5): t3 = t1 And 1: t(t2, t3) = t(t2, t3) + t(4, t3): Next t1
        w = _Width(m_trw(si)) - 1: h = _Height(m_trw(si)) - 1
        _MapTriangle (0, 0)-(w, 0)-(0, h), m_trw(si) To(t(0, 0), t(0, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))
        _MapTriangle (w, h)-(w, 0)-(0, h), m_trw(si) To(t(3, 0), t(3, 1))-(t(1, 0), t(1, 1))-(t(2, 0), t(2, 1))

    Next t
End Sub

Sub concatenation (t$)

    If t$ = m_lasttext$ Then Exit Sub
    m_lasttext$ = t$
    m_trw(0) = 0


    ind = 0: tr_c = 0: f_size = 10
    Do Until ac >= Len(t$): ac = ac + 1: ac$ = Mid$(t$, ac, 1)
        If ac$ = Chr$(m_fntset(0)) Then

            vh = InStr(ac + 1, t$, Chr$(m_fntset(1))): If vh = 0 Then Print "syntax error in text command": End
            v = Val(Mid$(t$, ac + 3, vh - ac - 3))
            Select Case LCase$(Mid$(t$, ac + 1, 2))
                Case "fi": ind = v
                Case "fh": f_size = v
            End Select
            ac = vh
        Else
            find = -1
            If Sgn(m_fnt(ind, 7)) Then
                For t = 20 To 20 + m_fnt(ind, 7) * 5
                    If Asc(ac$) = m_fnt(ind, t) Then find = t: Exit For
                Next t
            End If

            If find = -1 Then
                find = 20 + m_fnt(ind, 7) * 5
                savedest = _Dest
                _Font m_fnt(ind, 1)
                sh = m_fnt(ind, 14)
                pwac = _PrintWidth(ac$)
                temp2 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)

                m_fnt(ind, find + 2) = 1 / (m_fnt(ind, 0) + sh) * (pwac + sh) * m_fnt(ind, 6) 'accel
                m_fnt(ind, find + 3) = 1 / m_fnt(ind, 0) * (m_fnt(ind, 0) + sh) * 1.2 'accel
                m_fnt(ind, find + 4) = 1 / m_fnt(ind, 0) * pwac * m_fnt(ind, 6) * m_fnt(ind, 15) 'accel

                _Dest temp2: Cls , 0
                _Font m_fnt(ind, 1)
                Color _RGBA32(m_fnt(ind, 10), m_fnt(ind, 11), m_fnt(ind, 12), m_fnt(ind, 13)), 0
                _PrintString (sh, sh), ac$

                If m_fnt(ind, 3) = -1 Then
                    temp11 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)
                    _Dest temp11

                    sy = m_fnt(ind, 5) * _Width(m_fnt(ind, 2))
                    sx = sy / _Height * _Width

                    _MapTriangle (0, 0)-(sx, 0)-(0, sy), m_fnt(ind, 2) To(0, 0)-(_Width, 0)-(0, _Height)
                    _MapTriangle (sx, sy)-(sx, 0)-(0, sy), m_fnt(ind, 2) To(_Width, _Height)-(_Width, 0)-(0, _Height)

                    _SetAlpha m_fnt(ind, 4)
                    temp10 = _NewImage(pwac + sh, m_fnt(ind, 0) + sh, 32)

                    _Dest temp10
                    Cls , _RGB32(0, 0, 0)
                    _Font m_fnt(ind, 1)
                    Color _RGB32(255, 255, 255)
                    _PrintString (0, 0), ac$
                    _SetAlpha 0, _RGB32(255, 255, 255) To _RGB32(1, 1, 1)
                    _Dest temp11
                    _PutImage , temp10
                    _ClearColor _RGB32(0, 0, 0)
                    _Dest temp2

                    _PutImage , temp11
                    _FreeImage temp10
                    _FreeImage temp11
                Else
                    Color _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4)), 0
                    _PrintString (0, 0), ac$
                    _SetAlpha m_fnt(ind, 5), _RGB32(m_fnt(ind, 2), m_fnt(ind, 3), m_fnt(ind, 4))
                End If

                m_fnt(ind, find + 1) = _CopyImage(temp2, m_fntset(2))
                _FreeImage temp2
                m_fnt(ind, find) = Asc(ac$)
                _Dest savedest
                m_fnt(ind, 7) = m_fnt(ind, 7) + 1

            End If

            si = m_trw(0) * 6 + 20
            m_trw(si) = m_fnt(ind, find + 1) 'text
            m_trw(si + 1) = actual_x
            m_trw(si + 2) = -f_size
            m_trw(si + 3) = m_trw(si + 1) + f_size * m_fnt(ind, find + 2)
            m_trw(si + 4) = m_trw(si + 2) + f_size * m_fnt(ind, find + 3)
            m_trw(si + 5) = ac$ = " "
            actual_x = m_trw(si + 1) + f_size * m_fnt(ind, find + 4)
            m_trw(0) = m_trw(0) + 1

        End If
        If f_size > f_sizemax Then f_sizemax = f_size
    Loop
    m_trw(1) = actual_x
    m_trw(2) = f_sizemax

End Sub
Reply
#7
Aha! That works!

Pete Smile
Reply




Users browsing this thread: 1 Guest(s)