Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
$RESIZE with Word-Wrap Routine.
#1
The Thread Subject title says it all...

Code: (Select All)
$RESIZE:SMOOTH
Sw = 60
Sh = 25
S& = _NEWIMAGE(Sw, Sh, 0)
SCREEN S&
DO: LOOP UNTIL _SCREENEXISTS
font& = _LOADFONT(ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf", 18, "MONOSPACE")
_FONT font&
PALETTE 0, 8
COLOR 15, 0
_SCREENMOVE 10, 10
_DELAY .2
ml = 0: mr = ml
w = _WIDTH - (ml + mr)
DO
    _LIMIT 30
    x$ = "In West          Los      Angeles born    and raised,    at                    the yacht club is where I spent most of my days, 'til a couple of coders who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser, 'Save password log in later!' Now I'm able to post and my speech is still free as I sit on my throne as the Prince of P.E."
    x$ = "In West Los Angeles born and raised, at the yacht club is where I spent most of my days, 'til a couple of coders who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser, 'Save password log in later!' Now I'm able to post and my speech is still free as I sit on my throne as the Prince of P.E."
    w2 = w - (ml + mr)
    CLS
    LOCATE 2
    DO
        WHILE -1
            t$ = MID$(x$, 1, w2)
            chop = 1
            IF w2 <> 1 THEN
                DO
                    IF LEFT$(t$, 1) = " " THEN
                        ' Only happens with more than 1 space between characters.
                        IF LTRIM$(t$) = "" THEN EXIT DO ELSE x$ = LTRIM$(x$): EXIT WHILE
                    END IF

                    IF MID$(x$, w2 + 1, 1) <> " " AND LTRIM$(t$) <> "" THEN ' Now we have to chop it.
                        IF INSTR(x$, " ") > 1 AND INSTR(t$, " ") <> 0 AND LEN(x$) > w2 THEN
                            t$ = MID$(t$, 1, _INSTRREV(t$, " ") - 1)
                            chop = 2
                        END IF
                    ELSE
                        chop = 2
                    END IF
                    EXIT DO
                LOOP
                x$ = MID$(x$, LEN(t$) + chop)
            ELSE
                x$ = MID$(x$, LEN(t$) + 1)
            END IF
            IF LEN(t$) AND CSRLIN < _HEIGHT - 1 THEN LOCATE , ml + 1: PRINT LTRIM$(t$)
            EXIT WHILE
        WEND
    LOOP UNTIL LEN(t$) AND LEN(LTRIM$(x$)) = 0
    oldsw = Sw: oldsh = Sh
    IF _RESIZE THEN
        Sw = _RESIZEWIDTH \ _FONTWIDTH
        Sh = _RESIZEHEIGHT \ _FONTHEIGHT
        IF oldsw <> Sw OR oldsh <> Sh THEN
            w = Sw
            S& = _NEWIMAGE(Sw, Sh, 0)
            SCREEN S&
            _FONT font&
            PALETTE 0, 8
        END IF
    ELSE
        DO
            _LIMIT 30
            IF _RESIZE THEN EXIT DO
            b$ = INKEY$
            IF LEN(b$) THEN
                IF b$ = CHR$(27) THEN SYSTEM
                SELECT CASE MID$(b$, 2, 1)
                    CASE "M"
                        IF ml < _WIDTH \ 2 THEN ml = ml + 1: mr = mr + 1
                        EXIT DO
                    CASE "K"
                        IF ml > 0 THEN ml = ml - 1: mr = mr - 1
                        EXIT DO
                END SELECT
            END IF
        LOOP
    END IF
LOOP

Now before you get too excited... and we'll pause a moment so Steve can change his pants... this little routine just clears the screen on each resize. That means if we added vertical scrolling we would also have to build an algorithm to handle vertical positioning so we don't just always return to the start of the document every time the window gets resized.

Oh, now that Steve's back, yo can use the arrow left and right keys to increase and decrease the page margins.

I need sleep. I'm having too much fun coding stuff from the past all over again... Big Grin [Search Fresh Prince of Bel Air for ref to text].

Pete
Shoot first and shoot people who ask questions, later.
Reply
#2
While you keep changing your title, I'll keep changing my avatar. Heart

This program is clever but could behave a bit weird on Linux. On Manjaro KDE after the user finishes dragging, the window could "dance" a bit. It's good enough for the hobbyist because it works, but it might not be something for a guy, who liked to say "BTW I use Arch" to try to impress his girlfriend...
Reply
#3
I wonder if it as to do with $RESIZE or the rapid NEWIMAGE changes? It operates smoothly on Windows, at least on my Win 10. I also made a custom resize, but only for Wndows. It relies on the Win32 API to get the job done for my borderless Window. Now I suppose that routine could be made Linux friendly, without the borderless window part. I'd also have to convert back to the QB64 mouse routine. I like the Win32 API mouse, because it polls outside the active QB64 app window.

Oh, and if I want to impress my girlfriend, I just show her a picture of my wife! She figures if I can bag a girl like her, I must be something pretty special. I tried that in reverse once. BIG, BIG, BIG mistake! It wasn't pretty, and I ended up being classified as "Special..." for about 6-weeks. Frying pans have a way of making a lasting impression on a person.

Pete
Shoot first and shoot people who ask questions, later.
Reply
#4
Will see what Steve thinks about it in a minute...

Maybe DSMan could check it out. I think he has both Windows and I know he uses Linux.

Pete
Reply
#5
Well crickets so far on the Linux issue and $RESIZE with _NEWIMAGE.

I like this resize code I put together. When I get some more time, I think I'll see if I can map it and assign arrays. I've made two types of WP routines. One that always writes to the drive, and another that uses arrays for each line of text. This would be a single array, which I've done in part before for parsing, but not in complete WP.

Use left and right arrow keys to squash/expand page width from the right side.
Code: (Select All)
WIDTH 160, 42
_FONT 16
_SCREENMOVE 10, 10
w = _WIDTH
DO
    _LIMIT 30
    ' Two text samples. The first has some multiple spaces. The routine will left justify but if the number of spaces equals or exceeds the page width then the whole line is left blank.
    REM x$ = "In West    Los Angeles born and raised, at    the    yacht club is where I spent most of my      days, 'til a couple of coders      who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser save password log in later. Now I'm able to post and my speech is still free as I sit on my throne as the Prince of P.E."
    x$ = "In West Los Angeles born and raised, at the yacht club is where I spent most of my days, 'til a couple of coders who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser save password log in later. Now I'm able to post and my speech is still free as I sit on my throne as the Prince of P.E."
    CLS
    IF w < _WIDTH - 1 THEN
        FOR i = 1 TO _HEIGHT: LOCATE i, w + 1: PRINT CHR$(179);: NEXT
    END IF
    LOCATE 1, 1
    ' ------------------------------------------------------Wrap Routine----------------------------------------------
    DO
        WHILE -1
            t$ = MID$(x$, 1, w)
            chop = 1
            IF w <> 1 THEN
                DO
                    IF LEFT$(t$, 1) = " " THEN ' Only happens with more than 1 space between characters.
                        IF LTRIM$(t$) = "" THEN EXIT DO ELSE x$ = LTRIM$(x$): EXIT WHILE
                    END IF
                    IF MID$(x$, w + 1, 1) <> " " AND LTRIM$(t$) <> "" THEN ' Now we have to chop it.
                        IF INSTR(x$, " ") > 1 AND INSTR(t$, " ") <> 0 AND LEN(x$) > w THEN
                            t$ = MID$(t$, 1, _INSTRREV(t$, " ") - 1)
                            chop = 2
                        END IF
                    ELSE
                        chop = 2
                    END IF
                    EXIT DO
                LOOP
                x$ = MID$(x$, LEN(t$) + chop)
            ELSE
                x$ = MID$(x$, LEN(t$) + 1)
            END IF
            IF LEN(t$) AND CSRLIN < _HEIGHT - 1 THEN LOCATE , ml + 1: PRINT LTRIM$(t$)
            EXIT WHILE
        WEND
    LOOP UNTIL LEN(t$) AND LEN(LTRIM$(x$)) = 0
    ------------------------------------------------------------------------------------------------------------------
    DO
        b$ = INKEY$
        IF LEN(b$) THEN
            IF b$ = CHR$(27) THEN SYSTEM
            SELECT CASE MID$(b$, 2, 1)
                CASE "K"
                    IF w > 1 THEN w = w - 1
                    EXIT DO
                CASE "M"
                    IF w < _WIDTH - 1 THEN w = w + 1
                    EXIT DO
            END SELECT
        END IF
    LOOP
LOOP

Pete
Reply
#6
Steve wishes you'd learn to code with SUB and FUNCTION routines.  Move out of the prehistoric era already!  Tongue

Code: (Select All)
viewScreen = _NewImage(640, 480, 32)
'viewScreen = _NewImage(80, 25, 0)
Screen viewScreen
$Resize:On
_Delay .25
DoNothing = _Resize 'clear the inital resize flag from where our screen resizes itsefl at startup

Do
    Cls , 0

    Locate 1, 21 'to test a line with an offset
    test$ = "This is a very long sentence which runs on and on and one and even contains tipos and errors and goofs and mistakes and all sorts of junk, but it is good for testing if we have word breaks working properly for us!"
    WordWrap test$, -1
    Print 'to test a line from the starting point
    WordWrap test$, -1

    If _Resize Then resizeFlag = -1
    If resizeFlag And _Resize = 0 Then 'wait until user finishes resizing to adjust screen size
        resizeFlag = 0
        w = _ResizeWidth: h = _ResizeHeight
        If _PixelSize = 0 Then w = w \ _FontWidth: h = h \ _FontHeight
        tempScreen = _NewImage(w, h, 0)
        Screen tempScreen
        _FreeImage viewScreen
        viewScreen = tempScreen
    End If

    _Limit 30
    _Display
Loop

Sub WordWrap (text As String, newline)
    Dim BreakPoint As String
    BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.

    w = _Width
    pw = _PrintWidth(text)
    x = Pos(0): y = CsrLin
    If _PixelSize <> 0 Then x = x * _FontWidth
    firstlinewidth = w - x + 1
    If pw <= firstlinewidth Then
        Print text;
        If newline Then Print
    Else
        'first find the natural length of the line
        For i = 1 To Len(text)
            p = _PrintWidth(Left$(text, i))
            If p > firstlinewidth Then Exit For
        Next
        lineend = i - 1
        t$ = RTrim$(Left$(text, lineend)) 'at most, our line can't be any longer than what fits the screen.
        For i = lineend To 1 Step -1
            If InStr(BreakPoint, Mid$(text, i, 1)) Then lineend = i: Exit For
        Next
        Print Left$(text, lineend)
        WordWrap LTrim$(Mid$(text, lineend + 1)), newline
    End If
End Sub


A few things I've noticed with what you posted:

1) $RESIZE:SMOOTH  <-- you don't want SMOOTH, since you're handling the resizing manually.  You want to just go with a basic $RESIZE:ON.  

2) S& = _NEWIMAGE(Sw, Sh, 0)   <-- you're making an awful lot of screens here.  Where's the corresponding _FREEIMAGE to go with that _NEWIMAGE???   Can someone say MEMORY LEAK??


3) You might want to consider doing like I have -- set a flag for when a resize event starts, but don't worry about any actual adjustments until after the user quits jerking around the borders with the mouse.  Sometimes you can have issues when trying to resize a screen that the user is still screwing around with.  I've found it generally best to wait until _RESIZE is zero once more, before doing my screen adjustments.
Reply
#7
Well hang on there, Mr. Rubble. Try it with something other than a 1980's black DOS screen then you'll see why I use SMOOTH. SMOOTH greatly reduces that ugly ASCII black border on resize.

Your routine errors out, btw...

Fred
Shoot first and shoot people who ask questions, later.
Reply
#8
Errors out?  When and doing what?  It runs perfectly fine here for me.  ??
Reply
#9
LOCATE 1, 21 'to test a line with an offset.

If you resize the width past that point, it errors out. What's that emoji you like, oh yeah Tongue .

Pete Big Grin
Reply
#10
Well today I decided to add and test some indexing to the above routine. What does indexing do? Glad you asked! (Schizophrenic meds are too expensive, don't you think? i do!) So indexing allows us to find the character the cursor is at. Since wrap does this...

1) Most sentences run short of the page margin.
2) Some sentences go up to the page margin, but have a space that follows, which we don't want to unjustify our next line so we hide it as a trailing space.
3) Some sentences have more than two spaces in them, and when a sentences stretches to the page width, both a trailing space and a next line hidden leading space or spaces needs to be accounted for.

Indexing counts and keeps track of all of these occurrences in row arrays.

So this little demo can be screen resized, and you can use the left and right arrow buttons to size the margins. All of the above changes the wrap appearance of the paragraph. The indexing keeps track of how many hidden spaces and characters have accumulated for each row, and then it's just a matter of counting how far in you are from the left margin to determine which character in the string you are on.

The routine highlights the character you are hovering on with the mouse then uses the indexing in a MID$(x$, index(), 1) to pull that character and display it at the bottom of the screen. All characters hovered on should match. f they don't, there's a bug in the algorithm.

Code: (Select All)
_CONTROLCHR OFF
$RESIZE:SMOOTH
Sw = 60
Sh = 25
S& = _NEWIMAGE(Sw, Sh, 0)
SCREEN S&
DO: LOOP UNTIL _SCREENEXISTS
font& = _LOADFONT(ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf", 18, "MONOSPACE")
_FONT font&
PALETTE 0, 8
COLOR 15, 0
_SCREENMOVE 10, 10
_DELAY .2
ml = 2: mr = ml
w = _WIDTH - (ml + mr)
DIM cnt(1000), ls(1000), ts(1000), cc(1000), cline(1000)
DO
    _LIMIT 30
    z$ = "In West          Los Angeles born        and raised, at the                  yacht club is where I spent most of my days, 'til a couple of coders who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser, 'Save password log in later!' Now I'm able to post and my speech is still  free as I sit on my  throne as the Prince of P.E."
    ''z$ = "In West Los Angeles born and raised, at the yacht club is where I spent most of my days, 'til a couple of coders who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser, 'Save password log in later!' Now I'm able to post and my speech is still free as I sit on my throne as the Prince of P.E."
    x$ = z$
    i = w - (ml + mr)
    IF i > 0 THEN w2 = w - (ml + mr)
    ERASE ls, ts, cc, cline
    CLS
    LOCATE 2
    cnt = 0: lspace = 0: tspace = 0: cc = 0
    COLOR 15, 0
    DO
        WHILE -1
            t$ = MID$(x$, 1, w2)
            cnt = cnt + 1: cc(cnt) = cc
            chop = 1: addon = 0
            IF w2 <> 1 THEN ' All instances except single column vertical printing.
                IF LEFT$(t$, 1) = " " THEN ' Only happens with more than 1 space between characters.
                    IF LTRIM$(t$) = "" THEN ' All spaces so print a blank line.
                        addon = LEN(t$)
                    ELSE ' Push back leading spaces.
                        lspace = LEN(t$) - LEN(LTRIM$(t$)): x$ = LTRIM$(x$): cnt = cnt - 1
                        EXIT WHILE '  This will now redo the outer loop.
                    END IF
                ELSEIF MID$(x$, w2 + 1, 1) <> " " AND LTRIM$(t$) <> "" THEN ' Now we have to chop it.
                    IF INSTR(x$, " ") > 1 AND INSTR(t$, " ") <> 0 AND LEN(x$) > w2 THEN
                        t$ = MID$(t$, 1, _INSTRREV(t$, " ")) ' Preserves the in-margin trailing space.
                    END IF
                ELSE
                    chop = 2: tspace = 1
                END IF
                x$ = MID$(x$, LEN(t$) + chop)
            ELSE
                x$ = MID$(x$, LEN(t$) + 1)
                IF t$ = " " THEN cc = cc + 1 ' Compensate for LEN(LTRIM$(t$)) = 0 a few lines below.
            END IF
            ls(cnt) = ls(cnt - 1) + lspace: lspace = 0
            cc(cnt) = cc: cline(cnt) = LEN(t$)
            ts(cnt) = ts(cnt - 1) + tspace: tspace = 0
            IF LEN(t$) AND CSRLIN < _HEIGHT - 1 THEN
                REM LOCATE , 1: PRINT cc(cnt); ls(cnt); ts(cnt - 1); cline(cnt);
                LOCATE , ml + 1: PRINT LTRIM$(t$) '<----------------------------------- PRINT TO SCREEN.
            END IF
            cc = cc + lspace + tsapce + LEN(LTRIM$(t$)) + addon
            EXIT WHILE
        WEND
    LOOP UNTIL LEN(LTRIM$(x$)) = 0
    oldsw = Sw: oldsh = Sh
    IF _RESIZE THEN
        oldmy = 0: oldmx = 0: oldmy2 = 0: oldmx2 = 0: oldm$ = ""
        Sw = _RESIZEWIDTH \ _FONTWIDTH
        Sh = _RESIZEHEIGHT \ _FONTHEIGHT
        IF oldsw <> Sw OR oldsh <> Sh THEN
            w = Sw
            S_old& = S&
            S& = _NEWIMAGE(Sw, Sh, 0)
            SCREEN S&
            _FREEIMAGE S_old&
            _FONT font&
            PALETTE 0, 8
        END IF
    ELSE
        DO
            _LIMIT 30
            IF _RESIZE THEN EXIT DO
            WHILE _MOUSEINPUT: WEND
            mx = _MOUSEX
            my = _MOUSEY
            m$ = CHR$(SCREEN(my, mx)): hl = 0
            IF my > 1 AND my <= cnt + 1 THEN
                IF my <> oldmy2 OR mx <> oldmx2 THEN
                    IF mx > ml AND mx <= ml + cline(my - 1) THEN
                        IF oldmy2 THEN LOCATE oldmy2, oldmx2: COLOR 15, 0: PRINT oldm$;
                        LOCATE my, mx: COLOR 0, 15: PRINT m$;: COLOR 15, 0
                        LOCATE _HEIGHT - 1, 2: PRINT "Row"; my - 1; " Col"; mx - ml; " #"; LTRIM$(STR$(cc(my - 1) + (mx - ml) + ls(my - 1) + ts(my - 2))); " "; MID$(z$, cc(my - 1) + (mx - ml) + ls(my - 1) + ts(my - 2), 1); "    ";
                        oldmy2 = my: oldmx2 = mx: oldm$ = m$: hl = -1
                    END IF
                END IF
            END IF
            IF hl THEN IF my <> oldmy2 OR mx <> oldmx2 THEN COLOR 15, 0: LOCATE oldmy2, oldmx2: PRINT oldm$;
            oldmy = my: oldmx = mx
            b$ = INKEY$
            IF LEN(b$) THEN
                IF b$ = CHR$(27) THEN SYSTEM
                oldmy = 0: oldmx = 0: oldmy2 = 0: oldmx2 = 0: oldm$ = ""
                SELECT CASE MID$(b$, 2, 1)
                    CASE "M"
                        IF ml < _WIDTH \ 2 THEN ml = ml + 1: mr = mr + 1
                        EXIT DO
                    CASE "K"
                        IF ml > 0 THEN ml = ml - 1: mr = mr - 1
                        EXIT DO
                END SELECT
            END IF
        LOOP
    END IF
LOOP

Pete
Reply




Users browsing this thread: 1 Guest(s)