Lenses source code

[Shockwave]

The source to the fastcoded thing I posted a little while ago in the challenge thread.

Code: [Select]

'
'      Magnabobs for the Magnification Challenge by Shockwave (C) 2009.
'
'===============================================================================


        OPTION STATIC
        OPTION EXPLICIT
       
'===============================================================================
'                                  Includes;
'===============================================================================

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

'===============================================================================
'                                  Variables;
'===============================================================================

        CONST   XRES    =   800
        CONST   YRES    =   600
       
        DIM SHARED AS INTEGER MAX_SIZE = 256:'HOW BIG CAN THE LENSE GET IN PIXELS       
       
        DIM SHARED AS UINTEGER SCREEN_BUFFER ( XRES * YRES )
        DIM SHARED AS UINTEGER SCREEN_BUFFER2( XRES * YRES ): '        Stores the backgroung pattern.
        DIM SHARED AS UINTEGER LENSE_BUFFER  ( MAX_SIZE * MAX_SIZE )
        DIM SHARED AS UINTEGER LENSE_START   ( MAX_SIZE ):' Offest to start copying to
        DIM SHARED AS UINTEGER LENSE_WIDTH   ( MAX_SIZE ):' How wide is each slice?
       
'===============================================================================
'                                  Subs;
'===============================================================================

        DECLARE SUB GEN_PATTERN()
        DECLARE SUB FILL_SCREEN()
       
        DECLARE SUB DRAW_LENSE(BYVAL XC AS INTEGER ,BYVAL YC AS INTEGER,BYVAL RAD AS INTEGER)


'===============================================================================
'                              Initialisation;
'===============================================================================

    PTC_ALLOWCLOSE(0)
    PTC_SETDIALOG(0,"",0,1)               

    IF (PTC_OPEN("(C) SHOCKWAVE",XRES,YRES)=0) THEN
    END-1
    END IF 
    GEN_PATTERN()
'===============================================================================
'                               Main Loop;
'===============================================================================

dim as integer ll
dim counter as double
dim as integer LM,RM

WHILE (GETASYNCKEYSTATE(VK_ESCAPE)<> -32767)
    counter=counter+.01
    FILL_SCREEN()
    FOR LL=1 TO 5
        DRAW_LENSE(400+170*sin((counter+LL)*1.4),300+170*sin((counter-LL)*1.1),250)
    NEXT

    PTC_UPDATE@SCREEN_BUFFER(0)
    SLEEP 1   
WEND
PTC_CLOSE()
EXITPROCESS(0)
END

SUB DRAW_LENSE(BYVAL XC AS INTEGER ,BYVAL YC AS INTEGER,BYVAL RAD AS INTEGER)
   
    DIM AS INTEGER COPY_TOP,COPY_BOT,COPY_WIDTH
   
'-------------------------------------------------------------------------------   
' FIRST STORE THE RECTANGLE TO BE MAPPED INTO  THE TEMPORARY BUFFER
'-------------------------------------------------------------------------------

    COPY_WIDTH=RAD/4:' BECAUSE THE CHUNK WE COPY IS HALF THE RADIUS OF THE LENSE
                     ' THIS MEANS IT WILL BE MAGNIFIED, IF THE COPY WIDTH WAS
                     ' WIDER IT WOULD BE A REFRACTION AND NOT A MAGNIFICATION.

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

    COPY_TOP=YC-COPY_WIDTH:' WE NEED TO GRAB A RECTANGULAR SQUARE OUT OF THE
    COPY_BOT=XC-COPY_WIDTH:' BUFFER SO THAT WE CAN MAP IT ONTO THE SPHERE.
   
    DIM AS INTEGER YL,XL
    DIM AS UINTEGER PTR PP1,PP2
   
'-------------------------------------------------------------------------------
'              COPY RECTANGULAR REGION INTO SEQUENTIAL BUFFER;
'-------------------------------------------------------------------------------

    PP2=@LENSE_BUFFER(0)
    FOR YL=YC-COPY_WIDTH TO YC+COPY_WIDTH   
        PP1=@SCREEN_BUFFER((YL*XRES)+(XC-COPY_WIDTH))
       
        FOR XL=XC-COPY_WIDTH TO XC+COPY_WIDTH
            *PP2=*PP1
            PP1+=1
            PP2+=1
        NEXT         
    NEXT

'-------------------------------------------------------------------------------
'                             DRAW THE LENSE!
'-------------------------------------------------------------------------------
    DIM AS DOUBLE U,V
    DIM AS DOUBLE INTERPOL,X_INTER
   
   
    V=0

    RAD=RAD/2
    DIM AS INTEGER R2,LOOPY,WW,LP,XX,xcc,ycc
    xcc=xc-rad
    ycc=yc-rad       
    LP=0
    FOR LOOPY = -RAD TO RAD       
        WW = Sqr((RAD*RAD)-LOOPY*LOOPY)
        LENSE_START(LP) = (RAD-WW)
        LENSE_WIDTH(LP) = (RAD+WW)-(RAD-WW)
        LP=LP+1
    NEXT
    V=0
    U=0
    DIM CUNT AS INTEGER
    DIM ARSE AS UINTEGER PTR   
    INTERPOL=.5
    FOR LP=0 TO RAD*2   
        X_INTER=((RAD)/(LENSE_WIDTH(LP)))
        U=0
        CUNT=INT(V)*RAD
        ARSE=@SCREEN_BUFFER(((LP+ycc)*XRES)+LENSE_START(LP)+(XCC-2))       
        *ARSE=&H000000
        ARSE+=1
        *ARSE=&H000000
        ARSE+=1
       
        FOR XX=0 TO LENSE_WIDTH(LP)
            *ARSE=LENSE_BUFFER(CUNT+INT(U))
            ARSE+=1
            U=U+x_inter
        NEXT
        *ARSE=&H000000
        ARSE+=1
        *ARSE=&H000000
    V=V+INTERPOL
    NEXT
   

END SUB




SUB FILL_SCREEN()
DIM AS INTEGER X,Y,RR

DIM PP1 AS UINTEGER PTR
DIM PP2 AS UINTEGER PTR
PP1=@SCREEN_BUFFER(0)
PP2=@SCREEN_BUFFER2(0)
FOR Y=0 TO XRES*YRES
    *PP1=*PP2
   PP1+=1
   PP2+=1
NEXT
END SUB


SUB GEN_PATTERN()
DIM AS INTEGER X,Y,RR,STC,MO,Y2,LL,STP
STC=1
MO=1
STP=15
FOR Y=0 TO YRES-1 STEP STP
   
    MO=MO+1
    IF MO>3 THEN MO=1
    STC=MO
   
    FOR Y2=0 TO STP-1
        FOR X=0 TO XRES-1 STEP STP
           
            IF STC=1 THEN RR=RGB(Y/5,Y/4,Y/3)
            IF STC=2 THEN RR=RGB(Y/4,Y/3,Y/5)
            IF STC=3 THEN RR=RGB(Y/3,Y/5,Y/4)
           
            FOR LL=0 TO STP
            SCREEN_BUFFER2(X+LL+( (Y+Y2)*XRES))=RR
            NEXT
            STC=STC+1
            IF STC>3 THEN STC=1

        NEXT
    NEXT Y2
NEXT

END SUB


[DrewPee]

At this moment I have no idea how you do that - so I am intrigued, will be looking at the code and hopefully understanding at least some of it!

Thanks for the code Shockwave!

[Ferris]

k++

[Shockwave]

Cheers for the Karma

[rdc]

Nifty as always.

[Shockwave]

Cheers Rick