QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Programs v
Scribble Text demo

Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Linear Mode
Scribble Text demo
James D Jarvis Offline
Senior Member
****
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation: 58
#6
05-15-2022, 09:57 PM (This post was last modified: 05-15-2022, 10:00 PM by James D Jarvis.)
[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
Find
Reply


Messages In This Thread
Scribble Text demo - by James D Jarvis - 05-15-2022, 05:59 PM
RE: Scribble Text demo - by bplus - 05-15-2022, 06:45 PM
RE: Scribble Text demo - by James D Jarvis - 05-15-2022, 07:08 PM
RE: Scribble Text demo - by bplus - 05-15-2022, 07:18 PM
RE: Scribble Text demo - by James D Jarvis - 05-15-2022, 08:05 PM
RE: Scribble Text demo - by James D Jarvis - 05-15-2022, 09:57 PM
RE: Scribble Text demo - by James D Jarvis - 05-17-2022, 08:35 PM



Users browsing this thread: 1 Guest(s)