-
Notifications
You must be signed in to change notification settings - Fork 1
/
mRC6.bas
93 lines (73 loc) · 2.79 KB
/
mRC6.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Attribute VB_Name = "mRC6"
Option Explicit
'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Public SRF As cCairoSurface
Public CC As cCairoContext
Public pW As Long
Public pH As Long
Public pW1 As Long
Public pH1 As Long
Public cnt As Long
Public FPS As Long
Public srfBYTES() As Byte
Public Border#, Border2#, InvBorder#, InvBorder2#
Attribute Border2.VB_VarUserMemId = 1073741833
Attribute InvBorder.VB_VarUserMemId = 1073741833
Attribute InvBorder2.VB_VarUserMemId = 1073741833
Public PIChDC As Long
Public Function SetBorder(v#)
Border = v
Border2 = v * v
InvBorder = 1 / Border
InvBorder2 = 1 / Border2
End Function
Public Sub DrawUsingRC6()
Dim X&, Y&
Dim X40&, X41&, X42&
Dim D#
CC.SetSourceRGB 0.16, 0.25, 0.16
CC.Paint
SRF.BindToArray srfBYTES()
Dim P#, q#, T#
T = Timer * 8#
UpdateSegPos 1, vec2(180 + 100 * Cos(T * 0.13), _
120 + 100 * Cos(T * 0.09)), vec2(105, 105)
UpdateSegPos 2, vec2(pW * 0.5 + pW * 0.4 * Cos(T * 0.075 + 1), _
pH * 0.5 + pH * 0.4 * Cos(T * 0.09 + 2)), _
vec2(pW * 0.5 + pW * 0.4 * Cos(T * 0.07 + 3), _
pH * 0.5 + pH * 0.4 * Cos(T * 0.05 + 4))
UpdateRingPos 6, vec2(pW * 0.3 + pW * 0.2 * Cos(T * 0.07), pH * 0.7 + pH * 0.2 * Cos(T * 0.04))
For X = 0 To pW1
X40 = X * 4&
X41 = X40 + 1&
X42 = X40 + 2&
For Y = 0 To pH1
D = sdSCENEex(vec2(X * 1, Y * 1))
If D > 0# Then ' outside
If D <= Border2 Then
'------------------------------------------
D = Sqr(D)
P = D * InvBorder
'------------------------------------------
' P = D * InvBorder2
'------------------------------------------
q = 1# - P
srfBYTES(X40, Y) = 32 * q + P * srfBYTES(X40, Y) '255 * (0.5 + 0.5 * Cos(D * 0.5))
srfBYTES(X41, Y) = 200 * q + P * srfBYTES(X41, Y)
srfBYTES(X42, Y) = 255 * q + P * srfBYTES(X42, Y)
'srfBYTES(x4 + 3, y) = 255
End If
Else 'inside
srfBYTES(X40, Y) = 32
srfBYTES(X41, Y) = 200
srfBYTES(X42, Y) = 255
'srfBYTES(x4 + 3, y) = 255
End If
Next
Next
SRF.ReleaseArray srfBYTES
'---------------------------------
SRF.DrawToDC PIChDC
'---------------------------------
'fMain.PIC = SRF.Picture
End Sub