QB64 Phoenix Edition
Scribble Text demo - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Scribble Text demo (/showthread.php?tid=415)

Scribble Text demo - James D Jarvis - 05-15-2022

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


RE: Scribble Text demo - bplus - 05-15-2022

Hey not bad! All lines, interesting.


[Image: image-2022-05-15-144453875.png]

RE: Scribble Text demo - James D Jarvis - 05-15-2022

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).

RE: Scribble Text demo - bplus - 05-15-2022

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.

RE: Scribble Text demo - James D Jarvis - 05-15-2022

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]

RE: Scribble Text demo - James D Jarvis - 05-15-2022

[Image: 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


RE: Scribble Text demo - James D Jarvis - 05-17-2022

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