Option Explicit
'Script written by Luis Gil
'Script copyrighted by www.legil.org
'Script version Friday, 24 July 2009 13:02:40

Dim bolDir : bolDir = True 'will flip warp/weft direction for curves

Call Main()

Sub Main()
	
	Dim strSrf
	strSrf = Rhino.GetObject("Select a surface", 8)
	If IsNull(strSrf) Then Exit Sub
	
	Dim uDom, vDom
	uDom = Rhino.SurfaceDomain(strSrf, 0)
	vDom = Rhino.SurfaceDomain(strSrf, 1)
	
	Dim uDiv, vDiv
	uDiv = Rhino.GetInteger("Divisions in U direction", ,1)
	If IsNull(uDiv) Then Exit Sub
	vDiv = Rhino.GetInteger("Divisions in V direction", ,1)
	If IsNull(vDiv) Then Exit Sub
	
	Dim dblOffset
	dblOffset = Rhino.GetReal("Weave offset", 1.0, 0.0)
	If IsNull(dblOffset) Then Exit Sub
	
	'store current working layer to reset at end of script. in the mean time, work to weave layer
	Dim originalLayer : originalLayer = Rhino.CurrentLayer
	Rhino.AddLayer "Warp"
	Rhino.LayerColor "Warp", RGB(239, 187, 28)
	Rhino.AddLayer "Weft"
	Rhino.LayerColor "Weft", RGB(238, 130, 34)
	
	Dim stepU, stepV
	stepU = (uDom(1) - uDom(0)) / uDiv
	stepV = (vDom(1) - vDom(0)) / vDiv
	
	Dim arrUCurves, arrVCurves
	ReDim arrUCurves(uDiv)
	ReDim arrVCurves(vDiv)
	
	Rhino.EnableRedraw False
	Dim i, j
	Dim crvCount : crvCount = 0
	For i = uDom(0) To uDom(1) Step stepU
		Dim arrVPl 'PL = place holder
		ReDim arrVPl(vDiv)
		Dim count : count = 0
		
		
		For j = vDom(0) To vDom(1) Step stepV
			arrVPl(count) = j
			count = count +1
		Next
		Dim arrU, t
		ReDim arrU(vDiv)
		For t = 0 To vDiv
			arrU(t) = Array(i, arrVPl(t))
		Next
		
		arrUCurves(crvCount) = Rhino.AddInterpCrvOnSrfUV(strSrf, arrU)
		crvCount = crvCount + 1
		
	Next
	
	Dim s, q
	Dim crvCount2 : crvCount2 = 0
	
	For s = vDom(0) To vDom(1) Step stepV
		Dim arrUPl 'PL = place holder
		ReDim arrUPl(uDiv)
		Dim count2 : count2 = 0
		
		For q = uDom(0) To uDom(1) Step stepU
			arrUPl(count2) = q
			count2 = count2 +1
		Next
		Dim arrV, w
		ReDim arrV(uDiv)
		For w = 0 To uDiv
			arrV(w) = Array(arrUPl(w), s)
			'Rhino.Print CStr(s) + " ; " + CStr(arrUPl(w))
		Next
		
		arrVCurves(crvCount2) = Rhino.AddInterpCrvOnSrfUV(strSrf, arrV)
		crvCount2 = crvCount2 +1
		
	Next
	Rhino.EnableRedraw True
	
	Dim arrUCrvIntpts, u
	'uUrvIntPts will be based on the number of v curves because those will be used with
	'the curveIntersections function. same for the vCrvIntPts below.

	ReDim arrUcrvIntPts(UBound(arrUCurves))

	For u = 0 To UBound(arrUCurves)
		arrUCrvIntPts(u) = curveIntersections(arrUCurves(u),arrVCurves)
	Next

	Dim arrVCrvIntPts, v
	ReDim arrVCrvIntPts(UBound(arrVCurves))
	For v = 0 To UBound(arrVCurves)
		arrVCrvIntPts(v) = curveIntersections(arrVCurves(v), arrUCurves)
	Next
	
	Rhino.CurrentLayer "Warp"
	Dim arrWeaveU, n
	bolDir = True
	ReDim arrWeaveU(UBound(arrUCurves))
	For n = 0 To UBound(arrWeaveU)
		arrWeaveU(n) = createWeave(strSrf, arrUCrvIntPts(n), dblOffset)
		bolDir = Not(bolDir)
	Next
	
	Rhino.CurrentLayer "Weft"
	Dim arrWeaveV, n2
	bolDir = False
	ReDim arrWeaveV(UBound(arrVCurves))
	For n2 = 0 To UBound(arrWeaveV)
		arrWeaveV(n2) = createWeave(strSrf, arrVCrvIntPts(n2), dblOffset)
		bolDir = Not(bolDir)
	Next
	
	Rhino.DeleteObjects arrUCurves
	Rhino.DeleteObjects arrVCurves
	Rhino.CurrentLayer originalLayer 'reset layer
	Rhino.HideObject strSrf
End Sub

Function curveIntersections(strCurve, arrCrossCurves)
	Dim arrIntPts
	ReDim arrIntPts(UBound(arrCrossCurves))
	
	Dim i, index
	index = 0
	
	For i = 0 To UBound(arrCrossCurves)
	
		Dim arrIntInfo
		arrIntInfo = Rhino.CurveCurveIntersection(strCurve, arrCrossCurves(i))
		'below Is the attempt To extract the intersection point from the resulting array
		'from the Rhino.CurveCurveIntersection. n should be equal To zero at all times, but
		'double check here if error occurs
		arrIntPts(index) = arrIntInfo(0, 1)
		'Rhino.AddPoint arrIntPts(index)
		index = index + 1
	Next
	curveIntersections = arrIntPts

End Function

Function createWeave(strSrf, arrCrvIntPts, offset)
	Rhino.EnableRedraw False
	
	Dim arrUVParam, arrSrfNorm, i
	ReDim arrPtDirection(UBound(arrCrvIntPts))
	Rhino.Print strSrf
	For i = 0 To UBound(arrCrvIntPts)
		arrUVParam = Rhino.SurfaceClosestPoint(strSrf, arrCrvIntPts(i))
		arrPtDirection(i) = Rhino.SurfaceNormal(strSrf, arrUVParam)
	Next
	'below: reverse every other normal vector
	Dim q
	If bolDir Then
		For q = 1 To UBound(arrPtDirection) Step 2
			arrPtDirection(q)= Rhino.VectorReverse(arrPtDirection(q))
		Next
	Else
		For q = 0 To UBound(arrPtDirection) Step 2
			arrPtDirection(q)= Rhino.VectorReverse(arrPtDirection(q))
		Next
	End If
	
	
	'scale vector to shift positions
	Dim t
	For t = 0 To UBound(arrPtDirection)
		Dim arrDisplacementVector
		'Rhino.AddTextDot CStr(t), arrPtDirection(t)
		arrDisplacementVector = Rhino.VectorUnitize(arrPtDirection(t))
		arrDisplacementVector = Rhino.VectorScale(arrDisplacementVector, offset)
		arrPtDirection(t) = Rhino.VectorAdd(arrCrvIntPts(t), arrDisplacementVector) 
		'Rhino.AddPoint arrPtDirection(t)
		'Rhino.AddTextDot CStr(t), arrPtDirection(t)
	Next
	
	createWeave = Rhino.AddInterpCurve(arrPtDirection)
	
	Rhino.EnableRedraw True
End Function