Posts: 2,697
Threads: 328
Joined: Apr 2022
Reputation:
217
Code: (Select All)
Screen _NewImage(800, 600, 32)
$Color:32
f = _LoadFont("./DejaVuSansMono.ttf", 16, "monospace")
_Font f
'first, let's showcase WHY we need to use QPrint over Print:
a$ = "This_is_a_line_with_underscores"
Print a$
Qlocate 2, 1
Qprint a$, -1
Locate 5, 1
Print "Notice something different with those two statements?"
Print "The first line, which uses PRINT, clips off those underscores to make certain that our height is *EXACTLY* 16 pixels."
Print
Print "QPrint, with uses _UPrintString as its roots, renders above and below the main height as necessary for flourishes and underscores."
Sleep
Cls
_Font 16: _FreeFont f
f = _LoadFont("./DejaVuSansMono.ttf", 24, "monospace")
_Font f
Locate 1, 5 'test positioning of first qprint
For i = 1 To 25
Qprint Str$(i), -1 'print enough to test screen scrolling
Sleep 'so we can watch it in action!
Next
'And here we have a test of multi-line string printing
Cls
a$ = "This is a really long line of rambling text that represents nothing more than an attempt to write so much junk on a single line that we end up having to split this text and move it down onto multiple lines, so that we don't lose what we're printing beyond the bounds of the screen. Nothing here really, and if you read all of this, you're a good man(tm)!"
For i = 1 To 5
Qprint a$, -1
Sleep 'so we can watch it in action!
Next
Sub Qprint (text$, newline)
'Note that this does NOT print unicode or utf-8 formated strings.
'That functionality has to be expanded in a future update.
'This only prints ASCII characters, but it does so by making use of the _UPrint commands,
'so that font clipping and such doesn't occur and make various fonts illegible.
OriginalX = Pos(1)
OriginalY = CsrLin
CurrentX = (OriginalX - 1) * _FontWidth
CurrentY = (OriginalY - 1) * _UFontHeight
temp$ = text$
Do
finished = 0
MaxX = _Width - CurrentX
TextWidth = _UPrintWidth(temp$)
If TextWidth < MaxX Then 'there's enough room to print on the current line
_UPrintString (CurrentX, CurrentY), temp$
CurrentX = CurrentX + _UPrintWidth(temp$)
finished = -1
Else 'we need to print what we can and continue to the next line
lastchar = QFindMaxPos(temp$, MaxX)
_UPrintString (CurrentX, CurrentY), Left$(temp$, lastchar)
temp$ = Mid$(temp$, lastchar + 1)
MaxX = _Width
GoSub scrollup
CurrentX = 0
CurrentY = CurrentY + _UFontHeight
finished = 0
End If
GoSub scrollup
Loop Until finished
If newline Then CurrentY = CurrentY + _UFontHeight: CurrentX = 0
GoSub scrollup
Exit Sub
scrollup:
If CurrentY > _Height - _UFontHeight Then
'scroll up routine:
$Checking:Off
Dim m As _MEM
m = _MemImage(0)
screenw = _UFontHeight * _Width * _PixelSize
t$ = Space$(m.SIZE - screenw)
_MemGet m, m.OFFSET + screenw, t$
Cls , _BackgroundColor(_Dest)
_MemPut m, m.OFFSET, t$
_MemFree m
$Checking:On
'end of scrolling routine
CurrentY = CurrentY - _UFontHeight
End If
Qlocate Int(CurrentY / _UFontHeight) + 1, Int(CurrentX / _FontWidth) + 1
Return
End Sub
Function QFindMaxPos (text$, w)
'Quick Find Max Position
'This routine quickly finds which position fits within a given width of a string
'This works on a binary search method to determine max length and character position,
'So for long strings or large screens, it can find the proper position much quicker than just searching
'and comparing lengths from left to right, or right to left.
min = 0
max = Len(text$)
If _FontWidth Then 'monospaced font
max = Int(w / _FontWidth) + 1 'the most possible characters that can fit on a line
Else
If max > w Then max = w 'most possible would be 1 character per pixel!
End If
If _UPrintWidth(Left$(text$, max)) < w Then QFindMaxPos = max: Exit Function
Do
test = Int((max - min) / 2) + min
p = _UPrintWidth(Left$(text$, test))
If p = oldp Then Exit Do
Select Case p
Case Is < w
min = test
Case Is > w: max = test
Case Is = w: Exit Do
End Select
oldp = p
Loop
QFindMaxPos = test
End Function
Sub Qlocate (x, y)
'a replacement to error check to make certain that we stay within the proper screen coordinates
'while using the new _uprintstring command
CurrentX = (y) * _FontWidth
CurrentY = (x) * _UFontHeight
If CurrentX > _Width Then Error 5: Exit Sub
If CurrentY > _Height Then Error 5: Exit Sub
Locate x, y
End Sub
Required font is below, in case anyone needs it for testing this:
DejaVuSansMono.7z (Size: 159.16 KB / Downloads: 41)
Currently, this basically mimics the behavior of PRINT in the fact that it breaks words at the border of the screen, with no concern whatsoever over performing any sort of decent word wrap.
Note that since _UPrintString uses more screen area than Print (as illustrated in those first lines where PRINT clips off part of the text on us), our LOCATE positions are *NOT* going to be the same here, when we swap back and forth between the two commands.
LOCATE 10,10: PRINT "Foo"
LOCATE 10,10: QPRINT "Foo"
^The above will print to two completely different areas of the screen! (Print, as I've pointed out already, doesn't display the same height and width characters, so what is considered to be a "line", is going to be smaller than with UPrintString.)
Don't think you can swap back and forth between PRINT and QPRINT seemlessly. That's not gonna happen! Choose one. Use one. And forget the other even exists, except in the most extreme cases.
Posts: 1,581
Threads: 59
Joined: Jul 2022
Reputation:
52
I think it should have come with a test for compiling with QB64PE v3.7 and later.
Otherwise, "Why this no work?" And they press hard for their "project" to be completed like that. Remember some people hate upgrading. On Windows have to swallow the large archive pill. On Linux might have to do it to the whole system. Oh well.
Some advice to other people: before using this routine please install the latest version/release of QB64 Phoenix Edition which is v3.9.1.
Posts: 2,697
Threads: 328
Joined: Apr 2022
Reputation:
217
There's a real simple test for folks with outdated versions -- load it in the IDE, if you see ERROR: COMMAND NOT RECOGNIZED, then you can't compile it. 
Just as useful and easy as adding an $IF VERSION check at the beginning of the code to just have it tell you the same thing after compiling and running.
Posts: 730
Threads: 30
Joined: Apr 2022
Reputation:
43
I'm just waiting for the obligatory "this doesn't work in QB64 v0.9 on Windows XP" or whatever.
Tread on those who tread on you
Posts: 2,697
Threads: 328
Joined: Apr 2022
Reputation:
217
(12-11-2023, 08:19 PM)SpriggsySpriggs Wrote: I'm just waiting for the obligatory "this doesn't work in QB64 v0.9 on Windows XP" or whatever.
I've gotten to the point where I just agree with those folks. "Yep. You're right."
Posts: 2,697
Threads: 328
Joined: Apr 2022
Reputation:
217
Code: (Select All)
Screen _NewImage(800, 600, 32)
$Color:32
Randomize Timer
f = _LoadFont("./DejaVuSansMono.ttf", 16, "monospace")
_Font f
'first, let's showcase WHY we need to use QPrint over Print:
a$ = "This_is_a_line_with_underscores"
Print a$
Qlocate 2, 1
Qprint a$, -1, _Width
Locate 5, 1
Print "Notice something different with those two statements?"
Print "The first line, which uses PRINT, clips off those underscores to make certain that our height is *EXACTLY* 16 pixels."
Print
Print "QPrint, with uses _UPrintString as its roots, renders above and below the main height as necessary for flourishes and underscores."
Sleep
Cls
_Font 16: _FreeFont f
f = _LoadFont("./DejaVuSansMono.ttf", 24, "monospace")
_Font f
Locate 1, 5 'test positioning of first qprint
For i = 1 To 25
Qprint Str$(i), -1, _Width 'print enough to test screen scrolling
Sleep 'so we can watch it in action!
Next
'And here we have a test of multi-line string printing
Cls
a$ = "This is a really long line of rambling text that represents nothing more than an attempt to write so much junk on a single line that we end up having to split this text and move it down onto multiple lines, so that we don't lose what we're printing beyond the bounds of the screen. Nothing here really, and if you read all of this, you're a good man(tm)!"
For i = 1 To 3
x = Int(Rnd * 500) + 300
Qprint a$, -1, _Width 'to show that we can set the width which we want to limit the text to. This can be really useful for things such as popo-up boxes and such.
Sleep 'so we can watch it in action!
Next
'And now we try and print one long line of uninterrupted letters
Cls
Locate 10, 10 'With no valid breakpoint, this text should scroll down to the next line before printing
Qprint "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", -1, _Width
'And, with a space in the mid-point of that.
Locate 15, 10 'We have a valid breakpoint here. This should print and then scroll to the next line to start printing fresh
Qprint "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", -1, _Width
Sub Qprint (text$, newline As Long, maxwidth As Long)
'Note that this does NOT print unicode or utf-8 formated strings.
'That functionality has to be expanded in a future update.
'This only prints ASCII characters, but it does so by making use of the _UPrint commands,
'so that font clipping and such doesn't occur and make various fonts illegible.
OriginalX = Pos(1)
OriginalY = CsrLin
CurrentX = (OriginalX - 1) * _FontWidth
CurrentY = (OriginalY - 1) * _UFontHeight
temp$ = text$
Do
finished = 0
MaxX = maxwidth - CurrentX
TextWidth = _UPrintWidth(temp$)
If TextWidth <= MaxX Then 'there's enough room to print on the current line
_UPrintString (CurrentX, CurrentY), temp$
CurrentX = CurrentX + _UPrintWidth(temp$)
finished = -1
Else 'we need to print what we can and continue to the next line
lastchar = QFindMaxPos(temp$, MaxX)
If Asc(temp$, lastchar + 1) = 32 Then 'the next character is a space; we're good to break here
_UPrintString (CurrentX, CurrentY), Left$(temp$, lastchar)
temp$ = _Trim$(Mid$(temp$, lastchar + 1))
Else 'we look for the previous space
l = _InStrRev(Left$(temp$, lastchar), " ")
If l > 0 Then 'we found a space. make it the break point.
_UPrintString (CurrentX, CurrentY), Left$(temp$, l)
temp$ = _Trim$(Mid$(temp$, l + 1))
Else 'there's not a single space between this point and the start of the string?
If MaxX < maxwidth Then 'we're only on a partial line
'don't do anything. Just let the routine rotate through to try and print on the full line below.
Else 'we're on a full line already. Just print the damn line of jibberish!
_UPrintString (CurrentX, CurrentY), Left$(temp$, lastchar)
temp$ = _Trim$(Mid$(temp$, lastchar + 1))
End If
End If
End If
MaxX = maxwidth
GoSub scrollup
CurrentX = 0
CurrentY = CurrentY + _UFontHeight
finished = 0
End If
GoSub scrollup
Loop Until finished
If newline Then CurrentY = CurrentY + _UFontHeight: CurrentX = 0
GoSub scrollup
Exit Sub
scrollup:
If CurrentY > _Height - _UFontHeight Then
'scroll up routine:
$Checking:Off
Dim m As _MEM
m = _MemImage(0)
screenw = _UFontHeight * _Width * _PixelSize
t$ = Space$(m.SIZE - screenw)
_MemGet m, m.OFFSET + screenw, t$
Cls , _BackgroundColor(_Dest)
_MemPut m, m.OFFSET, t$
_MemFree m
$Checking:On
'end of scrolling routine
CurrentY = CurrentY - _UFontHeight
End If
Qlocate Int(CurrentY / _UFontHeight) + 1, Int(CurrentX / _FontWidth) + 1
Return
End Sub
Function QFindMaxPos (text$, w)
'Quick Find Max Position
'This routine quickly finds which position fits within a given width of a string
'This works on a binary search method to determine max length and character position,
'So for long strings or large screens, it can find the proper position much quicker than just searching
'and comparing lengths from left to right, or right to left.
min = 0
max = Len(text$)
If _FontWidth Then 'monospaced font
max = Int(w / _FontWidth) + 1 'the most possible characters that can fit on a line
Else
If max > w Then max = w 'most possible would be 1 character per pixel!
End If
If _UPrintWidth(Left$(text$, max)) < w Then QFindMaxPos = max: Exit Function
Do
test = Int((max - min) / 2) + min
p = _UPrintWidth(Left$(text$, test))
If p = oldp Then Exit Do
Select Case p
Case Is < w
min = test
Case Is > w: max = test
Case Is = w: Exit Do
End Select
oldp = p
Loop
QFindMaxPos = test
End Function
Sub Qlocate (x, y)
'a replacement to error check to make certain that we stay within the proper screen coordinates
'while using the new _uprintstring command
CurrentX = (y) * _FontWidth
CurrentY = (x) * _UFontHeight
If CurrentX > _Width Then Error 5: Exit Sub
If CurrentY > _Height Then Error 5: Exit Sub
Locate x, y
End Sub
We now have proper word wrap (only on spaces), and custom width settings.
Posts: 22
Threads: 6
Joined: Oct 2023
Reputation:
0
"this doesn't work in QB32 v0.1 on Windows 98SE...(or whatever)"
Posts: 2,697
Threads: 328
Joined: Apr 2022
Reputation:
217
(12-12-2023, 04:27 AM)JamesAlexander Wrote: "this doesn't work in QB32 v0.1 on Windows 98SE...(or whatever)"
You're right! Doesn't work in GW-BASIC or BASICA-A either!
Posts: 730
Threads: 30
Joined: Apr 2022
Reputation:
43
I've never noticed that underscores are slightly lower than the rest of the characters. Interesting stuff. Then again, I almost never use anything other than the default font unless I'm doing a Win32 GUI.
Tread on those who tread on you
Posts: 1,581
Threads: 59
Joined: Jul 2022
Reputation:
52
The "DejaVu Mono" can't be used in Geany on Linux precisely because the underscores don't display. Must use "Liberation Mono" or "Noto" which also comes with many operating systems. My recommendation is to use "Cousine" Nerd font. But personally it's because I dislike the saxophone-looking lowercase "L", prefer for it to look like a flagpole. The "Noto" is offensive to me because the lowercase "R" is really ugly and out of place. It looks great, except for that great flaw, and except it was created by Google. I want to avoid Google in the few places that I could.
|
