home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH14 / SRC / M4OPS.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-04-17  |  11.5 KB  |  365 lines
  1. Attribute VB_Name = "M4Ops"
  2. Option Explicit
  3.  
  4. Global Const PI = 3.14159265358979
  5. Global Const INFINITY = 2147483647
  6.  
  7. Type Point4D
  8.     coord(1 To 5) As Single
  9.     trans(1 To 5) As Single
  10. End Type
  11.  
  12. Type Segment4D
  13.     pt1 As Integer
  14.     pt2 As Integer
  15. End Type
  16.  
  17.  
  18.  
  19. ' ***********************************************
  20. ' Create a transformation matrix for orthographic
  21. ' projection along the X-W plane.
  22. ' ***********************************************
  23. Sub m4OrthoSide(M() As Single)
  24.     m4Identity M
  25.     M(1, 1) = 0
  26.     M(3, 1) = -1
  27.     M(3, 3) = 0
  28.     M(4, 4) = 0
  29. End Sub
  30. ' ***********************************************
  31. ' Create a transformation matrix for orthographic
  32. ' projection along the Y-W plane.
  33. ' ***********************************************
  34. Sub m4OrthoTop(M() As Single)
  35.     m4Identity M
  36.     M(2, 2) = 0
  37.     M(3, 2) = -1
  38.     M(3, 3) = 0
  39.     M(4, 4) = 0
  40. End Sub
  41.  
  42. ' ***********************************************
  43. ' Create a transformation matrix for orthographic
  44. ' projection along the W-Z plane.
  45. ' ***********************************************
  46. Sub m4OrthoFront(M() As Single)
  47.     m4Identity M
  48.     M(3, 3) = 0
  49.     M(4, 4) = 0
  50. End Sub
  51.  
  52. ' ***********************************************
  53. ' Create an identity matrix.
  54. ' ***********************************************
  55. Public Sub m4Identity(M() As Single)
  56. Dim i As Integer
  57. Dim j As Integer
  58.  
  59.     For i = 1 To 5
  60.         For j = 1 To 5
  61.             If i = j Then
  62.                 M(i, j) = 1
  63.             Else
  64.                 M(i, j) = 0
  65.             End If
  66.         Next j
  67.     Next i
  68. End Sub
  69.  
  70. ' ***********************************************
  71. ' Normalize a 4-D point vector.
  72. ' ***********************************************
  73. Public Sub m4NormalizeCoords(x As Single, y As Single, z As Single, w As Single, S As Single)
  74.     x = x / S
  75.     y = y / S
  76.     z = z / S
  77.     w = w / S
  78.     S = 1
  79. End Sub
  80.  
  81. ' ***********************************************
  82. ' Normalize a 4-D point vector.
  83. ' ***********************************************
  84. Public Sub m4NormalizePoint(P() As Single)
  85. Dim i As Integer
  86. Dim value As Single
  87.  
  88.     value = P(5)
  89.     For i = 1 To 4
  90.         P(i) = P(i) / value
  91.     Next i
  92.     P(5) = 1
  93. End Sub
  94.  
  95.  
  96. ' ***********************************************
  97. ' Normalize a 4-D transformation matrix.
  98. ' ***********************************************
  99. Public Sub m4NormalizeMatrix(M() As Single)
  100. Dim i As Integer
  101. Dim j As Integer
  102. Dim value As Single
  103.  
  104.     value = M(5, 5)
  105.     For i = 1 To 5
  106.         For j = 1 To 5
  107.             M(i, j) = M(i, j) / value
  108.         Next j
  109.     Next i
  110. End Sub
  111.  
  112.  
  113.  
  114.  
  115.  
  116. ' ***********************************************
  117. ' Create a 4-D transformation matrix for a
  118. ' perspective projection along the W axis into
  119. ' the X-Y-Z space with focus at the origin and the
  120. ' center of projection at point (0, 0, 0, D).
  121. ' ***********************************************
  122. Public Sub m4PerspectiveW(M() As Single, D As Single)
  123.     m4Identity M
  124.     If D <> 0 Then M(4, 5) = -1 / D
  125. End Sub
  126. ' ***********************************************
  127. ' Create a 4-D transformation matrix for scaling
  128. ' by scale factors Sx, Sy, Sz, and Sw.
  129. ' ***********************************************
  130. Public Sub m4Scale(M() As Single, Sx As Single, Sy As Single, Sz As Single, Sw As Single)
  131.     m4Identity M
  132.     M(1, 1) = Sx
  133.     M(2, 2) = Sy
  134.     M(3, 3) = Sz
  135.     M(4, 4) = Sw
  136. End Sub
  137.  
  138. ' ***********************************************
  139. ' Create a 3-D transformation matrix for
  140. ' translation by Tx, Ty, Tz, and Tw.
  141. ' ***********************************************
  142. Public Sub m4Translate(M() As Single, Tx As Single, Ty As Single, Tz As Single, Tw As Single)
  143.     m4Identity M
  144.     M(5, 1) = Tx
  145.     M(5, 2) = Ty
  146.     M(5, 3) = Tz
  147.     M(5, 4) = Tw
  148. End Sub
  149.  
  150. ' ***********************************************
  151. ' Create a 4-D transformation matrix for rotation
  152. ' around the XY plane (angle measured in radians).
  153. ' ***********************************************
  154. Public Sub m4XYRotate(M() As Single, theta As Single)
  155.     m4Identity M
  156.     M(3, 3) = Cos(theta)
  157.     M(4, 4) = M(3, 3)
  158.     M(3, 4) = Sin(theta)
  159.     M(4, 3) = -M(3, 4)
  160. End Sub
  161.  
  162. ' ***********************************************
  163. ' Create a 4-D transformation matrix for rotation
  164. ' around the XZ plane (angle measured in radians).
  165. ' ***********************************************
  166. Public Sub m4XZRotate(M() As Single, theta As Single)
  167.     m4Identity M
  168.     M(2, 2) = Cos(theta)
  169.     M(4, 4) = M(2, 2)
  170.     M(2, 4) = Sin(theta)
  171.     M(4, 2) = -M(2, 4)
  172. End Sub
  173.  
  174.  
  175. ' ***********************************************
  176. ' Create a 4-D transformation matrix for rotation
  177. ' around the YZ plane (angle measured in radians).
  178. ' ***********************************************
  179. Public Sub m4YZRotate(M() As Single, theta As Single)
  180.     m4Identity M
  181.     M(1, 1) = Cos(theta)
  182.     M(4, 4) = M(1, 1)
  183.     M(1, 4) = Sin(theta)
  184.     M(4, 1) = -M(1, 4)
  185. End Sub
  186. ' ***********************************************
  187. ' Create a 4-D transformation matrix for rotation
  188. ' around the XW plane (angle measured in radians).
  189. ' ***********************************************
  190. Public Sub m4XWRotate(M() As Single, theta As Single)
  191.     m4Identity M
  192.     M(2, 2) = Cos(theta)
  193.     M(3, 3) = M(2, 2)
  194.     M(2, 3) = Sin(theta)
  195.     M(3, 2) = -M(2, 3)
  196. End Sub
  197.  
  198.  
  199. ' ***********************************************
  200. ' Create a 4-D transformation matrix for rotation
  201. ' around the YW plane (angle measured in radians).
  202. ' ***********************************************
  203. Public Sub m4YWRotate(M() As Single, theta As Single)
  204.     m4Identity M
  205.     M(1, 1) = Cos(theta)
  206.     M(3, 3) = M(1, 1)
  207.     M(3, 1) = Sin(theta)
  208.     M(1, 3) = -M(3, 1)
  209. End Sub
  210.  
  211. ' ***********************************************
  212. ' Create a 4-D transformation matrix for rotation
  213. ' around the ZW plane (angle measured in radians).
  214. ' ***********************************************
  215. Public Sub m4ZWRotate(M() As Single, theta As Single)
  216.     m4Identity M
  217.     M(1, 1) = Cos(theta)
  218.     M(2, 2) = M(1, 1)
  219.     M(1, 2) = Sin(theta)
  220.     M(2, 1) = -M(1, 2)
  221. End Sub
  222.  
  223.  
  224. ' ***********************************************
  225. ' Set copy = orig.
  226. ' ***********************************************
  227. Public Sub m4MatCopy(copy() As Single, orig() As Single)
  228. Dim i As Integer
  229. Dim j As Integer
  230.  
  231.     For i = 1 To 5
  232.         For j = 1 To 5
  233.             copy(i, j) = orig(i, j)
  234.         Next j
  235.     Next i
  236. End Sub
  237.  
  238. ' ************************************************
  239. ' Apply a transformation matrix to a point where
  240. ' the transformation may not have 0, 0, 0, 1 in
  241. ' its final column. Normalize only the X and Y
  242. ' components of the result to preserve the Z
  243. ' information.
  244. ' ************************************************
  245. Public Sub m4ApplyFull(V() As Single, M() As Single, Result() As Single)
  246. Dim i As Integer
  247. Dim j As Integer
  248. Dim value As Single
  249.  
  250.     For i = 1 To 5
  251.         value = 0#
  252.         For j = 1 To 5
  253.             value = value + V(j) * M(j, i)
  254.         Next j
  255.         Result(i) = value
  256.     Next i
  257.     
  258.     ' Renormalize the point.
  259.     ' Note that value still holds Result(5).
  260.     If value <> 0 Then
  261.         Result(1) = Result(1) / value
  262.         Result(2) = Result(2) / value
  263.         Result(3) = Result(3) / value
  264.         ' Do not transform the w component.
  265.     Else
  266.         ' Make the W value greater than that of
  267.         ' the center of projection so the point
  268.         ' will be clipped.
  269.         Result(4) = INFINITY
  270.     End If
  271.     Result(5) = 1#
  272. End Sub
  273.  
  274.  
  275.  
  276.  
  277. ' ************************************************
  278. ' Apply a transformation matrix to a point.
  279. ' ************************************************
  280. Public Sub m4Apply(V() As Single, M() As Single, Result() As Single)
  281.     Result(1) = V(1) * M(1, 1) + _
  282.                 V(2) * M(2, 1) + _
  283.                 V(3) * M(3, 1) + _
  284.                 V(4) * M(4, 1) + M(5, 1)
  285.     Result(2) = V(1) * M(1, 2) + _
  286.                 V(2) * M(2, 2) + _
  287.                 V(3) * M(3, 2) + _
  288.                 V(4) * M(4, 2) + M(5, 2)
  289.     Result(3) = V(1) * M(1, 3) + _
  290.                 V(2) * M(2, 3) + _
  291.                 V(3) * M(3, 3) + _
  292.                 V(4) * M(4, 3) + M(5, 3)
  293.     Result(4) = V(1) * M(1, 4) + _
  294.                 V(2) * M(2, 4) + _
  295.                 V(3) * M(3, 4) + _
  296.                 V(4) * M(4, 4) + M(5, 4)
  297.     Result(5) = 1#
  298. End Sub
  299.  
  300. ' ************************************************
  301. ' Multiply two matrices together. The matrices
  302. ' may not contain 0, 0, 0, 0, 1 in their last
  303. ' columns.
  304. ' ************************************************
  305. Public Sub m4MatMultiplyFull(Result() As Single, A() As Single, B() As Single)
  306. Dim i As Integer
  307. Dim j As Integer
  308. Dim k As Integer
  309. Dim value As Single
  310.  
  311.     For i = 1 To 5
  312.         For j = 1 To 5
  313.             value = 0#
  314.             For k = 1 To 5
  315.                 value = value + A(i, k) * B(k, j)
  316.             Next k
  317.             Result(i, j) = value
  318.         Next j
  319.     Next i
  320. End Sub
  321. ' ***********************************************
  322. ' Multiply two matrices together.
  323. ' ***********************************************
  324. Public Sub m4MatMultiply(Result() As Single, A() As Single, B() As Single)
  325.     Result(1, 1) = A(1, 1) * B(1, 1) + A(1, 2) * B(2, 1) + A(1, 3) * B(3, 1) + A(1, 4) * B(4, 1)
  326.     Result(1, 2) = A(1, 1) * B(1, 2) + A(1, 2) * B(2, 2) + A(1, 3) * B(3, 2) + A(1, 4) * B(4, 2)
  327.     Result(1, 3) = A(1, 1) * B(1, 3) + A(1, 2) * B(2, 3) + A(1, 3) * B(3, 3) + A(1, 4) * B(4, 3)
  328.     Result(1, 4) = A(1, 1) * B(1, 4) + A(1, 2) * B(2, 4) + A(1, 3) * B(3, 4) + A(1, 4) * B(4, 4)
  329.     Result(1, 5) = 0#
  330.     Result(2, 1) = A(2, 1) * B(1, 1) + A(2, 2) * B(2, 1) + A(2, 3) * B(3, 1) + A(2, 4) * B(4, 1)
  331.     Result(2, 2) = A(2, 1) * B(1, 2) + A(2, 2) * B(2, 2) + A(2, 3) * B(3, 2) + A(2, 4) * B(4, 2)
  332.     Result(2, 3) = A(2, 1) * B(1, 3) + A(2, 2) * B(2, 3) + A(2, 3) * B(3, 3) + A(2, 4) * B(4, 3)
  333.     Result(2, 4) = A(2, 1) * B(1, 4) + A(2, 2) * B(2, 4) + A(2, 3) * B(3, 4) + A(2, 4) * B(4, 4)
  334.     Result(2, 5) = 0#
  335.     Result(3, 1) = A(3, 1) * B(1, 1) + A(3, 2) * B(2, 1) + A(3, 3) * B(3, 1) + A(3, 4) * B(4, 1)
  336.     Result(3, 2) = A(3, 1) * B(1, 2) + A(3, 2) * B(2, 2) + A(3, 3) * B(3, 2) + A(3, 4) * B(4, 2)
  337.     Result(3, 3) = A(3, 1) * B(1, 3) + A(3, 2) * B(2, 3) + A(3, 3) * B(3, 3) + A(3, 4) * B(4, 3)
  338.     Result(3, 4) = A(3, 1) * B(1, 4) + A(3, 2) * B(2, 4) + A(3, 3) * B(3, 4) + A(3, 4) * B(4, 4)
  339.     Result(3, 5) = 0#
  340.     Result(4, 1) = A(4, 1) * B(1, 1) + A(4, 2) * B(2, 1) + A(4, 3) * B(3, 1) + A(4, 4) * B(4, 1)
  341.     Result(4, 2) = A(4, 1) * B(1, 2) + A(4, 2) * B(2, 2) + A(4, 3) * B(3, 2) + A(4, 4) * B(4, 2)
  342.     Result(4, 3) = A(4, 1) * B(1, 3) + A(4, 2) * B(2, 3) + A(4, 3) * B(3, 3) + A(4, 4) * B(4, 3)
  343.     Result(4, 4) = A(4, 1) * B(1, 4) + A(4, 2) * B(2, 4) + A(4, 3) * B(3, 4) + A(4, 4) * B(4, 4)
  344.     Result(4, 5) = 0#
  345.     Result(5, 1) = A(5, 1) * B(1, 1) + A(5, 2) * B(2, 1) + A(5, 3) * B(3, 1) + A(5, 4) * B(4, 1) + B(5, 1)
  346.     Result(5, 2) = A(5, 1) * B(1, 2) + A(5, 2) * B(2, 2) + A(5, 3) * B(3, 2) + A(5, 4) * B(4, 2) + B(5, 2)
  347.     Result(5, 3) = A(5, 1) * B(1, 3) + A(5, 2) * B(2, 3) + A(5, 3) * B(3, 3) + A(5, 4) * B(4, 3) + B(5, 3)
  348.     Result(5, 4) = A(5, 1) * B(1, 4) + A(5, 2) * B(2, 4) + A(5, 3) * B(3, 4) + A(5, 4) * B(4, 4) + B(5, 4)
  349.     Result(5, 5) = 1#
  350. End Sub
  351.  
  352.  
  353. ' ***********************************************
  354. ' Give the vector the indicated length.
  355. ' ***********************************************
  356. Sub m4SizeVector(ByVal L As Single, x As Single, y As Single, z As Single, w As Single)
  357.     L = L / Sqr(x * x + y * y + z * z + w * w)
  358.     x = x * L
  359.     y = y * L
  360.     z = z * L
  361.     w = w * L
  362. End Sub
  363.  
  364.  
  365.