+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: word wrap + action words! (/showthread.php?tid=2480)
word wrap + action words! - SMcNeill - 03-04-2024
Code: (Select All)
$Color:32
Type Box_Type
As Long X, Y, Wide, Tall, AssociatedWith
End Type
Type Word_Type
As String word, desc, action
As Integer insensitive
End Type
ReDim Shared Action(10000) As Box_Type, Words(10000) As Word_Type
Dim Shared As Long ActionMax
Dim Shared As Long TextX, TextY, MaxX, MaxY
Dim Shared As Long Font, FontBold, FontItalic
Dim Shared Font$, FontBold$, FontItalic$
Font$ = _ReadFile$("SourceCodePro-Medium.ttf")
FontBold$ = _ReadFile$("SourceCodePro-Bold.ttf")
FontItalic$ = _ReadFile$("SourceCodePro-Italic.ttf")
Screen _NewImage(800, 600, 32)
_ScreenMove _Middle
AddWord "cheese", "Cheese is a tasty milky treat!", "popup", -1
Do
ResetAll
SetFonts 24
WordWrap "Hello World. This is a long line of crappy text that I have no clue what the heck to do with it." + Chr$(10)
SetFonts 32
WordWrap "Hello World 2. What happens if we eat cheese?"
ProcessMouse
_Limit 30
_Display
Loop Until _MouseButton(2)
Sub ResetAll
TextX = 0: TextY = 0
ActionMax = 0
Cls , 0
End Sub
Sub SetFonts (Size)
Select Case _Font
Case Font: SetFont = 0
Case FontBold: SetFont = 1
Case FontItalic: SetFont = 2
End Select
_Font 16
If Font <> 0 Then _FreeFont Font
If FontBold <> 0 Then _FreeFont FontBold
If FontItalic <> 0 Then _FreeFont FontItalic 'free old fonts
Font = _LoadFont(Font$, Size, "memory,monospace") 'load fonts at new size
FontBold = _LoadFont(FontBold$, Size, "memory,monospace")
FontItalic = _LoadFont(FontItalic$, Size, "memory,monospace")
w = _Width
h = _Height
fw = _UPrintWidth("W")
fh = _ULineSpacing
' MaxX = w \ fw 'calculate the max amount of text we can put on the screen
' MaxH = h \ fh
MaxX = _Width - 1
MaxY = _Height - 1
Select Case SetFont 'resize the font to the new size, but keep the same italic/bold setting
Case 0: _Font Font
Case 1: _Font FontBold
Case 2: _Font FontItalic
End Select
End Sub
Sub AddWord (word$, desc$, action$, insensitive)
If word$ = "" Then Exit Sub 'can't process a blank word
If action$ = "" Then Exit Sub 'can't be bothered to try and process a word that does nothing. 
For i = 0 To UBound(Words)
If Words(i).word = "" Then 'we're at blank words. Insert this new one.
Exit For
Else
If Words(i).insensitive = 0 Then
If Words(i).word = word$ Then Exit Sub 'this is a place to add new words, not screw around with old ones! Exit! Exit, Will Robinson!
Else
If _StriCmp(Words(i).word, word$) = 0 Then Exit Sub 'this is a place to add new words, not screw around with old ones! Exit! Exit, Will Robinson!
End If
End If
Next
ReDim _Preserve Words(10000 + UBound(Words)) As Word_Type 'we has a shitload of words! Make room for more!!
Words(i).word = word$
Words(i).desc = desc$
Words(i).action = action$
Words(i).insensitive = insensitive
End Sub
Sub ProcessMouse
Static oldMB
While _MouseInput: Wend
MB = _MouseButton(1)
x = _MouseX: y = _MouseY
For i = 0 To ActionMax
If x >= Action(i).X And x <= Action(i).Wide And y >= Action(i).Y And y <= Action(i).Tall Then 'we have the mouse over an action!
p = Action(i).AssociatedWith
Select Case Words(p).action
Case "popup"
If MB And Not oldMB Then _MessageBox Words(p).word, Words(p).desc, "info"
End Select
Exit For 'action found. No need to keep checking.
End If
Next
oldMB = MB
End Sub
Sub ProcessWord (word$)
If word$ = "" Then Exit Sub
For i = 0 To 10000
If Words(i).insensitive = -1 Then
If _StriCmp(Words(i).word, word$) = 0 Then Exit For
Else
If _StrCmp(Words(i).word, word$) = 0 Then Exit For
End If
Next
If i > 10000 Then
_UPrintString (TextX, TextY), word$
Exit Sub
End If
'At this point, we've determined that this is one of our unique/control words. Let's process it as we should.
Select Case Words(i).action
Case "popup"
Color LightBlue, 0
_UPrintString (TextX, TextY), word$
Line (TextX, TextY + _UFontHeight)-Step(_UPrintWidth(word$), 0), LightBlue
Color White, 0
ActionMax = ActionMax + 1
Action(ActionMax).X = TextX
Action(ActionMax).Y = TextY
Action(ActionMax).Wide = TextX + _UPrintWidth(word$)
Action(ActionMax).Tall = TextY + _UFontHeight
Action(ActionMax).AssociatedWith = i
End Select
End Sub
Sub WordWrap (text$)
If text$ = "" Then Exit Sub
breakpoint$ = ",.; !?" + Chr$(10) + Chr$(13)
temp$ = text$
Do
MaxLineWidth = MaxX - TextX
If MaxLineWidth < _UPrintWidth("W") Then AddLine: MaxLineWidth = MaxX
For bp = 1 To Len(temp$)
If InStr(breakpoint$, Mid$(temp$, bp, 1)) Then Exit For 'we found a break point
Next
l$ = Left$(temp$, bp - 1) 'don't get the break point itself; we'll deal with it afterwards
pw = _UPrintWidth(l$)
If pw <= MaxLineWidth Then 'the word fits on the current line
ProcessWord l$
temp$ = Mid$(temp$, Len(l$) + 1)
TextX = TextX + pw 'move to end of word
Else 'the word is too long to fit on the current line
If pw > MaxX Then 'WTH? One word longer than our whole line? Break that bastard! It'll never fit on ANY line!
For i = 1 To bp
If _UPrintWidth(Left$(temp$, i)) > MaxLineWidth Then Exit For
Next
_UPrintString (TextX, TextY), Left$(l$, i - 1) 'print what we can on this line
temp$ = Mid$(temp$, i)
AddLine
Else 'the word can fit unbroken. We just move it down to the next line.
AddLine
ProcessWord l$
temp$ = Mid$(temp$, Len(l$) + 1)
TextX = pw 'move to end of word
End If
End If
Select Case Left$(temp$, 1)
Case Chr$(10)
If Mid$(temp$, 2, 1) = Chr$(13) Then temp$ = Mid$(temp$, 2)
AddLine
Case Chr$(13)
AddLine
Case Else
_UPrintString (TextX, TextY), Left$(temp$, 1)
TextX = TextX + _UPrintWidth(Mid$(temp$, 1, 1))
End Select
temp$ = Mid$(temp$, 2)
Loop Until temp$ = ""
End Sub
Sub AddLine
TextX = 0 'It's the start of a new line
UF = _UFontHeight
If TextY + UF <= MaxY Then 'we still have room for another line on the screen
TextY = TextY + UF
Else 'no room on screen. scroll the text
tempimage = _CopyImage(_Dest)
Cls , 0
_PutImage (0, UF)-(_Width - 1, _Height - 1), tempimage, _Dest, (0, 0)-(_Width - 1, _Height - i - UF)
_FreeImage tempimage
End If
End Sub
fonts.7z (Size: 125.83 KB / Downloads: 49)
For use with the fonts above.
So, what is this?
This is a work-in-progess word wrap system which also processes "Action words".
And what the BLEEEP is an "Action word", you ask??
It's a word that causes an action!!
Umm... Think a hyperlink. Click it, and it opens up a webpage.
Though, in this case, I expect it to be able to do more things for me -- such as popup a text descriptor or a word, or perhaps an image, or give a creatures stats or weapon quality, or....
Yout get it, I hope -- it's a word which we can then process to perform an ACTION!!
In this work-in-progress demo, I only have ONE action supported at the moment: Create a text pop up to add description about a word.
Other actions will come as time allows.
And what the heck is ALL this for you ask?
The engine behind what I hope to be a very interactive and intuitive Text-Adventure Game. Want more information on an antique desk in the room? Instead of typing something like "Inspect desk" and getting a "You can not inspect that" type message, you can tell at a glance if the desk is underlined and highlighted as an interactive object. Left click it to inspect it. Right click it to pull up a popup to interact with it (try to move it, ect)...
Resizable, word-wrapping, with action words! Who could ever want anything more??
RE: word wrap + action words! - Pete - 03-04-2024
Been there, done that... but in SCREEN 0, of course. Who could ever want anything more??
Have fun with it,
Pete
RE: word wrap + action words! - MasterGy - 03-04-2024
I don't know why, the _readfile$ command is not recognized by my ide. (3.11) then I will try another one, I thought it was the latest one until now
RE: word wrap + action words! - bplus - 03-04-2024
@MasterGy v3.12 (just .01 away!) https://qb64phoenix.com/forum/showthread.php?tid=2469