Got so drunk for St. Patricks Day, I programmed something in graphics...

[bplus]

+1 coming along nicely, is the h for font height or that not ready yet?

[Pete]

Thanks! Hey wait, where's my +1 ???

Font sizing is on hold, for a bit, until the established foundation passes pressure testing. If what's coded now isn't 100% sound, the different sizes will throw it into complete chaos, so bad I won't even be able to hire Maxwell Smart to save the day. Oh wait, he's in prison. Apparently he was brought up on charges for sexually harassing 99 when his shoe phone was upgraded to a camera model.

Pete

[bplus]

"Hey wait, where's my +1 ???"

opps, should be there now

btw 5 star rating thanks to me (and no one else) 1900+ views!! that many people really care about pete getting drunk? i think not, i hope not

more points might come from outlining your goals for this thread and is it too late to rename it? it appears to be start of advanced editor?
how do links tie in with 'project' word you've used @pete

[Pete]

LOL on the view count. I was thinking the same thing. Has the country gone to crap so bad that bots now excessively crawl posts 10x more when elements of debauchery are involved?

I did a slight upgrade, just now, to address a multiple shell issue and added a way to delete up lines.

Pete

 - Debaucher, debaker, decandlestick maker.

[Kernelpanic]

@bplus & @Pete - the answer is simple: when it comes to drinking, you're always interesting!

[Pete]

The amount of alcohol I consume in a year consists of maybe a 12-pack of beer and a bottle of wine. Scotch and other types of whiskey, about a bottle a decade. That said, my favorite beer is Heineken and I'll never transition to Bud Light!

Oh, updated the app to include the ability to remove or edit hyperlinks.

Pete

[Pete]

Added text scrolling...

https://qb64phoenix.com/forum/showthread...9#pid23879

[bplus]

it's scrolling down but not up for me.

seems pretty easy to load and save files on popup, then I can test bigger files? can it handle more than page of text?

[Pete]

Code: (Select All)

If m.wh > 0 Then m.mousekey$ = Chr$(0) + "P" Else m.mousekey$ = Chr$(0) + "H"

@bplus

Fixed this line. I had two "P" instead of a "P" and "H" Still hungover, I guess!

Yes, it can handle more than one page. No limit, except memory. Links are 255 max for now. I could expand that to 60,000+ by just using one more matrix space per character.

I'm experiencing a bug when I go back to the larger text field. I'll post one with a larger field, as soon as I track down what's causing the issue.

Thanks!

Pete

[Pete]

I can't tell these days if I'm getting too old, or getting to complicated. Simple wrap routines are a decent challenge, but I'm adding in variable size fonts and a matrix string to keep those attributes in memory. Well, a code snippet is worth a thousand words, so here you go...

Code: (Select All)

_ControlChr Off

$Color:32

Screen _NewImage(1300, 600, 32)

f16& = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 16)

f20& = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 20)

_ScreenMove 20, 0

_Font f16&

mc = 10

noa = 5

sa = 5

ln = 1

ReDim m$(7)

ReDim a$(7)

a$(1) = "abcd "

a$(1) = a$(1) + String$(mc - Len(a$(1)), Chr$(0))

a$(2) = "wert cat"

a$(2) = a$(2) + String$(mc - Len(a$(2)), Chr$(0))

a$(3) = "123 56 7"

a$(3) = a$(3) + String$(mc - Len(a$(3)), Chr$(0))

a$(4) = "X box A "

a$(4) = a$(4) + String$(mc - Len(a$(3)), Chr$(0))

a$(5) = "Pete 1. "

a$(5) = a$(5) + String$(mc - Len(a$(3)), Chr$(0))

a$(6) = "zzzzzzzz"

a$(6) = a$(6) + String$(mc - Len(a$(3)), Chr$(0))

a$(7) = "complete"

a$(7) = a$(7) + String$(mc - Len(a$(3)), Chr$(0))

For i = 1 To UBound(a$)

    m$(i) = String$(mc * (noa + 1) + sa, Chr$(0))

    Mid$(m$(i), 1, Len(m$(1))) = a$(i) 'Front end.

    k = InStr(a$(i) + Chr$(0), Chr$(0)) - 1

    Mid$(m$(i), mc + 1, sa) = String$(5, "|")

    For j = 1 To k

        Mid$(m$(i), mc + sa + 1 + ((j - 1) * noa), 1) = Mid$(a$(i), j, 1)

        Mid$(m$(i), mc + sa + 2 + (j - 1) * noa, 1) = Chr$(16) ' 16 pixels high.

        Mid$(m$(i), mc + sa + 3 + (j - 1) * noa, 1) = Chr$(8) ' 8 pixels wide.

    Next

    Print i, m$(i); "|", Len(m$(i))

Next

_Display: Sleep: Cls

If scr + ln = 1 Then h2 = 1 Else h2 = 0

h = 0: i = 1

Do

    c = c + 1

    Print "At line:"; c; "looking above and below... "

    For g = h + h2 To i

        If ln + g > UBound(m$) Then Exit Do

        j = mc - InStr(Mid$(m$(ln - 1 + g), 1, mc) + Chr$(0), Chr$(0))

        x% = 0: For p = 1 To mc - 1 - j

            x% = x% + Asc(Mid$(m$(ln - 1 + g), mc + sa + 3 + (p - 1) * noa, 1))

        Next

        j2 = (mc - 1) * 8 - x%

        k = _InStrRev(Mid$(m$(ln + g), 1, j + 1), " ") - 1

        If k < 0 Then k = InStr(Mid$(m$(ln + g), 1, mc) + Chr$(0), Chr$(0)) - 1

        x% = 0: For p = 1 To k

            x% = x% + Asc(Mid$(m$(ln + g), mc + sa + 3 + (p - 1) * noa, 1))

        Next

        k2 = x%

        Print "Analyzing lines"; ln - 1 + g; "and"; ln + g; "  |"; Mid$(m$(ln - 1 + g), 1, mc); "|", "|"; Mid$(m$(ln + g), 1, mc); "|"

        Print "Number of open spaces (j) on line:  "; ln - 1 + g; "="; j

        Print "Number of chrs (k) to wrap upwards:"; ln + g; "="; k

        Print "Number of open pixels (j2) on line:  "; ln - 1 + g; "="; j2

        Print "Number of pixels (k2) in 1st word line:"; ln + g; "="; k2

        If k2 And k2 <= j2 Then

            Print: Print "------> Word Wrap lines"; ln - 1 + g; "and"; ln + g

            Mid$(m$(ln + g - 1), mc - j, k + 1) = Mid$(m$(ln + g), 1, k + 1) ' Front end

            Mid$(m$(ln + g - 1), mc + sa + 1 + (mc - 1 - j) * noa, (j + 1) * noa) = Mid$(m$(ln + g), mc + sa + 1, (k + 1) * noa) ' Back end.

            x% = InStr(Mid$(m$(ln + g), k + 2, mc - (k + 2)) + Chr$(0), Chr$(0)) - 1

            Mid$(m$(ln + g), 1, mc) = Mid$(m$(ln + g), k + 2, x%) + String$(mc - x%, Chr$(0)) ' Front end.

            Mid$(m$(ln + g), mc + sa + 1, mc * noa) = Mid$(m$(ln + g), mc + sa + 1 + (k + 1) * noa, (x%) * noa) + String$((mc - x% + 1) * noa, Chr$(0)) ' Front end.

            Exit For

        Else

            If Left$(m$(ln + g), 1) = Chr$(0) Then

                j = UBound(m$)

                Print: Print "------> Decreasing Array Size from"; j; "to"; j - 1: Print

                For i = c To j - 1

                    m$(i) = m$(i + 1)

                Next

                ReDim _Preserve m$(j - 1)

            Else

                Print "------> Can't Wrap this line...": Print

            End If

        End If

    Next

    h2 = 0: h = h + 1: i = h + 1



    GoSub mydisplay



    Print "--------------------------------------------------------------------------------------------------------------------------"

    _Display: Sleep: Cls

Loop

Print: Print "Finished..."



GoSub mydisplay



Sleep 2

End



mydisplay:

For q = 1 To UBound(m$)

    Print m$(q)

Next

col = 0: row = 400: maxheight = 0

For q = 1 To UBound(m$)

    For qq = 1 To mc

        f& = Asc(Mid$(m$(q), mc + sa + 2 + (qq - 1) * noa, 1))

        If f& = 0 Then Exit For

        If f& <> oldf& Then

            If f& > maxheight Then maxheight = f&

            _Font f&: oldf& = f&

        End If

        _PrintString (col, row - maxheight \ 2), Mid$(m$(q), qq, 1)

        col = col + Asc(Mid$(m$(q), mc + sa + 3 + (qq - 1) * noa, 1)) + 2

    Next

    row = row + 16: col = 0

Next

Return

 

It simply word wraps the 7 9-characters or less lines into a 6-line block. You have to keep pressing keys to get it to advance. All the added crap is for debugging purposes. The bottom of the screen would be the actual display. It is set up for pixels, so when I change the sizes, my next bit of testing, it should wrap according to size, and not character count.


Edit:

Okay, changing the font of 1-character from 16 to 20 works, so this looks promising...

Code: (Select All)

_ControlChr Off

$Color:32

Screen _NewImage(1300, 600, 32)

Dim f&(2)

f&(1) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 16)

f&(2) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 20)

_ScreenMove 20, 0

_Font f&(1)

mc = 10

noa = 5

sa = 5

ln = 1

ReDim m$(7)

ReDim a$(7)

a$(1) = "abc "

a$(1) = a$(1) + String$(mc - Len(a$(1)), Chr$(0))

a$(2) = "wert cat"

a$(2) = a$(2) + String$(mc - Len(a$(2)), Chr$(0))

a$(3) = "123 56 7"

a$(3) = a$(3) + String$(mc - Len(a$(3)), Chr$(0))

a$(4) = "X box A "

a$(4) = a$(4) + String$(mc - Len(a$(3)), Chr$(0))

a$(5) = "Pete 1. "

a$(5) = a$(5) + String$(mc - Len(a$(3)), Chr$(0))

a$(6) = "zzzzzzzz"

a$(6) = a$(6) + String$(mc - Len(a$(3)), Chr$(0))

a$(7) = "complete"

a$(7) = a$(7) + String$(mc - Len(a$(3)), Chr$(0))

For i = 1 To UBound(a$)

    m$(i) = String$(mc * (noa + 1) + sa, Chr$(0))

    Mid$(m$(i), 1, Len(m$(1))) = a$(i) 'Front end.

    k = InStr(a$(i) + Chr$(0), Chr$(0)) - 1

    Mid$(m$(i), mc + 1, sa) = String$(5, "|")

    For j = 1 To k

        Mid$(m$(i), mc + sa + 1 + ((j - 1) * noa), 1) = Mid$(a$(i), j, 1)

        Mid$(m$(i), mc + sa + 2 + (j - 1) * noa, 1) = Chr$(1) ' Font size.

        Mid$(m$(i), mc + sa + 3 + (j - 1) * noa, 1) = Chr$(8) ' 8 pixels wide.

        Mid$(m$(i), mc + sa + 4 + (j - 1) * noa, 1) = Chr$(16) ' 16 pixels high.

    Next

    Print i, m$(i); "|", Len(m$(i))

    Mid$(m$(2), mc + sa + 2 + (2 - 1) * noa, 1) = Chr$(2)

    Mid$(m$(2), mc + sa + 3 + (2 - 1) * noa, 1) = Chr$(10)

    Mid$(m$(2), mc + sa + 4 + (2 - 1) * noa, 1) = Chr$(20)

Next

_Display: Sleep: Cls

If scr + ln = 1 Then h2 = 1 Else h2 = 0

h = 0: i = 1

Do

    c = c + 1

    Print "At line:"; c; "looking above and below... "

    For g = h + h2 To i

        If ln + g > UBound(m$) Then Exit Do

        j = mc - InStr(Mid$(m$(ln - 1 + g), 1, mc) + Chr$(0), Chr$(0))

        x% = 0: For p = 1 To mc - 1 - j

            x% = x% + Asc(Mid$(m$(ln - 1 + g), mc + sa + 3 + (p - 1) * noa, 1))

        Next

        j2 = (mc - 1) * 8 - x%

        k = _InStrRev(Mid$(m$(ln + g), 1, j + 1), " ") - 1

        If k < 0 Then k = InStr(Mid$(m$(ln + g), 1, mc) + Chr$(0), Chr$(0)) - 1

        x% = 0: For p = 1 To k

            x% = x% + Asc(Mid$(m$(ln + g), mc + sa + 3 + (p - 1) * noa, 1))

        Next

        k2 = x%

        Print "Analyzing lines"; ln - 1 + g; "and"; ln + g; "  |"; Mid$(m$(ln - 1 + g), 1, mc); "|", "|"; Mid$(m$(ln + g), 1, mc); "|"

        Print "Number of open spaces (j) on line:  "; ln - 1 + g; "="; j

        Print "Number of chrs (k) to wrap upwards:"; ln + g; "="; k

        Print "Number of open pixels (j2) on line:  "; ln - 1 + g; "="; j2

        Print "Number of pixels (k2) in 1st word line:"; ln + g; "="; k2

        If k2 And k2 <= j2 Then

            Print: Print "------> Word Wrap lines"; ln - 1 + g; "and"; ln + g

            Mid$(m$(ln + g - 1), mc - j, k + 1) = Mid$(m$(ln + g), 1, k + 1) ' Front end

            Mid$(m$(ln + g - 1), mc + sa + 1 + (mc - 1 - j) * noa, (j + 1) * noa) = Mid$(m$(ln + g), mc + sa + 1, (k + 1) * noa) ' Back end.

            x% = InStr(Mid$(m$(ln + g), k + 2, mc - (k + 2)) + Chr$(0), Chr$(0)) - 1

            Mid$(m$(ln + g), 1, mc) = Mid$(m$(ln + g), k + 2, x%) + String$(mc - x%, Chr$(0)) ' Front end.

            Mid$(m$(ln + g), mc + sa + 1, mc * noa) = Mid$(m$(ln + g), mc + sa + 1 + (k + 1) * noa, (x%) * noa) + String$((mc - x% + 1) * noa, Chr$(0)) ' Front end.

            Exit For

        Else

            If Left$(m$(ln + g), 1) = Chr$(0) Then

                j = UBound(m$)

                Print: Print "------> Decreasing Array Size from"; j; "to"; j - 1: Print

                For i = c To j - 1

                    m$(i) = m$(i + 1)

                Next

                ReDim _Preserve m$(j - 1)

            Else

                Print "------> Can't Wrap this line...": Print

            End If

        End If

    Next

    h2 = 0: h = h + 1: i = h + 1



    GoSub mydisplay



    Print "--------------------------------------------------------------------------------------------------------------------------"

    _Display: Sleep: Cls

Loop

Print: Print "Finished..."



GoSub mydisplay



Sleep 2

End



mydisplay:

For q = 1 To UBound(m$)

    Print m$(q)

Next

col = 0: row = 400: maxheight = 0

For q = 1 To UBound(m$)

    For qq = 1 To mc

        f& = Asc(Mid$(m$(q), mc + sa + 2 + (qq - 1) * noa, 1))

        fw& = Asc(Mid$(m$(q), mc + sa + 3 + (qq - 1) * noa, 1)) + 2

        fh& = Asc(Mid$(m$(q), mc + sa + 4 + (qq - 1) * noa, 1))

        If f& = 0 Then Exit For

        If fh& > maxheight Then maxheight = fh&

        If f& <> oldf& Then

            _Font f&(f&): oldf& = f&

        End If

        _PrintString (col, row - fh& \ 2), Mid$(m$(q), qq, 1)

        col = col + fw&

    Next

    row = row + maxheight + 2: col = 0

Next

Return

Pete