Dim ss$(10)
ss$(1)="Y,X = drehung um die X-Achse"
ss$(2)="A,S = drehung um die Y-Achse"
ss$(3)="Q,W = drehung um die Z-Achse"
ss$(4)="M,N = Skalieren"
ss$(5)="P   = Projektionsart wählen"
ss$(6)="Cursorblock = Objekt verschieben"
ss$(7)="ESC = Programm beenden"
ss$(8)="rechte Maustaste = Objekt rotieren."
Global ende
Const  maxatoms=400       ; Maximale Anzahl Ecken
Const  maxbonds=200       ; Maximale Anzahl Kanten
Const  dist=4             ; verzerrung für perspektivtransformation
Global transformflag = 1  ; 1 = parallel, 2 = perspektiv-transformation
Global xw#=0
Global yw#=0
Global zw#=0
Global faktor#=1.0
Global xcenter=400
Global ycenter=300
Global noa,nob
Dim koo# (maxatoms,3)  ;     1=x,    2=y,    3=z
Dim neu# (maxatoms,3)  ;     1=x,    2=y,    3=z
Dim lines# (maxatoms,2);     1=a,    2=b
Dim Ploot# (maxatoms,2);     1=x,    2=y

SeedRnd MilliSecs ()                   ; Zufallsgenerator zurücksetzen
Graphics 1024, 768, 16, 1              ; grafik Modus setzen
SetBuffer BackBuffer ()                ; Doublebuffering vorbereiten
readdata                               ; einlesen der 3d Daten
 

; Hauptschleife
While Ende = 0                   
Cls
Tastaturabfrage
drehung xw#,yw#,zw#
transform
zeichnen


yi=10
For i=1 To 8
Text 700,yi,ss$(i)
yi=yi+17
Next

Flip
Wend
; Hauptschleife



Function drehung(xw#,yw#,zw#)
For i=0 To noa-1
neu#(i,1)=koo#(i,1)
neu#(i,2)=koo#(i,2)*Cos(xw#)-koo#(i,3)*Sin(xw#)
neu#(i,3)=koo#(i,2)*Sin(xw#)+koo#(i,3)*Cos(xw#)
altx#=neu#(i,1)
alty#=neu#(i,2)
altz#=neu#(i,3)
neu#(i,1)=altx#*Cos(yw#)+altz#*Sin(yw#)
neu#(i,3)=-altx#*Sin(yw#)+altz#*Cos(yw#)
altx#=neu#(i,1)
alty#=neu#(i,2)
neu#(i,1)=altx#*Cos(zw#)-alty#*Sin(zw#)
neu#(i,2)=altx#*Sin(zw#)+alty#*Cos(zw#)
Next
End Function


Function perspektivtransform()
For i=0 To noa-1
If dist+neu#(i,3)<>0 Then
Ploot#(i,1)=50*faktor*(neu#(i,1)*dist/(neu#(i,3)+dist))+xcenter
ploot#(i,2)=50*faktor*(neu#(i,2)*dist/(neu#(i,3)+dist))+ycenter
EndIf
Next
End Function



Function paralleltransform()
For i=0 To noa-1
ploot#(i,1)=neu#(i,1)*50*faktor+xcenter
ploot#(i,2)=neu#(i,2)*50*faktor+ycenter
Next
End Function


Function transform()
If transformflag=0 Then paralleltransform
If transformflag=1 Then perspektivtransform
End Function


Function readdata()
Read noa ;anzahl der ecken einlesen
Read nob ; anzahl der kanten einlesen
For i=0 To noa-1
Read Char
koo#(i,1)=char
Read char
koo#(i,2)=char
Read char
koo#(i,3)=char
Next
For i=0 To nob-1
Read char
lines#(i,1)=char
Read char
lines#(i,2)=char
Next
End Function


Function zeichnen()
For i=0 To nob-1
Color 255,255,255
Line ploot#(lines#(i,1),1),ploot#(lines#(i,1),2),ploot#(lines#(i,2),1),ploot#(lines#(i,2),2)
Color 255,0,0
Text ploot#(i,1),ploot#(i,2),Str$(i)
Color 255,255,255
Next
End Function



;********************************************** Tastaturabfrage ***********************************************
Function Tastaturabfrage()
lastrichtung=0
If KeyDown(1) Then Ende = 1                           ; Beenden wenn Esc Taste gedrückt
If KeyDown(200)  Then ycenter=ycenter-5  :xw#=xw#+0.05
If KeyDown(208) Then  ycenter=ycenter+5  :xw#=xw#-0.05
If KeyDown(203) Then  xcenter=xcenter-5  :yw#=yw#+0.05
If KeyDown(205) Then  xcenter=xcenter+5  :yw#=yw#-0.05
If KeyDown(45) Then xw#=xw#+1 ;x
If KeyDown(44) Then xw#=xw#-1 ;y
If KeyDown(31) Then yw#=yw#+1 ;s
If KeyDown(30) Then yw#=yw#-1 ;a
If KeyDown(17) Then zw#=zw#+1 ;w
If KeyDown(16) Then zw#=zw#-1 ;q
If KeyDown(49) Then faktor=faktor+0.01 ;n
If KeyDown(50) Then faktor=faktor-0.01 ;m
If KeyHit(25) Then transformflag=1-transformflag ;p

mxs=(MouseYSpeed())

mys=(MouseXSpeed())

If MouseDown(2) Then
yw#=yw#-mys
xw#=xw#-mxs
;zw#=zw#-mzs
EndIf
;negativ=links positiv=rechts MouseXSpeed


End Function
;********************************************** Tastaturabfrage ***********************************************
;
;
;
;
;
;
   
Data 8,12 ;anzahl ecken, anzahl kanten

Data -1.0,1.0,1.0  ;x,y,z koordinaten im raum
Data 1.0,1.0,1.0
Data 1.0,-1.0,1.0
Data -1.0,-1.0,1.0
Data 1.0,1.0,-1.0
Data 1.0,-1.0,-1.0
Data -1.0,-1.0,-1.0
Data -1.0,1.0,-1.0

Data 0,1,1,2,2,3,3,0,4,5,5,6,6,7,7,4,0,7,1,4,3,6,2,5 ;miteinander verbundene ecken

Function Culling(x1,y1,x2,y2,x3,y3)
   If((x2-x1) * (y3-y1) - (y2-y1) * (x3-x1) > 0) Return(True)
   Return(False)
End Function