Dark Bit Factory & Gravity

PROGRAMMING => Freebasic => Topic started by: Shockwave on August 15, 2009

Title: Double Twisters
Post by: Shockwave on August 15, 2009

I put this together because I wanted to show people how to make this very simple but great looking effect.

Exe attached.

Code: [Select]

'

' EXAMPLE USING TWO FAKE LIGHT SOURCED TWISTERS
' SHOWING HOW TO CODE THIS VERY SIMPLE BUT NICE EFFECT.

' BY SHOCKWAVE, WWW.DBFINTERACTIVE.COM

'===============================================================================

    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"
   
'===============================================================================
'   THE PICTURE;
'===============================================================================

'   FIXED SIZE ARRAYS DECLARE ALL VARIABLES;

    OPTION STATIC
    OPTION EXPLICIT
   
'===============================================================================
'   LETS SET UP TINYPTC.
'===============================================================================

    CONST XRES = 800:' WIDTH OF YOUR SCREEN
    CONST YRES = 600:' HEIGHT OF YOUR SCREEN
'===============================================================================
'   SCREEN BUFFER;
'===============================================================================

    DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
    DECLARE SUB DRAW_SLICE(BYVAL XP AS INTEGER ,BYVAL YP AS INTEGER, BYVAL SLICE AS INTEGER, BYVAL TC AS UINTEGER)
    DECLARE SUB DRAWSECTION(BYVAL PASS AS DOUBLE, BYVAL XPASS AS INTEGER ,BYVAL YPASS AS INTEGER,BYVAL PLUS AS DOUBLE)
    DECLARE SUB TWISTERS()
    DIM SHARED AS DOUBLE OPX1(YRES)
    DIM SHARED AS DOUBLE R2D
    R2D=3.13/720
    DIM SHARED AS DOUBLE RADDEG
    RADDEG=3.14/360

'===============================================================================
'   ACTUALLY OPEN THE SCREEN;
'===============================================================================

    PTC_ALLOWCLOSE(0)
    PTC_SETDIALOG(1,"DOUBLE TWISTERS"+CHR$(13)+"",0,1)               
    IF (PTC_OPEN("BY SHOCKWAVE/CODIGOS",XRES,YRES)=0) THEN
    END-1
    END IF   
    SLEEP 5
   
    DIM SHARED AS DOUBLE T1,T2,DV,DOLD
   

'===============================================================================
'  MAIN LOOP (UNTIL ESC OR LEFT MOUSE)
'===============================================================================


WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE) 
    DOLD=TIMER
    TWISTERS()
    PTC_UPDATE@BUFFER(0)
    'CLEAR THE SCREEN
    SLEEP 1
    ERASE BUFFER
    DV=(((TIMER-DOLD)*10)+1)
    T1=T1+DV
    T2=T2+DV*3
WEND

    EXITPROCESS(0)

END


SUB TWISTERS()
    DIM Y AS INTEGER
    DIM AS DOUBLE PX1,PX2,Q
   
   
    FOR Y=0 TO YRES-1
        Q=150*SIN((Y+T1)*.01)
        PX1=200+129*SIN((Y+T1)*R2D)
        PX2=200+ 30*COS((Y+T1+720)*R2D)

        IF PX1>OPX1(Y) THEN
                DRAWSECTION(Y-T2-Q,PX1,Y,1)
                DRAWSECTION(Y+T2+Q,PX2,Y,.6)
        ELSE
                DRAWSECTION(Y+T2+Q,PX2,Y,.6)
                DRAWSECTION(Y-T2-Q,PX1,Y,1)
        END IF
        OPX1(Y)=PX1   
    NEXT
   
   
END SUB


SUB DRAWSECTION(BYVAL PASS AS DOUBLE, BYVAL XPASS AS INTEGER ,BYVAL YPASS AS INTEGER,BYVAL PLUS AS DOUBLE)
    DIM AS INTEGER X1,X2,X3,X4,TC,CL
    X1=(120*SIN( PASS     *RADDEG))+XPASS
    X2=(120*SIN((PASS+180) *RADDEG))+XPASS
    X3=(120*SIN((PASS+360)*RADDEG))+XPASS
    X4=(120*SIN((PASS+540)*RADDEG))+XPASS
   
   
    IF X2>X1 THEN
        CL=X2-X1       
        DRAW_SLICE(X1+XPASS,YPASS,X2-X1,RGB(CL*.9,CL*.8,CL*PLUS))
    END IF

    IF X3>X2 THEN
        CL=X3-X2       
        DRAW_SLICE(X2+XPASS,YPASS,X3-X2,RGB(CL*PLUS,CL*.9,CL*.8))
    END IF

    IF X4>X3 THEN
        CL=X4-X3       
        DRAW_SLICE(X3+XPASS,YPASS,X4-X3,RGB(CL*.9,CL*.8,CL*PLUS))
    END IF

    IF X1>X4 THEN
        CL=X1-X4       
        DRAW_SLICE(X4+XPASS,YPASS,X1-X4,RGB(CL*PLUS,CL*.9,CL*.8))
    END IF

   


END SUB


SUB DRAW_SLICE(BYVAL XP AS INTEGER , BYVAL YP AS INTEGER, BYVAL SLICE AS INTEGER, BYVAL TC AS UINTEGER)
    DIM PP AS UINTEGER PTR
        PP=@BUFFER(XP+(YP*XRES))
        '-----------------------------------------------------------------------
        ASM
            MOV EAX,dword ptr[TC]
            MOV ECX, [SLICE]
            MOV EDI, [PP]
            REP STOSD
        END ASM
        '-----------------------------------------------------------------------
END SUB

Adding a texture to this is elementary, if there is call for it I'll add one.

Title: Re: Double Twisters
Post by: Dr.Death on August 15, 2009

Nice work shocky you never stop helping people out with your little code tricks.
Freebasic just keeps on amazing me too  :goodpost:

Title: Re: Double Twisters
Post by: TinDragon on August 15, 2009

Looks nice tho not sure about the cream color  :D

Title: Re: Double Twisters
Post by: Shockwave on August 15, 2009

Yep, the colours suck.

Title: Re: Double Twisters
Post by: va!n on August 15, 2009

Shockwave i love you :P your sources are really great! K++