Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
I wanted old style vector fonts in a program and realized I had to work them up myself. Here's a demo program that goes along with the scribble font editor I posted earlier.
Code: (Select All) 'scribbledemo 1
' a demo program to go along with the scribble font editor and subs I am working on
Dim Shared S1&
Dim Shared Klr(0 To 255) As _Unsigned Long
Dim Shared pencolor As _Unsigned Long
Dim Shared charcode$(0 To 255), current_ch
Dim Shared fonstspec$
Dim Shared fontW, fontH
fontW = 10
fontH = 16
S1& = _NewImage(640, 480, 32) ' the main screen
Screen S1&
_PrintMode _KeepBackground , S1&
'loadfont "zarp01.sft" <- the extrnal file i used and a stub for some other use
loadhardfont 'so the demo works without an external file
Randomize Timer
scale = 2
For scale = 0.1 To 20 Step 0.2
Cls
_Limit 60
For X = 64 To 90
scribblechar (X - 64) * (10 * scale), 100, Chr$(X), scale, scale, _RGB(250, 250, 250)
Next X
_Display
Next scale
oldscale = scale
For n = 1 To 27
For scale = oldscale To 0.1 Step -0.2
Cls
_Limit 200
X = 63 + n
'randomizing the color of the letters to give old-school vector flicker effect
scribblechar 100, 100, Chr$(X), scale, scale, _RGB(Int(Rnd * 200) + 50, Int(Rnd * 200) + 50, Int(Rnd * 200) + 50)
_Display
Next scale
Next n
Cls
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal positon of the print coordinate"
scribbleprint 100, 100, AA$, SW, 2, _RGB32(250, 250, 250)
_Delay 1
For SC = 1 To 3 Step 0.1
Cls
_Limit 3
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal position of the print coordinate"
scribbleprint 100, 60, AA$, SW * SC, SH * SC, _RGB32(250, 250, 250)
_Display
Next SC
For SC = 3 To 0.5 Step -0.1
Cls
_Limit 5
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal position of the print coordinate"
scribbleprint 100, 60, AA$, SW * SC, SH * SC, _RGB32(250, 250, 250)
_Display
Next SC
scribbleprint 1, 400, "Enter Your Name.", 1, 1.5, _RGB32(250, 250, 250)
Input A$
Cls
A$ = "Bye " + A$ + "!"
scribbleprint Int(Rnd * 400), Int(Rnd * 400), A$, (Rnd * 3) + 1, (Rnd * 3) + 1, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
reps = Int(Rnd * 900) + 12
For X = 1 To reps
_Limit 100
ch = Int(Rnd * 128) + 1
scalew = (Rnd * 6) + .5: scaleh = (Rnd * 6) + .5
Klr(0) = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
xx = Int(Rnd * 600): yy = Int(Rnd * 400)
scribbleprint xx, yy, Chr$(ch), scalew, scaleh, Klr(0)
_Display
Next X
hardfont: 'incomplete ascii scribble font for demo so no extra files needed
Data "","032161838A7C1C0A03U2333U2434U6353U546453U6354U3324233433U5354U6463U172A6A77593917","032161838B6D2D0B03U1423342514U7463546574U17193B5B7977U5977U593917"
Data "4332130507394B59878573524346","1742774B17","483C2C2D6D6C5C48U4672402246U477587794715071947","2D6D6C4B2C2DU4B5A7987755442341507193A4B"
Data "36446476684836","346476786A3A282634U00808D0D00","543425273858676554","00808D0D00U3454656758382725343638U5458U3557U5537U3555U3757"
Data "2C6C8A886626080A2CU2662U426264","21617365251321U454DU2969","2181832321U333A1C1939","2181842421U8489696C8A89U343C1D1A3A","3745574937U4542U494CU5777U3717U3614U5674U7A58U381A"
Data "1C12771C","16727B16","255285U525BU285B88","3A3121243AU6A6171746AU6C6D7D6CU3C3D2D3C","8C8131043787U414C"
Data "827121121324U15336385896B2B1915U7A8B8C7D2D1C","25757828257826762875"
Data "385A78U335173U515AU3B7B","5A52U345274","385A78U5A52","1666U446648"
Data "7616U341638","242777","322436U526456","42168642","0321436183854B0503"
Data "","5D6C5B4C5DU5972513259","204042332220U606273828060","212CU616CU0484U0A8A","3D30U606DU8583613113153767898B6C2C1B"
Data "1B75U5A7A7C5C5AU3634141636","8D6DU7D242240608284080B2D4D6A","61818264726261","71131B7D","11737B1D"
Data "1676U2369U6329","1777U444A","5E6D6B8B8D5E","2676","5B7B7D5D5B"
Data "721C","20020B2D6D8B826020U622B","3251U505DU3D7D","0504406084870A0D8D"
Data "04022060828567898B6D2D0B09U6727","8808505DU4D6D","8000062565878B6D2D0B","605031050B2D6D8B87662608"
Data "010080474D","2D0B082666888B6D2DU6684826020020426","80894EU81703003062888","52546252U5A58685A"
Data "54536354U575A3C","71177D","2575U2979","22882D","141230608286484AU4C4D5D4C","6C3C1913306083896A4A38344363665735","0D408DU7A1A"
Data "0D0040736606U8A66U6D8AU0D6D","40064D89U8440","0D0020873D0D","80000D8DU7707"
Data "0D0080U0656","8440075D8A8858","0D00U808DU8606","2070U404DU2D7DU","1080U606B4D1B19"
Data "000DU8D0680","000D8D","0D0048808D","0D008D80","2060828C7D1D0C0220","0D0050835606"
Data "030A3D5D8A83503003U8E48","0D0050835606U8D46","8360300337898B6D2D0A","0080404D"
Data "000B2D6D8B80","004D80","002D456D80","008DU0D80","004580U454D","00800D8D"
Data "70101D7D","118D","11717C1C","634023","1D8D","212243","1D1969U35656DU7D1DU3526"
Data "1D12U2D5D7B59191C2D","4D1A4679U4D7B","6D62U6C4D1D1969","7D1D1936567919"
Data "3D355275U1868","56785B1956U7E76U2E7E","1D12U587DU1858","2D4DU393DU36354536"
Data "676C4E2C2AU64746564","1D12U187DU1866","3D1DU2D22","1D174A777D"
Data "1D177D77","3D1B193757797B5D3D","1E171847794B1A","666C7E8EU6836093B68"
Data "1D16U18365678","1B2D6D7B592917255577","353D4DU1767","161B3D6D7C76"
Data "164D76","163D496D76","167DU761D","167AU767C4E2C","16761D7D"
Data "71413235462748393C4D7D","4145U484D","21516265567758696C5D2D","13316381"
Data "232666634123","734113164876U666B3B","171B3D6D7C77U75748475U15142415"
Data "7B4D1B1745777818U33624233","090D5D6B6909U061555666C7DU124162"
Data "061555666D1D0B0969U13122213U43425243"
Data "","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","","",""
Data "","","","","","","",""
Sub loadhardfont
Restore hardfont
For cc = 0 To 255
Read charcode$(cc)
Next cc
Close #1
Line (1, 370)-(639, 479), Klr(0), BF
Locate 25, 25
Print "FONT LOADED"
_Delay 0.5
End Sub
Sub loadfont (filename$)
filein$ = filename$
Open filein$ For Input As #1
For headerread = 1 To 6
Input #1, dummy$
Next headerread
Input #1, fontspec$ 'not used yet but keeeping in place for revision
For cc = 0 To 255
Input #1, charcode$(cc)
Next cc
Close #1
Line (1, 370)-(639, 479), Klr(0), BF
Locate 25, 25
Print "FONT LOADED"
_Delay 0.5
End Sub
Sub scribbleprint (x, y, t$, sw, sh, pk As _Unsigned Long)
pl = Len(t$)
screenwid = _Width(32) 'chnage this to your screen mode if you don't use 32-bit
px = x
py = y
For c = 1 To pl
ct$ = Mid$(t$, c, 1)
scribblechar px, py, ct$, sw, sh, pk
px = px + (fontW * sw)
If px + fontW >= screenwid Then
px = x
' py = y + (fontH * sh)
py = py + (fontH * sh)
End If
Next c
End Sub
Sub scribblechar (x, y, t$, sw, sh, tk As _Unsigned Long)
xx = x
yy = y
lx$ = ""
ly$ = ""
points = 0
tt = Asc(t$)
If Len(charcode$(tt)) > 0 Then
For c = 1 To Len(charcode$(tt))
If Mid$(charcode$(tt), c, 1) <> "U" Then
nx$ = Mid$(charcode$(tt), c, 1)
ny$ = Mid$(charcode$(tt), c + 1, 1)
c = c + 1
If points = 0 Then
lx$ = nx$
ly$ = ny$
points = points + 1
Else
points = points + 1
If points = 2 Then
lx = Val("&H" + lx$): ly = Val("&H" + ly$)
nx = Val("&H" + nx$): ny = Val("&H" + ny$)
Line (xx + lx * sw, yy + ly * sh)-(xx + nx * sw, yy + ny * sh), tk
points = points - 1
lx$ = nx$
ly$ = ny$
End If
End If
Else
lx$ = ""
ly$ = ""
points = 0
End If
Next c
End If
End Sub
Posts: 3,974
Threads: 177
Joined: Apr 2022
Reputation:
219
Hey not bad! All lines, interesting.
![[Image: image-2022-05-15-144453875.png]](https://i.ibb.co/SVJ0hzv/image-2022-05-15-144453875.png)
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
Thanks. Sometime someday the text might rotate but I really don't need that for what I wanted these for. Looks like careful placement of the line segments when initially draw might speed it up (not sure however).
Posts: 3,974
Threads: 177
Joined: Apr 2022
Reputation:
219
Here's what Bplus Font looks like:
I had to make special arc and line drawing subs which draw thickness by drawing thousands of tiny circles along a line or arc.
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
05-15-2022, 08:05 PM
(This post was last modified: 05-15-2022, 08:05 PM by James D Jarvis.)
Circles following the lines was where I figured I'd go if I wanted to make thicker lines. I just fiddled with slapping them at the coordinate points for the line segments so far (because it's lazy-easy).
![[Image: image.png]](https://i.ibb.co/SyZSC7R/image.png)
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
05-15-2022, 09:57 PM
(This post was last modified: 05-15-2022, 10:00 PM by James D Jarvis.)
![[Image: image.png]](https://i.ibb.co/SsDNKn4/image.png)
I took the plunge and used the circles technique to plot the points on the lines. It isn't perfect yet because I'm using the default circle drawing but it certainly works.
Code: (Select All) 'scribbledemo 2
' a demo program to go along with the scribble font editor and subs I am working on
Dim Shared S1&
Dim Shared Klr(0 To 255) As _Unsigned Long
Dim Shared pencolor As _Unsigned Long
Dim Shared charcode$(0 To 255), current_ch
Dim Shared fonstspec$
Dim Shared fontW, fontH
fontW = 10
fontH = 16
S1& = _NewImage(640, 480, 32) ' the main screen
Screen S1&
_PrintMode _KeepBackground , S1&
'loadfont "zarp01.sft" <- the extrnal file i used and a stub for some other use
loadhardfont 'so the demo works without an external file
Randomize Timer
scale = 2
For scale = 0.1 To 20 Step 0.2
Cls
_Limit 60
For X = 64 To 90
scribblechar (X - 64) * (10 * scale), 100, Chr$(X), scale, scale, _RGB(250, 250, 250)
Next X
_Display
Next scale
oldscale = scale
For n = 1 To 27
For scale = oldscale To 0.1 Step -0.2
Cls
_Limit 200
X = 63 + n
'randomizing the color of the letters to give old-school vector flicker effect
scribblechar 100, 100, Chr$(X), scale, scale, _RGB(Int(Rnd * 200) + 50, Int(Rnd * 200) + 50, Int(Rnd * 200) + 50)
_Display
Next scale
Next n
Cls
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal positon of the print coordinate"
scribbleprint 100, 100, AA$, SW, 2, _RGB32(250, 250, 250)
_Delay 1
For SC = 1 To 3 Step 0.1
Cls
_Limit 3
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal position of the print coordinate"
scribbleprint 100, 60, AA$, SW * SC, SH * SC, _RGB32(250, 250, 250)
_Display
Next SC
For SC = 3 To 0.5 Step -0.1
Cls
_Limit 5
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal position of the print coordinate"
scribbleprint 100, 60, AA$, SW * SC, SH * SC, _RGB32(250, 250, 250)
_Display
Next SC
Input A$
Cls
For c = 65 To 85
fatscribblechar (c - 64) * 32, 10, Chr$(c), 3, 4, _RGB32(250, 250, 250)
Next c
Input A$
For X = 1 To 10 Step 0.5
Cls
_Limit 20
fatscribblechar 100, 100, "A", X, X, _RGB32(200, 150, 250)
fatprint 400, 10, "Fat Print", 2, 4, _RGB(250, 250, 100)
fatprint 300, 70, "Fat print does pseudo scaling for line weight ", 1, 2.5, _RGB(100, 150, 222)
_Display
Next X
scribbleprint 1, 400, "Enter Your Name.", 1, 1.5, _RGB32(250, 250, 250)
Input A$
Cls
A$ = "Bye " + A$ + "!"
scribbleprint Int(Rnd * 400), Int(Rnd * 400), A$, (Rnd * 3) + 1, (Rnd * 3) + 1, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
reps = Int(Rnd * 900) + 12
For X = 1 To reps
_Limit 100
ch = Int(Rnd * 128) + 1
scalew = (Rnd * 6) + .5: scaleh = (Rnd * 6) + .5
Klr(0) = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
xx = Int(Rnd * 600): yy = Int(Rnd * 400)
scribbleprint xx, yy, Chr$(ch), scalew, scaleh, Klr(0)
_Display
Next X
hardfont: 'incomplete ascii scribble font for demo so no extra files needed
Data "","032161838A7C1C0A03U2333U2434U6353U546453U6354U3324233433U5354U6463U172A6A77593917","032161838B6D2D0B03U1423342514U7463546574U17193B5B7977U5977U593917"
Data "4332130507394B59878573524346","1742774B17","483C2C2D6D6C5C48U4672402246U477587794715071947","2D6D6C4B2C2DU4B5A7987755442341507193A4B"
Data "36446476684836","346476786A3A282634U00808D0D00","543425273858676554","00808D0D00U3454656758382725343638U5458U3557U5537U3555U3757"
Data "2C6C8A886626080A2CU2662U426264","21617365251321U454DU2969","2181832321U333A1C1939","2181842421U8489696C8A89U343C1D1A3A","3745574937U4542U494CU5777U3717U3614U5674U7A58U381A"
Data "1C12771C","16727B16","255285U525BU285B88","3A3121243AU6A6171746AU6C6D7D6CU3C3D2D3C","8C8131043787U414C"
Data "827121121324U15336385896B2B1915U7A8B8C7D2D1C","25757828257826762875"
Data "385A78U335173U515AU3B7B","5A52U345274","385A78U5A52","1666U446648"
Data "7616U341638","242777","322436U526456","42168642","0321436183854B0503"
Data "","5D6C5B4C5DU5972513259","204042332220U606273828060","212CU616CU0484U0A8A","3D30U606DU8583613113153767898B6C2C1B"
Data "1B75U5A7A7C5C5AU3634141636","8D6DU7D242240608284080B2D4D6A","61818264726261","71131B7D","11737B1D"
Data "1676U2369U6329","1777U444A","5E6D6B8B8D5E","2676","5B7B7D5D5B"
Data "721C","20020B2D6D8B826020U622B","3251U505DU3D7D","0504406084870A0D8D"
Data "04022060828567898B6D2D0B09U6727","8808505DU4D6D","8000062565878B6D2D0B","605031050B2D6D8B87662608"
Data "010080474D","2D0B082666888B6D2DU6684826020020426","80894EU81703003062888","52546252U5A58685A"
Data "54536354U575A3C","71177D","2575U2979","22882D","141230608286484AU4C4D5D4C","6C3C1913306083896A4A38344363665735","0D408DU7A1A"
Data "0D0040736606U8A66U6D8AU0D6D","40064D89U8440","0D0020873D0D","80000D8DU7707"
Data "0D0080U0656","8440075D8A8858","0D00U808DU8606","2070U404DU2D7DU","1080U606B4D1B19"
Data "000DU8D0680","000D8D","0D0048808D","0D008D80","2060828C7D1D0C0220","0D0050835606"
Data "030A3D5D8A83503003U8E48","0D0050835606U8D46","8360300337898B6D2D0A","0080404D"
Data "000B2D6D8B80","004D80","002D456D80","008DU0D80","004580U454D","00800D8D"
Data "70101D7D","118D","11717C1C","634023","1D8D","212243","1D1969U35656DU7D1DU3526"
Data "1D12U2D5D7B59191C2D","4D1A4679U4D7B","6D62U6C4D1D1969","7D1D1936567919"
Data "3D355275U1868","56785B1956U7E76U2E7E","1D12U587DU1858","2D4DU393DU36354536"
Data "676C4E2C2AU64746564","1D12U187DU1866","3D1DU2D22","1D174A777D"
Data "1D177D77","3D1B193757797B5D3D","1E171847794B1A","666C7E8EU6836093B68"
Data "1D16U18365678","1B2D6D7B592917255577","353D4DU1767","161B3D6D7C76"
Data "164D76","163D496D76","167DU761D","167AU767C4E2C","16761D7D"
Data "71413235462748393C4D7D","4145U484D","21516265567758696C5D2D","13316381"
Data "232666634123","734113164876U666B3B","171B3D6D7C77U75748475U15142415"
Data "7B4D1B1745777818U33624233","090D5D6B6909U061555666C7DU124162"
Data "061555666D1D0B0969U13122213U43425243"
Data "","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","","",""
Data "","","","","","","",""
Sub loadhardfont
Restore hardfont
For cc = 0 To 255
Read charcode$(cc)
Next cc
Close #1
Line (1, 370)-(639, 479), Klr(0), BF
Locate 25, 25
Print "FONT LOADED"
_Delay 0.5
End Sub
Sub loadfont (filename$)
filein$ = filename$
Open filein$ For Input As #1
For headerread = 1 To 6
Input #1, dummy$
Next headerread
Input #1, fontspec$ 'not used yet but keeeping in place for revision
For cc = 0 To 255
Input #1, charcode$(cc)
Next cc
Close #1
Line (1, 370)-(639, 479), Klr(0), BF
Locate 25, 25
Print "FONT LOADED"
_Delay 0.5
End Sub
Sub scribbleprint (x, y, t$, sw, sh, pk As _Unsigned Long)
pl = Len(t$)
screenwid = _Width(32) 'chnage this to your screen mode if you don't use 32-bit
px = x
py = y
For c = 1 To pl
ct$ = Mid$(t$, c, 1)
scribblechar px, py, ct$, sw, sh, pk
px = px + (fontW * sw)
If px + fontW >= screenwid Then
px = x
' py = y + (fontH * sh)
py = py + (fontH * sh)
End If
Next c
End Sub
Sub scribblechar (x, y, t$, sw, sh, tk As _Unsigned Long)
xx = x
yy = y
lx$ = ""
ly$ = ""
points = 0
tt = Asc(t$)
If Len(charcode$(tt)) > 0 Then
For c = 1 To Len(charcode$(tt))
If Mid$(charcode$(tt), c, 1) <> "U" Then
nx$ = Mid$(charcode$(tt), c, 1)
ny$ = Mid$(charcode$(tt), c + 1, 1)
c = c + 1
If points = 0 Then
lx$ = nx$
ly$ = ny$
points = points + 1
Else
points = points + 1
If points = 2 Then
lx = Val("&H" + lx$): ly = Val("&H" + ly$)
nx = Val("&H" + nx$): ny = Val("&H" + ny$)
Line (xx + lx * sw, yy + ly * sh)-(xx + nx * sw, yy + ny * sh), tk
points = points - 1
lx$ = nx$
ly$ = ny$
End If
End If
Else
lx$ = ""
ly$ = ""
points = 0
End If
Next c
End If
End Sub
Sub hotscribblechar (x, y, t$, sw, sh, tk As _Unsigned Long)
xx = x
yy = y
lx$ = ""
ly$ = ""
points = 0
tt = Asc(t$)
If Len(charcode$(tt)) > 0 Then
For c = 1 To Len(charcode$(tt))
If Mid$(charcode$(tt), c, 1) <> "U" Then
nx$ = Mid$(charcode$(tt), c, 1)
ny$ = Mid$(charcode$(tt), c + 1, 1)
c = c + 1
If points = 0 Then
lx$ = nx$
ly$ = ny$
points = points + 1
Else
points = points + 1
If points = 2 Then
lx = Val("&H" + lx$): ly = Val("&H" + ly$)
nx = Val("&H" + nx$): ny = Val("&H" + ny$)
Line (xx + lx * sw, yy + ly * sh)-(xx + nx * sw, yy + ny * sh), tk
Circle (xx + lx * sw, yy + ly * sh), 1 * ((sw + sy) / 2), tk
Circle (xx + nx * sw, yy + ny * sh), 1 * ((sw + sy) / 2), tk
points = points - 1
lx$ = nx$
ly$ = ny$
End If
End If
Else
lx$ = ""
ly$ = ""
points = 0
End If
Next c
End If
End Sub
Sub fatscribblechar (x, y, t$, sw, sh, tk As _Unsigned Long)
xx = x
yy = y
lx$ = ""
ly$ = ""
LW = (sw + sh) / 4
points = 0
tt = Asc(t$)
If Len(charcode$(tt)) > 0 Then
For c = 1 To Len(charcode$(tt))
If Mid$(charcode$(tt), c, 1) <> "U" Then
nx$ = Mid$(charcode$(tt), c, 1)
ny$ = Mid$(charcode$(tt), c + 1, 1)
c = c + 1
If points = 0 Then
lx$ = nx$
ly$ = ny$
points = points + 1
Else
points = points + 1
If points = 2 Then
lx = Val("&H" + lx$): ly = Val("&H" + ly$)
nx = Val("&H" + nx$): ny = Val("&H" + ny$)
Line (xx + lx * sw, yy + ly * sh)-(xx + nx * sw, yy + ny * sh), tk
fatLine xx + lx * sw, yy + ly * sh, xx + nx * sw, yy + ny * sh, LW, tk
points = points - 1
lx$ = nx$
ly$ = ny$
End If
End If
Else
lx$ = ""
ly$ = ""
points = 0
End If
Next c
End If
End Sub
Sub fatLine (x0, y0, x1, y1, TT, tk As _Unsigned Long)
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
fatLineLow x1, y1, x0, y0, TT, tk
Else
fatLineLow x0, y0, x1, y1, TT, tk
End If
Else
If y0 > y1 Then
fatLineHigh x1, y1, x0, y0, TT, tk
Else
fatLineHigh x0, y0, x1, y1, TT, tk
End If
End If
End Sub
Sub fatLineLow (x0, y0, x1, y1, tt, tk As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
'D = (2 * dy) - dx
d = (dy + dy) - dx
y = y0
For x = x0 To x1
Circle (x, y), tt, tk
Paint (x, y), tk
If d > 0 Then
y = y + yi
' D = D + (2 * (dy - dx))
d = d + ((dy - dx) + (dy - dx))
Else
' D = D + 2 * dy
d = d + dy + dy
End If
Next x
End Sub
Sub fatLineHigh (x0, y0, x1, y1, tt, tk As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
' D = (2 * dx) - dy
D = (dx + dx) - dy
x = x0
For y = y0 To y1
Circle (x, y), tt, tk
Paint (x, y), tk
If D > 0 Then
x = x + xi
' D = D + (2 * (dx - dy))
D = D + ((dx - dy) + (dx - dy))
Else
' D = D + 2 * dx
D = D + dx + dx
End If
Next y
End Sub
Sub fatprint (x, y, t$, sw, sh, pk As _Unsigned Long)
pl = Len(t$)
screenwid = _Width(32) 'chnage this to your screen mode if you don't use 32-bit
px = x
py = y
For c = 1 To pl
ct$ = Mid$(t$, c, 1)
fatscribblechar px, py, ct$, sw, sh, pk
px = px + (fontW * sw)
If px + fontW >= screenwid Then
px = x
' py = y + (fontH * sh)
py = py + (fontH * sh)
End If
Next c
End Sub
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
I updated the main font drawing subs to make use of draw, which simplifies rotating the text. I haven't gone full draw commands and may not as the scribble font code is small and the conversion between the two schemes makes for more dynamic scaling options. The scribble font editor will be getting some updates but not likely to see them for a few days.
Code: (Select All) 'scribbledemo 3
' a demo program to go along with the scribble font editor and subs I am working on
' now uses draw for some of the text rendering
Dim Shared S1&
Dim Shared Klr(0 To 255) As _Unsigned Long
Dim Shared pencolor As _Unsigned Long
Dim Shared charcode$(0 To 255), current_ch
Dim Shared fonstspec$
Dim Shared fontW, fontH
fontW = 10
fontH = 16
S1& = _NewImage(640, 480, 32) ' the main screen
Screen S1&
_PrintMode _KeepBackground , S1&
'loadfont "zarp01.sft" <- the extrnal file i used and a stub for some other use
loadhardfont 'so the demo works without an external file
Randomize Timer
scale = 2
For scale = 0.1 To 20 Step 0.2
Cls
_Limit 60
For X = 64 To 90
drawchar (X - 64) * (10 * scale), 100, Chr$(X), scale, scale, _RGB(250, 250, 250)
Next X
_Display
Next scale
oldscale = scale
For n = 1 To 27
For scale = oldscale To 0.1 Step -0.5
Cls
_Limit 200
X = 63 + n
'randomizing the color of the letters to give old-school vector flicker effect
drawchar 100, 100, Chr$(X), scale, scale, _RGB(Int(Rnd * 200) + 50, Int(Rnd * 200) + 50, Int(Rnd * 200) + 50)
_Display
Next scale
Next n
Cls
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal positon of the print coordinate"
scribbleprint 100, 100, AA$, SW, 2, _RGB32(250, 250, 250)
_Delay 1
For SC = 1 To 3 Step 0.1
Cls
_Limit 3
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal position of the print coordinate"
scribbleprint 100, 60, AA$, SW * SC, SH * SC, _RGB32(250, 250, 250)
_Display
Next SC
For SC = 3 To 0.5 Step -0.1
Cls
_Limit 5
AA$ = "Some sample text AbCdEfGhIjKlMnOpQrStUvWxYz"
scribbleprint 10, 20, AA$, 1, 1.5, _RGB32(250, 250, 250)
SW = 1: SH = 1
AA$ = "It doesn't do true print scrolling but it does support scale based wrapping back to the horizontal position of the print coordinate"
scribbleprint 100, 60, AA$, SW * SC, SH * SC, _RGB32(250, 250, 250)
_Display
Next SC
Input A$
AA$ = "Print can be rotated with the scribbleprintrot command."
For DD = 0 To 360 Step 10
Cls
_Limit 10
scribbleprintrot 200, 200, AA$, 1.5, 1.5, _RGB32(250, 250, 250), DD
_Display
Next DD
scribbleprint 10, 10, "Wait a minute...", 1.5, 1.5, _RGB32(250, 250, 250)
Draw "ta12"
scribbleprint 10, 40, "...something is a bit off", 1.5, 1.5, _RGB32(250, 250, 250)
Draw "ta0"
drawstring 300, 300, "How's this?", 1.5, 1.5, _RGB32(250, 200, 200), 12
Locate 20, 10: Input A$
For DD = 12 To 360 Step 12
_Limit 20
Cls
scribbleprint 10, 10, "The drawstring command let's you scale and rotate a whole string.", 1.2, 1.2, _RGB32(250, 250, 250)
drawstring 300, 300, "Rotating Text !", 1.5, 1.5, _RGB32(250, 200, 200), DD
_Display
Next DD
ss = 1: b = 1
xx = 300: YY = 300
For DD = 0 To 360 Step 12
_Limit 20
If b = 1 Then ss = ss + .25
If ss > 6 Then
ss = ss - .5
b = 0
End If
If ss < .75 Then b = 1
Cls
scribbleprint 10, 10, "The drawstring command let's you scale and rotate a whole string.", 1.2, 1.2, _RGB32(250, 250, 250)
drawstring xx, YY, "Rotating Text !", ss, ss, _RGB32(250, 200, 200), DD
xx = xx - 10: YY = YY - 7
_Display
Next DD
Input A$
Cls
For c = 65 To 85
fatscribblechar (c - 64) * 32, 10, Chr$(c), 3, 4, _RGB32(250, 250, 250)
Next c
Input A$
For X = 1 To 10 Step 0.5
Cls
_Limit 20
fatscribblechar 100, 100, "A", X, X, _RGB32(200, 150, 250)
fatprint 400, 10, "Fat Print", 2, 4, _RGB(250, 250, 100)
fatprint 300, 70, "Fat print does pseudo scaling for line weight ", 1, 2.5, _RGB(100, 150, 222)
_Display
Next X
scribbleprint 1, 400, "Enter Your Name.", 1, 1.5, _RGB32(250, 250, 250)
Input A$
Cls
A$ = "Bye " + A$ + "!"
scribbleprint Int(Rnd * 400), Int(Rnd * 400), A$, (Rnd * 3) + 1, (Rnd * 3) + 1, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
reps = Int(Rnd * 900) + 12
For X = 1 To reps
_Limit 100
ch = Int(Rnd * 128) + 1
scalew = (Rnd * 6) + .5: scaleh = (Rnd * 6) + .5
Klr(0) = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
xx = Int(Rnd * 600): YY = Int(Rnd * 400)
scribbleprint xx, YY, Chr$(ch), scalew, scaleh, Klr(0)
_Display
Next X
hardfont: 'incomplete ascii scribble font for demo so no extra files needed
Data "","032161838A7C1C0A03U2333U2434U6353U546453U6354U3324233433U5354U6463U172A6A77593917","032161838B6D2D0B03U1423342514U7463546574U17193B5B7977U5977U593917"
Data "4332130507394B59878573524346","1742774B17","483C2C2D6D6C5C48U4672402246U477587794715071947","2D6D6C4B2C2DU4B5A7987755442341507193A4B"
Data "36446476684836","346476786A3A282634U00808D0D00","543425273858676554","00808D0D00U3454656758382725343638U5458U3557U5537U3555U3757"
Data "2C6C8A886626080A2CU2662U426264","21617365251321U454DU2969","2181832321U333A1C1939","2181842421U8489696C8A89U343C1D1A3A","3745574937U4542U494CU5777U3717U3614U5674U7A58U381A"
Data "1C12771C","16727B16","255285U525BU285B88","3A3121243AU6A6171746AU6C6D7D6CU3C3D2D3C","8C8131043787U414C"
Data "827121121324U15336385896B2B1915U7A8B8C7D2D1C","25757828257826762875"
Data "385A78U335173U515AU3B7B","5A52U345274","385A78U5A52","1666U446648"
Data "7616U341638","242777","322436U526456","42168642","0321436183854B0503"
Data "","5D6C5B4C5DU5972513259","204042332220U606273828060","212CU616CU0484U0A8A","3D30U606DU8583613113153767898B6C2C1B"
Data "1B75U5A7A7C5C5AU3634141636","8D6DU7D242240608284080B2D4D6A","61818264726261","71131B7D","11737B1D"
Data "1676U2369U6329","1777U444A","5E6D6B8B8D5E","2676","5B7B7D5D5B"
Data "721C","20020B2D6D8B826020U622B","3251U505DU3D7D","0504406084870A0D8D"
Data "04022060828567898B6D2D0B09U6727","8808505DU4D6D","8000062565878B6D2D0B","605031050B2D6D8B87662608"
Data "010080474D","2D0B082666888B6D2DU6684826020020426","80894EU81703003062888","52546252U5A58685A"
Data "54536354U575A3C","71177D","2575U2979","22882D","141230608286484AU4C4D5D4C","6C3C1913306083896A4A38344363665735","0D408DU7A1A"
Data "0D0040736606U8A66U6D8AU0D6D","40064D89U8440","0D0020873D0D","80000D8DU7707"
Data "0D0080U0656","8440075D8A8858","0D00U808DU8606","2070U404DU2D7DU","1080U606B4D1B19"
Data "000DU8D0680","000D8D","0D0048808D","0D008D80","2060828C7D1D0C0220","0D0050835606"
Data "030A3D5D8A83503003U8E48","0D0050835606U8D46","8360300337898B6D2D0A","0080404D"
Data "000B2D6D8B80","004D80","002D456D80","008DU0D80","004580U454D","00800D8D"
Data "70101D7D","118D","11717C1C","634023","1D8D","212243","1D1969U35656DU7D1DU3526"
Data "1D12U2D5D7B59191C2D","4D1A4679U4D7B","6D62U6C4D1D1969","7D1D1936567919"
Data "3D355275U1868","56785B1956U7E76U2E7E","1D12U587DU1858","2D4DU393DU36354536"
Data "676C4E2C2AU64746564","1D12U187DU1866","3D1DU2D22","1D174A777D"
Data "1D177D77","3D1B193757797B5D3D","1E171847794B1A","666C7E8EU6836093B68"
Data "1D16U18365678","1B2D6D7B592917255577","353D4DU1767","161B3D6D7C76"
Data "164D76","163D496D76","167DU761D","167AU767C4E2C","16761D7D"
Data "71413235462748393C4D7D","4145U484D","21516265567758696C5D2D","13316381"
Data "232666634123","734113164876U666B3B","171B3D6D7C77U75748475U15142415"
Data "7B4D1B1745777818U33624233","090D5D6B6909U061555666C7DU124162"
Data "061555666D1D0B0969U13122213U43425243"
Data "","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","",""
Data "","","","","","","","","","","","","","","","","","",""
Data "","","","","","","",""
Sub loadhardfont
Restore hardfont
For cc = 0 To 255
Read charcode$(cc)
Next cc
Close #1
Locate 25, 25
Print "FONT LOADED"
_Delay 0.5
End Sub
Sub loadfont (filename$)
filein$ = filename$
Open filein$ For Input As #1
For headerread = 1 To 6
Input #1, dummy$
Next headerread
Input #1, fontspec$ 'not used yet but keeeping in place for revision
For cc = 0 To 255
Input #1, charcode$(cc)
Next cc
Close #1
Locate 25, 25
Print "FONT LOADED"
_Delay 0.5
End Sub
Sub scribbleprint (x, y, t$, sw, sh, pk As _Unsigned Long)
pl = Len(t$)
screenwid = _Width(32) 'chnage this to your screen mode if you don't use 32-bit
px = x
py = y
For c = 1 To pl
ct$ = Mid$(t$, c, 1)
drawchar px, py, ct$, sw, sh, pk
px = px + (fontW * sw)
If px + fontW >= screenwid Then
px = x
' py = y + (fontH * sh)
py = py + (fontH * sh)
End If
Next c
End Sub
Sub scribbleprintrot (x, y, t$, sw, sh, pk As _Unsigned Long, rta)
pl = Len(t$)
screenwid = _Width(32) 'change this to your screen mode if you don't use 32-bit
Draw "ta" + Str$(rta)
px = x
py = y
For c = 1 To pl
ct$ = Mid$(t$, c, 1)
drawchar px, py, ct$, sw, sh, pk
px = px + (fontW * sw)
If px + fontW >= screenwid Then
px = x
' py = y + (fontH * sh)
py = py + (fontH * sh)
End If
Next c
' Draw "ta0"
End Sub
Sub drawchar (x, y, t$, sw, sh, tk As _Unsigned Long)
xx = x
yy = y
tt = Asc(t$)
A$ = "U" + charcode$(tt)
If Len(charcode$(tt)) > 0 Then
tempK = Point(xx, yy)
PSet (xx, yy), tempK
Draw "C" + Str$(tk)
lastx = 0
lasty = 0
For c = 1 To Len(A$)
If Mid$(A$, c, 1) = "U" Then
nc$ = nc$ + "b"
Else
nc$ = nc$ + "m"
nx = Val("&H" + Mid$(A$, c, 1))
ny = Val("&H" + Mid$(A$, c + 1, 1))
xdiff = (nx - lastx) * sw
ydiff = (ny - lasty) * sh
c = c + 1
If nx > lastx Then nc$ = nc$ + "+" + Str$(xdiff)
If nx < lastx Then nc$ = nc$ + Str$(xdiff)
If nx = lastx Then nc$ = nc$ + "+0"
nc$ = nc$ + ","
If ny > lasty Then nc$ = nc$ + "+" + Str$(ydiff)
If ny < lasty Then nc$ = nc$ + Str$(ydiff)
If ny = lasty Then nc$ = nc$ + "+0"
lastx = nx
lasty = ny
End If
Next c
Draw nc$
End If
End Sub
Sub hotscribblechar (x, y, t$, sw, sh, tk As _Unsigned Long)
xx = x
yy = y
lx$ = ""
ly$ = ""
points = 0
tt = Asc(t$)
If Len(charcode$(tt)) > 0 Then
For c = 1 To Len(charcode$(tt))
If Mid$(charcode$(tt), c, 1) <> "U" Then
nx$ = Mid$(charcode$(tt), c, 1)
ny$ = Mid$(charcode$(tt), c + 1, 1)
c = c + 1
If points = 0 Then
lx$ = nx$
ly$ = ny$
points = points + 1
Else
points = points + 1
If points = 2 Then
lx = Val("&H" + lx$): ly = Val("&H" + ly$)
nx = Val("&H" + nx$): ny = Val("&H" + ny$)
Line (xx + lx * sw, yy + ly * sh)-(xx + nx * sw, yy + ny * sh), tk
Circle (xx + lx * sw, yy + ly * sh), 1 * ((sw + sy) / 2), tk
Circle (xx + nx * sw, yy + ny * sh), 1 * ((sw + sy) / 2), tk
points = points - 1
lx$ = nx$
ly$ = ny$
End If
End If
Else
lx$ = ""
ly$ = ""
points = 0
End If
Next c
End If
End Sub
Sub fatscribblechar (x, y, t$, sw, sh, tk As _Unsigned Long)
xx = x
yy = y
lx$ = ""
ly$ = ""
LW = (sw + sh) / 4
points = 0
tt = Asc(t$)
If Len(charcode$(tt)) > 0 Then
For c = 1 To Len(charcode$(tt))
If Mid$(charcode$(tt), c, 1) <> "U" Then
nx$ = Mid$(charcode$(tt), c, 1)
ny$ = Mid$(charcode$(tt), c + 1, 1)
c = c + 1
If points = 0 Then
lx$ = nx$
ly$ = ny$
points = points + 1
Else
points = points + 1
If points = 2 Then
lx = Val("&H" + lx$): ly = Val("&H" + ly$)
nx = Val("&H" + nx$): ny = Val("&H" + ny$)
Line (xx + lx * sw, yy + ly * sh)-(xx + nx * sw, yy + ny * sh), tk
fatLine xx + lx * sw, yy + ly * sh, xx + nx * sw, yy + ny * sh, LW, tk
points = points - 1
lx$ = nx$
ly$ = ny$
End If
End If
Else
lx$ = ""
ly$ = ""
points = 0
End If
Next c
End If
End Sub
Sub fatLine (x0, y0, x1, y1, TT, tk As _Unsigned Long)
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
fatLineLow x1, y1, x0, y0, TT, tk
Else
fatLineLow x0, y0, x1, y1, TT, tk
End If
Else
If y0 > y1 Then
fatLineHigh x1, y1, x0, y0, TT, tk
Else
fatLineHigh x0, y0, x1, y1, TT, tk
End If
End If
End Sub
Sub fatLineLow (x0, y0, x1, y1, tt, tk As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
'D = (2 * dy) - dx
d = (dy + dy) - dx
y = y0
For x = x0 To x1
Circle (x, y), tt, tk
Paint (x, y), tk
If d > 0 Then
y = y + yi
' D = D + (2 * (dy - dx))
d = d + ((dy - dx) + (dy - dx))
Else
' D = D + 2 * dy
d = d + dy + dy
End If
Next x
End Sub
Sub fatLineHigh (x0, y0, x1, y1, tt, tk As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
' D = (2 * dx) - dy
d = (dx + dx) - dy
x = x0
For y = y0 To y1
Circle (x, y), tt, tk
Paint (x, y), tk
If d > 0 Then
x = x + xi
' D = D + (2 * (dx - dy))
d = d + ((dx - dy) + (dx - dy))
Else
' D = D + 2 * dx
d = d + dx + dx
End If
Next y
End Sub
Sub fatprint (x, y, t$, sw, sh, pk As _Unsigned Long)
pl = Len(t$)
screenwid = _Width(32) 'chnage this to your screen mode if you don't use 32-bit
px = x
py = y
For c = 1 To pl
ct$ = Mid$(t$, c, 1)
fatscribblechar px, py, ct$, sw, sh, pk
px = px + (fontW * sw)
If px + fontW >= screenwid Then
px = x
' py = y + (fontH * sh)
py = py + (fontH * sh)
End If
Next c
End Sub
Sub drawstring (x, y, t$, sw, sh, pk As _Unsigned Long, rta)
pl = Len(t$)
screenwid = _Width(32) 'change this to your screen mode if you don't use 32-bit
px = x
py = y
tempK = Point(px, py)
PSet (px, py), tempK
' nc$ = "C" + Str$(pk) + " TA" + Str$(rta)
Draw "C" + Str$(pk)
nc$ = " TA" + Str$(rta)
lastx = 0
lasty = 0
For cc = 1 To pl
A$ = "U" + charcode$(Asc(Mid$(t$, cc, 1)))
For c = 1 To Len(A$)
If Mid$(A$, c, 1) = "U" Then
nc$ = nc$ + "b"
Else
nc$ = nc$ + "m"
nx = Val("&H" + Mid$(A$, c, 1))
ny = Val("&H" + Mid$(A$, c + 1, 1))
xdiff = (nx - lastx) * sw
ydiff = (ny - lasty) * sh
c = c + 1
If nx > lastx Then nc$ = nc$ + "+" + Str$(xdiff)
If nx < lastx Then nc$ = nc$ + Str$(xdiff)
If nx = lastx Then nc$ = nc$ + "+0"
nc$ = nc$ + ","
If ny > lasty Then nc$ = nc$ + "+" + Str$(ydiff)
If ny < lasty Then nc$ = nc$ + Str$(ydiff)
If ny = lasty Then nc$ = nc$ + "+0"
lastx = nx
lasty = ny
End If
Next c
gor = 10 * sw
nc$ = nc$ + " br" + Str$(gor)
Next cc
' Print nc$
Draw nc$
End Sub
|
