101 lines
2.6 KiB
Plaintext
101 lines
2.6 KiB
Plaintext
Type vector
|
|
v(2) As Double
|
|
End Type
|
|
|
|
Type sphere
|
|
cx As Integer
|
|
cy As Integer
|
|
cz As Integer
|
|
r As Integer
|
|
End Type
|
|
|
|
Function dot(x As vector, y As vector) As Double
|
|
Return x.v(0)*y.v(0) + x.v(1)*y.v(1) + x.v(2)*y.v(2)
|
|
End Function
|
|
|
|
Sub normalizeVector(v As vector)
|
|
Dim invLen As Double = 1.0 / Sqr(dot(v, v))
|
|
v.v(0) *= invLen
|
|
v.v(1) *= invLen
|
|
v.v(2) *= invLen
|
|
End Sub
|
|
|
|
Function hitSphere(s As sphere, x As Integer, y As Integer, z1 As Double Ptr, z2 As Double Ptr) As Boolean
|
|
Dim xx As Integer = x - s.cx
|
|
Dim yy As Integer = y - s.cy
|
|
Dim zsq As Integer = s.r*s.r - (xx*xx + yy*yy)
|
|
|
|
If zsq >= 0 Then
|
|
Dim zsqrt As Double = Sqr(zsq)
|
|
*z1 = s.cz - zsqrt
|
|
*z2 = s.cz + zsqrt
|
|
Return True
|
|
End If
|
|
Return False
|
|
End Function
|
|
|
|
Function createDeathStar(posic As sphere, neg As sphere, k As Double, amb As Double, direc As vector) As Any Ptr
|
|
Dim As Integer w = posic.r * 4
|
|
Dim As Integer h = posic.r * 3
|
|
|
|
Dim As Any Ptr img = Imagecreate(w, h, Rgb(0,0,0))
|
|
|
|
Dim vec As vector
|
|
Dim As Double z1, z2, zs1, zs2
|
|
|
|
For y As Integer = posic.cy - posic.r To posic.cy + posic.r
|
|
For x As Integer = posic.cx - posic.r To posic.cx + posic.r
|
|
If hitSphere(posic, x, y, @z1, @z2) Then
|
|
Dim hit As Boolean = hitSphere(neg, x, y, @zs1, @zs2)
|
|
|
|
If hit Then
|
|
If zs1 > z1 Then hit = False
|
|
If zs2 > z2 Then Continue For
|
|
End If
|
|
|
|
If hit Then
|
|
vec.v(0) = neg.cx - x
|
|
vec.v(1) = neg.cy - y
|
|
vec.v(2) = neg.cz - zs2
|
|
Else
|
|
vec.v(0) = x - posic.cx
|
|
vec.v(1) = y - posic.cy
|
|
vec.v(2) = z1 - posic.cz
|
|
End If
|
|
|
|
normalizeVector(vec)
|
|
Dim s As Double = dot(direc, vec)
|
|
If s < 0 Then s = 0
|
|
|
|
Dim lum As Double = 255 * (s^k + amb) / (1 + amb)
|
|
If lum < 0 Then lum = 0
|
|
If lum > 255 Then lum = 255
|
|
|
|
Dim shade As Integer = lum
|
|
Pset img, (x + w\2, y + h\2), Rgb(shade, shade, shade)
|
|
End If
|
|
Next x
|
|
Next y
|
|
|
|
Return img
|
|
End Function
|
|
|
|
' Main program
|
|
Screenres 500, 400, 32
|
|
Windowtitle "Death Star FreeBASIC"
|
|
|
|
Dim direct As vector
|
|
direct.v(0) = 20
|
|
direct.v(1) = -40
|
|
direct.v(2) = -10
|
|
normalizeVector(direct)
|
|
|
|
Dim posic As sphere = Type(0, 0, 0, 120)
|
|
Dim neg As sphere = Type(-50, -50, -30, 75)
|
|
|
|
Dim img As Any Ptr = createDeathStar(posic, neg, 1.5, 0.2, direct)
|
|
Put (0, 0), img
|
|
Imagedestroy(img)
|
|
|
|
Sleep
|