REM This demo reads html text for color and hyperlink tags, only. See x$. The screen displays the results without

REM the tags, and will be word wrapped, if the right margin changes, by using the arrow right and left keys or

REM resizing with a mouse drag at the right side of the screen.

$Resize:On

Do: Loop Until _Resize = 0

Type mousevar

    mx As Integer ' Row.

    my As Integer ' Column.

    wh As Integer ' Wheel.

    lb As Integer ' Left Button.

    rb As Integer ' Right Button.

    lb_status As Integer ' Left Button Status.

    rb_status As Integer ' Right Button Status.

    CursorStyle As Integer ' 0 Default, 1 Link style. (Hand).

    mousekey As String ' Auto Keyboard Input.

End Type

Dim m As mousevar

Palette 7, 63

Palette 4, 52

Palette 1, 17

Palette 2, 42

Palette 0, 56

Color 0, 7

Width 80, 25

Cls

fsize = 20

font& = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", fsize, "monospace")

If font& <= 0 Then _Font 16 Else _Font font&

_Delay 1

_ScreenMove _Middle

ReDim id(_Height, _Width) As Integer

ReDim linelength(_Height) As Integer

ReDim linkmap(_Height) As String

w = 80: rswidth = 80

x$ = "This is an example of a way to include <span style=" + Chr$(34) + "color: rgb(153, 0, 0);" + Chr$(34) + ">color</span> and hypertext in a "

x$ = x$ + "<span style=" + Chr$(34) + "color: rgb(0, 102, 0);" + Chr$(34) + ">SCREEN 0</span> text word wrap simulation. Let's go to <a href=" + Chr$(34) + "https://duckduckgo.com" + Chr$(34) + ">DuckDuckGo!</a> Okay, how about <a href=" + Chr$(34) + "https://qb64phoenix.com" + Chr$(34) + ">QB64Phoenix?</a> Maybe try <a href=" + Chr$(34) + "https://www.tapatalk.com/groups/qbasic/" + Chr$(34) + ">The QBASIC Forum!</a>"

instructions$ = "Press Arrow Lt/Rt Keys to Change Rt. Margin."

Locate 2, _Width \ 2 - Len(instructions$) \ 2

Print instructions$;

View Print 4 To _Height - 1

Do

    Cls 2

    If w < _Width Then ' Display right margin bar when width is less than 80.

        For i = 4 To _Height - 2: Locate i, w + 1: Print Chr$(179);: Next

    End If



    GoSub zero_variables



    Locate 4, 1

    Do

        i% = i% + 1

        c$ = Mid$(x$, i%, 1)

        Select Case c$

            Case "<" ' Strips out entire front tag.

                If Mid$(x$, i%, 2) <> "</" Then

                    j% = InStr(Mid$(x$, i%), ">") ' Length of front tag.

                    parse$ = Mid$(x$, i%, j%) ' Front tag.

                    If InStr(LCase$(parse$), "153, 0, 0") Then tag$ = "red"

                    If InStr(LCase$(parse$), "0, 102, 0") Then tag$ = "green"

                    If InStr(LCase$(parse$), "href") Then tag$ = "link"

                    i% = i% + j% - 1 ' Advances text reader past then front tag on next read.

                    If InStr(LCase$(parse$), "153, 0, 0") Then tag$ = "red"

                    If InStr(LCase$(parse$), "0, 102, 0") Then tag$ = "green"

                    If InStr(LCase$(parse$), "href") Then tag$ = "link"

                    Select Case tag$

                        Case "red": Color 4

                        Case "green": Color 2

                        Case "link": Color 1

                    End Select

                Else ' End tag

                    j% = InStr(Mid$(x$, i%), ">") ' Length of end tag.

                    i% = i% + j% - 1 ' Advances text reader past then end tag on next read.



                    GoSub default_variables ' Tag event is over so reset the variables.



                End If

                _Continue ' Nothing to display, so continue loop.

            Case " "

                flag = 1 ' Find the length of the upcoming word after any front tag is processed.

                r% = 1 ' The r% variables is a wrap evaluator. It provides the length of the next word or character like a single-letter word or space.

            Case Else ' Non-space character.

                If flag Then

                    flag = 0

                    chop$ = Mid$(x$, i%, InStr(Mid$(x$ + " ", i%), " ") - 1)

                    r% = InStr(chop$ + "</", "</") - 1 ' Number of characters enclosed in a tag.

                Else

                    r% = 1 ' Default value.

                End If

        End Select

        If col% + r% > w Then ' Wrap.

            If row% = _Height - 2 Then Exit Do ' At bottom margin so can't advance.

            If col% > 0 Then ' Advance row unless word being printed at left margin is longer than the line width.

                row% = row% + 1: col% = 0

            End If

        End If

        col% = col% + 1

        Locate row%, col%

        If w > 1 Then

            If c$ <> " " Then ' Non-Space.



                GoSub displayit



            Else ' Space.

                If col% = 1 Then col% = 0 ' Ignore leading space.

                cc = cc + 1

            End If

        Else ' For vertical 1-column displays, only.



            GoSub displayit ' Preserves spaces for a single column vertical display.



        End If

        If tag$ = "link" Then Mid$(linkmap(CsrLin), col%, 1) = String$(1, "*") ' Map the screen to find the link.

    Loop Until i% >= Len(x$)

    linelength(row%) = col% - 1 ' Set the bottom margin text character count.

    col% = 0: cc = 0: flag = 0



    GoSub default_variables



    Do

        _Limit 60



        mouse m



        If m.lb_status = 1 Then

            If m.CursorStyle = 1 Then ' Follow link.

                parse$ = Mid$(x$, 1, id(m.my, m.mx))

                parse$ = Mid$(parse$, _InStrRev(parse$, "href=") + 6)

                url$ = Mid$(parse$, 1, InStr(parse$, Chr$(34)) - 1)

                Shell _DontWait url$

            End If

        End If

        If m.mx <= linelength(m.my) Then ' Mouse is within text line.

            If Mid$(linkmap(m.my), m.mx, 1) = "*" Then

                _MouseShow "LINK"

                m.CursorStyle = 1

            Else

                _MouseShow "TEXT"

                m.CursorStyle = 0

            End If

        Else

            _MouseShow "DEFAULT"

            m.CursorStyle = 0

        End If

        Locate 25, 1: Print Space$(_Width);

        Locate 25, 1: Print "Page Width ="; w; "#Chrs ="; linelength(m.my); " Mouse y, x = "; LTrim$(Str$(m.my)); ","; m.mx; " Character Map:"; id(m.my, m.mx); Mid$(x$, id(m.my, m.mx), 1);

        If _Resize Then Exit Do

        b$ = InKey$

        If Len(b$) Then

            If b$ = Chr$(27) Then System

            Select Case Mid$(b$, 2, 1) ' Change right margin.

                Case "K"

                    If w > 1 Then w = w - 1

                    Exit Do

                Case "M"

                    If w < rswidth Then w = w + 1

                    Exit Do

            End Select

        End If

    Loop

    If b$ = "" And m.lb_status Then w = _ResizeWidth \ _FontWidth - 1: rswidth = w: If w > 80 Then w = 80

Loop

End



zero_variables:

ReDim id(_Height, _Width) As Integer

ReDim linelength(_Height) As Integer

ReDim linkmap(_Height)

i% = 0: j% = 0: row% = 4: col% = 0: flag = 0: linkmap(CsrLin) = String$(w, Chr$(0))

Return



default_variables:

Color 0

tag$ = ""

link$ = ""

Return



displayit:

Print c$;

id(CsrLin, col%) = i% ' Allows the mouse to find where the displayed text is in the original formatted text.

If col% = 1 Then ' The row has advanced.

    linelength(CsrLin - 1) = cc ' Complete the character count of the line above.

    linkmap(CsrLin) = String$(w, Chr$(0)) ' Reset (blank) the link map for the current line.

    cc = 0 ' Reset the charcter counter.

Else

    cc = cc + 1 ' Advance the character counter.

End If

Return



Sub mouse (m As mousevar)

    ' Local vars: i%,j%

    Static oldmx As Integer, oldmy As Integer

    While _MouseInput

        m.wh = m.wh + _MouseWheel

    Wend

    m.mx = _MouseX

    m.my = _MouseY

    m.lb = _MouseButton(1)

    m.rb = _MouseButton(2)

    Select Case m.lb

        Case 0

            Select Case m.lb_status

                Case -2

                    m.lb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.

                Case -1

                    m.lb_status = -2 ' The clicked event triggered any event structured to occur when the button is released.

                Case 0

                    ' Button has not been pressed yet.

                Case 1

                    m.lb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.

                Case 2

                    m.lb_status = 0 ' The drag event is over because the button was released.

            End Select

        Case -1

            Select Case m.lb_status ' Note drag is determined in the text highlighting routine.

                Case -1

                    ' An event occurred and the button is still down.

                    If oldmx <> m.mx Or oldmy <> m.my Then m.lb_status = 2 ' Drag.

                Case 0

                    m.lb_status = 1 ' Left button was just pressed.

                Case 1

                    m.lb_status = -1 ' The button is down and triggered any event structured to occur on initial press.  The status will remain -1 as long as the button is depressed.

            End Select

    End Select

    Select Case m.rb

        Case 0

            Select Case m.rb_status

                Case -2

                    m.rb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.

                Case -1

                    m.rb_status = -2 ' The clicked event triggered any event structured to occur when the button is released.

                Case 0

                    ' Button has not been pressed yet.

                Case 1

                    m.rb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.

                Case 2

                    m.rb_status = 0 ' The drag event is over because the button was released.

            End Select

        Case -1

            Select Case m.rb_status

                Case -1

                    ' An event occurred and the button is still down.

                Case 0

                    m.rb_status = 1 ' button was just pressed.

                Case 1

                    m.rb_status = -1 ' The button is down and triggered any event structured to occur on initial press.  The status will remain -1 as long as the button is depressed.

            End Select

    End Select

    oldmx = m.mx: oldmy = m.my

End Sub