QB64 Phoenix Edition › QB64 Rising › Prolific Programmers › Petr
Text in the form of a circle

Threaded Mode
Text in the form of a circle
Petr Offline
Mini-Mod
***
Posts: 176
Threads: 36
Joined: May 2022
Reputation: 16
#1
02-25-2023, 02:09 PM
Code: (Select All)
_Title "Round text"
Screen _NewImage(1024, 768, 32)
R = 75
ct& = RoundText&("QB64 Phoenix call: Hello World!  ", R, _Pi(1.5))
_PutImage (512 - R, 384 - R), ct&
_Display


Function RoundText& (text As String, InternalRadius As Integer, StartRadius As Single)
    D = _Dest: So = _Source
    VImg& = _NewImage(_PrintWidth(text) + 1, _FontHeight + 1, 32)
    Ob = (InternalRadius + _FontHeight)
    Ol = InternalRadius
    _Dest VImg&: _PrintString (0, 0), text$: _Dest D
    R& = _NewImage((InternalRadius + _FontHeight) * 2, (InternalRadius + _FontHeight) * 2, 32)
    U = _Width(R&) / 2
    Dim X(4), Y(4), sX(4), sY(4)
    S = 200
    PW = _PrintWidth(text)
    p2 = CInt(PW / S)
    For C = StartRadius To StartRadius + _Pi(2) Step (_Pi(2) / S) ' 200 steps
        'dest
        X(1) = U + Cos(C) * Ob
        Y(1) = U + Sin(C) * Ob
        X(2) = U + Cos(C) * Ol
        Y(2) = U + Sin(C) * Ol
        X(3) = U + Cos(C + _Pi(2) / S) * Ob
        Y(3) = U + Sin(C + _Pi(2) / S) * Ob
        X(4) = U + Cos(C + _Pi(2) / S) * Ol
        Y(4) = U + Sin(C + _Pi(2) / S) * Ol
        'source
        sX(1) = (PW / S) * n
        sY(1) = 0
        sX(2) = sX(1)
        sY(2) = _FontHeight
        sX(3) = sX(1) + PW / S
        sY(3) = 0
        sX(4) = sX(3)
        sY(4) = sY(2)

        n = n + p2
        If n > S Then Exit For
        _MapTriangle (sX(1), sY(1))-(sX(2), sY(2))-(sX(3), sY(3)), VImg& To(X(1), Y(1))-(X(2), Y(2))-(X(3), Y(3)), R&
        _MapTriangle (sX(2), sY(2))-(sX(3), sY(3))-(sX(4), sY(4)), VImg& To(X(2), Y(2))-(X(3), Y(3))-(X(4), Y(4)), R&
    Next
    RoundText& = R&
End Function


Attached Files Image(s)
   


Website Find
Reply
CharlieJV Offline
Senior Member
****
Posts: 490
Threads: 95
Joined: Apr 2022
Reputation: 23
#2
02-25-2023, 04:28 PM
(02-25-2023, 02:09 PM)Petr Wrote:
Code: (Select All)
_Title "Round text"
Screen _NewImage(1024, 768, 32)
R = 75
ct& = RoundText&("QB64 Phoenix call: Hello World!  ", R, _Pi(1.5))
_PutImage (512 - R, 384 - R), ct&
_Display


Function RoundText& (text As String, InternalRadius As Integer, StartRadius As Single)
    D = _Dest: So = _Source
    VImg& = _NewImage(_PrintWidth(text) + 1, _FontHeight + 1, 32)
    Ob = (InternalRadius + _FontHeight)
    Ol = InternalRadius
    _Dest VImg&: _PrintString (0, 0), text$: _Dest D
    R& = _NewImage((InternalRadius + _FontHeight) * 2, (InternalRadius + _FontHeight) * 2, 32)
    U = _Width(R&) / 2
    Dim X(4), Y(4), sX(4), sY(4)
    S = 200
    PW = _PrintWidth(text)
    p2 = CInt(PW / S)
    For C = StartRadius To StartRadius + _Pi(2) Step (_Pi(2) / S) ' 200 steps
        'dest
        X(1) = U + Cos(C) * Ob
        Y(1) = U + Sin(C) * Ob
        X(2) = U + Cos(C) * Ol
        Y(2) = U + Sin(C) * Ol
        X(3) = U + Cos(C + _Pi(2) / S) * Ob
        Y(3) = U + Sin(C + _Pi(2) / S) * Ob
        X(4) = U + Cos(C + _Pi(2) / S) * Ol
        Y(4) = U + Sin(C + _Pi(2) / S) * Ol
        'source
        sX(1) = (PW / S) * n
        sY(1) = 0
        sX(2) = sX(1)
        sY(2) = _FontHeight
        sX(3) = sX(1) + PW / S
        sY(3) = 0
        sX(4) = sX(3)
        sY(4) = sY(2)

        n = n + p2
        If n > S Then Exit For
        _MapTriangle (sX(1), sY(1))-(sX(2), sY(2))-(sX(3), sY(3)), VImg& To(X(1), Y(1))-(X(2), Y(2))-(X(3), Y(3)), R&
        _MapTriangle (sX(2), sY(2))-(sX(3), sY(3))-(sX(4), sY(4)), VImg& To(X(2), Y(2))-(X(3), Y(3))-(X(4), Y(4)), R&
    Next
    RoundText& = R&
End Function

Very good stuff !
BASIC Anywhere Machine
Website Find
Reply
Petr Offline
Mini-Mod
***
Posts: 176
Threads: 36
Joined: May 2022
Reputation: 16
#3
02-25-2023, 08:12 PM
Thank you, @CharlieJV here is small modification - program create animation from text. 

Code: (Select All)
_Title "Round text as animation"
Screen _NewImage(1024, 768, 32)
'easy way for creating animation
$Color:32
Dim Video(40) As Long
AngleStep = _Pi(2) / 40
R = 50
'create animation frames
For VF = 1 To 40
    Psi = Psi + (_Pi(1) / 40)
    Video(VF) = RoundText&("QB64 Phoenix call: Hello World!  ", 20 + Sin(Psi) * R, Angle)
    Angle = Angle + AngleStep
Next VF

'play video
Locate 1: Print "Press Esc to end."
Do Until K& = 27
    For PV = 1 To 40
        K& = _KeyHit
        _PutImage (512 - _Width(Video(PV)) / 2, 384 - _Height(Video(PV)) / 2), Video(PV)
        _Display
        _Limit 20
        Line (412, 284)-(612, 484), Black, BF
    Next
Loop

'free memory after end
For FM = 1 To 40
    _FreeImage Video(FM)
Next FM
End


Function RoundText& (text As String, InternalRadius As Integer, StartRadius As Single)
    D = _Dest: So = _Source
    VImg& = _NewImage(_PrintWidth(text) + 1, _FontHeight + 1, 32)
    Ob = (InternalRadius + _FontHeight)
    Ol = InternalRadius
    _Dest VImg&: _PrintString (0, 0), text$: _Dest D
    R& = _NewImage((InternalRadius + _FontHeight) * 2, (InternalRadius + _FontHeight) * 2, 32)
    U = _Width(R&) / 2
    Dim X(4), Y(4), sX(4), sY(4)
    S = 200
    PW = _PrintWidth(text)
    p2 = CInt(PW / S)
    For C = StartRadius To StartRadius + _Pi(2) Step (_Pi(2) / S) ' 200 steps
        'dest
        X(1) = U + Cos(C) * Ob
        Y(1) = U + Sin(C) * Ob
        X(2) = U + Cos(C) * Ol
        Y(2) = U + Sin(C) * Ol
        X(3) = U + Cos(C + _Pi(2) / S) * Ob
        Y(3) = U + Sin(C + _Pi(2) / S) * Ob
        X(4) = U + Cos(C + _Pi(2) / S) * Ol
        Y(4) = U + Sin(C + _Pi(2) / S) * Ol
        'source
        sX(1) = (PW / S) * n
        sY(1) = 0
        sX(2) = sX(1)
        sY(2) = _FontHeight
        sX(3) = sX(1) + PW / S
        sY(3) = 0
        sX(4) = sX(3)
        sY(4) = sY(2)

        n = n + p2
        If n > S Then Exit For
        _MapTriangle (sX(1), sY(1))-(sX(2), sY(2))-(sX(3), sY(3)), VImg& To(X(1), Y(1))-(X(2), Y(2))-(X(3), Y(3)), R&
        _MapTriangle (sX(2), sY(2))-(sX(3), sY(3))-(sX(4), sY(4)), VImg& To(X(2), Y(2))-(X(3), Y(3))-(X(4), Y(4)), R&
    Next
    RoundText& = R&
End Function


Website Find
Reply
SMcNeill Offline
Super Moderator
******
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation: 116
#4
02-26-2023, 12:32 AM
I've got one that works similar to this, that's been in my toolbox forever:

Code: (Select All)
_Define A-Z As _FLOAT
Dim BlendedScreen As Long

ViewScreen = _NewImage(800, 800, 32): Screen ViewScreen


CreateBlendedScreen 'Create a blended screen of colors
Screen BlendedScreen 'Display that  screen
Sleep 'Pause so folks can view that screen

'For fun, add some fontage to the screen also
Color &HFF000000, 0 'Black with transparent background
f = _LoadFont("cour.ttf", 48)
If f > 0 Then
    _Font f
    w = _PrintWidth("Hello World! We love STEVE! He's Sooo AWESOME!")
    sw = _Width: sh = _Height
    _PrintString ((sw - w) \ 2 + 1, 0), "Hello World! We love STEVE! He's Sooo AWESOME!"
End If

Sleep 'Give the user the time to see our nice screen pattern which we're going to "warp" to our circle.


Screen ViewScreen 'Swap back over to our main screen
CreateCircle 400, 400, 400, 100 'Use that blended screen as reference so we can plot/color our circle in that same pattern
Sleep 'Pause to show the circle before ending the demo
System


Sub CreateCircle (Xcenter, YCenter, radius As Long, width As Long)
    Shared BlendedScreen As Long
    p = _Pi(2) * radius
    tempimage = _NewImage(p, width, 32)
    _PutImage , BlendedScreen, tempimage
    _Source tempimage
    For i = 0 To p - 1 Step .25
        For w = 0 To width - 1
            ai = 360 / p
            a = _D2R(ai * i)
            x = Xcenter - Sin(a) * (radius - w)
            y = YCenter + Cos(a) * (radius - w)
            PSet (x, y), Point(i, w)
        Next
    Next
    _Source 0
    _FreeImage tempimage
End Sub


Sub CreateBlendedScreen
    Shared BlendedScreen As Long
    If Not BlendedScreen Then BlendedScreen = _NewImage(1536, 50, 32) Else Exit Sub
    'step from red to green
    Dim kolor As _Float, i As _Float
    _Dest BlendedScreen
    For i = 0 To 255
        kolor = kolor + 1
        Line (i, 0)-Step(0, 99), _RGB32(255, kolor, 0)
    Next
    For i = 256 To 511
        kolor = kolor - 1
        Line (i, 0)-Step(0, 99), _RGB32(kolor, 255, 0)
    Next
    For i = 512 To 767
        kolor = kolor + 1
        Line (i, 0)-Step(0, 99), _RGB32(0, 255, kolor)
    Next
    For i = 768 To 1023
        kolor = kolor - 1
        Line (i, 0)-Step(0, 99), _RGB32(0, kolor, 255)
    Next
    For i = 1024 To 1279
        kolor = kolor + 1
        Line (i, 0)-Step(0, 99), _RGB32(kolor, 0, 255)
    Next
    For i = 1280 To 1535
        kolor = kolor - 1
        Line (i, 0)-Step(0, 99), _RGB32(255, 0, kolor)
    Next
    _Dest ViewScreen
End Sub


   
Website Find
Reply
PhilOfPerth Offline
Senior Member
****
Posts: 456
Threads: 63
Joined: Apr 2022
Reputation: 10
#5
02-26-2023, 01:09 AM
Yes, very similar... two discs, with text between ! Big Grin
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Website Find
Reply
PhilOfPerth Offline
Senior Member
****
Posts: 456
Threads: 63
Joined: Apr 2022
Reputation: 10
#6
02-26-2023, 01:12 AM
(02-25-2023, 08:12 PM)Petr Wrote: Thank you, @CharlieJV here is small modification - program create animation from text. 

Code: (Select All)
_Title "Round text as animation"
Screen _NewImage(1024, 768, 32)
'easy way for creating animation
$Color:32
Dim Video(40) As Long
AngleStep = _Pi(2) / 40
R = 50
'create animation frames
For VF = 1 To 40
    Psi = Psi + (_Pi(1) / 40)
    Video(VF) = RoundText&("QB64 Phoenix call: Hello World!  ", 20 + Sin(Psi) * R, Angle)
    Angle = Angle + AngleStep
Next VF

'play video
Locate 1: Print "Press Esc to end."
Do Until K& = 27
    For PV = 1 To 40
        K& = _KeyHit
        _PutImage (512 - _Width(Video(PV)) / 2, 384 - _Height(Video(PV)) / 2), Video(PV)
        _Display
        _Limit 20
        Line (412, 284)-(612, 484), Black, BF
    Next
Loop

'free memory after end
For FM = 1 To 40
    _FreeImage Video(FM)
Next FM
End


Function RoundText& (text As String, InternalRadius As Integer, StartRadius As Single)
    D = _Dest: So = _Source
    VImg& = _NewImage(_PrintWidth(text) + 1, _FontHeight + 1, 32)
    Ob = (InternalRadius + _FontHeight)
    Ol = InternalRadius
    _Dest VImg&: _PrintString (0, 0), text$: _Dest D
    R& = _NewImage((InternalRadius + _FontHeight) * 2, (InternalRadius + _FontHeight) * 2, 32)
    U = _Width(R&) / 2
    Dim X(4), Y(4), sX(4), sY(4)
    S = 200
    PW = _PrintWidth(text)
    p2 = CInt(PW / S)
    For C = StartRadius To StartRadius + _Pi(2) Step (_Pi(2) / S) ' 200 steps
        'dest
        X(1) = U + Cos(C) * Ob
        Y(1) = U + Sin(C) * Ob
        X(2) = U + Cos(C) * Ol
        Y(2) = U + Sin(C) * Ol
        X(3) = U + Cos(C + _Pi(2) / S) * Ob
        Y(3) = U + Sin(C + _Pi(2) / S) * Ob
        X(4) = U + Cos(C + _Pi(2) / S) * Ol
        Y(4) = U + Sin(C + _Pi(2) / S) * Ol
        'source
        sX(1) = (PW / S) * n
        sY(1) = 0
        sX(2) = sX(1)
        sY(2) = _FontHeight
        sX(3) = sX(1) + PW / S
        sY(3) = 0
        sX(4) = sX(3)
        sY(4) = sY(2)

        n = n + p2
        If n > S Then Exit For
        _MapTriangle (sX(1), sY(1))-(sX(2), sY(2))-(sX(3), sY(3)), VImg& To(X(1), Y(1))-(X(2), Y(2))-(X(3), Y(3)), R&
        _MapTriangle (sX(2), sY(2))-(sX(3), sY(3))-(sX(4), sY(4)), VImg& To(X(2), Y(2))-(X(3), Y(3))-(X(4), Y(4)), R&
    Next
    RoundText& = R&
End Function

Wow, I like that one Petr! Nice job.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Website Find
Reply




Users browsing this thread: 1 Guest(s)