XProfan

'  Erste Gehversuche mit einfachen 3D-Drahtobjekten [P. Specht 1997] - angepasst auf
'  selbstständige Rotation mit Bildschirmpuffer [J. Strobl 2013]
Declare a!, b!, c!, x!,y!,z!, xx!,yy!,zz!, ca!,cb!,cc!,sa!,sb!,sc!
Declare a11!,a21!,a31!,a12!,a22!,a32!,a13!,a23!,a33!
Declare xr!,yr!,zr!,gr!,dist!, ur!,p&,xv!,yv!,i&,j&
Declare x0!,y0!,z0!,x1!,y1!,z1!, u0!,v0!,u1!,v1!
Declare s0&,s1&,p0!,p1!
Declare e&,Eckpunkte#, v&, Verbindungen#
Declare hScrBuffer&
Declare elapsedTime&, lastMesuredTime&
Declare msecAccumulator&
WindowStyle 2 | 8 | 16
Window 0,0 - 512, 384
' Initialisieren
@Set("TrueColor", 1)
Randomize
ur!=Pi()/180
'  Maßstab Realobjekt zu Modell
gr! = 30
'  Stegfarbe
' Stopvariable, durch ESC-Taste gesetzt
hScrBuffer& = @Create("hNewPic", Width(%hwnd), Height(%hwnd), 0)
i&=0
lastMesuredTime& = &gettickcount
UserMessages 16

WhileNot i&

    'Cls @Rgb(240,240,255)
    'Locate 0,0:Print "Mausklick! Ende mit ESC-Taste"
    '  Entfernung (Mittlerer Betrachtungs-Vorversatz)
    'dist! = Rnd(300) + 300
    dist! = 600
    ' Zufälliger Versatz in x und y Richtung (macht Ergebnis interessanter)
    'xv! = @Rnd(150) - 100
    'yv! = @Rnd(200) - 100
    '  Zufällige Euler-Drehwinkel per die Szene erzeugen
    'a! = (Rnd(180) - 90) * ur!
    'b! = (Rnd(40) - 20) * ur!
    'c! = (Rnd(80) - 20) * ur!
    elapsedTime& = &gettickcount - lastMesuredTime&
    lastMesuredTime& = &gettickcount
    msecAccumulator& = msecAccumulator& + elapsedTime&

    If msecAccumulator& > 500

        SetText %hwnd, "Framerate: " + @Str$((1 / elapsedTime& * 1000) \ 1) + " FPS"
        msecAccumulator& = msecAccumulator& - 500

    EndIf

    a! = a! + ur! * (elapsedTime& / 25)
    b! = b! + ur! * (elapsedTime& / 25)
    c! = c! + ur! * (elapsedTime& / 25)
    '  Streckeneinheit gemäß obigen Drehwinkeln in die drei
    '  Ebenen (Grundriss, Aufriss, Seitenriss) projizieren
    '      Vorbereitung Variablenaufruf statt laufende Winkel-Neuberechnung
    ca! = Cos(a!) : cb! = Cos(b!) : cc! = Cos(c!)
    sa! = Sin(a!)  : sb! = Sin(b!) : sc! = Sin(c!)
    '      Rotationsfaktoren der Bewegungsmatrix berechnen
    a11! = ca! * cb!
    a21! = cc! * sb! + sc! * sa! * cb!
    a31! = sc! * sb! - cc! * sa! * cb!
    a12! = -1 * ca! * sb!
    a22! = cc! * cb! - sc! * sa! * sb!
    a32! = sc! * cb! + cc! * sa! * sb!
    a13! = sa!
    a23! = -1 * sc! * ca!
    a33! = cc! * ca!
    '    Translation des Modells, wenn gewünscht
    xx! = 0
    yy! = 0
    zz! = 0
    '   3D-Modell eines Papierflugzeugs (possibile um den Schwerpunkt!)
    e& = 14' Zahl der Eckpunkte
    Dim Eckpunkte#, e& * 3 * 8
    Float Eckpunkte#,0 = 0,-2,18, 0,-2,-3, -1,0,-3, -1,0,14, 1,0,14, 1,0,-3, -4,0,-3, -4,0,1, -5,1,-2, -5,1,-3, 4,0,1, 4,0,-3, 5,1,-3,  5,1,-2
    v& = 19' Zahl der Verbindungsstege
    Dim  Verbindungen#, v& * 2 * 2
    Word Verbindungen#,0 = 0,1, 1,2, 2,3, 3,0, 0,4, 4,5, 5,1, 3,7, 7,6, 6,2, 7,8, 8,9, 9,6, 4,10, 10,11, 11,5, 10,13, 13,12, 12,11
    StartPaint hScrBuffer&
    UsePen 0,2, @Rgb(255, 0, 0)
    Cls @Rgb(240,240,255)
    DrawText 0, 0, "Beenden mit ESC"
    j& = 0

    While j& < v&

        s0& = @Word( Verbindungen#, j& * 4)
        x! = gr! * @Float( Eckpunkte#, 24 * s0&)
        y! = gr! * @Float( Eckpunkte#, 24 * s0& + 8)
        z! = gr! * @Float( Eckpunkte#, 24 * s0& + 16)
        xr! = xx! + a11! * x! + a12! * y! + a13! * z!
        yr! = yy! + a21! * x! + a22! * y! + a23! * z!
        zr! = zz! + a31! * x! + a32! * y! + a32! * z!
        x0! = xr! + xv! : y0! = yr! + yv!  : z0! = zr! + dist!
        s1& = @Word( Verbindungen#, j& * 4 + 2 )
        x! = gr! * @Float( Eckpunkte#, 24 * s1&)
        y! = gr! * @Float( Eckpunkte#, 24 * s1& + 8)
        z! = gr! * @Float( Eckpunkte#, 24 * s1& + 16)
        xr! = xx! + a11! * x! + a12! * y! + a13! * z!
        yr! = yy! + a21! * x! + a22! * y! + a23! * z!
        zr! = zz! + a31! * x! + a32! * y! + a32! * z!
        x1! = xr! + xv! : y1! = yr! + yv! : z1! = zr! + dist!
        '  In 3D-Endstellung gebrachte Stegpunkte auf Ausgabebereich projizieren
        u0! = x0! * 192 / z0! + 250
        v0! = 192 - y0! * 192 / z0!
        u1! = x1! * 192 / z1! + 250
        v1! = 192 - y1! * 192 / z1!
        ' Drahtsteg zeichnen
        Line u0!,v0! - u1!,v1!
        ' Nächster Steg!
        Inc j&

    EndWhile

    EndPaint
    DrawPic hScrBuffer&, 0, 0; 0
    'WaitInput
    Case @Iskey(27) : i&=1
    Case %umessage = 16 : i&=1

EndWhile

' Fertig
Dispose Eckpunkte#
Dispose Verbindungen#
End