Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Thursday, February 19, 2009 3:46:24 PM

Call Main()
Sub Main()
	Dim arrGridPts 
	arrGridPts = tetraGridPts(array(20,10))
	
	arrGridPts = tetraPostProcess(arrGridPts)
	
	Call DrawTetraMatrix(arrGridPts )
End Sub


Sub DrawTetraMatrix(arr3dTetraPts)
	Dim thisTetra, thatTetra
	Dim maxM : maxM = Ubound( arr3dTetraPts )
	Dim maxN : maxN = Ubound( arr3dTetraPts(m) )
	Dim n,m
	For m=0 To maxM
		Rhino.EnableRedraw(False)
		For n=0 To maxN
			Dim strTetType
			If ( n Mod 2 = 0 ) Then 
				strTetType = "a" 
			Else 
				strTetType = "b"
			End If
			thisTetra = arr3dTetraPts(m)(n)
			
			'' internal to this tetra
			ReDim arrStrLines(5)
			arrStrLines(0) = Rhino.AddLine( thisTetra(0) , thisTetra(1) )
			arrStrLines(1) =  Rhino.AddLine( thisTetra(0) , thisTetra(2) )
			arrStrLines(2) =  Rhino.AddLine( thisTetra(0) , thisTetra(3) )
			arrStrLines(3) =  Rhino.AddLine( thisTetra(1) , thisTetra(2) )
			arrStrLines(4) =  Rhino.AddLine( thisTetra(1) , thisTetra(3) )
			arrStrLines(5) =  Rhino.AddLine( thisTetra(2) , thisTetra(3) )
			If strTetType = "a" Then 
				Call Rhino.ObjectColor(arrStrLines, RGB(255,0,0))
			Else
				Call Rhino.ObjectColor(arrStrLines, RGB(0,0,255))
			End If
			
			
			'' do the one to the right
			If (n < maxN) Then
				thatTetra = arr3dTetraPts(m)(n+1)
				Call Rhino.AddLine( thisTetra(2) , thatTetra(3) )
				Call Rhino.AddLine( thisTetra(2) , thatTetra(0) )
				Call Rhino.AddLine( thisTetra(1) , thatTetra(3) )
				Call Rhino.AddLine( thisTetra(1) , thatTetra(0) )
			End If
			
			'' do the one above
			If (m < maxM) Then
				thatTetra = arr3dTetraPts(m+1)(n)
				If strTetType = "a" Then
					Call Rhino.AddLine( thisTetra(1) , thatTetra(2) )
					Call Rhino.AddLine( thisTetra(1) , thatTetra(0) )
					Call Rhino.AddLine( thisTetra(3) , thatTetra(2) )
					Call Rhino.AddLine( thisTetra(3) , thatTetra(0) )	
				Else
					Call Rhino.AddLine( thisTetra(0) , thatTetra(1) )
					Call Rhino.AddLine( thisTetra(0) , thatTetra(3) )
					Call Rhino.AddLine( thisTetra(2) , thatTetra(1) )
					Call Rhino.AddLine( thisTetra(2) , thatTetra(3) )	
				End If
			End If
			
			'' do the one down and to the right
			If ( (n < maxN) And (m > 0) ) Then
				thatTetra = arr3dTetraPts(m-1)(n+1)
				If strTetType = "a" Then
					Call Rhino.AddLine( thisTetra(2) , thatTetra(0) )
				Else
					Call Rhino.AddLine( thisTetra(1) , thatTetra(3) )
				End If
			End If
			
			'' do the one up and to the right
			If ( (n < maxN) And (m < maxM) ) Then
				thatTetra = arr3dTetraPts(m+1)(n+1)
				If strTetType = "a" Then
					Call Rhino.AddLine( thisTetra(1) , thatTetra(3) )
				Else
					Call Rhino.AddLine( thisTetra(2) , thatTetra(0) )
				End If
			End If
			
			'' do the one down and to the left
			If ( (n > 0) And (m > 0) ) Then
				thatTetra = arr3dTetraPts(m-1)(n-1)
				If strTetType = "a" Then
					Call Rhino.AddLine( thisTetra(0) , thatTetra(2) )
				Else
					Call Rhino.AddLine( thisTetra(3) , thatTetra(1) )
				End If
			End If
			
			'' do the one up and to the left
			If ( (n > 0) And (m < maxM) ) Then
				thatTetra = arr3dTetraPts(m+1)(n-1)
				If strTetType = "a" Then
					Call Rhino.AddLine( thisTetra(3) , thatTetra(1) )
				Else
					Call Rhino.AddLine( thisTetra(0) , thatTetra(2) )
				End If
			End If
			
		Next
		Rhino.EnableRedraw(True)
	Next
End Sub

Function tetraPostProcess( arr3dTetraPts )
	Dim thisTetra
	
	Dim maxM : maxM = Ubound( arr3dTetraPts )
	Dim maxN : maxN = Ubound( arr3dTetraPts(m) )
	Dim n,m
	For m=0 To maxM
		For n=0 To maxN
			Dim strTetType
			If ( n Mod 2 = 0 ) Then 
				strTetType = "a" 
			Else 
				strTetType = "b"
			End If
			thisTetra = arr3dTetraPts(m)(n)
			
			Dim scale
			scale = (Sin((n/maxN)*Rhino.Pi)*2.0) + (Sin((m/maxM)*Rhino.Pi)*2.0) + 0.5 '' pseudo-radial based on sine waves
			'scale = Abs(Sin((n/maxN)*Rhino.Pi*2)*2.0)+0.5
			thisTetra = ScalePtsAboutCentroid1D( thisTetra ,scale , 2 )
			
			arr3dTetraPts(m)(n) = thisTetra
		Next
	Next
	tetraPostProcess = arr3dTetraPts
End Function

Function tetraGridPts( arrCount )
	Dim arrGridDim: arrGridDim = array(2.6,2.6)
	Dim maxM : maxM = arrCount(1)
	Dim maxN : maxN = arrCount(0)
	
	ReDim arrRetGrid( maxM )
	
	Dim n,m
	For m=0 To maxM
		ReDim arrRetRow(maxN)
		For n=0 To maxN
			Dim arrCellCenter : arrCellCenter = array(arrGridDim(0)*n,arrGridDim(1)*m,0)
			If ( n Mod 2 = 0 ) Then
				arrRetRow(n) = tetraCellPtsA(arrCellCenter, m/maxM)
			Else
				arrRetRow(n) = tetraCellPtsB(arrCellCenter, abs((m/maxM)-1) )
			End If
		Next
		arrRetGrid(m) = arrRetRow
	Next
	
	tetraGridPts = arrRetGrid
End Function

Function tetraCellPtsA(arrCent, t)
	ReDim arrPts(3)
	arrPts(0) = array( -0.739795,	-0.657596,	-0.657596 )
	arrPts(1) = array(  0.575396,	 0.657596,	-0.328798 )
	arrPts(2) = array(  0.575396,	-0.657596,	 0.328798 )
	arrPts(3) = array( -0.410997,	 0.657596,	 0.657596 )
	
	Dim tVec : tVec = Rhino.VectorCreate(arrPts(3),arrPts(0))
	tVec = Rhino.VectorScale(tVec, abs(t-1)-0.5)
	arrPts(0) = Rhino.PointAdd(arrPts(0),tVec)
	
	tetraCellPtsA = MovePoints(arrPts,arrCent)
End Function

Function tetraCellPtsB(arrCent, t)
	ReDim arrPts(3)
	arrPts(0) = array( -0.739795,	 0.657596,	 0.657596 )
	arrPts(1) = array(  0.575396,	-0.657596,	 0.328798 )
	arrPts(2) = array(  0.575396,	 0.657596,	-0.328798 )
	arrPts(3) = array( -0.410997,	-0.657596,	-0.657596 )
	
	Dim tVec : tVec = Rhino.VectorCreate(arrPts(0),arrPts(3))
	tVec = Rhino.VectorScale(tVec, abs(t-1)-0.5)
	arrPts(3) = Rhino.PointAdd(arrPts(3),tVec)
	
	tetraCellPtsB = MovePoints(arrPts,arrCent)
End Function


''' VECTOR UTILITY METHODS

Function MovePoints(arrPts, arrVec)
	ReDim retPts(ubound(arrPts))
	Dim n
	For n=0 To Ubound(arrPts)
		retPts(n) = Rhino.PointAdd(arrPts(n),arrVec)
	Next
	MovePoints = retPts
End Function

Function ScalePtsAboutCentroid1D(arrPts, scale, intDim)
	Dim cent, tVec
	cent = Centroid(arrPts)
	ScalePtsAboutCentroid1D = ScalePtsAboutPoint1D(arrPts,cent,scale,intDim)
End Function

Function ScalePtsAboutCentroid(arrPts, scale)
	Dim cent, tVec
	cent = Centroid(arrPts)
	ScalePtsAboutCentroid = ScalePtsAboutPoint(arrPts,cent,scale)
End Function

Function ScalePtsAboutPoint(arrPts, arrPt, scale)
	Dim tVec
	tVec = Rhino.VectorCreate(array(0,0,0), arrPt)
	
	Dim n
	For n=0 To Ubound(arrPts)
		arrPts(n) = Rhino.PointAdd(arrPts(n), tVec)
		arrPts(n) = Rhino.PointScale(arrPts(n), scale)
		arrPts(n) = Rhino.PointAdd(arrPts(n), Rhino.VectorReverse(tVec))
	Next
	ScalePtsAboutPoint = arrPts
End Function

Function ScalePtsAboutPoint1D(arrPts, arrPt, scale, intDim)
	'' 0 = x-axis (default)
	'' 1 = y-axis
	'' 2 = z-axis
	
	Dim tVec
	tVec = Rhino.VectorCreate(array(0,0,0), arrPt)
	
	Dim n
	For n=0 To Ubound(arrPts)
		Dim pt
		pt = Rhino.PointAdd(arrPts(n), tVec)
		Select Case intDim
			Case 1
				arrPts(n) = array(pt(0),		pt(1)*scale,	pt(2) )
			Case 2
				arrPts(n) = array(pt(0),		pt(1),			pt(2)*scale )
			Case Else
				arrPts(n) = array(pt(0)*scale,	pt(1),			pt(2) )
		End Select
		arrPts(n) = Rhino.PointAdd(arrPts(n), Rhino.VectorReverse(tVec))
	Next
	ScalePtsAboutPoint1D = arrPts
End Function