Share My Creation Morph Example

Morph Example (Square -> Circle)

(move you mouse on the form)

Code:

B4X:
#Region  Project Attributes
    #MainFormWidth: 600
    #MainFormHeight: 600
#End Region

Sub Process_Globals
    Private fx As JFX
    Private MainForm As Form
    Type vector(origin_x As Float, origin_y As Float)
    Dim totalpoints As Int = 100
    Dim side As Int
    Dim r As Float = 200
    Dim circle, square, triangle, current, shapetodo As List
    Dim c As Canvas
    Dim amt As Double = 0
    Dim btn1, btn2 As Button
End Sub

Sub AppStart (Form1 As Form, Args() As String)
    MainForm = Form1
    MainForm.SetFormStyle("UNIFIED")
    MainForm.Show

    circle.Initialize
    square.Initialize
    triangle.Initialize
    current.Initialize
    shapetodo.Initialize
   
    btn1.Initialize("btn")
    btn2.Initialize("btn")
   
    btn1.Text = "Square"
    btn1.Tag = "1"
    btn2.Text = "Triangle"
    btn2.Tag = "2"

    c.Initialize("c")
    MainForm.RootPane.AddNode(c,0,0,MainForm.Width,MainForm.Height)
    MainForm.RootPane.AddNode(btn1,0,0,200,50)
    MainForm.RootPane.AddNode(btn2,MainForm.Width-200,0,200,50)

    createcircle 'create circle vectors
    createsquare 'create square vectors
    createtriangle 'create triabgle vectors
   
    createcurrent(triangle) 'copy selected shape to morph to a circle
    draw 'draw current
End Sub

Sub createcircle
    Dim cx = c.Width/2 ,cy = c.Height/2 As Float
    Dim a As Float = 0
    Dim da As Float = (cPI*2) / totalpoints

    Dim newangle As Float = -3*cPI/4
    Do While a < cPI*2
        Dim point As vector
        point.origin_x = (Cos(newangle)*r)+cx
        point.origin_y= (Sin(newangle)*r)+cy
        circle.Add(point)
        a = a + da
        newangle = newangle + da
    Loop
End Sub

Sub createsquare
    side = totalpoints / 4
    Dim cx = c.Width/2 ,cy = c.Height/2 As Float
    Dim x = -r, y = -r As Float
    Dim dist As Float = (r*2) / side

    For i = 0 To totalpoints-1
        Dim point As vector
        point.origin_x = x+cx
        point.origin_y = y+cy
        square.Add(point)
        
        If i < totalpoints*0.25 Then
            x = x + dist
        else if i < totalpoints*0.5 Then
            y = y + dist
        else if i < totalpoints*0.75 Then
            x = x - dist
        Else     
            y = y - dist
        End If
    Next
End Sub

Sub createtriangle
    side = totalpoints / 3
    Dim cx = c.Width/2 ,cy = c.Height/2 As Float
    Dim x = -r, y = r/2 As Float
    Dim dist As Float = (r*2) / side

    For i = 0 To totalpoints-1
        Dim point As vector
        point.origin_x = x+cx
        point.origin_y = y+cy
        triangle.Add(point)
        
        If i < totalpoints*0.33 Then
            x = x + dist/2
            y = y - dist/2
        else if i < totalpoints*0.66 Then
            x = x + dist/2
            y = y + dist/2
        Else     
            x = x - dist
        End If
    Next
End Sub

Sub createcurrent(l As List)
    shapetodo = l
    current.Clear
    For Each v As vector In shapetodo
        current.Add(v)
    Next
End Sub

Sub update(l As List)
    For i = 0 To current.Size-1
        Dim cv As vector = circle.Get(i)
        Dim sv As vector = l.Get(i)
        Dim v As vector = lerp(cv,sv,amt)
        current.Set(i,v)
    Next
End Sub

Sub lerp(v1 As vector,v2 As vector,amount As Double) As vector
    Dim newv As vector
    newv.origin_x = ((v1.origin_x-v2.origin_x) * amount)+v2.origin_x
    newv.origin_y = ((v1.origin_y-v2.origin_y) * amount)+v2.origin_y
    Return newv
End Sub

Sub draw
    For i = 0 To current.Size-1
        Dim point As vector = current.Get(i)
        Dim point2 As vector
        If i < current.Size-1 Then point2 = current.Get(i+1) Else point2 = current.Get(0)
        c.DrawLine(point.origin_x,point.origin_y,point2.origin_x,point2.origin_y,fx.Colors.Black,0)
    Next
    fillpath(current)
   
    c.DrawText("<- MOVE YOUR MOUSE FROM LEFT TO THE RIGHT ->",c.Width/2,c.Height-30,fx.DefaultFont(12),fx.Colors.Black, "CENTER")
   
End Sub

Sub fillpath(l As List)
    Dim pathlist As List
    pathlist.Initialize
   
    For i = 0 To l.Size-1
        Dim point As vector = l.Get(i)
        pathlist.Add(Array As Double(point.origin_x,point.origin_y))
    Next
   
    c.ClipPath(pathlist)
    c.DrawRect(0,0,c.Width,c.Height,fx.Colors.ARGB(20,50,50,50),True,0)
    c.RemoveClip
End Sub

Sub MainForm_MouseMoved (EventData As MouseEvent)
    c.ClearRect(0,0,c.Width,c.Height)
    amt = NumberFormat((100 / c.Width * EventData.X) / 100,1,1)
    update(shapetodo)
    draw
End Sub

Sub btn_MouseClicked (EventData As MouseEvent)
    Dim b As Button = Sender
    Select b.Tag
        Case "1"
            createcurrent(square)
        Case "2"
            createcurrent(triangle)    
    End Select
   
    c.ClearRect(0,0,c.Width,c.Height)
    update(shapetodo)
    draw
End Sub

morph.png
 

Attachments

  • morph.jar
    309.6 KB · Views: 245
Last edited:

ilan

Expert
Licensed User
Longtime User
after @Erel has explained to me how the ClipPath is working in b4j i have added a fill option and updated the code in the first post.

have fun :)

(if you like math i have an exercise for you, try to morph between triangle and circle ;), should not be that hard)
 
Last edited:

ilan

Expert
Licensed User
Longtime User
(if you like math i have an exercise for you, try to morph between triangle and circle ;), should not be that hard)

i was bored so i did it, sorry :)

SEE POST #1 (CODE UPDATED)
 
Last edited:
Top