FreeBasic

Маленький, но красивый пример, показывающий использование всего одного оператора PSET для реализации эффекта 3D.
Платформы: Windows, Linux
Автор: A.Dewavrin, создано 2006 году.

Const SC_WIDTH  As Integer = 640

Const SC_HEIGHT As Integer = 480

Const NB_P      As Integer = 50000

Const RAY       As Integer = 2^23-1


Screenres SC_WIDTH,SC_HEIGHT, 24, 1, 1


Dim X(NB_P) As Integer

Dim Y(NB_P) As Integer

Dim Z(NB_P) As Integer

Dim As Integer xs, ys, i, xprim, yprim, zprim

'Place the points on a sphere using spherical coords
Randomize

For i=0 To NB_P-1

    Const PI As Double = 3.1415927

    Dim As Double teta
    teta = 2*PI*rnd(1)
    Dim As Double phi
    phi = PI*rnd(1)-.5*PI
    X(i) = Cos(teta)*cos(phi)*RAY*2

    Y(i) = Sin(phi)*RAY*.5

    Z(i) = Sin(teta)*cos(phi)*RAY*1

Next i

While Inkey = ""
    'Rotate points. Feel free to use this trick but please mention my name :
    'A.Dewavrin (dewavrin@yahoo.com), apr 2006
    For i=0 To NB_P-1

        xprim = X(i) - Z(i) Shr 7

        zprim = X(i) Shr 7 + Z(i)
        X(i) = xprim
        Z(i) = zprim
        xprim = X(i) - Y(i) Shr 8

        yprim = X(i) Shr 8 + Y(i)
        X(i) = xprim
        Y(i) = yprim
    Next i

    Screensync

    Screenlock

    Cls


    'Draw UFO
    For i=0 To NB_P-1

        xs = X(i) Shr 15 + SC_WIDTH/3

        ys = Y(i) Shr 15 + SC_HEIGHT/3

        If Z(i)>0 Then                  'visible points only
            Dim iCol As Integer

            iCol = Z(i) And &hFF0000    'the closer, the lighter
            Pset (xs, ys), iCol
        Endif
    Next i

    Color Rgb(0,0,192)
    Print " tHE ReD U.F.O."
    Color Rgb(0,0,128)
    Print NB_P; " points rotated without a multiply, a cos or a sine !"
    Locate 59, 12

    Color Rgb(0,0,60)
    Print " A.Dewavrin (dewavrin@yahoo.com), apr 2006"

    Screenunlock

Wend