12-12-2023, 01:16 AM
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.