Posts: 1,858
Threads: 190
Joined: Apr 2022
Reputation:
88
12-06-2022, 02:39 PM
(This post was last modified: 12-06-2022, 09:35 PM by Pete.)
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...  [Search Fresh Prince of Bel Air for ref to text].
Pete
If eggs are brain food, Biden has his scrambled.
Posts: 1,710
Threads: 63
Joined: Jul 2022
Reputation:
52
While you keep changing your title, I'll keep changing my avatar. 
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...
Posts: 1,858
Threads: 190
Joined: Apr 2022
Reputation:
88
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
If eggs are brain food, Biden has his scrambled.
Posts: 1,858
Threads: 190
Joined: Apr 2022
Reputation:
88
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
Posts: 1,858
Threads: 190
Joined: Apr 2022
Reputation:
88
12-06-2022, 10:05 PM
(This post was last modified: 12-06-2022, 10:12 PM by Pete.)
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
Posts: 2,325
Threads: 280
Joined: Apr 2022
Reputation:
180
Steve wishes you'd learn to code with SUB and FUNCTION routines. Move out of the prehistoric era already! 
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.
Posts: 1,858
Threads: 190
Joined: Apr 2022
Reputation:
88
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
If eggs are brain food, Biden has his scrambled.
Posts: 2,325
Threads: 280
Joined: Apr 2022
Reputation:
180
Errors out? When and doing what? It runs perfectly fine here for me. ??
Posts: 1,858
Threads: 190
Joined: Apr 2022
Reputation:
88
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 .
Pete
Posts: 1,858
Threads: 190
Joined: Apr 2022
Reputation:
88
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
|
