Slowing down a little bit...
...as sorting the surfaces order needs a reliable calculation of their distances. So the procedure
has been done to check if objects need to be investigated in more detail. But there are two puzzles to be solved then:
1. an anchor point within the overlapping part of the two objects (done in the 2D representation)
2. original points (3D) on the two overlapping objects close to this anchor point
The anchor point was done by chosing the center of the overlapping coordinates (\x=(Max(*mx\Min,\MaximaX\Min)+Min(*mx\Max,\MaximaX\Max))/2, \y=...) which could be outside an object in certain cases. Now a new
Code: Select all
; Define
; Version 0.6a - Michael Vogel
; --- DEBUGGING ONLY ---
Global c1von,c1bis,c2von,c2bis
Global sort1.s,sort2.s
Global mem1,mem2
Global pointinfo.s
; --- DEBUGGING ONLY ---
EnableExplicit
#WX=1200
#WY=850
#Iterationn=20
#ZoomScale=0.05
#ZweiPi=#PI+#PI
#PiHalbe=#PI/2
#PiTeil=#PI/36
#PiRadiant=#PI/180
#PiGrad=180/#PI
#MarkerCiphers=1
#MarkerLength=4
#MarkerWidth=45*#PI/180
#MaxInteger= 1<<31-1
#ColorPaper= $FFFFFFFF
#ColorFront= $C0E0E0F0
#ColorWood= $E05090B0
#ColorDistance= $f0004020
#MinCoordinate=-#MaxInteger
#MaxCoordinate= #MaxInteger
#Debug=1
; ------------------------------------------------------------------------------------
Structure MaximaType
Min.i
Max.i
EndStructure
Structure DotType
x.d; skaliert
y.d; skaliert
z.d; skaliert
_x.i; 2D-Transformation
_y.i; 2D-Transformation
;_rb.i; 3D-Punkt-Distanz (rot/blau)
_distance.q; Z-Distanz zum Betrachter
type.i; zum Debuggen etc.
EndStructure
Structure ObjectType
Type.i; Punkt, Linie, Oberfläche (3 oder 4 Punkte)
Dot.i[4]; Punktkoordinaten
MaximaX.MaximaType
MaximaY.MaximaType
MaximaZ.MaximaType
Color.i; Flächenfarbe
Outline.i; Linienfarbe
Centre.i; Flächenmittelpunkt
Visible.i; sichtbares Segment
Info.s; Marker
EndStructure
Structure SorterType
Object.i
Distance.q
Reverse.i
EndStructure
Structure Mat
x.d[4]
y.d[4]
z.d[4]
t.d[4]
EndStructure
Structure IntersectionType
ObjectA.i
ObjectB.i
; Mittelpunkt der Schnittfläche
x.i
y.i
; Eckpunkte der Schnittfläche
CompilerIf #Debug
x1.i
y1.i
x2.i
y2.i
info.s
pinfo.s
CompilerEndIf
; Reihenfolge
AoverB.i
EndStructure
Structure SettingType
ShowOutline.i
ShowSurface.i
ShowPoints.i
ShowHidden.i
ShowInformation.i
ShowDebugInformation.i
ShowObjectInformation.i
ShowIntersectionInformation.i
ShowMarker.i
ModeCalculation.i
ModeRotation.i
ModeFill.i
ModeLine.i
Optimizer.i
ZoomFactor.i
ShowThreeD.i; 3D-Darstellung
ThreeD_Distance.i; Punktabstand für 3D-Effekt; - - -
ThreeD_Left.i; Farbfilter für das linke Auge (rot) - - -
ThreeD_Right.i; ...rechtes Auge (grün, blau) - - -
EndStructure
; ------------------------------------------------------------------------------------
Global MaxElements= 25000
Global.Mat Matrix, Calc, RotXMat, RotYMat, RotZMat, Camera, TempMat
Global Dim Dot.DotType(MaxElements); Dot(0) wird für den Offset verwendet
Global Dim Object.ObjectType(MaxElements)
Global Dim Sorter.SorterType(MaxElements)
Global Dim Intersection.IntersectionType(MaxElements)
; Bildschirmgröße für Graphikfenster
Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)
Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)
Global Screen_X=ScreenX-1
Global Screen_Y=ScreenY-1
Global ScreenZ
Global OffsetX=#WX>>1;ScreenX>>1
Global OffsetY=#WY>>1;ScreenY>>1
; Skalierung für 3D-Transformation
Global.d ViewX, ViewY, ViewZ
Global.d AngleX, AngleY, AngleZ; Rotationswinkel (per Maus auswählbar)
Global.d XdivPi=#PI/OffsetX; Skalierung, um genau eine Drehung nach 'X' zu erlauben
Global.d YdivPi=#PI/OffsetY; Skalierung, um genau eine Drehung nach 'Y' zu erlauben
Global.d RealZoomFactor; skalierte Vergrößerung
Global CounterDots, CounterObjects, CounterIntersections
Global OptCamera; =OptCameraZ
Global OptCameraX, OptCameraY
Global Setting.SettingType
; ------------------------------------------------------------------------------------
OptCamera= 500
With Setting
\ShowInformation=1
\ShowSurface= 1
\ShowOutline= 0
\ShowMarker= 1
\ZoomFactor= 25
\ModeRotation= 1
\ModeFill= 1
\Optimizer= 1
EndWith
; ------------------------------------------------------------------------------------
Enumeration
#Win
#Canvas
;
#MoveLeft
#MoveRight
#MoveUp
#MoveDown
#ShiftLeft
#ShiftRight
#ShiftUp
#ShiftDown
#RotateLeft
#RotateRight
#RotateUp
#RotateDown
#PerspectiveMinus
#PerspectivePlus
#ZoomMinus
#ZoomPlus
#ResetView
#CalculationMode
#ToggleRotation
#ToggleLine
#ToggleMarker
#ToggleFill
#ToggleHidden
#ToggleIntersection
#ToggleOutline
#ToggleSurface
#TogglePoints
#ToggleInformation
#ToggleDebugInformation
#ToggleObjectInformation
EndEnumeration
Enumeration
#DotTypeDefault
#DotTypeCentreLine
#DotTypeCentreTriangle
#DotTypeCentreRectangle
EndEnumeration
Enumeration
#ObjectTypeDot
#ObjectTypeLine
#ObjectTypeMarker
#ObjectTypeTriangle
#ObjectTypeRectangle
EndEnumeration
Enumeration
#CalculationModeIntersection
#CalculationModeCenter
#CalculationModeFirstPoint
#CalculationModeLastPoint
EndEnumeration
Global Dim ObjectDots(#ObjectTypeRectangle)
ObjectDots(#ObjectTypeDot)=1
ObjectDots(#ObjectTypeLine)=2
ObjectDots(#ObjectTypeMarker)=2
ObjectDots(#ObjectTypeTriangle)=3
ObjectDots(#ObjectTypeRectangle)=4
; ------------------------------------------------------------------------------------
Declare.i InsidePolygon(x,y,object)
Declare RecalcDot(i)
; ------------------------------------------------------------------------------------
Macro StrM(value)
RSet(StrD(value,2),8)
EndMacro
Macro AddLine(p1,p2,outline)
CreateObject(#ObjectTypeLine,p1,p2,#Null,#Null,#Null,outline)
EndMacro
Macro AddTriangle(p1,p2,p3,color,outline)
CreateObject(#ObjectTypeTriangle,p1,p2,p3,#Null,color,outline)
EndMacro
Macro AddRectangle(p1,p2,p3,p4,color,outline)
CreateObject(#ObjectTypeRectangle,p1,p2,p3,p4,color,outline)
EndMacro
Macro AddPathRectangle(x1,y1,x2,y2)
AddPathBox(x1,y1,(x2)-(x1),(y2)-(y1))
EndMacro
; ------------------------------------------------------------------------------------
Procedure.i Max(a,b)
If a>b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure.i Min(a,b)
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure.s StrDot(l)
Protected s.s=Str(l)
Protected i.i=Len(s)
While i>3
i-3
;s=Left(s,i)+"."+StringMid(@s,i,#MaxString)
s=InsertString(s,".",i+1)
Wend
ProcedureReturn s
EndProcedure
Procedure.s IfStr(bool,yes.s,no.s)
If bool
ProcedureReturn yes
Else
ProcedureReturn no
EndIf
EndProcedure
Procedure.s DotInfo(object,dotnr)
ProcedureReturn "#"+RSet(Str(Object(object)\Dot[dotnr]),2)+": "+StrDot(Dot(Object(object)\Dot[dotnr])\_x)+"|"+StrDot(Dot(Object(object)\Dot[dotnr])\_y)+", "+StrDot(Dot(Object(object)\Dot[dotnr])\_distance)
EndProcedure
Macro Bit(value,bit)
((value)>>(bit-1)&1)
EndMacro
; ------------------------------------------------------------------------------------
; EndDefine
Procedure.s GetObjectType(type)
ProcedureReturn StringField("Dot.Line.Marker.Triangle.Rectangle.-.-.-.-",type+1,".")
EndProcedure
Procedure.s GetObjectInfo(object,verbose=#Null)
Protected.i i
Protected.s s
With Object(object)
For i=0 To 3
s+", "+Str(\Dot[i])
Next i
s=GetObjectType(\Type)+" object. Dots: "+Mid(s,3)
If verbose
s="#"+Str(object)+": "+s
EndIf
EndWith
;s=s+#CR$+"*"
ProcedureReturn s
EndProcedure
Procedure GetViewDistance(dot)
With Dot(dot)
ProcedureReturn Sqr(Pow(ViewX-OptCameraX+\x,2)+Pow(ViewY-OptCameraY+\y,2)+Pow(ViewZ-OptCamera+\z,2))
ProcedureReturn Sqr(Pow(ViewX-\x,2)+Pow(ViewY-\y,2)+Pow(ViewZ-\z,2))
ProcedureReturn Sqr(Pow(OptCameraX-\x,2)+Pow(OptCameraY-\y,2)+Pow(OptCamera-\z,2))
EndWith
EndProcedure
Procedure.d GetDotDistance(a,b)
ProcedureReturn Sqr(Pow(Dot(a)\x-Dot(b)\x,2)+Pow(Dot(a)\y-Dot(b)\y,2)+Pow(Dot(a)\z-Dot(b)\z,2))
EndProcedure
Procedure.i GetXyDistance(x,y,dot)
x-Dot(dot)\_x
y-Dot(dot)\_y
x*x
y*y
ProcedureReturn x+y
EndProcedure
Procedure ShowDot(dot,info.s="")
With Dot(dot)
Debug "."+Str(dot)+": "+Str(\x)+"|"+Str(\y)+"|"+Str(\z)+" ("+Str(\_x)+"|"+Str(\_y)+") - "+StrDot(\_distance)+" '"+info+"'"
EndWith
EndProcedure
Procedure GetPointNearDot(x,y,object)
; Suche Punkt auf bestehendem Objekt, welcher möglichst nahe einem Bildpunkt liegt
Protected.d ax,ay,az
Protected.d bx,by,bz
Protected.d dx,dy,dz
Protected.d ox,oy,oz
Protected i,j,n,m1,m2
Protected best,dist,max
Protected b1,b2
If InsidePolygon(x,y,object)
Debug "--- "+Str(x)+"|"+Str(y)+" in Objekt "+Str(object)+" ---"
;StartDrawing(CanvasOutput(#Canvas)); <->
With Object(object)
If \Type=#ObjectTypeRectangle
; Eckpunkt nahe der Bildschirmkoordinate suchen...
max=#MaxInteger
i=ObjectDots(\Type)
While i
i-1
dist=GetXyDistance(x,y,\Dot[i])
; ShowDot(\Dot[i],StrDot(dist))
If dist<max
max=dist
best=i
EndIf
Wend
; Vektor zum nächsten Eckpunkt vormerken...
b1=(best+1)%ObjectDots(\Type)
b2=(best+ObjectDots(\Type)-1)%ObjectDots(\Type)
;If GetXyDistance(x,y,\Dot[b1])>GetXyDistance(x,y,\Dot[b2])
; Swap b1,b2
;EndIf
n=\Dot[best]
ShowDot(n)
m1=\Dot[b1]
ax=Dot(m1)\x-Dot(n)\x
ay=Dot(m1)\y-Dot(n)\y
az=Dot(m1)\z-Dot(n)\z
m2=\Dot[b2]
bx=Dot(m2)\x-Dot(n)\x
by=Dot(m2)\y-Dot(n)\y
bz=Dot(m2)\z-Dot(n)\z
Debug Str(n)+" ("+Str(Dot(n)\x)+"|"+Str(Dot(n)\y)+"|"+Str(Dot(n)\z)+") To "+Str(m1)+" delta: "+Str(bx)+"|"+Str(by)+"|"+Str(bz)
; Punkte entlang des Vektors berechnen...
max=#MaxInteger
For i=0 To #Iterationn
For j=0 To #Iterationn
Dot(0)\x=Dot(n)\x+ax*i/#Iterationn+bx*j/#Iterationn
Dot(0)\y=Dot(n)\y+ay*i/#Iterationn+by*j/#Iterationn
Dot(0)\z=Dot(n)\z+az*i/#Iterationn+bz*j/#Iterationn
RecalcDot(0)
; ...und bei Annäherung merken...
dist=GetXyDistance(x,y,#Null)
;Box(Dot(0)\_x,Dot(0)\_y,2,2,#Black)
If dist<max
;Debug "Iteration "+Str(i)+"/"+Str(j)+" "+Str(Dot(0)\x)+"|"+Str(Dot(0)\y)+"|"+Str(Dot(0)\z)+" = "+Str(Dot(0)\_x)+"|"+Str(Dot(0)\_y)+" d:"+StrDot(dist)
;Box(Dot(0)\_x,Dot(0)\_y,2,2,#Cyan)
max=dist
m1=i
m2=j
ox=Dot(0)\x
oy=Dot(0)\y
oz=Dot(0)\z
; Debug Str(dx)+" | "+Str(dy)+" | "+Str(dz)+" = "+Str(Dot(0)\_x)+" | "+Str(Dot(0)\_y)
EndIf
Next j
Next i
; das ist nun der beste Punkt
Dot(0)\x=ox
Dot(0)\y=oy
Dot(0)\z=oz
Dot(0)\type=#DotTypeDefault
RecalcDot(#Null)
pointinfo=Str(ox)+"|"+Str(oy)+"|"+Str(oz)+"("+Str(Dot(0)\_x)+","+Str(Dot(0)\_y)+")"
; StartDrawing(CanvasOutput(#Canvas))
; Box(Dot(0)\_x-2,Dot(0)\_y-2,4,4,#Red)
; DrawText(Dot(0)\_x+10,Dot(0)\_y-2,Str(object),#Red,#White)
; StopDrawing(); <->
ShowDot(10)
ProcedureReturn #True
EndIf
EndWith
EndIf
ProcedureReturn #Null
EndProcedure
Procedure GetMedianDistance(x,y,object)
Protected i,dots
Protected.d a,b,total
Protected.d Dim t(4)
With Object(object)
dots=ObjectDots(\Type)-1
For i=0 To dots
a=x-Dot(\Dot[i])\_x
b=y-Dot(\Dot[i])\_y
t(i)=Sqr(a*a+b*b)
total+t(i)
Next i
a=0
For i=0 To dots
t(i)=total/t(i)
a+t(i)
Next i
;Debug a
b=0
For i=0 To dots
b+Dot(\Dot[i])\_distance*t(i)/a
Next i
EndWith
ProcedureReturn b
EndProcedure
Procedure ShowMat(*m.mat,title.s="")
Debug "- "+title+RSet(" ",38-Len(title),"-")
Debug "X"+StrM(*m\x[0])+" |"+StrM(*m\x[1])+" |"+StrM(*m\x[2])+" |"+StrM(*m\x[3])
Debug "Y"+StrM(*m\y[0])+" |"+StrM(*m\y[1])+" |"+StrM(*m\y[2])+" |"+StrM(*m\y[3])
Debug "Z"+StrM(*m\z[0])+" |"+StrM(*m\z[1])+" |"+StrM(*m\z[2])+" |"+StrM(*m\z[3])
Debug "T"+StrM(*m\t[0])+" |"+StrM(*m\t[1])+" |"+StrM(*m\t[2])+" |"+StrM(*m\t[3])
Macro DebugMat
ShowMat(@Camera,"Camera")
ShowMat(@Matrix,"Matrix")
ShowMat(@Calc,"Calc")
EndMacro
EndProcedure
Procedure ShowObjects(verbose)
Protected i
Protected s.s
Protected t.s
While i<CounterObjects
i+1
t+" > "+Str(Sorter(i)\Object)
If verbose
With Object(i)
s="#"+RSet(Str(i),2,"0")+" order "+RSet(Str(Sorter(i)\Reverse),2,"0")+" "+GetObjectType(\Type)+": "+IfStr(\Visible,"visible","hidden")
Debug s
EndWith
EndIf
Wend
Debug " Draw "+Mid(t,4)
EndProcedure
Procedure ShowSorter(s.s="")
Protected i
Debug "--- "+s+"---"
For i=1 To CounterObjects
Debug "#"+Str(i)+": "+Str(Sorter(i)\Object)+", "+Sorter(i)\Reverse
Next i
EndProcedure
Procedure.d GetAngle(x1,y1,x2,y2,up=0)
If x1>x2 And up
ProcedureReturn ATan2(x1-x2,y1-y2)
Else
ProcedureReturn ATan2(x2-x1,y2-y1)
EndIf
;ProcedureReturn ATan((y2-y1)/(x2-x1))
;ProcedureReturn Degree(ATan((y2-y1)/(x2-x1)))
EndProcedure
Macro SorterCopy(source,destination)
; Debug "copy "+Str(source)+" to "+Str(destination)
Sorter(destination)\Distance=Sorter(source)\Distance
Sorter(destination)\Object=Sorter(source)\Object
Sorter(destination)\Reverse=Sorter(source)\Reverse
EndMacro
Procedure MoveBehind(oo,up)
Protected i,poo,pup
poo=Sorter(oo)\Reverse
pup=Sorter(up)\Reverse
If poo<pup
SorterCopy(poo,0)
While poo<pup
SorterCopy(poo+1,poo)
poo+1
Wend
SorterCopy(0,pup)
For i=1 To CounterObjects
Sorter(Sorter(i)\Object)\Reverse=i
Next i
EndIf
EndProcedure
Procedure.i InsidePolygon(x,y,object)
Protected s.s
Protected i,j,c
Protected b1,b2,b3
Protected dx,dy
Protected dots
; int pnpoly(int npol, float *xp, float *yp, float x, float y)
; {
; int i, j, c = 0;
; For (i = 0, j = npol-1; i < npol; j = i++) {
; If ((((yp[i] <= y) && (y < yp[j])) ||
; ((yp[j] <= y) && (y < yp[i]))) &&
; (x < (xp[j] - xp[i]) * (y - yp[i]) / (yp[j] - yp[i]) + xp[i]))
; c = !c;
; }
; Return c;
; }
With Object(object)
dots=ObjectDots(\Type)
While i<dots
s=s+Str(Dot(\Dot[i])\_x)+","+Str(Dot(\Dot[i])\_y)+"; "
j=(i+dots-1)%dots
b1=Bool( (Dot(\Dot[i])\_y <= y) And (y < Dot(\Dot[j])\_y) )
b2=Bool( (Dot(\Dot[j])\_y <= y) And (y < Dot(\Dot[i])\_y) )
If b1 Or b2
dx=(Dot(\Dot[j])\_x-Dot(\Dot[i])\_x)
dy=(Dot(\Dot[j])\_y-Dot(\Dot[i])\_y)
If ( x < dx * (y-Dot(\Dot[i])\_y) / dy + Dot(\Dot[i])\_x)
c!1
EndIf
EndIf
i+1
Wend
EndWith
;Debug s+" --> "+Str(c)
ProcedureReturn c
EndProcedure
Procedure.i IntersectPolygon(a,b)
Protected s.s
Protected i,dots
Protected in
With Object(a)
dots=ObjectDots(\Type)
While i<dots
s=s+Str(Dot(\Dot[i])\_x)+","+Str(Dot(\Dot[i])\_y)+"; "
If InsidePolygon(Dot(\Dot[i])\_x,Dot(\Dot[i])\_y,b)
;Debug "JUHU "+s
ProcedureReturn #True
EndIf
i+1
Wend
EndWith
;Debug s
ProcedureReturn #Null
EndProcedure
Procedure GetIntersectionAnchor(x1,y1,x2,y2,object1,object2,*m.point,draw=#Null)
Protected n,x,y
Protected.q mx,my
#Speedup=1
If draw
VectorSourceColor($a02080f0)
EndIf
For x=x1 To x2 Step #Speedup
For y=y1 To y2 Step #Speedup
If InsidePolygon(x,y,object1)
If InsidePolygon(x,y,object2)
mx+x
my+y
n+1
If draw
AddPathCircle(x,y,1)
FillPath()
EndIf
EndIf
EndIf
Next y
Next x
If n
mx/n
my/n
If draw
AddPathCircle(mx,my,1)
EndIf
If *m
*m\x=mx
*m\y=my
EndIf
ProcedureReturn #True
EndIf
ProcedureReturn #Null
EndProcedure
Procedure CreateIntersection(i,j,*mx.MaximaType,*my.MaximaType)
Protected s.s
Protected n,di,dj
Protected m.Point
With Object(j)
CounterIntersections+1
Intersection(CounterIntersections)\ObjectA=i
Intersection(CounterIntersections)\ObjectB=j
If 0
Intersection(CounterIntersections)\x=(Max(*mx\Min,\MaximaX\Min)+Min(*mx\Max,\MaximaX\Max))/2
Intersection(CounterIntersections)\y=(Max(*my\Min,\MaximaY\Min)+Min(*my\Max,\MaximaY\Max))/2
Else
If GetIntersectionAnchor(Max(*mx\Min,\MaximaX\Min),Max(*my\Min,\MaximaY\Min),Min(*mx\Max,\MaximaX\Max),Min(*my\Max,\MaximaY\Max),i,j,@m)
Intersection(CounterIntersections)\x=m\x
Intersection(CounterIntersections)\y=m\y
Else
Debug "PANIK - keine Überlappung?!"
EndIf
EndIf
CompilerIf #Debug
Intersection(CounterIntersections)\x1=Max(*mx\Min,\MaximaX\Min)
Intersection(CounterIntersections)\y1=Max(*my\Min,\MaximaY\Min)
Intersection(CounterIntersections)\x2=Min(*mx\Max,\MaximaX\Max)
Intersection(CounterIntersections)\y2=Min(*my\Max,\MaximaY\Max)
CompilerEndIf
;Debug GetMedianDistance(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,i)
;Debug GetMedianDistance(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,j)
Intersection(CounterIntersections)\AoverB=Bool(GetMedianDistance(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,i) > GetMedianDistance(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,j))
Protected dx,dy
dx=Intersection(CounterIntersections)\x
dy=Intersection(CounterIntersections)\y
s=Str(j)+IfStr(IntersectPolygon(i,j),"* "," ")+IfStr(Intersection(CounterIntersections)\AoverB,"ok","up")
Debug "> "+s+" X:"+Str(*mx\Min)+"-"+Str(*mx\Max)+" : "+Str(\MaximaX\Min)+"-"+Str(\MaximaX\Max)+" Y:"+Str(*my\Min)+"-"+Str(*my\Max)+" : "+Str(\MaximaY\Min)+"-"+Str(\MaximaY\Max)
; Debug "* ---: "+StrDot(dx)+"|"+StrDot(dy)+", "+StrDot(GetMedianDistance(dx,dy,i))+" > "+StrDot(GetMedianDistance(dx,dy,j))
CompilerIf #Debug
If 0
Debug "a "+DotInfo(i,0)+" - "+DotInfo(j,0)
Debug "b "+DotInfo(i,1)+" - "+DotInfo(j,1)
Debug "c "+DotInfo(i,2)+" - "+DotInfo(j,2)
Debug "d "+DotInfo(i,3)+" - "+DotInfo(j,3)
; Protected n,d
; Protected max1,max2
; ;Protected mem1,mem2
;
; max1=#MaxInteger
; max2=#MaxInteger
; For n=c1von To c1bis
; d=(Dot(n)\_x-dx)*(Dot(n)\_x-dx)+(Dot(n)\_y-dy)*(Dot(n)\_y-dy)
; If d<max1
; max1=d
; mem1=n
; EndIf
; Next n
; For n=c2von To c2bis
; d=(Dot(n)\_x-dx)*(Dot(n)\_x-dx)+(Dot(n)\_y-dy)*(Dot(n)\_y-dy)
; If d<max2
; max2=d
; mem2=n
; EndIf
; Next n
;
; Debug Str(mem1)+" = "+StrDot(Dot(mem1)\_distance)
; Debug Str(mem2)+" = "+StrDot(Dot(mem2)\_distance)
EndIf
Intersection(CounterIntersections)\pinfo="{}"
If GetPointNearDot(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,i)
Intersection(CounterIntersections)\pinfo=Str(i)+":"+Str(j)+" "+pointinfo
di=Dot(0)\_distance
If GetPointNearDot(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,j)
Intersection(CounterIntersections)\pinfo+" * "+pointinfo
dj=Dot(0)\_distance
n=Bool(di>dj)
If n<>Intersection(CounterIntersections)\AoverB
Debug "CHANGE ORDER (to "+IfStr(Intersection(CounterIntersections)\AoverB,"ok","up")+")"
Intersection(CounterIntersections)\AoverB=n
EndIf
EndIf
EndIf
; n=Bool(Dot(mem1)\_distance<Dot(mem2)\_distance)
; If n<>Intersection(CounterIntersections)\AoverB
; Debug "CHANGE ORDER (to "+IfStr(Intersection(CounterIntersections)\AoverB,"ok","up")+")"
; Intersection(CounterIntersections)\AoverB=n
; EndIf
Intersection(CounterIntersections)\info="#"+Str(i)+"/"+s+"|"+StrDot(GetMedianDistance(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,i))+"/"+StrDot(GetMedianDistance(Intersection(CounterIntersections)\x,Intersection(CounterIntersections)\y,j))
CompilerEndIf
If Intersection(CounterIntersections)\AoverB
MoveBehind(Intersection(CounterIntersections)\ObjectA,Intersection(CounterIntersections)\ObjectB)
Else
MoveBehind(Intersection(CounterIntersections)\ObjectB,Intersection(CounterIntersections)\ObjectA)
EndIf
ShowObjects(#Null)
EndWith
EndProcedure
Procedure.i Intersect(*a.MaximaType,*b.MaximaType)
If *a\Min >= *b\Max Or *a\Max <= *b\Min
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.i CalcMaxima()
Protected i,j,c,n
i=0
While i<CounterObjects
i+1
If Object(i)\Visible=#True
With Object(i)
;If \Type=#ObjectTypeRectangle
;Debug GetObjectInfo(i,1)
\MaximaX\Max=#MinCoordinate
\MaximaX\Min=#MaxCoordinate
\MaximaY\Max=#MinCoordinate
\MaximaY\Min=#MaxCoordinate
\MaximaZ\Max=#MinCoordinate
\MaximaZ\Min=#MaxCoordinate
n=ObjectDots(\Type)
While n
n-1
c=Dot(\Dot[n])\_x
If \MaximaX\Min>c : \MaximaX\Min=c : EndIf
If \MaximaX\Max<c : \MaximaX\Max=c : EndIf
c=Dot(\Dot[n])\_y
If \MaximaY\Min>c : \MaximaY\Min=c : EndIf
If \MaximaY\Max<c : \MaximaY\Max=c : EndIf
c=Dot(\Dot[n])\_distance
If \MaximaZ\Min>c : \MaximaZ\Min=c : EndIf
If \MaximaZ\Max<c : \MaximaZ\Max=c : EndIf
Wend
;Debug "X: "+\MaximaX\Min+" ... " +\MaximaX\Max
;Debug "Y: "+\MaximaY\Min+" ... " +\MaximaY\Max
;Debug "Z: "+\MaximaZ\Min+" ... " +\MaximaZ\Max
;EndIf
EndWith
EndIf
Wend
EndProcedure
Procedure.i GetIntersections()
Protected.i i,j,c,n
Protected.MaximaType mx,my,mz
Protected s.s
CounterIntersections=#Null
i=0
While i<CounterObjects
i+1
If Object(i)\Visible=#True And Object(i)\Type=#ObjectTypeRectangle
Debug GetObjectInfo(i,1)
With Object(i)
mx\Min=\MaximaX\Min
mx\Max=\MaximaX\Max
my\Min=\MaximaY\Min
my\Max=\MaximaY\Max
mz\Min=\MaximaZ\Min
mz\Max=\MaximaZ\Max
EndWith
j=i
While j<CounterObjects
j+1
If Object(j)\Visible=#True And Object(j)\Type=#ObjectTypeRectangle
With Object(j)
If 0
If Intersect(\MaximaX,mx)
If Intersect(\MaximaY,my)
If Intersect(\MaximaZ,mz)
CreateIntersection(i,j,mx,my)
EndIf
EndIf
EndIf
Else
; Debug "Check "+Str(i)+" / "+Str(j)+"..."
If IntersectPolygon(i,j) Or IntersectPolygon(j,i); wegen 369,571, 352,359, 337,375, 356,588 und 352,555, 595,635, 595,421, 334,343 bzw. Polygon in Polygon
;If i+j=7
CreateIntersection(i,j,mx,my)
;EndIf
EndIf
EndIf
EndWith
EndIf
Wend
EndIf
Wend
EndProcedure
Procedure.d GetObjectRelation(a,b)
Protected.i i
Protected.s s
Debug "Compare "+Str(a)+" + "+Str(b)
Debug GetObjectInfo(a)
Debug GetObjectInfo(b)
EndProcedure
Procedure SetNorm(*m.mat)
*m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
*m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
*m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetTransformation(*m.mat,x.d,y.d,z.d)
*m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
*m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
*m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
*m\x[3]=x : *m\y[3]=y : *m\z[3]=z : *m\t[3]=1
EndProcedure
Procedure SetCamera(x,y,z.d)
OptCameraX=x
OptCameraY=y
OptCamera=z
Camera\x[0]=1 : Camera\y[0]=0 : Camera\z[0]=0 : Camera\t[0]=0
Camera\x[1]=0 : Camera\y[1]=1 : Camera\z[1]=0 : Camera\t[1]=0
Camera\x[2]=0 : Camera\y[2]=0 : Camera\z[2]=1 : Camera\t[2]=0
Camera\x[3]=x : Camera\y[3]=y : Camera\z[3]=z : Camera\t[3]=1
EndProcedure
Procedure SetScale(*m.mat,x.d,y.d,z.d)
*m\x[0]=x : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
*m\x[1]=0 : *m\y[1]=y : *m\z[1]=0 : *m\t[1]=0
*m\x[2]=0 : *m\y[2]=0 : *m\z[2]=z : *m\t[2]=0
*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotX(*m.mat,angle.d)
Protected s.d=Sin(angle)
Protected c.d=Cos(angle)
*m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
*m\x[1]=0 : *m\y[1]=c : *m\z[1]=s : *m\t[1]=0
*m\x[2]=0 : *m\y[2]=-s : *m\z[2]=c : *m\t[2]=0
*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotY(*m.mat,angle.d)
Protected s.d=Sin(angle)
Protected c.d=Cos(angle)
*m\x[0]=c : *m\y[0]=0 : *m\z[0]=s : *m\t[0]=0
*m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
*m\x[2]=-s : *m\y[2]=0 : *m\z[2]=c : *m\t[2]=0
*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotZ(*m.mat,angle.d)
Protected s.d=Sin(angle)
Protected c.d=Cos(angle)
*m\x[0]=c : *m\y[0]=s : *m\z[0]=0 : *m\t[0]=0
*m\x[1]=-s : *m\y[1]=c : *m\z[1]=0 : *m\t[1]=0
*m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
*m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure Multiply(*m.mat,*n.mat,*result.mat)
TempMat\x[0]=*m\x[0]**n\x[0] + *m\x[1]**n\y[0] + *m\x[2]**n\z[0] + *m\x[3]**n\t[0]
TempMat\y[0]=*m\y[0]**n\x[0] + *m\y[1]**n\y[0] + *m\y[2]**n\z[0] + *m\y[3]**n\t[0]
TempMat\z[0]=*m\z[0]**n\x[0] + *m\z[1]**n\y[0] + *m\z[2]**n\z[0] + *m\z[3]**n\t[0]
TempMat\t[0]=*m\t[0]**n\x[0] + *m\t[1]**n\y[0] + *m\t[2]**n\z[0] + *m\t[3]**n\t[0]
TempMat\x[1]=*m\x[0]**n\x[1] + *m\x[1]**n\y[1] + *m\x[2]**n\z[1] + *m\x[3]**n\t[1]
TempMat\y[1]=*m\y[0]**n\x[1] + *m\y[1]**n\y[1] + *m\y[2]**n\z[1] + *m\y[3]**n\t[1]
TempMat\z[1]=*m\z[0]**n\x[1] + *m\z[1]**n\y[1] + *m\z[2]**n\z[1] + *m\z[3]**n\t[1]
TempMat\t[1]=*m\t[0]**n\x[1] + *m\t[1]**n\y[1] + *m\t[2]**n\z[1] + *m\t[3]**n\t[1]
TempMat\x[2]=*m\x[0]**n\x[2] + *m\x[1]**n\y[2] + *m\x[2]**n\z[2] + *m\x[3]**n\t[2]
TempMat\y[2]=*m\y[0]**n\x[2] + *m\y[1]**n\y[2] + *m\y[2]**n\z[2] + *m\y[3]**n\t[2]
TempMat\z[2]=*m\z[0]**n\x[2] + *m\z[1]**n\y[2] + *m\z[2]**n\z[2] + *m\z[3]**n\t[2]
TempMat\t[2]=*m\t[0]**n\x[2] + *m\t[1]**n\y[2] + *m\t[2]**n\z[2] + *m\t[3]**n\t[2]
TempMat\x[3]=*m\x[0]**n\x[3] + *m\x[1]**n\y[3] + *m\x[2]**n\z[3] + *m\x[3]**n\t[3]
TempMat\y[3]=*m\y[0]**n\x[3] + *m\y[1]**n\y[3] + *m\y[2]**n\z[3] + *m\y[3]**n\t[3]
TempMat\z[3]=*m\z[0]**n\x[3] + *m\z[1]**n\y[3] + *m\z[2]**n\z[3] + *m\z[3]**n\t[3]
TempMat\t[3]=*m\t[0]**n\x[3] + *m\t[1]**n\y[3] + *m\t[2]**n\z[3] + *m\t[3]**n\t[3]
*result\x[0]=TempMat\x[0]
*result\x[1]=TempMat\x[1]
*result\x[2]=TempMat\x[2]
*result\x[3]=TempMat\x[3]
*result\y[0]=TempMat\y[0]
*result\y[1]=TempMat\y[1]
*result\y[2]=TempMat\y[2]
*result\y[3]=TempMat\y[3]
*result\z[0]=TempMat\z[0]
*result\z[1]=TempMat\z[1]
*result\z[2]=TempMat\z[2]
*result\z[3]=TempMat\z[3]
*result\t[0]=TempMat\t[0]
*result\t[1]=TempMat\t[1]
*result\t[2]=TempMat\t[2]
*result\t[3]=TempMat\t[3]
EndProcedure
Procedure MoveObjects(x,y)
Protected i,n
While i<=CounterDots
With Dot(i)
\x+x
\z+y
EndWith
i+1
Wend
EndProcedure
Procedure CreatePoint(x.d,y.d,z.d,type=#DotTypeDefault)
Protected i
If Setting\Optimizer; Punkt in den gespeicherten Punkten suchen...
i=CounterDots
While i
With Dot(i)
If \x=x And \y=y And \z=z
Break
EndIf
EndWith
i-1
Wend
EndIf
If i=0 And CounterDots<MaxElements; neuer Punkt
CounterDots+1
i=CounterDots
EndIf
With Dot(i); Koordinaten setzen
\x=x
\y=y
\z=z
\type=type
EndWith
ProcedureReturn i
EndProcedure
Procedure CreateObject(type,a,b,c,d,color,outline=#Null)
If CounterObjects<MaxElements
CounterObjects+1
With Object(CounterObjects)
\Type=type
\Dot[0]=a
\Dot[1]=b
\Dot[2]=c
\Dot[3]=d
\Color=color
\Outline=outline
Select type
Case #ObjectTypeLine,#ObjectTypeMarker
\Centre=CreatePoint((Dot(a)\x+Dot(b)\x)/2,(Dot(a)\y+Dot(b)\y)/2,(Dot(a)\z+Dot(b)\z)/2,#DotTypeCentreLine)
Case #ObjectTypeTriangle
Debug "TRIANGLE"
;;;\Centre=CreatePoint((Dot(a)\x+Dot(b)\x)/2,(Dot(a)\y+Dot(b)\y)/2,(Dot(a)\z+Dot(b)\z)/2,#TypeCentreTriangle)
Case #ObjectTypeRectangle
;Debug "JAU "+Str(CounterPoints)
\Centre=CreatePoint((Dot(a)\x+Dot(b)\x+Dot(c)\x+Dot(d)\x)/4,(Dot(a)\y+Dot(b)\y+Dot(c)\y+Dot(d)\y)/4,(Dot(a)\z+Dot(b)\z+Dot(c)\z+Dot(d)\z)/4,#DotTypeCentreRectangle)
Case #ObjectTypeDot
\Centre=Dot(a)
EndSelect
EndWith
ProcedureReturn CounterObjects
EndIf
ProcedureReturn #Null
EndProcedure
Procedure CreateLine(ax.d,ay.d,az.d, bx.d,by.d,bz.d,color.i)
Protected o,p1,p2
p1=CreatePoint(ax,ay,az)
p2=CreatePoint(bx,by,bz)
o=AddLine(p1,p2,color)
EndProcedure
Procedure CreateMarker(ax.d,ay.d,az.d, bx.d,by.d,bz.d,color.i)
Protected o,p1,p2
p1=CreatePoint(ax,ay,az)
p2=CreatePoint(bx,by,bz)
o=AddLine(p1,p2,color)
If o
With Object(o)
\Type=#ObjectTypeMarker
\Info=StrD(GetDotDistance(p1,p2),#MarkerCiphers); oder mit *Pow(10,#MarkerCiphers) als Integer speichern)
EndWith
EndIf
EndProcedure
Procedure CreateBox(ax.d,ay.d,az.d, bx.d,by.d,bz.d,color.i,outline.i=#Null,elements=$FFFFF)
Protected p1,p2,p3,p4,p5,p6,p7,p8
Protected x,y
Enumeration
#Null
#ElementSurfaceBottom
#ElementSurfaceFront
#ElementSurfaceLeft
#ElementSurfaceBack
#ElementSurfaceRight
#ElementSurfaceTop
#ElementLineBackBottom
#ElementLineBackRight
#ElementLineBackTop
#ElementLineBackLeft
#ElementLineFrontBottom
#ElementLineFrontRight
#ElementLineFrontTop
#ElementLineFrontLeft
#ElementLineBottomLeft
#ElementLineBottomRight
#ElementLineTopLeft
#ElementLineTopRight
EndEnumeration
bx+ax
by+ay
bz+az
p1=CreatePoint(ax,ay,az)
p2=CreatePoint(bx,ay,az)
p3=CreatePoint(bx,by,az)
p4=CreatePoint(ax,by,az)
p5=CreatePoint(ax,ay,bz)
p6=CreatePoint(bx,ay,bz)
p7=CreatePoint(bx,by,bz)
p8=CreatePoint(ax,by,bz)
; DEBUGGING
If outline
If Bit(elements,#ElementLineBackBottom)
AddLine(p1,p2,outline)
EndIf
If Bit(elements,#ElementLineBackRight)
AddLine(p2,p3,outline)
EndIf
If Bit(elements,#ElementLineBackTop)
AddLine(p3,p4,outline)
EndIf
If Bit(elements,#ElementLineBackLeft)
AddLine(p4,p1,outline)
EndIf
If Bit(elements,#ElementLineFrontBottom)
AddLine(p5,p6,outline)
EndIf
If Bit(elements,#ElementLineFrontRight)
AddLine(p6,p7,outline)
EndIf
If Bit(elements,#ElementLineFrontTop)
AddLine(p7,p8,outline)
EndIf
If Bit(elements,#ElementLineFrontLeft)
AddLine(p8,p5,outline)
EndIf
If Bit(elements,#ElementLineBottomLeft)
AddLine(p1,p5,outline)
EndIf
If Bit(elements,#ElementLineBottomRight)
AddLine(p2,p6,outline)
EndIf
If Bit(elements,#ElementLineTopRight)
AddLine(p3,p7,outline)
EndIf
If Bit(elements,#ElementLineTopLeft)
AddLine(p4,p8,outline)
EndIf
EndIf
#DebugPoints=1;6
If Bit(elements,#ElementSurfaceBack)
AddRectangle(p4,p3,p2,p1,color,outline); Uhrzeigersinn...
EndIf
If Bit(elements,#ElementSurfaceBottom)
AddRectangle(p1,p2,p6,p5,color,outline)
EndIf
If Bit(elements,#ElementSurfaceRight)
If #Debug And CounterObjects=2; 3
AddRectangle(p2,p3,p7,p6,color|$80,outline)
; c1von=CounterDots
; For x=0 To #DebugPoints
; For y=0 To #DebugPoints
; CreatePoint(Dot(p2)\x,Dot(p2)\y+(Dot(p3)\y-Dot(p2)\y)*y/#DebugPoints,Dot(p3)\z+(Dot(p7)\z-Dot(p3)\z)*x/#DebugPoints)
; Next y
; Next x
; c1bis=CounterDots
Else
AddRectangle(p2,p3,p7,p6,color,outline)
EndIf
EndIf
If Bit(elements,#ElementSurfaceTop)
AddRectangle(p3,p4,p8,p7,color,outline)
EndIf
If Bit(elements,#ElementSurfaceLeft)
AddRectangle(p4,p1,p5,p8,color,outline)
EndIf
If Bit(elements,#ElementSurfaceFront)
Debug CounterObjects
If #Debug And CounterObjects=1; 2
AddRectangle(p5,p6,p7,p8,color|$C000,outline)
; c2von=CounterDots
; For x=0 To #DebugPoints
; For y=0 To #DebugPoints
; CreatePoint(Dot(p5)\x+(Dot(p6)\x-Dot(p5)\x)*x/#DebugPoints,Dot(p6)\y+(Dot(p7)\y-Dot(p6)\y)*y/#DebugPoints,Dot(p6)\z)
; Next y
; Next x
; c2bis=CounterDots
Else
AddRectangle(p5,p6,p7,p8,color,outline)
EndIf
EndIf
EndProcedure
Procedure CreatePyramid(ax.d,ay.d,az.d, bx.d,by.d,bz.d, height.d, color.i,outline.i=#Null)
Protected p1,p2,p3,p4,p5
bx+ax
by+ay
bz+az
p1=CreatePoint(ax,ay,az)
p2=CreatePoint(bx,ay,az)
p3=CreatePoint(bx,by,az)
p4=CreatePoint(ax,by,az)
p5=CreatePoint(ax,ay,bz);**** Mittelpunkt verschoben um Höhe
If outline
AddLine(p1,p2,outline)
AddLine(p2,p3,outline)
AddLine(p3,p4,outline)
AddLine(p4,p1,outline)
AddLine(p1,p5,outline)
AddLine(p2,p5,outline)
AddLine(p3,p5,outline)
AddLine(p4,p5,outline)
EndIf
AddRectangle(p4,p3,p2,p1,color,outline); Uhrzeigersinn...
AddTriangle(p1,p2,p5,color,outline)
AddTriangle(p2,p3,p5,color,outline)
AddTriangle(p3,p4,p5,color,outline)
AddTriangle(p4,p1,p5,color,outline)
EndProcedure
Procedure Redraw()
Protected.i i,n,m
Protected.i color
Protected.d x,y,z
Protected.i x0,y0,x1,y1,x2,y2
Protected.s s
Protected.d angle
Protected.i ObjectsShown, ObjectsHidden
Protected FillMode
Protected.d LineMode
StartVectorDrawing(CanvasVectorOutput(#Canvas))
VectorFont(FontID(0))
;VectorSourceColor($C0FFFFFF)
VectorSourceColor(#ColorPaper)
FillVectorOutput()
FillMode=Setting\ModeFill*$FF000000
LineMode=Setting\ModeLine+0.8
; --- Oberflächen ------------------------------------------------------------------------------
If Setting\ShowSurface
While i<CounterObjects
i+1
n=Sorter(i)\Object
With Object(n)
Select \type
Case #ObjectTypeRectangle
If \Visible Or Setting\ShowHidden
ObjectsShown+1
MovePathCursor(Dot(\Dot[0])\_x,Dot(\Dot[0])\_y)
AddPathLine(Dot(\Dot[1])\_x,Dot(\Dot[1])\_y)
AddPathLine(Dot(\Dot[2])\_x,Dot(\Dot[2])\_y)
AddPathLine(Dot(\Dot[3])\_x,Dot(\Dot[3])\_y)
ClosePath()
VectorSourceColor(\Color|FillMode)
FillPath(#PB_Path_Preserve)
VectorSourceColor(\Outline)
StrokePath(LineMode,#PB_Path_RoundCorner)
Else
ObjectsHidden+1
EndIf
Case #ObjectTypeMarker
If Setting\ShowMarker
VectorSourceColor(\Outline)
x1=Dot(\Dot[0])\_x
y1=Dot(\Dot[0])\_y
x2=Dot(\Dot[1])\_x
y2=Dot(\Dot[1])\_y
x0=Dot(\Centre)\_x
y0=Dot(\Centre)\_y
angle=GetAngle(x1,y1,x2,y2,#Null)
MovePathCursor(x1,y1)
AddPathLine(x2,y2)
StrokePath(LineMode,#PB_Path_RoundCorner)
MovePathCursor(x1,y1)
angle+#MarkerWidth
AddPathLine(x1+Cos(angle)*#MarkerLength,y1+Sin(angle)*#MarkerLength)
angle-#MarkerWidth*2
AddPathLine(x1+Cos(angle)*#MarkerLength,y1+Sin(angle)*#MarkerLength)
angle+#MarkerWidth
AddPathLine(x1,y1)
StrokePath(1,#PB_Path_RoundCorner|#PB_Path_Preserve)
FillPath()
MovePathCursor(x2,y2)
angle+#MarkerWidth
AddPathLine(x2-Cos(angle)*#MarkerLength,y2-Sin(angle)*#MarkerLength)
angle-#MarkerWidth*2
AddPathLine(x2-Cos(angle)*#MarkerLength,y2-Sin(angle)*#MarkerLength)
angle+#MarkerWidth
AddPathLine(x2,y2)
StrokePath(1,#PB_Path_RoundCorner|#PB_Path_Preserve)
FillPath()
angle=Degree(GetAngle(x1,y1,x2,y2,#True))
RotateCoordinates(x0,y0,angle)
MovePathCursor(x0-VectorTextWidth(\Info)/2,y0-VectorTextHeight(\Info)/2)
AddPathText(\Info)
VectorSourceColor(#ColorPaper)
StrokePath(5,#PB_Path_RoundCorner|#PB_Path_Preserve)
VectorSourceColor(\Outline)
FillPath()
RotateCoordinates(x0,y0,-angle)
EndIf
EndSelect
EndWith
Wend
EndIf
; --- Lines ------------------------------------------------------------------------------
If Setting\ShowOutline
LineMode=Setting\ModeLine+1
n=0
While n<CounterObjects
n+1
With Object(n)
Select \type
Case #ObjectTypeLine
If \Outline
MovePathCursor(Dot(\Dot[0])\_x,Dot(\Dot[0])\_y)
AddPathLine(Dot(\Dot[1])\_x,Dot(\Dot[1])\_y)
VectorSourceColor(\Outline)
StrokePath(LineMode,#PB_Path_RoundEnd)
EndIf
EndSelect
EndWith
Wend
EndIf
; --- Dot Information ------------------------------------------------------------------------------
If Setting\ShowPoints
x=120
y=20+Setting\ShowInformation*60
z=1
i=0
n=0
While n<CounterDots
n+1
With Dot(n)
If \Type=#DotTypeCentreRectangle Or Setting\ShowDebugInformation=#Null
i+1
color=$A0<<(8*i%3)
VectorSourceColor($FF000000|color)
AddPathCircle(Dot(n)\_x,Dot(n)\_y,3)
FillPath()
MovePathCursor(Dot(n)\_x,Dot(n)\_y)
AddPathLine(x,y)
; If mem1+mem2 And n<>mem1 And n<>mem2
; VectorSourceColor($80000000|color)
; EndIf
StrokePath(1)
; If n=mem1 Or n=mem2
; VectorSourceColor($FF00FFFF)
; AddPathBox(x-z*VectorTextWidth(s),y-VectorTextHeight(s)/2,VectorTextWidth(s),VectorTextHeight(s))
; FillPath()
; VectorSourceColor($FF000000|color)
; EndIf
s=Str(n)+": "+StrF(Dot(n)\_distance,2)
MovePathCursor(x-z*VectorTextWidth(s),y-VectorTextHeight(s)/2)
DrawVectorText(s)
y+14
If y>#WY-30
x=#WX-100
y=20
z=0
EndIf
EndIf
EndWith
Wend
EndIf
; --- Object Information ------------------------------------------------------------------------------
If Setting\ShowObjectInformation
x=240
y=20+Setting\ShowInformation*60
z=1
i=0
n=0
While n<CounterObjects
n+1
With Object(n)
If \Visible And Bool(\Type=#ObjectTypeRectangle Or Setting\ShowDebugInformation=0)
i+1
VectorSourceColor($FF000000+$A0<<(8*i%3))
AddPathCircle(Dot(\Centre)\_x,Dot(\Centre)\_y,3)
FillPath()
If Setting\ShowDebugInformation=0
MovePathCursor(Dot(\Centre)\_x+6,Dot(\Centre)\_y-8)
AddPathText(Str(n))
VectorSourceColor($FFFFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($FF000000+$A0<<(8*i%3))
FillPath()
EndIf
MovePathCursor(Dot(\Centre)\_x,Dot(\Centre)\_y)
AddPathLine(x,y)
StrokePath(1)
s="#"+Str(n)+": "+GetObjectInfo(n)
MovePathCursor(x-z*VectorTextWidth(s),y-VectorTextHeight(s)/2)
DrawVectorText(s)
y+14
If y>#WY-30
x=#WX-250
y=20
z=0
EndIf
EndIf
EndWith
Wend
EndIf
; --- Surface Information ------------------------------------------------------------------------------
If Setting\ShowDebugInformation
i=0
While i<CounterObjects
i+1
With Object(i)
Select \type
Case #ObjectTypeRectangle
If \Visible Or Setting\ShowHidden
s="#"+Str(i)+":"+Str(Dot(\Centre)\_distance)
;s=Str(Distance(\Centre))
MovePathCursor(Dot(\Centre)\_x-VectorTextWidth(s)/2,Dot(\Centre)\_y-VectorTextHeight(s)/2)
AddPathText(s)
VectorSourceColor($FFFFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($FF000000)
FillPath()
EndIf
EndSelect
EndWith
Wend
If Setting\ShowObjectInformation
i=0
While i<CounterIntersections
i+1
With Intersection(i)
VectorSourceColor($FF3030FF)
CompilerIf #Debug
AddPathRectangle(\x1,\y1,\x2,\y2)
StrokePath(2)
x=\x+60+Random(30)
y=\y+Random(50)-25
MovePathCursor(x,y)
AddPathLine(\x,\y)
VectorSourceColor($FFFFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundEnd)
VectorSourceColor($FF000090)
StrokePath(1)
MovePathCursor(x+5,y-5)
AddPathText(\info)
VectorSourceColor($FFFFFFFF)
StrokePath(4,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($FF000090)
FillPath()
CompilerEndIf
AddPathCircle(\x,\y,2)
FillPath()
EndWith
Wend
EndIf
EndIf
; --- Intersection Information ------------------------------------------------------------------------------
If Setting\ShowIntersectionInformation
i=0
While i<CounterIntersections
i+1
With Intersection(i)
x=\x-OffsetX
y=\y-OffsetY
x1=OffsetX+Cos(ATan2(x,y))*450
y1=OffsetY+Sin(ATan2(x,y))*400
MovePathCursor(\x,\y)
AddPathLine(x1,y1)
VectorSourceColor($a0FFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($F00000F0)
StrokePath(1,#PB_Path_RoundCorner)
AddPathBox(\x-1,\y-1,3,3)
VectorSourceColor($FFFFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($FF000000)
FillPath()
AddPathBox(\x1,\y1,\x2-\x1,\y2-\y1)
VectorSourceColor($50FFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($C00000F0)
StrokePath(1,#PB_Path_RoundCorner)
If Intersection(i)\ObjectA=18 Or Intersection(i)\ObjectB=18
GetIntersectionAnchor(\x1,\y1,\x2,\y2,Intersection(i)\ObjectA,Intersection(i)\ObjectB,#Null,#True)
EndIf
MovePathCursor(x1-VectorTextWidth(\pinfo)/2,y1-10)
AddPathText(\pinfo)
VectorSourceColor($a0FFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($F00000F0)
FillPath()
s=StringField(\pinfo,2,"(")
x=Val(s)
s=StringField(s,2,",")
y=Val(s)
If x And y
AddPathBox(x-1,y-1,3,3)
VectorSourceColor($FFFFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($FF00F000)
FillPath()
EndIf
s=StringField(\pinfo,3,"(")
x=Val(s)
s=StringField(s,2,",")
y=Val(s)
If x And y
AddPathBox(x-1,y-1,3,3)
VectorSourceColor($FFFFFFFF)
StrokePath(3,#PB_Path_Preserve|#PB_Path_RoundCorner)
VectorSourceColor($FFF000F0)
FillPath()
EndIf
EndWith
Wend
EndIf
; --- General Information ------------------------------------------------------------------------------
If Setting\ShowInformation
VectorSourceColor($FF000080)
MovePathCursor(20,20)
DrawVectorText("Viewpoint: "+Str(ViewX)+" | "+Str(ViewY)+" | "+Str(ViewZ)+", Angles "+Str(Degree(AngleX))+"° "+Str(Degree(AngleY))+"° "+Str(Degree(AngleZ))+"°, Offset "+Str(Dot(0)\x)+"|"+Str(Dot(0)\z))
MovePathCursor(20,35)
DrawVectorText("Camera: "+Str(OptCameraX)+" | "+Str(OptCameraY)+" | "+Str(OptCamera)+", Mode: "+StringField("Intersections.Center.First.Last :(",Setting\ModeCalculation+1,"."))
MovePathCursor(20,50)
DrawVectorText("Objects: "+Str(ObjectsShown)+" shown, "+Str(ObjectsHidden)+" hidden "+sort1+" >>"+sort2)
EndIf
StopVectorDrawing()
EndProcedure
Procedure RecalcDot(i)
Protected.d Scale
With Dot(i)
ViewX = \x*calc\x[0] + \y*calc\x[1] + \z*calc\x[2] + calc\x[3]
ViewY = \x*calc\y[0] + \y*calc\y[1] + \z*calc\y[2] + calc\y[3]
ViewZ = \x*calc\z[0] + \y*calc\z[1] + \z*calc\z[2] + calc\z[3]
Scale=OptCamera/ViewZ
\_x=ViewX*Scale*RealZoomFactor+OffsetX
\_y=ViewY*Scale*RealZoomFactor+OffsetY
\_distance=Scale*1000000
;\_distance=Int(Scale*10000000)*10000-(Abs(\_x-OffsetX)+Abs(\_y-OffsetY))/100
;\_rb=(Opt3DDistance+OptZoomFactor)/(ViewZ+32)
EndWith
EndProcedure
Procedure Recalc(mode)
Protected i
Multiply(@Camera,@Matrix,@Calc)
DebugMat
RealZoomFactor=Setting\ZoomFactor * #ZoomScale
For i=1 To CounterDots
RecalcDot(i)
Next i
For i=1 To CounterObjects
With Object(i)
Select \Type
Case #ObjectTypeRectangle
\Visible=Bool((Dot(\Dot[3])\_x-Dot(\Dot[0])\_x)*(Dot(\Dot[1])\_y-Dot(\Dot[0])\_y)-(Dot(\Dot[3])\_y-Dot(\Dot[0])\_y)*(Dot(\Dot[1])\_x-Dot(\Dot[0])\_x)>0)
Case #ObjectTypeTriangle
Default
\Visible=#True
EndSelect
EndWith
Next i
CalcMaxima()
For i=1 To CounterObjects
With Sorter(i)
\Object=i
Select Setting\ModeCalculation
Case #CalculationModeIntersection
\Distance=Dot(Object(i)\Centre)\_distance
Case #CalculationModeCenter
\Distance=Dot(Object(i)\Centre)\_distance; Distanz Mittelpunkt
Case #CalculationModeFirstPoint
\Distance=Object(i)\MaximaZ\Min; nähester Punkt
Case #CalculationModeLastPoint
\Distance=Object(i)\MaximaZ\Max; entferntester Punkt
EndSelect
EndWith
Next i
SortStructuredArray(Sorter(),#PB_Sort_Ascending,OffsetOf(SorterType\Distance),TypeOf(SorterType\Distance),1,CounterObjects)
For i=1 To CounterObjects
Sorter(Sorter(i)\Object)\Reverse=i
Next i
sort1=""
For i=1 To CounterObjects
sort1+" "+Str(Sorter(i)\Object)
Next i
; Protected n
; DataSection
; Data.i 1,2,12,9,10,6,3,4,5,7,8,11
; EndDataSection
; For i=1 To 12
; Read.i n
; Sorter(n)\Reverse=i
; Next i
;
; SortStructuredArray(Sorter(),#PB_Sort_Descending,OffsetOf(SorterType\Reverse),TypeOf(SorterType\Distance),1,CounterObjects)
; For i=1 To CounterObjects
; Sorter(Sorter(i)\Object)\Reverse=i
; Next i
;
; With Sorter(9)
; Sorter(0)\Distance=\Distance
; Sorter(0)\Object=\Object
; Sorter(0)\Reverse=\Reverse
; \Distance=Sorter(11)\Distance
; \Object=Sorter(11)\Object
; \Reverse=Sorter(11)\Reverse
; EndWith
; With Sorter(11)
; \Distance=Sorter(0)\Distance
; \Object=Sorter(0)\Object
; \Reverse=Sorter(0)\Reverse
; EndWith
If Setting\ModeCalculation=#CalculationModeIntersection
GetIntersections()
EndIf
sort2=""
For i=1 To CounterObjects
sort2+" "+Str(Sorter(i)\Object)
Next i
;GetObjectRelation(13,14)
;ShowObjects()
If mode
Redraw()
EndIf
EndProcedure
Procedure Rotation()
;Protected.mat test
SetRotX(@RotXMat,AngleY)
SetRotZ(@RotYMat,AngleX)
SetRotY(@RotZMat,AngleZ)
;SetTransformation(@test,0,0,0)
;Multiply(@RotXMat,@test,@RotXMat)
;Multiply(@RotYMat,@test,@RotYMat)
;Multiply(@RotZMat,@test,@RotZMat)
Multiply(@RotXMat,@RotYMat,@Matrix)
Multiply(@Matrix,@RotZMat,@Matrix)
;SetTransformation(@test,50,50,50)
;Multiply(@Matrix,@test,@Matrix)
Recalc(#True)
EndProcedure
Procedure ZoomPlus()
If Setting\ZoomFactor<60
Setting\ZoomFactor+1
Recalc(#True)
ElseIf Setting\ZoomFactor<150
Setting\ZoomFactor+2
Recalc(#True)
ElseIf Setting\ZoomFactor<300
Setting\ZoomFactor+5
Recalc(#True)
EndIf
EndProcedure
Procedure ZoomMinus()
If Setting\ZoomFactor>150
Setting\ZoomFactor-5
Recalc(#True)
ElseIf Setting\ZoomFactor>60
Setting\ZoomFactor-2
Recalc(#True)
ElseIf Setting\ZoomFactor>1
Setting\ZoomFactor-1
Recalc(#True)
EndIf
EndProcedure
Procedure DoObjects(demo)
Protected Surface
Protected Outline
Protected Elements=$FFFFF
Protected Bug
Select demo
Case 0
CreateBox(0,0,0, 100,100,100,$E0f0a060,$80000000)
CreateBox(200,0,0, 100,100,100,$E0f060a0,$80000000)
CreateBox(0,200,0, 100,100,100,$E0c0a0f0,$80000000)
CreateBox(0,0,200, 100,100,100,$E0c0f0a0,$80000000)
Case 1
Bug=%111111
;Bug=%100*1
Outline=$80000000
;Outline=$00000000
Elements=$fffff
;Elements=$32
;Elements=$12
Surface=$C0f0a060
CreateBox(0,0,0, 100,100,100,Surface,Outline,Elements)
If Bit(Bug,1) : CreateBox(0,0,105, 10,100,10,$80a0f060,Outline,Elements) : EndIf
If Bit(Bug,2) : CreateBox(18,0,105, 10,85,10,$80a060f0,Outline,Elements) : EndIf
If Bit(Bug,3) : CreateBox(36,0,105, 10,70,10,$80f0f060,Outline,Elements) : EndIf
If Bit(Bug,4) : CreateBox(54,0,105, 10,55,10,$8060a0f0,Outline,Elements) : EndIf
If Bit(Bug,5) : CreateBox(72,0,105, 10,40,10,$8060f0f0,Outline,Elements) : EndIf
If Bit(Bug,6) : CreateBox(90,0,105, 10,25,10,$80f060a0,Outline,Elements) : EndIf
;CreateBox(120,0,0, 80,100,80,$E0f060a0,Outline,Elements)
;CreateBox(0,0,120, 60,100,60,$E0c0a0f0,Outline,Elements)
;CreateBox(120,0,120, 40,100,40,$E0c0f0a0,Outline,Elements)
;CreateBox(105,0,105, 10,100,10,$10a0f060,Outline,Elements)
CreateMarker(0,0,130, 100,0,130, $FFFF0000)
Case 2
; unten
CreateBox(0,0,0, 62,50,60, #ColorFront,$40000000)
CreateBox(63,0,0, 62,50,60, #ColorFront,$40000000)
CreateBox(126,0,0, 62,50,60, #ColorFront,$40000000)
CreateBox(189,0,0, 62,50,40, #ColorFront,$40000000)
; mittig
CreateBox(0,51,0, 62,25,60, #ColorFront,$40000000)
CreateBox(63,51,0, 62,24,60, #ColorFront,$40000000)
CreateBox(126,51,0, 62,24,60, #ColorFront,$40000000)
CreateBox(189,51,0, 62,25,40, #ColorFront,$40000000)
; links/rechts
CreateBox(0,77,0, 62,130,60, #ColorFront,$40000000)
CreateBox(189,77,0, 62,130,40, #ColorFront,$40000000)
; oben
CreateBox(0,208,0, 62,50,60, #ColorFront,$40000000)
CreateBox(63,208,0, 62,50,40, #ColorFront,$40000000)
CreateBox(126,208,0, 62,50,40, #ColorFront,$40000000)
CreateBox(189,208,0, 62,50,40, #ColorFront,$40000000)
; Platten
CreateBox(62,77,0, 2,130,60, #ColorWood,$40000000)
CreateBox(62,206,40, 2,50,20, #ColorWood,$40000000)
CreateBox(62,206,0, 125,2,42, #ColorWood,$40000000)
CreateBox(62,76,0, 125,2,60, #ColorWood,$40000000)
CreateBox(187,0,40, 2,76,20, #ColorWood,$40000000)
CreateBox(187,76,0, 2,131,40, #ColorWood,$40000000)
; Marker
CreateMarker(0,0,100, 62,0,100, #ColorDistance)
CreateMarker(0,0,80, 251,0,80, #ColorDistance)
CreateMarker(-30,0,0, -30,257,0, #ColorDistance)
CreateMarker(270,0,0, 270,0,40, #ColorDistance)
CreateMarker(290,0,0, 290,0,60, #ColorDistance)
EndSelect
EndProcedure
Procedure Main()
Protected x,y,n
LoadFont(0,"Segoe UI",8)
OpenWindow(#Win,8,8,#WX,#WY,"Cursor-Keys, Zoom +/- Options: O=Outline S=Surfaces, L=Lines Modes: H=Hide, F=Fill, R=Rotation, C=Depth Other: P=Perspective, B,D,I,J,N=Debugging")
CanvasGadget(#Canvas,0,0,#WX,#WY)
AddKeyboardShortcut(#Win,#PB_Shortcut_Left|#PB_Shortcut_Shift,#ShiftLeft)
AddKeyboardShortcut(#Win,#PB_Shortcut_Right|#PB_Shortcut_Shift,#ShiftRight)
AddKeyboardShortcut(#Win,#PB_Shortcut_Up|#PB_Shortcut_Shift,#ShiftUp)
AddKeyboardShortcut(#Win,#PB_Shortcut_Down|#PB_Shortcut_Shift,#ShiftDown)
AddKeyboardShortcut(#Win,#PB_Shortcut_Left,#RotateLeft)
AddKeyboardShortcut(#Win,#PB_Shortcut_Right,#RotateRight)
AddKeyboardShortcut(#Win,#PB_Shortcut_Up,#RotateUp)
AddKeyboardShortcut(#Win,#PB_Shortcut_Down,#RotateDown)
AddKeyboardShortcut(#Win,#PB_Shortcut_Back,#ResetView)
AddKeyboardShortcut(#Win,#PB_Shortcut_B,#ToggleObjectInformation)
AddKeyboardShortcut(#Win,#PB_Shortcut_C,#CalculationMode)
AddKeyboardShortcut(#Win,#PB_Shortcut_C|#PB_Shortcut_Shift,#CalculationMode)
AddKeyboardShortcut(#Win,#PB_Shortcut_D,#TogglePoints)
AddKeyboardShortcut(#Win,#PB_Shortcut_F,#ToggleFill)
AddKeyboardShortcut(#Win,#PB_Shortcut_H,#ToggleHidden)
AddKeyboardShortcut(#Win,#PB_Shortcut_I,#ToggleInformation)
AddKeyboardShortcut(#Win,#PB_Shortcut_J,#ToggleDebugInformation)
AddKeyboardShortcut(#Win,#PB_Shortcut_L,#ToggleLine)
AddKeyboardShortcut(#Win,#PB_Shortcut_M,#ToggleMarker)
AddKeyboardShortcut(#Win,#PB_Shortcut_N,#ToggleIntersection)
AddKeyboardShortcut(#Win,#PB_Shortcut_O,#ToggleOutline)
AddKeyboardShortcut(#Win,#PB_Shortcut_P,#PerspectivePlus)
AddKeyboardShortcut(#Win,#PB_Shortcut_P|#PB_Shortcut_Shift,#PerspectiveMinus)
AddKeyboardShortcut(#Win,#PB_Shortcut_R,#ToggleRotation)
AddKeyboardShortcut(#Win,#PB_Shortcut_S,#ToggleSurface)
AddKeyboardShortcut(#Win,#PB_Shortcut_X,#MoveRight)
AddKeyboardShortcut(#Win,#PB_Shortcut_X|#PB_Shortcut_Shift,#MoveLeft)
AddKeyboardShortcut(#Win,#PB_Shortcut_Y,#MoveUp)
AddKeyboardShortcut(#Win,#PB_Shortcut_Y|#PB_Shortcut_Shift,#MoveDown)
AddKeyboardShortcut(#Win,#PB_Shortcut_Z,#ZoomPlus)
AddKeyboardShortcut(#Win,#PB_Shortcut_Z|#PB_Shortcut_Shift,#ZoomMinus)
; ------------------------------------------------------------------------------------
DoObjects(1)
; ------------------------------------------------------------------------------------
OptCameraX=-100
OptCameraY=50
OptCamera=1000
AngleX=Radian(0)
AngleY=Radian(-170)
AngleZ=Radian(30)
If 0
OptCameraX=-50
OptCameraY=-10
OptCamera=1000
AngleX=Radian(0)
AngleY=Radian(-140)
AngleZ=Radian(30)
Setting\ZoomFactor*2
EndIf
If 0
OptCameraX=0
OptCameraY=-60
OptCamera=1000
AngleX=Radian(0)
AngleY=Radian(250)
AngleZ=Radian(40)
Setting\ZoomFactor*2
EndIf
SetCamera(OptCameraX,OptCameraY,OptCamera)
SetNorm(@Matrix)
Rotation()
; ------------------------
If 0
x=502
y=616
n=2;Bool(GetKeyState_(#VK_SHIFT)&128)+2
;StartDrawing(CanvasOutput(#Canvas))
If GetPointNearDot(x,y,n); Dot(0)
StartDrawing(CanvasOutput(#Canvas))
DrawingMode(#PB_2DDrawing_Outlined)
Box(x-5,y-5,12,12,#Black)
DrawingMode(#PB_2DDrawing_Default)
DrawText(#WX-100,0,StrDot(Dot(0)\_distance)+" ",#Red,#White)
EndIf
DrawText(0,0,Str(x)+" | "+Str(y)+" ",#Black,#White)
ShowDot(0)
StopDrawing()
EndIf
; ------------------------
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget,#PB_Event_Menu
Select EventGadget()
Case #Canvas
If EventType()=#PB_EventType_MouseMove
x=GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX)
y=GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY)
StartDrawing(CanvasOutput(#Canvas))
n=Bool(GetKeyState_(#VK_SHIFT)&128)+2
If GetPointNearDot(x,y,n); Dot(0)
Box(x,y,2,2,#Red)
DrawText(#WX-100,(n-2)*20,StrDot(Dot(0)\_distance)+" ",#Red,#White)
EndIf
DrawText(0,0,Str(x)+" | "+Str(y)+" ",#Black,#White)
ShowDot(0)
StopDrawing()
EndIf
Case #ShiftLeft
SetCamera(OptCameraX-30,OptCameraY,OptCamera)
Recalc(#True)
Case #ShiftRight
SetCamera(OptCameraX+30,OptCameraY,OptCamera)
Recalc(#True)
Case #ShiftUp
SetCamera(OptCameraX,OptCameraY-30,OptCamera)
Recalc(#True)
Case #ShiftDown
SetCamera(OptCameraX,OptCameraY+30,OptCamera)
Recalc(#True)
Case #MoveLeft
MoveObjects(-10,0)
Recalc(#True)
Case #MoveRight
MoveObjects(10,0)
Recalc(#True)
Case #MoveUp
MoveObjects(0,10)
Recalc(#True)
Case #MoveDown
MoveObjects(0,-10)
Recalc(#True)
Case #RotateLeft
If Setting\ModeRotation
AngleZ-#PiTeil
If AngleZ<0 : AngleZ+#ZweiPi : EndIf
Else
AngleX-#PiTeil
If AngleX<0 : AngleX+#ZweiPi : EndIf
EndIf
Rotation()
Case #RotateRight
If Setting\ModeRotation
AngleZ+#PiTeil
If AngleZ>#ZweiPi : AngleZ-#ZweiPi : EndIf
Else
AngleX+#PiTeil
If AngleX>#ZweiPi : AngleX-#ZweiPi : EndIf
EndIf
Rotation()
Case #RotateUp
AngleY-#PiTeil
Rotation()
Case #RotateDown
AngleY+#PiTeil
Rotation()
Case #ToggleOutline
Setting\ShowOutline!1
Redraw()
Case #ToggleSurface
Setting\ShowSurface!1
Redraw()
Case #TogglePoints
Setting\ShowPoints!1
Setting\ShowObjectInformation*Bool(Setting\ShowPoints=0)
Redraw()
Case #ToggleHidden
Setting\ShowHidden!1
Redraw()
Case #CalculationMode
Setting\ModeCalculation=(Setting\ModeCalculation+1+((GetKeyState_(#VK_SHIFT)>>6)&2))&3
Recalc(#True)
Case #ToggleInformation
Setting\ShowInformation!1
Redraw()
Case #ToggleDebugInformation
Setting\ShowDebugInformation!1
Redraw()
Case #ToggleObjectInformation
Setting\ShowObjectInformation!1
Setting\ShowPoints*Bool(Setting\ShowObjectInformation=0)
Redraw()
Case #ToggleFill
Setting\ModeFill!1
Redraw()
Case #ToggleLine
Setting\ModeLine!1
Redraw()
Case #ToggleMarker
Setting\ShowMarker!1
Redraw()
Case #ToggleIntersection
Setting\ShowIntersectionInformation!1
Redraw()
Case #ToggleRotation
Setting\ModeRotation!1
Case #PerspectivePlus
If OptCamera>300
SetCamera(OptCameraX,OptCameraY,OptCamera-50)
Recalc(#True)
EndIf
Case #PerspectiveMinus
If OptCamera<3000
SetCamera(OptCameraX,OptCameraY,OptCamera+50)
Recalc(#True)
EndIf
Case #ResetView
AngleX=0 : AngleY=0 : AngleZ=0
ViewX=0 : ViewY=0 : ViewZ=0
SetCamera(0,0,1000)
SetNorm(@Matrix)
Rotation()
Recalc(#True)
Case #ZoomPlus
ZoomPlus()
Case #ZoomMinus
ZoomMinus()
EndSelect
Case #PB_Event_CloseWindow
End
Case #WM_CHAR
Select EventwParam()
Case '+'
ZoomPlus()
Case '-'
ZoomMinus()
EndSelect
EndSelect
ForEver
EndProcedure
Main()
End
