Most of the WP stuff I made decades ago required a lot of emphasis on saving memory, so a gigantic doc, as a single string, was not in the cards back then. At one point I made a single string version, but rather than dig through the last 8 years of crap quality work, I decided to have some fun and start a new build.
So this is the fundamentals without text highlighting. It has _Resize to squish or expand the page width. If you REM out the included test string, you can run it with whatever you have stored to your clipboard.
Right now, it is in bruit force mode, meaning it does a rewrap for every key press. I'll modify it to only wrap when needed, place it into subs, and switch over to UDTs at some point.
Use the Insert key to switch from insert to overwrite mode. All other WP keys to control the cursor, page keys, home end, Ctrl+Home, Ctrl+End, etc. are included. Enter key for paragraph.
Mardi Gras was fun, but it's good to be back home again. Hey, guess who I bumped into? https://qb64phoenix.com/forum/showthread.php?tid=4491
Pete
So this is the fundamentals without text highlighting. It has _Resize to squish or expand the page width. If you REM out the included test string, you can run it with whatever you have stored to your clipboard.
Right now, it is in bruit force mode, meaning it does a rewrap for every key press. I'll modify it to only wrap when needed, place it into subs, and switch over to UDTs at some point.
Use the Insert key to switch from insert to overwrite mode. All other WP keys to control the cursor, page keys, home end, Ctrl+Home, Ctrl+End, etc. are included. Enter key for paragraph.
Code: (Select All)
$Resize:On
Width 60, 35: _Font 16
t.mt = 3: t.ml = 4: t.mr = t.ml + 19: t.mb = t.mt + 4
t.pw = t.mr - t.ml + 1: total = Len(new$): DisplayHeight = t.mb - t.mt + 1
If Len(_Clipboard$) Then new$ = _Clipboard$
ReDim track(0), eol(0)
GoSub skin
CurStyle = 7
Do
ReDim map(DisplayHeight) As String: For i = 1 To DisplayHeight: map(i) = String$(t.ml - 1 + t.pw, Chr$(0)): Next
If Not scroll Then ReDim track(0), eol(0): index = 0: TextLines = 0: a = 1: DisplayOnScreen = 0: total = Len(new$) Else index = t.scr
CurShow = 0: Locate , , CurShow
Do
index = index + 1
If Not scroll Then
If TextLines >= t.scr And DisplayOnScreen = 0 Then DisplayOnScreen = -1
If InStr(Mid$(new$, a, t.pw + 1), Chr$(13)) Then
q = 2: c = a: para$ = Chr$(20)
x1$ = Mid$(new$, a, InStr(Mid$(new$, a, t.pw + 1), Chr$(13)) - 1)
Else
If Right$(Mid$(new$, a, t.pw + 1), 1) = " " And t.pw > 1 Then q = 1 Else q = 0
x1$ = Mid$(new$, a, t.pw): c = a
End If
If q Or a + t.pw > total Then
If a + Len(x1$) + q > total Then q = -1: Else a = a + Len(x1$) + q
Else
If _InStrRev(x1$, " ") Then x1$ = Mid$(x1$, 1, _InStrRev(x1$, " "))
a = a + Len(x1$)
End If
TextLines = TextLines + 1
ReDim _Preserve track(TextLines + 1), eol(TextLines + 1)
track(TextLines) = c: eol(TextLines) = Len(x1$)
Else
If UBound(track) < t.scr + 1 + cnt Then ReDim _Preserve track(t.scr + 1 + cnt + 1), eol(t.scr + 1 + cnt + 1)
x1$ = Mid$(new$, track(t.scr + 1 + cnt), eol(t.scr + 1 + cnt))
If Mid$(new$, track(t.scr + 1 + cnt) + eol(t.scr + 1 + cnt), 1) = Chr$(13) Then para$ = Chr$(20)
DisplayOnScreen = -1
End If
s$ = String$(t.pw, 0): Mid$(s$, 1) = x1$
If CurReplaceArray Then
If Len(para$) Then k = 1 Else k = 0
If track(index) - 1 + eol(index) + k >= CurReplaceArray Or q = -1 And DisplayOnScreen < 0 Then ' q = -1 handles deleting from the end of the text.
If cnt = 0 And DisplayOnScreen = 0 Then DisplayOnScreen = -1: t.scr = index - DisplayHeight
If DisplayOnScreen < 0 Then
yy = t.mt - 1 + cnt + 1: xx = t.ml + CurReplaceArray - track(index): CurReplaceArray = 0
If ParaRemoved And xx = t.ml And Mid$(new$, track(row - 1), 1) = Chr$(13) Then autokey$ = Chr$(0) + "H|" + Chr$(0) + "O"
End If
End If
End If
If DisplayOnScreen < 0 Then
cnt = cnt + 1
Mid$(map(cnt), 1) = x1$ + para$ ' Map may be 1 column longer if it ends in a paragraph.
Locate t.mt - 1 + cnt, t.ml, CurShow, 7, CurStyle: Print s$;
If cnt = DisplayHeight Or scroll And cnt = TextLines Then
DisplayOnScreen = 1: If scroll Then q = -1
End If
End If
para$ = ""
Loop Until q = -1
If DisplayOnScreen <> 1 Then For i = 0 To t.mb - t.mt - cnt: Locate t.mt + cnt + i, t.ml, CurShow, 7, CurStyle: Print Space$(t.pw);: Next: DisplayOnScreen = 1
track(TextLines + 1) = Len(new$) + 1: eol(TextLines + 1) = 0
j = 0: q = 0: x1$ = "": cnt = 0: scroll = 0: hh = 0: para$ = "": ParaRemoved = 0
CurShow = 1: j = 0: GoSub Place_Cursor
Do
If _Resize Then
If initiate Then
If _ResizeWidth \ _FontWidth > _Width And _Width < 150 Then t.mr = t.mr + 1: t.pw = t.mr - t.ml + 1: Width _Width + 1, _Height: _Font 16: GoSub skin: Exit Do
If _ResizeWidth \ _FontWidth < _Width Then
If t.mr - t.ml > 0 Then
t.mr = t.mr - 1: t.pw = t.mr - t.ml + 1: Width _Width - 1, _Height: _Font 16: GoSub skin: Exit Do
End If
End If
End If
initiate = 1
End If
_Limit 60
GoSub keyboard
If Len(b$) Then Exit Do
Loop
yy = CsrLin: xx = Pos(0)
Loop
keyboard:
While _MouseInput: m.mw = m.mw + _MouseWheel: Wend
m.x = _MouseX
m.y = _MouseY
m.lb = _MouseButton(1)
m.rb = _MouseButton(2)
If m.mw Then
If m.mw > 0 Then b$ = Chr$(0) + "P" Else b$ = Chr$(0) + "H"
m.mw = 0
Else
If Len(autokey$) Then
If InStr(autokey$, "|") Then b$ = Mid$(autokey$, 1, InStr(autokey$, "|") - 1): autokey$ = Mid$(autokey$, InStr(autokey$, "|") + 1) Else b$ = autokey$: autokey$ = ""
Else
b$ = InKey$
End If
End If
If Len(b$) Then
j = 0: row = yy + t.scr - (t.mt - 1): xxEOL = t.ml - 1 + eol(row)
Select Case b$
Case Chr$(27): System
Case Chr$(13) ' Paragraph.
t = track(yy - (t.mt - 1) + t.scr): t = t + xx - (t.ml - 1) - 1
new$ = Mid$(new$, 1, t - 1) + Chr$(13) + Chr$(10) + Mid$(new$, t)
TextLines = TextLines + 1: ReDim _Preserve track(TextLines + 1), eol(TextLines + 1)
autokey$ = Chr$(0) + "P" + "|" + Chr$(0) + "G"
Case Chr$(32) To Chr$(126)
t = track(row) + xx - (t.ml - 1) - 1
If t > total Or ovw = 0 Or ovw And Mid$(new$, t, 1) = Chr$(13) Then
new$ = Mid$(new$, 1, t - 1) + b$ + Mid$(new$, t)
Else ' Overwrite within text.
Mid$(new$, t, 1) = b$
End If
If xx > t.mr And yy = t.mb Then t.scr = t.scr + 1 ' Forces scroll down to next line.
If yy = t.mt And t.scr > 0 And DisplayHeight > 2 Then t.scr = t.scr - 1
If yy = t.mb And t.scr + DisplayHeight < TextLines And DisplayHeight > 1 Then t.scr = t.scr + 1
GoSub Cursor_Relocate: autokey$ = Chr$(0) + "M"
Case Chr$(8)
If row > 1 Or row = 1 And xx > t.ml Then autokey$ = Chr$(0) + "K|" + Chr$(0) + "S"
Case Chr$(0) + "S" ' Delete.
GoSub Cursor_Relocate
If Mid$(new$, CurReplaceArray, 1) = Chr$(13) Then k = 1 Else k = 0
new$ = Mid$(new$, 1, CurReplaceArray - 1) + Mid$(new$, CurReplaceArray + k + 1)
If yy = t.mt And t.scr > 0 And DisplayHeight > 2 Then t.scr = t.scr - 1
If yy = t.mb And t.scr + DisplayHeight < TextLines And DisplayHeight > 1 Then t.scr = t.scr + 1
If k Then ParaRemoved = -1: k = 0
Case Chr$(0) + "I" ' PgUp.
t.scr = t.scr - (DisplayHeight - 1): If t.scr < 0 Then t.scr = 0
If xx - (t.ml - 1) > eol(row) Then autokey$ = Chr$(0) + "O"
Case Chr$(0) + "Q" ' PgDn.
t.scr = t.scr + (DisplayHeight - 1): If t.scr + DisplayHeight > TextLines Then t.scr = TextLines - DisplayHeight
If xx - (t.ml - 1) > eol(row) Then autokey$ = Chr$(0) + "O"
Case Chr$(0) + "s" ' Ctrl + Arrow Lt.
k = track(row) - 1 + xx - (t.ml - 1) - 1: i = 0
If Mid$(new$, k, 1) = Chr$(10) Then
autokey$ = Chr$(0) + "K"
Else
Do Until k = 0
t$ = Mid$(new$, k, 1): If i = 0 And t$ > Chr$(32) Then i = 1
If i Then
If t$ = " " Then k = k + 1: Exit Do
If t$ = Chr$(13) Then k = k + 2: Exit Do
End If
k = k - 1
Loop
If k Then
CurReplaceArray = k
Do
If CurReplaceArray >= track(t.scr + 1) Then Exit Do Else t.scr = t.scr - 1
Loop
Else
autokey$ = Chr$(0) + "w"
End If
End If
k = 0: h = 0: i = 0: t$ = ""
Case Chr$(0) + "t" ' Ctrl + Arrow Rt.
k = track(row) - 1 + xx - (t.ml - 1): h = 0
If k < total Then
Do
t$ = Mid$(new$, k, 1): If t$ = " " Or t$ = Chr$(13) Then h = Asc(t$)
If t$ <> " " And h Then Exit Do Else k = k + 1
Loop Until k = total
If h = 13 And k = track(row) - 1 + xx - (t.ml - 1) Then
autokey$ = Chr$(0) + "M" ' Move off a paragraph. Do not use k + 2 here as it will jump a paragraph with terminal paragraph/paragraph/paragraph format.
Else
If k = total Then
autokey$ = Chr$(0) + "u"
Else
CurReplaceArray = k
If DisplayHeight >= TextLines Then k = TextLines Else k = t.scr + DisplayHeight
Do
If t.scr < TextLines - DisplayHeight And CurReplaceArray >= track(k) + eol(k) Then t.scr = t.scr + 1: k = k + 1 Else Exit Do
Loop
End If
End If
k = 0: h = 0: t$ = ""
Else
autokey$ = Chr$(0) + "O"
End If
Case Chr$(0) + "w" ' Ctrl + Home.
yy = t.mt: xx = t.ml: j = 0: GoSub Place_Cursor: t.scr = 0
Case Chr$(0) + "u" ' Ctrl + End.
If t.scr + DisplayHeight < TextLines Then
t.scr = TextLines - DisplayHeight: autokey$ = Chr$(0) + "u"
Else
yy = TextLines - t.scr + (t.mt - 1): xx = t.mr + 1: j = -1: GoSub Place_Cursor
autokey$ = Chr$(0) + "P" ' Check for terminal paragraph and ignore if not present.
End If
Case Chr$(0) + "G"
xx = t.ml: GoSub Place_Cursor
Case Chr$(0) + "O"
j = -1: xx = t.mr + 1: GoSub Place_Cursor
Case Chr$(0) + "K"
If xx > t.ml Then
xx = xx - 1: j = 0: GoSub Place_Cursor
Else
If row > 1 Then
tmp$ = Mid$(new$, track(row - 1) + eol(row - 1), 1)
If tmp$ = Chr$(13) Or tmp$ = Chr$(32) And eol(row - 1) = t.pw Then tmp$ = "" Else tmp$ = "|" + Chr$(0) + "K"
If autokey$ = "" Then
autokey$ = Chr$(0) + "H|" + Chr$(0) + "O" + tmp$
Else
autokey$ = Chr$(0) + "H|" + Chr$(0) + "O" + tmp$ + "|" + autokey$ ' Adds Backspace if present.
End If
tmp$ = ""
End If
End If
Case Chr$(0) + "M"
If xx < xxEOL Or xx = xxEOL And row = TextLines Or xx = xxEOL And Mid$(new$, track(row) + t.pw, 1) = " " Or xx = xxEOL And Mid$(new$, track(row) + eol(row), 1) = Chr$(13) Then
If row <= TextLines Then xx = xx + 1: j = 0: GoSub Place_Cursor
Else
If row < TextLines Or row = TextLines And xx > t.mr And Mid$(new$, track(row) + t.pw, 1) = " " Or Mid$(new$, track(row) + eol(row), 1) = Chr$(13) Then ' > occurs when a marginal space is present.
autokey$ = Chr$(0) + "P" + "|" + Chr$(0) + "G"
End If
End If
Case Chr$(0) + "H"
If yy = t.mt Then
If t.scr > 0 Then t.scr = t.scr - 1 Else b$ = ""
Else
yy = yy - 1: j = -1: GoSub Place_Cursor
End If
Case Chr$(0) + "P"
Select Case row
Case Is = TextLines ' Last line only cursors down if text line is full.
If eol(row) = t.pw And Mid$(new$, track(row) + t.pw, 1) = " " Or Mid$(new$, track(row) + eol(row), 1) = Chr$(13) Then
If yy = t.mb Then t.scr = t.scr + 1 Else yy = yy + 1: xx = t.ml
TextLines = TextLines + 1: ReDim _Preserve track(TextLines + 1), eol(TextLines + 1)
track(TextLines) = Len(new$) + 1: eol(TextLines) = 0
j = -1: GoSub Place_Cursor ' Cursor will be placed in home line position.
Else
b$ = "" ' Can't cursor down.
End If
Case Is < TextLines
If yy = t.mb Then t.scr = t.scr + 1 Else yy = yy + 1: j = -1: GoSub Place_Cursor
End Select
Case Chr$(0) + "R"
ovw = Not ovw
If ovw Then CurStyle = 1 Else CurStyle = 7
Case Else: b$ = ""
End Select
If Len(b$) = 2 Then If InStr("KMHPIQGOtsuw", Right$(b$, 1)) Then scroll = -1
Else
If m.y And oldmy <> m.y Or m.x And m.x <> oldmx Or m.lb = -1 Or m.rb = -1 Then
If m.y >= t.mt And m.x <= t.mr + 1 And m.y <= t.mb And m.x >= t.ml Then inside = _TRUE Else inside = _FALSE
If inside = _TRUE Then
If m.lb = -1 Then
y1 = m.y - (t.mt - 1): x1 = m.x - (t.ml - 1)
Rem t = track(y1 + t.scr): t = t + x1 - 1
If Asc(Mid$(map(y1), x1, 1)) Then
yy = m.y: xx = m.x: j = 0: GoSub Place_Cursor
Else
If Asc(Left$(map(y1), 1)) > 0 Then ' Click inside page but beyond text.
yy = m.y: xx = t.mr + 1: j = -1: GoSub Place_Cursor
Else
If t.scr + y1 = TextLines Then ' Last line after a new paragraph was started.
yy = m.y: xx = t.mr + 1: j = -1: GoSub Place_Cursor
End If
End If
End If
End If
End If
End If
End If
oldmy = m.y: oldmx = m.x
Return
Place_Cursor:
row = yy + t.scr - (t.mt - 1): xxEOL = t.ml - 1 + eol(row)
If j And xx > xxEOL Then xx = xxEOL + 1
Locate yy, xx, CurShow, 7, CurStyle
j = 0
Return
Cursor_Relocate:
CurReplaceArray = track(row) + xx - (t.ml - 1) - 1
Return
skin:
Locate t.mt - 1, t.ml - 1, 0: Print Chr$(218) + String$(t.mr - t.ml + 1, Chr$(196)) + Chr$(191)
For i = t.mt To t.mb: Locate i, t.ml - 1: Print Chr$(179);: Locate , t.mr + 1: Print Chr$(179);: Next
Locate t.mb + 1, t.ml - 1: Print Chr$(192) + String$(t.mr - t.ml + 1, Chr$(196)) + Chr$(217);
Locate t.mt, t.ml, CurShow, 7, CurStyle: yy = CsrLin: xx = Pos(0)
Return
Mardi Gras was fun, but it's good to be back home again. Hey, guess who I bumped into? https://qb64phoenix.com/forum/showthread.php?tid=4491
Pete
