05-15-2022, 05:59 PM
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