Ich habe das jetzt auf das Wesentliche runtergekürzt. Ich hoffe es ist damit auch übersichtlicher geworden.
Bei Ortho_UpdateAxis() werden die Vektoren berechnet, zum Ende der Prozedur (nach TODO suchen ggf., ab Zeile 195 bzw. 276 in meiner PB IDE) ist das zu lösende Rätsel. Ziel: Die Far/Near Punkte müssen in der 2D Darstellung identisch mit dem Focus Punkt sein (rot blinkender Zirkel in der Bildmitte), also alle übereinander liegen.
Mausrad = Zoom. Mausklick = Focus. "C" = Neigung ändern (habe es auf 0-180° begrenzt)
Code: Alles auswählen
EnableExplicit
; OrthoMini.pb
;
#ToRadian = #PI / 180.0
#ToDeg = 180.0 / #PI
#HPI = #PI / 2
#PI_INV = 1.0 / #PI
#MIN_ZOOM = 1.0 / 128.0
#MAX_ZOOM = 16.0
; 2d/3d Points
Structure point2f
x.f
y.f
EndStructure
Structure point3f
x.f
y.f
z.f
EndStructure
; OrthoCamera structure
Structure OrthoCamera
change.i ; internal / unused
flags.i ; unused
Width.i ; output width (screen/image/sprite...)
Height.i ; output height
midx.i ; output centre x
midy.i ; output centre y
zoom.f ; zoom
unzoom.f ; 1 / zoom
rotation.f ; in radiant
inclination.f ; in radiant
uf.f ; foreshortening (???) factor, z-lengths to x/y lengths (3D z axis is always along the vertical 2D screen y axis)
x.f ; focus/camera position x y z
y.f ;
z.f ;
dist_near.f ; arbitrary distance behind camera focus
dist_far.f ; arbitrary distance in front of camera focus
Scale.point3f ; unused addition zoom scale - unused (?)
InvScale.point3f ; inverted scale
Axis.point2f[3] ; 3D -> 2D vectors for conversion
InvAxis.point2f[3] ; 2D -> 3D vectors for conversion (on the focus plane)
Pick.point3f ; Pick/camera orientation vector (aka Richtungsvektor)
Far.point3f ; Far point (Pick*dist_far + camera position)
Near.point3f ; Near point (Pick*-dist_near + camera position)
EndStructure
; Ortho Camera methods
; 3D -> 2D
Procedure Ortho_CameraToScreen2(*O.OrthoCamera, count, *inPoints.Point3F, *outPoints.Point2F)
If *outPoints And *inPoints
Protected i
Protected xx.f = *O\Axis[0]\x
Protected xy.f = *O\Axis[0]\y
Protected yx.f = *O\Axis[1]\x
Protected yy.f = *O\Axis[1]\y
Protected zx.f = *O\Axis[2]\x
Protected zy.f = *O\Axis[2]\y
Protected midx.f = *O\midx
Protected midy.f = *O\midy
Protected ox.f = *O\x
Protected oy.f = *O\y
Protected oz.f = *O\z
Protected x.f, y.f, z.f
Protected x1.f, y1.f, x2.f, y2.f, y3.f
Protected zoom.f
While i < count
x = *inPoints\x - ox
y = *inPoints\y - oy
z = *inPoints\z - oz
x1 = xx * x
y1 = xy * x
x2 = yx * y
y2 = yy * y
y3 = zy * z
*outPoints\x = midx + x1 + x2
*outPoints\y = midy + y1 + y2 + y3
*inPoints + 12
*outPoints + 8
i + 1
Wend
ProcedureReturn i
EndIf
EndProcedure
Procedure Ortho_CameraToScreen(*O.OrthoCamera, x.f, y.f, z.f, *Screen.Point2F)
Protected x1.f , y1.f
Protected x2.f, y2.f
Protected x3.f, y3.f
If *Screen And *O
x = x - *O\x
y = y - *O\y
z = z - *O\z
x1 = *O\Axis[0]\x * x
y1 = *O\Axis[0]\y * x
x2 = *O\Axis[1]\x * y
y2 = *O\Axis[1]\y * y
x3 = *O\Axis[2]\x * z
y3 = *O\Axis[2]\y * z
*Screen\x = *O\midx + ((x1 + x2 + x3) )
*Screen\y = *O\midy + ((y1 + y2 + y3) )
EndIf
ProcedureReturn *Screen
EndProcedure
; 2D -> 3D
Procedure Ortho_CameraToWorld(*O.OrthoCamera, x.f, y.f, *Result.Point3F)
Protected x1.f , y1.f
Protected x2.f, y2.f
Protected x3.f, y3.f
Protected tx.f, ty.f
If *Result And *O
tx = (x - *O\midx)
ty = (y - *O\midy)
x1 = *O\invAxis[0]\x * tx; * *O\InvScale\x
y1 = *O\invAxis[0]\y * tx; * *O\InvScale\x
x2 = *O\invAxis[1]\x * ty; * *O\InvScale\y
y2 = *O\invAxis[1]\y * ty; * *O\InvScale\y
; x3 = *O\invAxis[2]\x * tz; * *O\Scale\z
; y3 = *O\invAxis[2]\y * tz; * *O\Scale\z
;
*Result\x = ( (x2 + x1)) + (*O\x)
*Result\y = ( (y2 + y1)) + (*O\y)
*Result\x = ( (x2 + x1)) + (*O\x)
*Result\y = ( (y2 + y1)) + (*O\y)
*Result\z = *O\z
Else
Debug "ERROR"
EndIf
ProcedureReturn *Result
EndProcedure
; Update vectors
Procedure Ortho_UpdateAxis(*O.OrthoCamera, rotation.f, inclination.f)
While inclination > #PI
inclination - (2 * #PI)
Wend
While inclination < - #PI
inclination + (2 * #PI)
Wend
While rotation > #PI
rotation - (2 * #PI)
Wend
While rotation < - #PI
rotation + (2 * #PI)
Wend
Protected zf.d, uf.d
zf = Sin(inclination) ;* inclination * #PI_INV
If inclination < 0
uf = 1.0 + (2 * (inclination) / #PI)
Else
uf = 1.0 - (2 * (inclination) / #PI)
EndIf
Protected i, uuf.d
*O\uf = uf
*O\rotation = rotation
*O\inclination = inclination
*O\Axis[0]\x = Cos(rotation)
*O\Axis[0]\y = - Sin(rotation)
*O\Axis[1]\x = Cos(rotation - #HPI)
*O\Axis[1]\y = - Sin(rotation - #HPI)
*O\Axis[2]\x = 0
*O\Axis[2]\y = - (zf)
If uf
uuf = 1.0 / uf
Else
uuf = 0
EndIf
*O\Axis[0]\y = *O\Axis[0]\y * uf
*O\Axis[1]\y = *O\Axis[1]\y * uf
Protected zoom.d = *O\zoom
Protected unzoom.d = 1 / *O\zoom
*O\unzoom = unzoom
*O\InvAxis[0]\x = Cos( - rotation)
*O\InvAxis[0]\y = - Sin( - rotation)
*O\InvAxis[1]\x = Cos( - rotation - #HPI) * uuf
*O\InvAxis[1]\y = - Sin( - rotation - #HPI) * uuf
*O\InvAxis[2]\x = 0
*O\InvAxis[2]\y = - (zf)
For i = 0 To 2
*O\Axis[i]\x = *O\Axis[i]\x * zoom
*O\Axis[i]\y = *O\Axis[i]\y * zoom
*O\InvAxis[i]\x = *O\InvAxis[i]\x * unzoom
*O\InvAxis[i]\y = *O\InvAxis[i]\y * unzoom
Next
Protected px.f, py.f, pz.f
;TODO: Richtungsvektor Formel geht nicht
; x = Math.cos(alpha) * Math.cos(beta);
; z = Math.sin(alpha) * Math.cos(beta);
; y = Math.sin(beta) ;
; px = Cos(rotation ) * Cos(inclination) ; Richtungsvektor
; py = Sin(rotation ) * Cos(inclination)
; pz = Sin(inclination)
px = Cos(rotation + #hpi) * Sin(inclination) ;TODO:Richtungsvektor
py = Sin(rotation + #hpi) * Sin(inclination)
pz = Cos(inclination)
*O\Pick\x = - px
*O\Pick\y = - py
*O\Pick\z = - pz
*O\Far\x = *O\x + (*O\Pick\x * *O\dist_far) ; Entfernter Punkt (weit vor der "Kamera")
*O\Far\y = *O\y + (*O\Pick\y * *O\dist_far)
*O\Far\z = *O\z + (*O\Pick\z * *O\dist_far)
*O\near\x = *O\x + (*O\Pick\x * *O\dist_near) ; "Naher" Punkt (weit hinter der "Kamera")
*O\near\y = *O\y + (*O\Pick\y * *O\dist_near)
*O\near\z = *O\z + (*O\Pick\z * *O\dist_near)
ProcedureReturn
EndProcedure
Procedure Ortho_Zoom(*O.OrthoCamera, zoom.f)
If zoom <= #MIN_ZOOM
zoom = #MIN_ZOOM
ElseIf zoom >= #MAX_ZOOM
zoom = #MAX_ZOOM
EndIf
*O\zoom = zoom
*O\unzoom = 1.0000 / zoom
Ortho_UpdateAxis(*O, *O\rotation, *O\inclination)
EndProcedure
; change position (focus)
Procedure Ortho_Move(*O.OrthoCamera, x.f, y.f, z.f, bRelative = #False)
If bRelative
*O\x = *O\x + x
*O\y = *O\y + y
*O\z = *O\z + z
Else
*O\x = x
*O\y = y
*O\z = z
EndIf
EndProcedure
; create camera object
Procedure Ortho_NewCamera(width, height, x.f, y.f, z.f, rotation.f, inclination.f, Zoom.f = 8.0, Dist.f = 255.0)
Protected *NEW.OrthoCamera
Protected zz.d
zz = zoom
*new = AllocateMemory(SizeOf(OrthoCamera))
*NEW\rotation = rotation * #ToRadian
*NEW\inclination = inclination * #ToRadian
*NEW\x = x
*NEW\y = y
*NEW\z = z
*NEW\Width = width
*NEW\Height = height
*New\midx = width / 2
*new\midy = height / 2
If zz <= 0.0125
zz = 0.0125
EndIf
If zz > #MAX_ZOOM
zz = #MAX_ZOOM
ElseIf z < #MIN_ZOOM
zz = #MIN_ZOOM
EndIf
*new\zoom = zz
*new\unzoom = 1.0 / zz
*new\Scale\x = 1.0
*new\Scale\y = 1.0
*new\Scale\z = 1.0
*new\InvScale\x = 1.0
*new\InvScale\y = 1.0
*new\InvScale\z = 1.0
*new\dist_far = 1000
*new\dist_near = -1000
Ortho_UpdateAxis(*NEW, *NEW\rotation, *NEW\inclination)
ProcedureReturn *NEW
EndProcedure
; Ortho Camera 2D drawing helpers
; LineXYZ
Procedure Ortho_DrawLineXYZ(*O.OrthoCamera, x1.f, y1.f, z1.f, x2.f, y2.f, z2.f, color)
Protected p1.point2f, p2.point2f
Ortho_CameraToScreen(*O, x1, y1, z1, @p1)
Ortho_CameraToScreen(*O, x2, y2, z2, @p2)
LineXY(p1\x, p1\y, p2\x, p2\y, color)
EndProcedure
; Draw primitives
Procedure Ortho_DrawCube(*C.OrthoCamera, x.f, y.f, z.f, size.f, color)
Protected p2.point2f
; top
Ortho_DrawLineXYZ(*C, x, y, z, x + size, y, z, color)
Ortho_DrawLineXYZ(*C, x + size, y, z, x + size, y + size, z, color)
Ortho_DrawLineXYZ(*C, x + size, y + size, z, x, y + size, z, color)
Ortho_DrawLineXYZ(*C, x, y, z, x, y + size, z, color)
; Ortho_CameraToScreen(*C,x+(size*0.5),y+(size*0.5),z,@p2)
;FillArea(p2\x,p2\y,color)
; bottom
Ortho_DrawLineXYZ(*C, x, y, z + size, x + size, y, z + size, color)
Ortho_DrawLineXYZ(*C, x + size, y, z + size, x + size, y + size, z + size, color)
Ortho_DrawLineXYZ(*C, x + size, y + size, z + size, x, y + size, z + size, color)
Ortho_DrawLineXYZ(*C, x, y, z + size, x, y + size, z + size, color)
; sides
;tl,tr,bl,br
Ortho_DrawLineXYZ(*C, x, y, z, x, y, z + size, color)
Ortho_DrawLineXYZ(*C, x + size, y, z, x + size, y, z + size, color)
Ortho_DrawLineXYZ(*C, x + size, y + size, z, x + size, y + size, z + size, color)
Ortho_DrawLineXYZ(*C, x, y + size, z, x, y + size, z + size, color)
EndProcedure
; Place text at 3D position
Procedure Ortho_DrawText(*O.OrthoCamera, wx.f, wy.f, wz.f, Text$, color)
Protected p1.point2f
Ortho_CameraToScreen(*O, wx, wy, wz, @p1)
DrawText(p1\x, p1\y, Text$, color)
EndProcedure
; "Editor" Methods, "World"
Structure EditorObject
type.i
size.f
color.l
radius.f
pos.point3f
worldMM.point3f[2]
EndStructure
Define ObjVisible, ObjInvisible
Define ObjBox, ObjMesh
Define.f offsetx, offsety, offsetz , deg, incl
NewList EdObj.EditorObject()
Procedure UpdObjRadius(*Obj.EditorObject)
Protected ax.f, ay.f, az.f, rx.f
If Abs(*Obj\worldMM[0]\x) > Abs(*OBJ\worldMM[1]\x)
ax = Abs(*Obj\worldMM[0]\x)
Else
ax = Abs(*Obj\worldMM[1]\x)
EndIf
If Abs(*Obj\worldMM[0]\y) > Abs(*OBJ\worldMM[1]\y)
ay = Abs(*Obj\worldMM[0]\y)
Else
ay = Abs(*Obj\worldMM[1]\y)
EndIf
If Abs(*Obj\worldMM[0]\z) > *OBJ\worldMM[1]\z
az = Abs(*Obj\worldMM[0]\z)
Else
az = Abs(*Obj\worldMM[1]\z)
EndIf
If ax > ay
rx = ax
Else
rx = ay
EndIf
If az > rx
rx = az
EndIf
*Obj\radius = rx
EndProcedure
Procedure AddObject(type, x.f, y.f, z.f, size.f, color)
Shared EdObj()
Shared ObjBox, ObjMesh
LastElement(EdObj())
AddElement(EdObj())
EdObj()\type = type
EdObj()\pos\x = x
EdObj()\pos\y = y
EdObj()\pos\z = z
EdObj()\color = color
EdObj()\size = size
If type > 1000 Or type < -1000
ObjMesh + 1
; MeshBuff_MinMax(type, @EdObj()\worldMM)
Protected i
For i = 0 To 1
With EdObj()\worldMM[i]
\x = \x + x
\y = \y + y
\z = \z + z
EndWith
Next
;Debug "ADDED MESHBUFF "+x+" "+y+" "+z
Else
ObjBox + 1
With EdObj()\worldMM[0]
\x = x
\y = y
\z = z
EndWith
With EdObj()\worldMM[1]
\x = x + size
\y = y + size
\z = z + size
EndWith
;Debug "ADDED CUBE "+x+" "+y+" "+z
EndIf
UpdObjRadius(@EdObj())
EndProcedure
Procedure ClearObjects()
Shared EdObj()
Shared ObjBox, ObjMesh
ObjMesh = 0
ObjBox = 0
ClearList(EdObj())
EndProcedure
; "MakeMap"
Procedure MakeMap(Text$, Array Color.l(1), size.f = 16)
Protected x, y, w, h, z, c, hw, hh
CreateImage(1, 256, 64)
StartDrawing(ImageOutput(1))
; DrawingFont(FontID(1))
DrawText(0, 0, Text$)
w = TextWidth(Text$)
h = TextHeight(Text$)
c = ArraySize(Color())
hw = w / 2
hh = h / 2
For z = 0 To c - 1 Step 1
For y = 0 To h - 1 Step 1
For x = 0 To w - 1 Step 1
If Point(x, y)
AddObject(1, (x - hw) * size, (y - hh) * size, z * size, size, Color(z))
EndIf
Next
Next
Next
StopDrawing()
FreeImage(1)
EndProcedure
Procedure MakeImageMap(File$, size.f = 16, r_x = 0, r_y = 0)
Protected x, y, w, h, z, c, hw, hh, pixel_color
If LoadImage(1, File$)
StartDrawing(ImageOutput(1))
w = ImageWidth(1)
h = ImageHeight(1)
c = Abs(size)
hw = (w / 2) - r_x
hh = (h / 2) - r_y
For y = 0 To h - 1 Step 1
For x = 0 To w - 1 Step 1
pixel_color = Point(x, y)
If pixel_color
For z = 0 To c - 1 Step 1
AddObject(1, (x - hw) * size, (y - hh) * size, z * size, size, pixel_color)
Next
EndIf
Next
Next
StopDrawing()
FreeImage(1)
Else
Debug "ERROR: could not load image:"
Debug File$
EndIf
EndProcedure
; "World"
Procedure ObjectVisible(*O.OrthoCamera, *X.EditorObject)
Protected p2.point2f
Protected radius = *X\radius * *O\unzoom
Ortho_CameraToScreen(*O, *X\pos\x, *X\pos\y, *X\pos\z, @p2)
If p2\x + radius <= 0
ElseIf p2\y + radius <= 0
ElseIf p2\x - radius >= *O\Width
ElseIf p2\y - radius >= *O\Height
Else
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
; Draw all
Procedure DrawObjects(*O.OrthoCamera)
Shared EdObj()
Shared ObjVisible, ObjInvisible
Shared ObjBox, ObjMesh
Protected *X.EditorObject
Static last_inclination.f
Protected inclination.f = (*O\inclination * #ToDeg) + 90
If inclination > 180 : inclination - 360 : EndIf
If last_inclination < 0 And inclination >= 0
Debug "sort asc"
SortStructuredList(EdObj(), #PB_Sort_Ascending, OffsetOf(EditorObject\pos) + 8, #PB_Float)
ElseIf last_inclination > 0 And inclination < 0
Debug "sort desc"
SortStructuredList(EdObj(), #PB_Sort_Descending, OffsetOf(EditorObject\pos) + 8, #PB_Float)
EndIf
last_inclination = inclination
ObjVisible = 0
ObjInvisible = 0
ForEach EdObj()
*X = @EdObj()
If ObjectVisible(*O, *X)
If *X\type = 1
;Debug "draw cube"
Ortho_DrawCube(*O, *X\pos\x, *X\pos\y, *X\pos\z, *X\size, *X\color)
;Ortho_DrawBox2(*O, *X\worldMM[0]\x,*X\worldMM[0]\y,*X\worldMM[0]\z,*X\worldMM[1]\x,*X\worldMM[1]\y,*X\worldMM[1]\z,$8f8f8f)
ElseIf *X\type > 10
;Debug "draw mesh "+*X\type
; Draw_MeshBuff(*O, *X\type, *X\pos\x, *X\pos\y, *X\pos\z, *X\color, *X\size)
;Ortho_DrawBox2(*O, *X\worldMM[0]\x,*X\worldMM[0]\y,*X\worldMM[0]\z,*X\worldMM[1]\x,*X\worldMM[1]\y,*X\worldMM[1]\z,$8f8f8f)
EndIf
ObjVisible + 1
Else
ObjInvisible + 1
EndIf
Next
EndProcedure
; Draw UI
Procedure DrawOnOff(x, y, text$, bValue, color = $FFFFFF)
Protected txtlen = DrawText(x, y, text$, color)
If bValue
DrawText(x + txtlen, y, "ON", $00FF00)
Else
DrawText(x + txtlen, y, "OFF", $0000FF)
EndIf
EndProcedure
; Main
Procedure Main()
; Open window, create canvas gadget
OpenWindow(1, 0, 0, 800 , 600, "Ortho Mini", #PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered | #PB_Window_Maximize)
CanvasGadget(1, 0, 0, WindowWidth(1), WindowHeight(1), #PB_Canvas_Keyboard)
SetActiveGadget(1) ; needs to be done to capture keyboard inputs at program start
Protected event
Protected ms, zoom.f = 1
Protected rotation.f = 0
Protected inclination.f = 17.5
Protected val, auto_rotation = 1, auto_inclination = 1, show_axis = 0
Protected p3.point3f
Protected Dim DefColors.l(16) ; Colors for PureBasic Text
DefColors(0) = $0F0F0F
DefColors(1) = $040404
DefColors(2) = $010101
DefColors(3) = $000012
DefColors(4) = $000123
DefColors(5) = $001234
DefColors(6) = $012345
DefColors(7) = $123456
DefColors(8) = $234567
DefColors(9) = $345678
DefColors($A) = $456789
DefColors($B) = $56789A
DefColors($C) = $6789AB
DefColors($D) = $789ABC
DefColors($E) = $89ABCD
DefColors($F) = $0ABCDE
Protected *C.OrthoCamera = Ortho_NewCamera(GadgetWidth(1), GadgetHeight(1), 0, 180, 0, rotation, inclination, 8) ; create camera
Ortho_Zoom(*C, zoom) ; something does not work if not called
; Create "map/world"
UsePNGImageDecoder() ; needed to display image
MakeImageMap(#PB_Compiler_Home + "examples/sources/Data/ToolBar/Save.png", 4, 0, -40)
MakeMap("PureBasic", DefColors(), 6)
; Main Event Loop
Repeat
event = WindowEvent()
If ElapsedMilliseconds() - ms >= 1000 / 30 ; Redraw
Ortho_UpdateAxis(*C, rotation * #ToRadian, inclination * #ToRadian)
StartDrawing(CanvasOutput(1))
Box(0, 0, OutputWidth(), OutputHeight(), $010101)
DrawingMode(1)
DrawObjects(*C)
If show_axis
; Draw X/Y/Z axes with legend
Ortho_DrawLineXYZ(*C, 0, 0, 0, 8000, 0, 0, $FF) ; Red = X
Ortho_DrawLineXYZ(*C, 0, 0, 0, -8000, 0, 0, $AA); -X
Ortho_DrawText(*C, 8000, 0, 0, "+X", $FF)
Ortho_DrawText(*C, -8000, 0, 0, "-X", $AA)
Ortho_DrawLineXYZ(*C, 0, 0, 0, 0, 8000, 0, $FF0000) ; Blue = Y
Ortho_DrawLineXYZ(*C, 0, 0, 0, 0, -8000, 0, $AA0000); -Y
Ortho_DrawText(*C, 0, 8000, 0, "+Y", $FF0000)
Ortho_DrawText(*C, 0, -8000, 0, "-Y", $AA0000)
Ortho_DrawLineXYZ(*C, 0, 0, 0, 0, 0, 8000, $FF00) ; Green = Z
Ortho_DrawLineXYZ(*C, 0, 0, 0, 0, 0, -8000, $AA00); -Z
Ortho_DrawText(*C, 0, 0, 8000, "+Z", $FF00)
Ortho_DrawText(*C, 0, 0, -8000, "-Z", $AA00)
; Focus circle
Circle(*C\midx, *C\midy, 4, ElapsedMilliseconds() % 256)
Ortho_DrawText(*C, *C\x, *C\y, *C\z, " Focus [" + Str(*C\x) + " " + Str(*C\y) + " " + Str(*C\z) + "]", $AAAAAA)
Ortho_DrawLineXYZ(*C, *C\x, *C\y, *C\z, *C\Far\x, *C\Far\y, *C\Far\z, $FFFF) ; Far
Ortho_DrawText(*C, *C\Far\x, *C\Far\y, *C\Far\z, " Far [" + Str(*C\Far\x) + " " + Str(*C\Far\y) + " " + Str(*C\Far\z) + "]", $FFFF)
Ortho_DrawLineXYZ(*C, *C\x, *C\y, *C\z, *C\Near\x, *C\Near\y, *C\Near\z, $AAAA) ; Near
Ortho_DrawText(*C, *C\Near\x, *C\Near\y, *C\Near\z, " Near [" + Str(*C\Near\x) + " " + Str(*C\Near\y) + " " + Str(*C\Near\z) + "]", $AAAA)
DrawText(0, 0, "Rotation: " + StrF(rotation, 1) + "° -- Inclination: " + StrF(inclination, 1) + "°")
If Zoom > 1
DrawText(GadgetWidth(1) * 0.5, 0, "Zoom: " + Str(zoom) + "x")
Else
DrawText(GadgetWidth(1) * 0.5, 0, "Zoom: 1:" + Str(1 / zoom))
EndIf
Else
DrawText(0, 0, "Press [P] or [F1]")
EndIf
StopDrawing()
ms = ElapsedMilliseconds()
; check for auto rotation/inclination ... "screenblanker effect"
If auto_rotation
rotation + 1
EndIf
While rotation >= 180
rotation - 360
Wend
While rotation < -180
rotation + 360
Wend
If auto_inclination
inclination + 1.77
EndIf
While inclination >=180
inclination - 360
Wend
While inclination <-180
inclination + 360
Wend
EndIf
Select event
Case 0
Delay(10)
Case #PB_Event_SizeWindow, #PB_Event_MaximizeWindow ; resize window
ResizeGadget(1, 0, 0, WindowWidth(1), WindowHeight(1))
*C\Width = GadgetWidth(1) : *C\midx = *C\Width * 0.5
*C\Height = GadgetHeight(1) : *C\midy = *C\Height * 0.5
Case #PB_Event_Gadget
Select EventType()
; Hot keys ------------------------------------------------------------------------------
Case #PB_EventType_KeyDown
Select GetGadgetAttribute(1, #PB_Canvas_Key)
Case #PB_Shortcut_F1
MessageRequester("F1 - Help", "WASD - Move focus"+#CR$+
"Mouse click - Move focus"+#CR$+
"Mouse wheel - Zoom"+#CR$+#CR$+
"R - auto rotation"+#CR$+
"I - auto inclination"+#CR$+
"C - rotate/incline with mouse"+#CR$+
"P - print axis, show info "+#CR$+
"F1 - this help"+#CR$,#PB_MessageRequester_Info)
Case #PB_Shortcut_Escape ; Escape = Quit
Break
Case #PB_Shortcut_C ; C = change inclination & rotation
inclination = - 180 + (360 * (GetGadgetAttribute(1, #PB_Canvas_MouseY) / GadgetHeight(1)))
rotation = - 180 + (360 * (GetGadgetAttribute(1, #PB_Canvas_MouseX) / GadgetWidth(1)))
Case #PB_Shortcut_W ; WASD = move focus; UP
Ortho_CameraToWorld(*C, *C\midx, *C\midy - 16, @p3)
*C\x = p3\x : *C\y = p3\y : *C\z = p3\z
Case #PB_Shortcut_A ; left
Ortho_CameraToWorld(*C, *C\midx - 16, *C\midy, @p3)
*C\x = p3\x : *C\y = p3\y : *C\z = p3\z
Case #PB_Shortcut_S ; right
Ortho_CameraToWorld(*C, *C\midx, *C\midy + 16, @p3)
*C\x = p3\x : *C\y = p3\y : *C\z = p3\z
Case #PB_Shortcut_D ; down
Ortho_CameraToWorld(*C, *C\midx + 16, *C\midy, @p3)
*C\x = p3\x : *C\y = p3\y : *C\z = p3\z
Case #PB_Shortcut_R ; auto rotation on/off
auto_rotation ! 1
Case #PB_Shortcut_I
auto_inclination ! 1
Case #PB_Shortcut_P
show_axis ! 1
EndSelect
; Hot keys end -------------------
; Mouse ........................
Case #PB_EventType_LeftClick ; left click = change focus
Ortho_CameraToWorld(*C, GetGadgetAttribute(1, #PB_Canvas_MouseX), GetGadgetAttribute(1, #PB_Canvas_MouseY), @p3)
Ortho_Move(*C, p3\x, p3\y, p3\z)
Case #PB_EventType_MouseWheel ; mouse wheel = zoom
val = GetGadgetAttribute(1, #PB_Canvas_WheelDelta)
If val > 0
zoom * 2
If zoom > #MAX_ZOOM
zoom = #MAX_ZOOM
EndIf
ElseIf val < 0
zoom * 0.5
If zoom < #MIN_ZOOM
zoom = #MIN_ZOOM
EndIf
EndIf
Ortho_Zoom(*C, zoom)
; Mouse end ..................
EndSelect
Default
; Debug "event:"+Event
EndSelect
Until event = #PB_Event_CloseWindow
CloseWindow(1) ; Program end
End
EndProcedure
Main()