Author Topic: Steel vectorballs (Read 5110 times)

Shockwave · « **on:** June 28, 2009 »

No apologies for the code, it's rushed

'
'                           FAKE LIGHTSOURCED BOBS
'
'                           BY SHOCKWAVE  27-06-09
'
'
'===============================================================================

    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"

'-------------------------------------------------------------------------------    
'   SCREEN SETUP;    
'-------------------------------------------------------------------------------

    CONST   XRES    =    800
    CONST   YRES    =    600




    DIM SHARED AS INTEGER POINTS=27
    DIM SHARED AS DOUBLE VXR,VYR,VZR,size

    size=110
    DIM SHARED AS DOUBLE VX(POINTS),VY(POINTS),VZ(POINTS),VT(POINTS)
    
    DIM SHARED AS DOUBLE VTX(POINTS),VTY(POINTS),VTZ(POINTS),VTT(POINTS)

    DECLARE SUB ROTATE()
    DECLARE SUB DRAW_BOBS()
    
    DIM L AS INTEGER
    
    FOR L=1 TO POINTS
        READ VX(L),VY(L),VZ(L),VT(L)
    NEXT

'-------------------------------------------------------------------------------
'   YOU CAN MESS WITH THESE A BIT IF YOU KNOW WHAT YOU ARE DOING;
'   THEY DEFINE HOW BIG THE BOB IS AND THE SIZE OF THE TEMPLATE
'   YOU'LL NEED TO MANUALLY ADJUST LATER IN THE CODE TO CENTER THE REFLECTION.
'-------------------------------------------------------------------------------

    DIM SHARED AS INTEGER RINGSIZE = 300
    DIM SHARED AS INTEGER BOBSIZE  = 120
    
    DIM SHARED AS UINTEGER BOB_BUFFER    ( BOBSIZE * BOBSIZE ):  ' HOLDS THE BOB
    DIM SHARED AS UINTEGER BUFFER        ( XRES * YRES ):        ' SCREEN BUFFER 
    DIM SHARED AS UINTEGER RING_BUFFERA  ( RINGSIZE * RINGSIZE ):' ORIGINAL TEMPLATE
    DIM SHARED AS UINTEGER RING_BUFFERB  ( RINGSIZE * RINGSIZE ):' "WORK" TEMPLATE
    DIM SHARED AS UINTEGER CPALETTE      ( 1000 ,3 )
    

    DECLARE SUB CREATEBOB():           '  WE NEED TO CREATE A NEW BOB EACH FRAME, THIS SUB DOES IT.
    DECLARE SUB FILL_RING_BUFFER():    '  SUB TO GENERATE CIRCULAR FILL PATTERN.   
    DECLARE SUB COPY_RING_BUFFER():    '  SUB TO COPY TEMPLATE TO WORK BUFFER AND CREATE BOB

'-------------------------------------------------------------------------------

'   SUB TO DRAW CIRCLES;
    DECLARE SUB CIRC(BYVAL BUFF AS INTEGER , BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CR AS INTEGER,BYVAL CG AS INTEGER,BYVAL CB AS INTEGER)    

'   SUB TO DRAW BOBS;
    DECLARE SUB DRAW_BOB(BYVAL XP AS INTEGER, BYVAL YP AS INTEGER, BYVAL BT AS INTEGER )

    DECLARE SUB BERASE()

'-------------------------------------------------------------------------------

    FILL_RING_BUFFER():' GENERATE FILL PATTERN.

'-------------------------------------------------------------------------------
'   SET UP THE SCREEN.
'-------------------------------------------------------------------------------

    PTC_ALLOWCLOSE(0)    
    PTC_SETDIALOG(1,"WWW.DBFINTERACTIVE.COM"+CHR$(13)+"FULL SCREEN?",0,1)               
    IF (PTC_OPEN("Coded by Shockwave",XRES,YRES)=0) THEN
    END-1
    END IF    


'-------------------------------------------------------------------------------
'   SPAGHETTI CODE: VARIABLES ARE JUST THERE SO WE HAVE SOME TO MOVE AND DRAW BOBS.
'-------------------------------------------------------------------------------

    DIM SHARED AS INTEGER XX,C
    DIM SHARED AS DOUBLE NNN,FFF,GGG,HHH,LIGHTX,LIGHTY
    
    DIM SHARED AS DOUBLE ANGLE,OLD
    
'-------------------------------------------------------------------------------
'   MAIN LOOP
'-------------------------------------------------------------------------------
    ANGLE =0
    OLD=TIMER
    WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)  
        ANGLE=ANGLE+((TIMER-OLD)*105)
        OLD=TIMER
        GGG=(TIMER*1.5)
        CREATEBOB()
        COPY_RING_BUFFER()
 
    ROTATE()
    DRAW_BOBS()
    C=0
    FOR XX=20 TO 5 STEP-1
        CIRC(3,LIGHTX,LIGHTY,XX,C,C+20,C+40)
        C=C+20
        IF C>210 THEN C=210
    NEXT

        
        PTC_UPDATE@BUFFER(0)
        'ERASE BUFFER
        BERASE()


        SLEEP 1
    WEND
    EXITPROCESS(0)
    END




SUB DRAW_BOBS()
    DIM AS DOUBLE TX,TY,TZ,TT
    DIM AS INTEGER L1,L2
    
    FOR L1=1 TO POINTS-1
    FOR L2=1 TO POINTS-1
     TX=VTX(L2+1)
     TY=VTY(L2+1)
     TZ=VTZ(L2+1)
     TT=VTT(L2+1)    
     
     IF VTZ(L2)< TZ THEN

        VTX(L2+1)=VTX(L2)
        VTY(L2+1)=VTY(L2)
        VTZ(L2+1)=VTZ(L2)
        VTT(L2+1)=VTT(L2)

        VTX(L2)=TX
        VTY(L2)=TY
        VTZ(L2)=TZ
        VTT(L2)=TT


     END IF
     
     
     
    NEXT
    NEXT

FOR L1=1 TO POINTS
DRAW_BOB(VTX(L1),VTY(L1),VTT(L1))
NEXT
END SUB





SUB BERASE()
dim pp as integer ptr
DIM AS INTEGER SLICE,TC,Y,SV,LV,RW


'-------------------------------------------------------------------------------
'   COLOUR ME PURPLE!
'-------------------------------------------------------------------------------

DIM AS DOUBLE RRR,GGG
RRR=1
GGG=0
RW=0
FOR Y=0 TO YRES-1
    select case y
    case 0 to 39        
    TC=RGB(RW*.2,RW*.4,RW*1)
    RW=RW+1
    
    case yres-39 to yres
    RW=RW-1
    TC=RGB(RW*.2,RW*.4,RW*1)    
    case else
    LV=5+4*SIN((Y-ANGLE)*.03)
    
    SV=10+LV*SIN((ANGLE+Y)*.05)
    TC=RGB(SV,SV*RRR,SV*GGG)
    RRR=RRR-.0018
    GGG=GGG+.02
    case 40,yres-40
    TC=&hAACCFF
    end select
    
                    SLICE=XRES-1
                    PP=@BUFFER(Y*XRES)
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
NEXT

END SUB

'-------------------------------------------------------------------------------
'   DRAW A BOB AT XP,YP, MASKING THE COLOUR PURPLE. CAUTION !! NO CLIPPING !!
'-------------------------------------------------------------------------------

SUB DRAW_BOB(BYVAL XP AS INTEGER, BYVAL YP AS INTEGER , BYVAL BT AS INTEGER )
DIM AS INTEGER X,Y
DIM AS UINTEGER PTR PP1,PP2


PP1=@BOB_BUFFER(0)

FOR Y =0 TO BOBSIZE-1
    
    PP2=@BUFFER(((Y+YP)*XRES)+XP)
    FOR X=0 TO BOBSIZE-1        
    IF *PP1<>&HFF00FF THEN        
        *PP2=CPALETTE(*PP1 , BT)
    END IF    
    PP1+=1
    PP2+=1
    NEXT

NEXT


END SUB


'-------------------------------------------------------------------------------
'   CREATE A PURPLE SQUARE WITH A BLACK HOLE IN THE MIDDLE.
'-------------------------------------------------------------------------------

SUB CREATEBOB()

dim pp as integer ptr
DIM AS INTEGER SLICE,TC,Y


'-------------------------------------------------------------------------------
'   COLOUR ME PURPLE!
'-------------------------------------------------------------------------------

TC=RGB(255,0,255)

FOR Y=0 TO BOBSIZE-1
                    SLICE=BOBSIZE
                    PP=@BOB_BUFFER(Y*BOBSIZE)
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
NEXT

'-------------------------------------------------------------------------------
'   DRAW A BLACK HOLE IN THE MIDDLE!
'-------------------------------------------------------------------------------

CIRC(2,BOBSIZE/2,BOBSIZE/2,BOBSIZE/2,0,0,0)
END SUB



'-------------------------------------------------------------------------------
'        THIS SUB GENERATES A NEW WORK BUFFER AND THEN GETS THE BOB.
'-------------------------------------------------------------------------------

SUB COPY_RING_BUFFER()

'-------------------------------------------------------------------------------
'   COPY STORED TEMPLATE TO THE NEW ONE.
'-------------------------------------------------------------------------------

DIM AS INTEGER X,Y
DIM AS UINTEGER PTR PP1,PP2


PP1=@RING_BUFFERA(0)
PP2=@RING_BUFFERB(0)

FOR X=0 TO RINGSIZE*RINGSIZE
    
    *PP2=*PP1
    PP1+=1
    PP2+=1
    
NEXT 


'-------------------------------------------------------------------------------
'   DRAW OUR STENCIL ON TOP OF THE WORK TEMPLATE, MOVING IT AROUND A BIT TO 
'   CHEAT THE MOVING LIGHTSOURCE.
'-------------------------------------------------------------------------------

PP1=@BOB_BUFFER(0)

    NNN=(90+40*SIN(ANGLE*3.14/120))
    MMM=(90+40*COS(ANGLE*3.14/133))
    LIGHTY=((YRES/2)-330*COS(ANGLE*3.14/133))
    LIGHTX=((XRES/2)-330*SIN(ANGLE*3.14/120))
    FOR Y=0 TO BOBSIZE-1
        PP2=@RING_BUFFERB(((Y+INT(MMM))*RINGSIZE)+INT(NNN))
        FOR X=0 TO BOBSIZE-1
            IF *PP1 <> &HFF00FF THEN
                *PP1=*PP2
            END IF            
        PP1+=1
        PP2+=1
        NEXT
    NEXT
END SUB



SUB FILL_RING_BUFFER()
    
    '---------------------------------------------------------------------------
    ' GENERATE A GRADIENT:
    '---------------------------------------------------------------------------
    
    DIM AS INTEGER Y,P
    DIM AS DOUBLE RR,GG,BB,BR
    P=0
    FOR Y=RINGSIZE/2 TO 1 STEP-1
    
        CIRC(1,RINGSIZE/2,RINGSIZE/2,Y,P,0,0)

        '-----------------------------------------------------------------------
        ' FAKE A SPECULAR HIGHLIGHT:
        '-----------------------------------------------------------------------
        


        IF Y<60 THEN 
        P=P+4
        END IF

        IF Y<120 THEN 
        P=P+1
        END IF


        P=P+1
        IF P>1000 THEN P=1000


    NEXT
    BR=90
    RR=0
    GG=0
    BB=0
    
    FOR Y=0 TO 1000
        if y>300 then
        RR=RR+.45
        GG=GG+.45
        BB=BB+.45   
        BR=BR+.45
        end if
        
        if y>250 then
        RR=RR+.45
        GG=GG+.45
        BB=BB+.45   
        BR=BR+.45
        end if
    IF Y<30 THEN
        BR=BR-2
        
    ELSE
        
        RR=RR+.2
        GG=GG+.2
        BB=BB+.2
    END IF
    
        IF BB>255 THEN BB=255
        IF RR>255 THEN RR=255
        IF GG>255 THEN GG=255
        
        IF BR>255 THEN BR=255
        
        CPALETTE(Y,1)=RGB(INT(RR),BR,BR)
        CPALETTE(Y,2)=RGB(BR,INT(GG),BR)
        CPALETTE(Y,3)=RGB(BR,BR,INT(BB))
    NEXT
    
    
END SUB



SUB CIRC(BYVAL BUFF AS INTEGER , BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CR AS INTEGER,BYVAL CG AS INTEGER,BYVAL CB AS INTEGER)

'-------------------------------------------------------------------------
'
' FILLED CIRCLE ROUTINE WITH ASSEMBLY LANGUAGE RASTERISING.
' USAGE  CIRC ( X , Y , RADIUS , R , G , B )
' REMEMBER THAT X + Y ARE THE CENTER OF YOUR CIRCLE.
' THIS HAS BASIC CLIPPING TO SCREEN BOUNDARIES.
'
'-------------------------------------------------------------------------

DIM  as integer r2,cc,loopy,ww,l,clipl , clipr,slice,tc,BXR,BYR
IF BUFF=1 THEN BXR=RINGSIZE
IF BUFF=1 THEN BYR=RINGSIZE

IF BUFF=2 THEN BXR=BOBSIZE
IF BUFF=2 THEN BYR=BOBSIZE
 
IF BUFF=3 THEN BXR=XRES
IF BUFF=3 THEN BYR=YRES


dim pp as integer ptr
r2=r*r
cc=-r
TC = RGB ( CR , CG , CB )
IF BUFF=1 THEN
    TC=CR
for loopy = cc to r     
        ww = Sqr(r2-loopy*loopy)

        if loopy+cy>=0 and loopy+cy<BYR then
            clipl = cx-ww
            clipr = (cx+ww)-1
            if clipl<0 then clipl=0
            if clipr>BXR-1 then clipr = BXR-1
            pp=@RING_BUFFERA((BXR*(loopy+CY))+clipl)
            slice = clipr-clipl
            
            if slice>0 then
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
            end if
            

    
        end if

next
END IF

IF BUFF=2 THEN
for loopy = cc to r     
        ww = Sqr(r2-loopy*loopy)

        if loopy+cy>=0 and loopy+cy<BYR then
            clipl = cx-ww
            clipr = (cx+ww)-1
            if clipl<0 then clipl=0
            if clipr>BXR-1 then clipr = BXR-1
            PP=@BOB_BUFFER((BXR*(loopy+CY))+clipl)
            SLICE = CLIPR-CLIPL
            
            if slice>0 then
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
            end if
            

    
        end if

next
END IF


IF BUFF=3 THEN
for loopy = cc to r     
        ww = Sqr(r2-loopy*loopy)

        if loopy+cy>=0 and loopy+cy<BYR then
            clipl = cx-ww
            clipr = (cx+ww)-1
            if clipl<0 then clipl=0
            if clipr>BXR-1 then clipr = BXR-1
            PP=@BUFFER((BXR*(loopy+CY))+clipl)
            SLICE = CLIPR-CLIPL
            
            if slice>0 then
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
            end if
            

    
        end if

next
END IF



END SUB





SUB ROTATE()
    
    DIM A AS INTEGER
    DIM VX1 AS DOUBLE
    dim VY1 AS DOUBLE 
    dim VZ1 AS DOUBLE
    
    DIM VZZ AS DOUBLE    
    dim vxx as double
    dim vyy as double
    
    DIM VDV AS DOUBLE

'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################

For a=1 To points

    VX1=VX(A)
    VY1=VY(A)
    VZ1=VZ(A)
    
'######################
'## X,Y,Z rotations! ##
'######################
  Vxx=Vx1
  Vyy=Vy1*cos(Vxr)+Vz1*sin(Vxr)
  Vzz=Vz1*cos(Vxr)-Vy1*sin(Vxr)
  
  Vy1=Vyy
  Vx1=Vxx*cos(Vyr)-Vzz*sin(Vyr)
  Vz1=Vxx*sin(Vyr)+Vzz*cos(Vyr)
  
  Vzz=Vz1
  Vxx=Vx1*cos(Vzr)-Vy1*sin(Vzr)
  Vyy=Vx1*sin(Vzr)+Vy1*cos(Vzr)
'########################
'## Apply Perspective! ##
'########################
  Vdv=(Vzz/4)+1
  Vxx=(size*(Vxx/Vdv))+(XRES/2)-60
  Vyy=(size*(Vyy/Vdv))+(YRES/2)-60
  Vtx(a)=(Vxx)
  Vty(a)=(Vyy)
  Vtz(a)=(Vzz)
  VtT(a)=(VT(A))
  'buffer(vtx(a)+(vty(a)*xres)) = &hffffff
 

 
 Next 
 
        Vxr=Vxr+.01
        Vyr=Vyr+.02 
        Vzr=Vzr+.03 

END SUB


data -1,-1,-1,1
data  0,-1,-1,1
data  1,-1,-1,1
data -1, 0,-1,1
data  0, 0,-1,1
data  1, 0,-1,1
data -1, 1,-1,1
data  0, 1,-1,1
data  1, 1,-1,1

data -1,-1, 0,2
data  0,-1, 0,2
data  1,-1, 0,2
data -1, 0, 0,2
data  0, 0, 0,2
data  1, 0, 0,2
data -1, 1, 0,2
data  0, 1, 0,2
data  1, 1, 0,2

data -1,-1, 1,3
data  0,-1, 1,3
data  1,-1, 1,3
data -1, 0, 1,3
data  0, 0, 1,3
data  1, 0, 1,3
data -1, 1, 1,3
data  0, 1, 1,3
data  1, 1, 1,3

benny! · « **Reply #1 on:** June 28, 2009 »

Outstanding VectorBobs. Very cool. With seeing the lightsource
it makes much more sense now. Brilliant work, mate! That's truley
oldschoolish!

Pixel_Outlaw · « **Reply #2 on:** June 28, 2009 »

A very nice set of balls you are displaying there.

Shockwave · « **Reply #3 on:** June 28, 2009 »

Thank you, Im glad that you like them.. They are quite big.

Pixel_Outlaw · « **Reply #4 on:** June 28, 2009 »

One thing that might make it stand out even more is to consider using gradients that are not so linear. When a person looks at a metallic object, they know it is metal often because they see light reflections next to darker areas. Logically this could never be so we understand that there is an object being reflected. What you might try is giving each ball a sort of base reflection (which would be a very abstract series of light and dark) and then drawing your effect as a sort of transparent overlay. The world reflections on the balls would not move but your light mapped overlay light effect would.

Here we have a very basic but effective chrome reflection. This is very generic but we see a world reflected here.

Even though you can see the sun reflected there, that does not mean that the close light reflection comes directly from that angle. This frees you to put the reflection spot anywhere regardless of where the sun is "mapped".

Shockwave · « **Reply #5 on:** June 28, 2009 »

Damned nice idea P_O

I think that it could work too, just by blending the circular gradient over the base image your effect could be displayed.

I do like my balls, I know not everyone has balls of steel so I felt a bit bad about displaying them at first to be honest.

Now my balls are on display for everyone to see I think that I want them to look as good as possible so I will be very happy for anyone to play with my balls to add this effect to them.

Thanks mate

ferris · « **Reply #6 on:** July 03, 2009 »

Pretty cool

I remember the same effect in Blitz in DBF's Alive; also did one myself.

Great metallic spin

Shockwave · « **Reply #7 on:** July 03, 2009 »

You have a good memory

I was actually looking at that old demo and decided to make a freebasic version

ferris · « **Reply #8 on:** July 04, 2009 »

Good memory? Nah, just my favorite old demo

That and WhammyKefBalls

Fash's best work, along with No-3D I have to say.

Shockwave · « **Reply #9 on:** July 04, 2009 »

I spoke to Parabellum about a year and a half ago via Email

He has made a vectrex emulator in Java, it's brilliant. His blog is here;

http://vectrex-emu.blogspot.com/

It hasnt been updated since last year but it's fantastic stuff.

ferris · « **Reply #10 on:** July 04, 2009 »

Wow, great to see he's still kickin'

Shockwave · « **Reply #11 on:** July 12, 2009 »

Quote from: Ferris on July 04, 2009

Wow, great to see he's still kickin'

I wish that he would come back to be honest with you Ferris, he's one of my oldest friends on the internet and I miss the chats we used to have a great deal.

Author Topic: Steel vectorballs (Read 5110 times)

Shockwave

Steel vectorballs

benny!

Re: Steel vectorballs

Pixel_Outlaw

Re: Steel vectorballs

Shockwave

Re: Steel vectorballs

Pixel_Outlaw

Re: Steel vectorballs

Shockwave

Re: Steel vectorballs

ferris

Re: Steel vectorballs

Shockwave

Re: Steel vectorballs

ferris

Re: Steel vectorballs

Shockwave

Re: Steel vectorballs

ferris

Re: Steel vectorballs

Shockwave

Re: Steel vectorballs