08-28-2023, 12:45 PM
(08-27-2023, 11:27 PM)jcm Wrote:Code: (Select All)
_Title "Font From String Patterns" ' b+ 2023-08-27
' Inspired by grymmjack post here https://staging.qb64phoenix.com/showthread...0#pid18990
' I used his font patterns to get my version started
Screen _NewImage(800, 600, 32)
_ScreenMove 200, 60
Window (0, 0)-(800, 600)
Dim spattern$(0 To 255)
Dim pattern5$(0 To 255)
LoadPatterns9x9 spattern$()
LoadPatterns5x5 pattern5$()
FPrint "TESTING", spattern$(), 323, 550, 2, 3, &HFF0000FF, 0
FPrint "STARFIGHTER", spattern$(), 218, 420, 3, 3, &HFFFF0000, -15
FPrint "STARFISHING", spattern$(), 70, 300, 5, 3, &HFFFFFF00, 15
FPrint "BPLUS", spattern$(), 376, 50, 1, 2, &HFF008800, -90
FPrint "b+", pattern5$(), 435, 53, 1, 1, &HFFFFFFFF, 0
Sleep
Sub FPrint (s$, PA$(), x%, y%, scale%, spacing%, colr~&, Ang#)
' s$ is string to "print" out
' PA$() is the array of string holding the font THE SQUARE pattern (must be NxN pattern)
' x, y top, left corner of print just like _PrintString
' scale is multiplier of pixeled font at NxN so now is Scale * N x Scale * N
' spacing is amount of pixels * scale between letters
' color~& type allows up to _RGB32() colors
Dim As Integer ls, a, sq, r, c, i
Dim As Double Xp, Yp, Xpp, Ypp
ls = Len(s$)
For l = 1 To ls
a = Asc(s$, l)
If Len(PA$(a)) Then ' do we have a pattern
sq = Sqr(Len(PA$(a)))
'Print Chr$(a), sq 'debug
For r = 0 To sq - 1 ' row and col of letter block
For c = 0 To sq - 1
i = r * sq + c + 1
If Asc(PA$(a), i) <> Asc(".") Then
Xp = x% + ((l - 1) * (sq + spacing%) + c) * scale%
Yp = y% + r * scale%
'**
Xpp = x% + (Xp - x%) * Cos(_D2R(Ang#)) - (Yp - y%) * Sin(_D2R(Ang#))
Ypp = y% - (Xp - x%) * Sin(_D2R(Ang#)) - (Yp - y%) * Cos(_D2R(Ang#))
'Line (x% + ((l - 1) * (sq + spacing%) + c) * scale%, y% + r * scale%)-Step(scale%, scale%), colr~&, BF
Line (Xpp, Ypp)-Step(scale%, scale%), colr~&, BF
End If
Next
Next
End If
Next
End Sub
Sub LoadPatterns9x9 (SPattern() As String)
Dim As Integer a
a = Asc("S")
SPattern(a) = "..XXXXXX."
SPattern(a) = SPattern(a) + ".X......."
SPattern(a) = SPattern(a) + ".X......."
SPattern(a) = SPattern(a) + "..S......"
SPattern(a) = SPattern(a) + "...SXS..."
SPattern(a) = SPattern(a) + "......S.."
SPattern(a) = SPattern(a) + ".......S."
SPattern(a) = SPattern(a) + ".......S."
SPattern(a) = SPattern(a) + "SXXXXXX.."
a = Asc("T")
SPattern(a) = "XXXXXXXXX"
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
a = Asc("A")
SPattern(a) = "...aXA..."
SPattern(a) = SPattern(a) + "..X...X.."
SPattern(a) = SPattern(a) + "..X...X.."
SPattern(a) = SPattern(a) + ".X.....X."
SPattern(a) = SPattern(a) + ".XXXXXXX."
SPattern(a) = SPattern(a) + ".X.....X."
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
a = Asc("F")
SPattern(a) = "XXXXXXXXX"
SPattern(a) = SPattern(a) + "F........"
SPattern(a) = SPattern(a) + "F........"
SPattern(a) = SPattern(a) + "F........"
SPattern(a) = SPattern(a) + "FFFXXXX.."
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
a = Asc("I")
SPattern(a) = ".XXXXXXX."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + "....X...."
SPattern(a) = SPattern(a) + ".XXXXXXX."
a = Asc("G")
SPattern(a) = ".XXXXXXXX"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X....GGGX"
SPattern(a) = SPattern(a) + "X.......G"
SPattern(a) = SPattern(a) + "X......gG"
SPattern(a) = SPattern(a) + "X.....G.X"
SPattern(a) = SPattern(a) + ".XXXXX..G"
a = Asc("H")
SPattern(a) = "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "XXXXXXXXX"
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
a = Asc("E")
SPattern(a) = "XXXXXXXXX"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "XXXXXXX.."
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "XXXXXXXXX"
a = Asc("N")
SPattern(a) = "X.......N"
SPattern(a) = SPattern(a) + "XX......N"
SPattern(a) = SPattern(a) + "X.X.....N"
SPattern(a) = SPattern(a) + "N..X....N"
SPattern(a) = SPattern(a) + "N...X...N"
SPattern(a) = SPattern(a) + "N....X..N"
SPattern(a) = SPattern(a) + "N.....X.N"
SPattern(a) = SPattern(a) + "N......XN"
SPattern(a) = SPattern(a) + "N.......N"
a = Asc("B")
SPattern(a) = "BBBBBBB.."
SPattern(a) = SPattern(a) + "X......B."
SPattern(a) = SPattern(a) + "X.......N"
SPattern(a) = SPattern(a) + "N......N."
SPattern(a) = SPattern(a) + "NBBBBBN.."
SPattern(a) = SPattern(a) + "N......b."
SPattern(a) = SPattern(a) + "N.......B"
SPattern(a) = SPattern(a) + "N......X."
SPattern(a) = SPattern(a) + "NBBBBBB.."
a = Asc("L")
SPattern(a) = "B........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "N........"
SPattern(a) = SPattern(a) + "N........"
SPattern(a) = SPattern(a) + "N........"
SPattern(a) = SPattern(a) + "N........"
SPattern(a) = SPattern(a) + "N........"
SPattern(a) = SPattern(a) + "NBBBBBBLL"
a = Asc("U")
SPattern(a) = "B.......U"
SPattern(a) = SPattern(a) + "X.......U"
SPattern(a) = SPattern(a) + "X.......U"
SPattern(a) = SPattern(a) + "N.......U"
SPattern(a) = SPattern(a) + "N.......U"
SPattern(a) = SPattern(a) + "N.......U"
SPattern(a) = SPattern(a) + "N.......U"
SPattern(a) = SPattern(a) + "N.......U"
SPattern(a) = SPattern(a) + ".BBBBBBL."
a = Asc("P")
SPattern(a) = "XPPPPPP.."
SPattern(a) = SPattern(a) + "X......X."
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X......P."
SPattern(a) = SPattern(a) + "XXXXXX..."
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
SPattern(a) = SPattern(a) + "X........"
a = Asc("R")
SPattern(a) = "XPPPPPP.."
SPattern(a) = SPattern(a) + "X......X."
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X......P."
SPattern(a) = SPattern(a) + "XXXXXXR.."
SPattern(a) = SPattern(a) + "X.....R.."
SPattern(a) = SPattern(a) + "X......R."
SPattern(a) = SPattern(a) + "X.......X"
SPattern(a) = SPattern(a) + "X.......X"
End Sub
Sub LoadPatterns5x5 (SPattern() As String)
Dim As Integer a
a = Asc("b")
SPattern(a) = "b...."
SPattern(a) = SPattern(a) + "b...."
SPattern(a) = SPattern(a) + "b.bb."
SPattern(a) = SPattern(a) + "bb..b"
SPattern(a) = SPattern(a) + "b.bb."
a = Asc("+")
SPattern(a) = "....."
SPattern(a) = SPattern(a) + "..+.."
SPattern(a) = SPattern(a) + ".+++."
SPattern(a) = SPattern(a) + "..+.."
SPattern(a) = SPattern(a) + "....."
End Sub
Must select the whole code text and then press neat "QB64" button on reply toolbar. This is quoted, where it comes from had the code tags together.