nope.vba

Function Add(a As vec3, b As vec3) As vec3
    Dim r As New vec3
    
    r.x = a.x + b.x
    r.y = a.y + b.y
    r.z = a.z + b.z
    
    Set Add = r

End Function

Function Sub_(a As vec2, b As Double) As vec2
    Dim r As New vec2
    
    r.x = a.x - b
    r.y = a.y - b
    
    Set Sub_ = r

End Function


Function Mult(a As vec3, b As vec3) As vec3
    Dim r As New vec3
    
    r.x = a.x * b.x
    r.y = a.y * b.y
    r.z = a.z * b.z
    
    Set Mult = r

End Function

Function Div(a As vec2, b As vec2) As vec2
    Dim r As New vec2
    
    r.x = a.x / b.x
    r.y = a.y / b.y
    
    Set Div = r

End Function

Function Scalar(a As vec2, b As Double) As vec2
    Dim r As New vec2
    
    r.x = a.x * b
    r.y = a.y * b
    
    Set Scalar = r

End Function

Function Scalar3(a As vec3, b As Double) As vec3
    Dim r As New vec3
    
    r.x = a.x * b
    r.y = a.y * b
    r.z = a.z * b
    
    Set Scalar3 = r

End Function

Function CalcUV(resolution As vec2, fragcoord As vec2, aspect As vec2) As vec2
    Dim r As New vec2
    Dim num As New vec2
    'Dim denom As New vec2
    Dim tmp As New vec2
    
    Set num = Scalar(fragcoord, 2)
    'Set denom = Sub_(resolution, 1)
    Set tmp = Sub_(Div(num, resolution), 1)
    
    r.x = tmp.x * aspect.x
    r.y = tmp.y * aspect.y
    
    Set CalcUV = r

End Function

Function Length(p As vec3) As Double
    Dim r As New vec3

    r.x = p.x * p.x
    r.y = p.y * p.y
    r.z = p.z * p.z
    
    Dim v As Double: v = r.x + r.y + r.z
    v = Sqr(v)

    Length = v
End Function

Function ModDbl(Numerator As Double, Denominator As Double) As Double
    ModDbl = Numerator - Denominator * Int(Numerator / Denominator)
End Function

Function max(a As Double, b As Double) As Double
    If a > b Then
        max = a
    Else
        max = b
    End If
End Function

Function vmax(v As vec3) As Double

    Dim a As Double: a = max(v.x, v.y)
    Dim b As Double: b = max(a, v.z)

    vmax = b
End Function

Function Square(p As vec3, b As Double) As Double
    p.x = Abs(p.x) - b
    p.y = Abs(p.y) - b
    p.z = Abs(p.z) - b

    Square = vmax(p)

End Function

Function Map(p As vec3, r As Double) As Double


    Dim size As Double: size = 18
    
    
    
    Dim d As New vec3
    d.x = ModDbl(p.x + size * 0.5, size) - (size * 0.5)
    d.y = ModDbl(p.y + size * 0.5, size) - (size * 0.5)
    d.z = ModDbl(p.z + 28 * 0.5, 28) - (28 * 0.5)

    
    p.x = d.x
    p.y = d.y
    p.z = d.z
    
    
    Dim a As Double: a = Square(p, 3.5) 'Length(p) - 3.2
    

    Map = a
End Function

Function rm(ro As vec3, rd As vec3, start_ As Double, end_ As Double) As Double

    Dim sceneDist As Double: sceneDist = 1000
    Dim stepScale As Double: stepScale = 0.98
    Dim rayDepth As Double: rayDepth = start_
    Dim eps As Double: eps = 0.5

    Dim rd_mult_rayDepth As New vec3
    Dim p As New vec3

    For i = 1 To 30
        Set rd_mult_rayDepth = Scalar3(rd, rayDepth)
        Set p = Add(ro, rd_mult_rayDepth)
        
        sceneDist = Map(p, 0.6)
        
        If sceneDist < eps Or rayDepth >= end_ Then
            Exit For
        End If
        
        rayDepth = rayDepth + (sceneDist * stepScale)
    Next i
    
    If sceneDist >= eps Then
        rayDepth = end_
    Else
        rayDepth = rayDepth + sceneDist
    End If
    
    rm = rayDepth

End Function



Sub LoopRange()
    
    Dim rCell As Range
    Dim rRng As Range
    Dim angle As Double
    Dim res As Double

    Dim ro As New vec3
    Dim rd As New vec3
    
    Dim fragcoord As New vec2
    Dim aspect As New vec2
    Dim uv As New vec2
    Dim resolution As New vec2
    Dim rm_res As Double
    

    resolution.x = 20
    resolution.y = 20
    
    aspect.x = resolution.x / resolution.y
    aspect.y = 1
    
    ro.x = 8
    ro.y = 5.5
    ro.z = 0
    
    Application.Calculation = xlCalculationManual
    
    Set rRng = Sheet1.Range("A1:T20")
   
    
    Dim counter As Integer
    counter = 1
    
    Do While counter < 20
        
        
        
        
        For Each rCell In rRng.Cells
            
            rCell.Clear
            
            
            fragcoord.x = rCell.Column
            fragcoord.y = rCell.Row
            
            Set uv = CalcUV(resolution, fragcoord, aspect)
            
            rd.x = uv.x '+ (counter * 0.1)
            rd.y = uv.y
            rd.z = 1 ' + counter
            
            
            'ro.z = -2 - Sin(counter) * 0.5
            ro.z = counter * 3
            'ro.x = counter * 4
            
            rm_res = rm(ro, rd, 0, 50)
            
            If rm_res > 45 Then
                rCell.Interior.ColorIndex = 1
            ElseIf rm_res > 40 Then
                rCell.Interior.ColorIndex = 56
            ElseIf rm_res > 24 Then
                rCell.Interior.ColorIndex = 16
            ElseIf rm_res > 20 Then
                rCell.Interior.ColorIndex = 48
            ElseIf rm_res > 16 Then
                rCell.Interior.ColorIndex = 15
            Else
                rCell.Interior.ColorIndex = 2
            End If
            
        Next rCell
    
        counter = counter + 1
        
    Loop

    

End Sub