XProfan

'  first Gehversuche with einfachen 3D-Drahtobjekten [P. woodpecker 1997] - adjusted on
'  selbstständige Rotation with 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&, connections#
Declare hScrBuffer&
Declare elapsedTime&, lastMesuredTime&
Declare msecAccumulator&
Window Style 2 | 8 | 16
Window 0,0 - 512, 384
' Initialisieren
@Set("TrueColor", 1)
Randomize
ur!=Pi()/180
'  Maßstab Realobjekt To association
gr! = 30
'  Stegfarbe
' Stopvariable, through ESC-Button staid
hScrBuffer& = @Create("hNewPic", Width(%hwnd), Height(%hwnd), 0)
i&=0
lastMesuredTime& = &gettickcount
User Messages 16

WhileNot i&

    'Cls @Rgb(240,240,255)
    'Locate 0,0:Print "Mausklick! end with ESC-Taste"
    '  distance (Mittlerer Betrachtungs-Vorversatz)
    'dist! = Rnd(300) + 300
    dist! = 600
    ' Zufälliger Versatz in x and y direction (power Result interessanter)
    'xv! = @Rnd(150) - 100
    'yv! = @Rnd(200) - 100
    '  casually Euler-Drehwinkel for scene produce
    '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 according obigen Drehwinkeln into three
    '  plains (Grundriss, Aufriss, Seitenriss) projizieren
    '      preparation Variablenaufruf instead of ongoing Winkel-Neuberechnung
    ca! = Cos(a!) : cb! = Cos(b!) : cc! = Cos(c!)
    sa! = Sin(a!)  : sb! = Sin(b!) : sc! = Sin(c!)
    '      Rotationsfaktoren the Bewegungsmatrix to charge
    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 the Modells, if desired
    xx! = 0
    yy! = 0
    zz! = 0
    '   3D-association one Papierflugzeugs (possible around the Schwerpunkt!)
    e& = 14' number the 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' number the Verbindungsstege
    Dim  connections#, v& * 2 * 2
    Word connections#,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&
    USEP 0,2, @Rgb(255, 0, 0)
    Cls @Rgb(240,240,255)
    DrawText 0, 0, "Beenden with ESC"
    j& = 0

    While j& < v&

        s0& = @Word( connections#, 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( connections#, 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 brought Stegpunkte on Ausgabebereich projizieren
        u0! = x0! * 192 / z0! + 250
        v0! = 192 - y0! * 192 / z0!
        u1! = x1! * 192 / z1! + 250
        v1! = 192 - y1! * 192 / z1!
        ' Drahtsteg draw
        Line u0!,v0! - u1!,v1!
        ' Next web!
        Inc j&

    EndWhile

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

EndWhile

' ready
Dispose Eckpunkte#
Dispose connections#
End