Microsoft Small Basic

Program Listing: GCZ059-0

List Program

Initialise()
yy=300
InitHen ()
GraphicsWindow.Title="3D hen
GraphicsWindow.MouseMove = OnMouseMove
GraphicsWindow.MouseDown = OnMouseDown
GraphicsWindow.MouseUp = OnMouseUp
init="true"
LDEvents.MouseWheel =mwwl
ccm=LDText.Split ("lightgray gray darkgray orange darkorange saddlebrown red darkred #660000 #333333 #222222 #111111 " " ")
ballSX = LDArray.Create (15)
ballSY = LDArray.Create (15)
ballSZ = LDArray.Create (15)

While "True"

If (mww And mouseDown) or init Then
mww="false"
'GraphicsWindow.BrushColor = bg
'GraphicsWindow.FillRectangle(0,0,gw,gh)
GraphicsWindow.Clear ()
If init then
init="false"
else
theta = -(GraphicsWindow.MouseX-mouseX)/gw*PI
phi = -(GraphicsWindow.MouseY-mouseY)/gh*PI/2
cth=cth+theta
cpi=cpi+phi
'GraphicsWindow.Title =theta +":"+phi
setRotation()
matrix1 = matrix
matrix2 = rotationOLD
multiply()
rotation = matrix
endif

matrix = rotation
For pz=0 to 13
For py= ymax to 0 Step -1
For px=xmax -1 to 0 Step -1
bs=LDArray.GetValue (bll 14-pz)
bs1=LDArray.GetValue (bll 13-pz)

tt=text.GetSubText(bs py*12+xmax-px 1)
tt1=text.GetSubText(bs1 py*12+xmax-px 1)

If tt=" " then
else
For iBall = 1 To dtc
X = ballX[iBall]+px
Y = ballY[iBall]+py
Z = ballZ[iBall]+pz
getScreen()
LDArray.SetValue(ballSX iBall sx)
LDArray.SetValue(ballSY iBall sy)
LDArray.SetValue(ballSZ iBall sz)

EndFor

iq=1+(Text.GetIndexOf ("WORB" tt)-1)*3
cp=1
If tt1=" " then
zc=dtc
else
zc=dtc-4
endif
For iBall = 1 To zc Step 4
pp11= ldarray.GetValue (ballSX iBall)
pp12= ldarray.GetValue (ballSY iBall)+yy
pp21 = ldarray.GetValue (ballSX iBall+1)
pp22 = ldarray.GetValue (ballSY iBall+1)+yy
pp31 = ldarray.GetValue (ballSX iBall+2)
pp32 = ldarray.GetValue (ballSY iBall+2)+yy
pp41 = ldarray.GetValue (ballSX iBall+3)
pp42 = ldarray.GetValue (ballSY iBall+3)+yy

GraphicsWindow.BrushColor=ccm[iq]
cc1= GraphicsWindow.BrushColor
' cc[2]=LDColours.HSLtoRGB (10+iball*10 1 0.2)
If cp=2 then
cc[1]=LDColours.HSLtoRGB (LDColours.GetHue (cc1) 1 LDColours.GetLightness (cc1)*0.7)
ElseIf cp=3 then
cc[1]=LDColours.HSLtoRGB (LDColours.GetHue (cc1) 1 LDColours.GetLightness (cc1)*1.5)
endif
cp=cp+1
' gr= LDShapes.BrushGradient (cc, "DD")
GraphicsWindow.BrushColor=cc1
GraphicsWindow.FillTriangle (pp11 pp12 pp21 pp22 pp31 pp32)
GraphicsWindow.FillTriangle (pp31 pp32 pp41 pp42 pp11 pp12)
GraphicsWindow.PenColor =cc1
GraphicsWindow.PenWidth =1
GraphicsWindow.drawTriangle (pp11 pp12 pp21 pp22 pp31 pp32)
GraphicsWindow.drawTriangle (pp31 pp32 pp41 pp42 pp11 pp12)

iq=iq+1
EndFor
endif
endfor

endfor
endfor
endif
' GraphicsWindow.Title =cth+":"+cpi
Program.Delay(15)
EndWhile

'###########################################*SUBS****

Sub mwwl
scale =scale +LDEvents.LastMouseWheelDelta *10
init="true
EndSub

Sub Initialise
tx="0 0 1 1 0 0 0 0 0 1 1 0
ty="0 0 0 0 0 1 1 0 0 0 1 1
tz="0 1 1 0 0 0 1 1 1 1 1 1
zr="2 0 1

PI = 2.0*Math.ArcCos(0)
gw = 1200
gh = 800
bg = "darkblue"
GraphicsWindow.PenWidth=0
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
GraphicsWindow.BackgroundColor = bg
GraphicsWindow.Top = 0
GraphicsWindow.Left = 0
centreX = 0
centreY = 0
centreZ = 0

radBall = 15
scale = 50
theta = 244
phi = 160
cth=theta
cpi=phi
ballx=ldtext.Split(tx " ")
bally=ldtext.Split(ty " ")
ballz=ldtext.Split(tz " ")
zor= ldtext.Split(zr " ")
dtc=array.GetItemCount (ballx)

setRotation()
rotation = matrix
EndSub

Sub setRotation 'Input : theta, phi Output : matrix
mct=Math.Cos(theta)
mcp=Math.Cos(phi)
mst=Math.Sin(theta)
msp=Math.Sin(phi)

matrix[1][1] = Mct*Mcp
matrix[1][2] = mst
matrix[1][3] = mct*msp

matrix[2][1] = -mst*mcp
matrix[2][2] = mct
matrix[2][3] = -mst*msp

matrix[3][1] = -msp
matrix[3][2] = 0
matrix[3][3] = mcp
EndSub


Sub multiply
For i = 1 To 3
For j = 1 To 3
matrix[i][j] = 0
For k = 1 To 3
matrix[i][j] = matrix[i][j] + matrix1[i][k]*matrix2[k][j]
EndFor
EndFor
EndFor
EndSub

Sub getAngles 'Input : matrix Output theta, phi
phi = Math.ArcCos(Math.Min(1.0,Math.Max(-1.0,matrix[3][3])))
theta = Math.ArcCos(Math.Min(1.0,Math.Max(-1.0,matrix[2][2])))
If (matrix[1][2] < 0) Then
theta = theta+PI
EndIf
EndSub

Sub getScreen 'Input matrix, scale, centreX, centreY, centreZ, X, Y, Z
'Output SX, SY, SZ(depth)
DX = (X-centreX)*scale
DY = (Y-centreY)*scale
DZ = (Z-centreZ)*scale
SX = gw/2 + DX*matrix[2][1] + DY*matrix[2][2] + DZ*matrix[2][3]
SY = gh/2 + DX*matrix[3][1] + DY*matrix[3][2] + DZ*matrix[3][3]
SZ = (DX*matrix[1][1] + DY*matrix[1][2] + DZ*matrix[1][3])/255/scale
EndSub

Sub OnMouseMove
mww="true"
EndSub

Sub OnMouseDown
mww="true"
mouseX = GraphicsWindow.MouseX
mouseY = GraphicsWindow.MouseY
rotationOLD = rotation
mouseDown = "true"
EndSub

Sub OnMouseUp
mouseDown = "false"
EndSub


Sub inithen
bll=LDArray.Create (15)
' > . . . . . . .
block[13]= " O OOO O O OOO O "
block[12]= " O O "
block[11]= " O O "
block[10]= " W W "
block [9]= " WW WW WWW WWWWWW WWWWWW WWWWWW WW WW WW "
block [8]= " WWWW W W W W W W W W W W WWWW "
block [7]= " WWWWW W W W W W W W W W W WWWWW "
block [6]= " WWWWWW WWWWWwW wWWWWwW WWWWWwW WWWWWW "
block [5]= " WWW WW WWWR WWW "
block [4]= " WWW W R WWW "
block [3]= " WBW W OO WBW "
block [2]= " WWW WWRR WWW "
block [1]= " RR "
block [0]= " "
xmax = 11
ymax = 6
zmax = 12
For x=0 To 13
LDArray.SetValue (bll x+1 block[x])
EndFor
EndSub