Code: (Select All)
_ControlChr Off
$Color:32
Screen _NewImage(1300, 600, 32)
_ScreenMove 20, 0
Cls: _Display
Print "Begin typing..."
Dim f&(4)
f&(1) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 16)
f&(2) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 20)
f&(3) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 24)
f&(4) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 30)
f& = 1: _Font f&(f&)
mc = 10
noa = 5
sa = 5
ln = 1
inputline% = 90 ' 90 usable spaces on a 100 pixel input line.
row = 300: x = 1: ReDim m$(1)
Do
_Limit 30
b$ = InKey$
If Len(b$) Then
If b$ = Chr$(27) Then System
If b$ = Chr$(9) Then Cls: _Display: Exit Do
If b$ = Chr$(13) Then
c = 0: x = x + 1
row = row + 40: col = 0: _Continue
End If
If b$ = Chr$(0) + Chr$(59) Then f& = 1: _Font f&(1): _Continue
If b$ = Chr$(0) + Chr$(60) Then f& = 2: _Font f&(2): _Continue
If b$ = Chr$(0) + Chr$(61) Then f& = 3: _Font f&(3): _Continue
If b$ = Chr$(0) + Chr$(62) Then f& = 4: _Font f&(4): _Continue
If col = 0 Then ReDim _Preserve m$(x): m$(x) = String$(mc + sa + mc * noa, Chr$(0))
fw& = _PrintWidth(b$)
fh& = _FontHeight
If col + fw& < inputline% Then
_PrintString (col, row - fh& * .8), b$
c = c + 1
Mid$(m$(x), c, 1) = b$
Mid$(m$(x), mc + sa + 1 + (c - 1) * noa, 1) = b$
Mid$(m$(x), mc + sa + 2 + (c - 1) * noa, 1) = Chr$(f&)
Mid$(m$(x), mc + sa + 3 + (c - 1) * noa, 1) = Chr$(fw&)
Mid$(m$(x), mc + sa + 4 + (c - 1) * noa, 1) = Chr$(fh&)
col = col + fw&
Else
Beep
End If
End If
_Display
Loop
If scr + ln = 1 Then i = 1 Else i = 0 ' Prevents scanning above the top line.
c = 0: h = 0
_Font f&(1) ''' Temp.
Do
c = c + 1
For g = i To i + 1
If ln + g > UBound(m$) Then Exit Do
j = InStr(Mid$(m$(ln - 1 + g), 1, mc) + Chr$(0), Chr$(0)) - 1
' Calculate the pixel length of the top line.
x% = 0: For p = 1 To j
x% = x% + Asc(Mid$(m$(ln - 1 + g), mc + sa + 3 + (p - 1) * noa, 1))
Next
' Get the available space on the upper line by subtracting the pixel length of characters from the total line pixels.
j2 = inputline% - x%
k = 0: k2 = 0
Do
k = k + 1
j = Asc(Mid$(m$(ln + g), mc + sa + 3 + (k - 1) * noa, 1))
If j = 0 Then Exit Do
k2 = k2 + j
If k2 > j2 Then
If Mid$(m$(ln + g), k, 1) = Chr$(32) Then k2 = k2 - j: k = k - 1
Exit Do
End If
Loop
' # characters in the top line vs # charcters to be wraped upwards.
j = mc - InStr(Mid$(m$(ln - 1 + g), 1, mc) + Chr$(0), Chr$(0))
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 pixels (j2) on line:"; ln - 1 + g; "="; j2
Print "Number of chr pixels (k2) on line:"; ln + g; "="; k2
Print "Number of potential chrs (k) to move up:"; k
If k2 And k2 <= j2 Then
Mid$(m$(ln - 1 + g), mc - j, k + 1) = Mid$(m$(ln + g), 1, k + 1) ' Front end
Mid$(m$(ln - 1 + g), 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 ' Number of characters to remain on the current line.
If x% Then
Print: Print "------> Word Wrap lines"; ln - 1 + g; "and"; ln + g: Print
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
Print: Print "------> Decreasing Array Size from"; j; "to"; j - 1: Print
j = UBound(m$)
If ln + g < j Then
For p = ln + g To j - 1
m$(p) = m$(p + 1)
Next
End If
ReDim _Preserve m$(j - 1)
i = i - 1
Exit For
End If
Else
Print: Print "------> Can't Wrap this line...": Print
End If
Next
i = i + 1
GoSub mydisplay: f& = 1: _Font f&(f&)
Print "--------------------------------------------------------------------------------------------------------------------------"
_Display: Sleep: Cls
Loop
Print "Finished. [Press Enter to Run or Esc to quit.]": Print
GoSub mydisplay
Do: _Limit 30
b$ = InKey$
If b$ = Chr$(27) Then System
Loop Until b$ = Chr$(13)
Run
mydisplay:
oldf& = 0
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
fw& = Asc(Mid$(m$(q), mc + sa + 3 + (qq - 1) * noa, 1))
fh& = Asc(Mid$(m$(q), mc + sa + 4 + (qq - 1) * noa, 1))
If fh& > maxheight Then maxheight = fh&
If f& <> oldf& Then
_Font f&(f&): oldf& = f&
End If
_PrintString (col, row - fh& * .8), Mid$(m$(q), qq, 1) '''+ LTrim$(Str$(maxheight))
col = col + fw&
Next
row = row + maxheight + 6: col = 0
Next
Line (100, 360)-(100, 560) ' No character should go past this line and there should be room for a cursor past any end line.
_Display
Return
Barely had the time to tune this up a bit. The only issue I see now is when I put in a cursor. It will probably need to be a vertical text cursor. That can be enlarged vertically with the selected font. I've always used horizontal cursors because it is easy to change it fro an underscore to a block, to indicate inserting or overwriting typing modes. The problem with keeping it that way when mixing font sizes results at the right margin. The largest font character at that margin would mean using the widest cursor, which would appear beyond that margin. That's not a problem with a vertical text cursor. If I want to keep a horizontal cursor, I will have to rework the wrap routine to detect the font size of the last character of each line and subtract a space that wide from the open pixels on that line.
Pete
Got so drunk for St. Patricks Day, I programmed something in graphics...
