+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: MasterGy (https://qb64phoenix.com/forum/forumdisplay.php?fid=45)
+---- Thread: Handle letters dynamically (/showthread.php?tid=2485)
Handle letters dynamically - MasterGy - 03-05-2024
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!
RE: Handle letters dynamically - Pete - 03-05-2024
Quote:First you need a newimage,,32 image that uses the display. So that the screen is not SCREEN 0...DIE VARMINT!
Pete
RE: Handle letters dynamically - Pete - 03-08-2024
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
RE: Handle letters dynamically - MasterGy - 03-09-2024
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
RE: Handle letters dynamically - Pete - 03-10-2024
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
RE: Handle letters dynamically - MasterGy - 03-10-2024
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 SubRE: Handle letters dynamically - Pete - 03-10-2024
Aha! That works!
Pete
