MATHCOMP 3D Landscape

[Shockwave]

Code: [Select]

' Computer generated landscape programmed by Shockwave 2006.
' There is nothing especially clever about this, it uses some sin power to make
' the landscape and the colour palette by deforming a 3D grid.
' I wanted to add some interpolation, textures and proper rotations to this but ran
' out of time.
' Apologies for the uncommented code.
'-------------------------------------------------------------------------------


    CONST   XRES = 640:' SCREEN WIDTH
    CONST   YRES = 480:' SCREEN HEIGHT
   
    #include "ptc.bi"
   
    DIM SHARED AS UINTEGER BUFFER ( XRES * YRES ) :' SCREEN BUFFER
   
    PTC_SETFLIP(1) :' SCREEN SYNC ON.
   
    CONST GRX = 50
    CONST GRY = 50
   
    dim shared AS DOUBLE GRIDX ( GRX*2, GRY*2 )
    dim shared AS DOUBLE GRIDY ( GRX*2, GRY*2 )
    dim shared AS DOUBLE GRIDZ ( GRX*2, GRY*2 )

    dim shared AS DOUBLE GRIDR ( GRX*2, GRY*2 )
    dim shared AS DOUBLE GRIDG ( GRX*2, GRY*2 )
    dim shared AS DOUBLE GRIDB ( GRX*2, GRY*2 )

   
    dim shared as integer ttx( grx*2 , gry*2 )
    dim shared as integer tty( grx*2 , gry*2 )
   
    dim shared as double palettr(500)
    dim shared as double palettg(500)
    dim shared as double palettb(500)
   
    DIM SHARED AS DOUBLE XINTR,YINTR,XSRT,ZSRT,mmmm,zoom,yz,mmmmr,mmmmg,mmmm2,xz
    DIM SHARED AS INTEGER X,Y,gadd
   
   
        ZSRT=GRY+50
    FOR Y=-GRY TO GRY
        XSRT=-50
       
    FOR X=-GRX TO GRX
       
        XSRT=XSRT + 1
        mmmm=42*sin((Y+X)/9)
       
         
         GRIDX( X+50 , Y+50 ) = XSRT*4
         GRIDZ( X+50 , Y+50 ) = (ZSRT*30) /10000
         
         GRIDY( X+50 , Y+50) = (mmmm*SIN((Y/12))+mmmm*SIN(X/11))+319+(RND(1)*15)
         
         'GRIDB( X+50 , Y+50) = 2.5
         
         GRIDR( X+50 , Y+50) = (320-GRIDY( X+50 , Y+50)) / 6
         GRIDG( X+50 , Y+50) = (350-GRIDY( X+50 , Y+50)) / 22
         GRIDB( X+50 , Y+50) = (310-GRIDY( X+50 , Y+50)) / 28
         
        if gridr(X+50 , y+50) <0 then gridr(X+50 , y+50) = 0
        if gridg(X+50 , y+50) <0 then gridg(X+50 , y+50) = 0
        if gridb(X+50 , y+50) <1 then gridb(X+50 , y+50) = 1
       
        if gridr(X+50 , y+50) >2.5 then gridr(X+50 , y+50) = 2.5
        if gridg(X+50 , y+50) >2.5 then gridg(X+50 , y+50) = 2.5
        if gridb(X+50 , y+50) >2.0 then gridb(X+50 , y+50) = 2.0
        if  GRIDY( X+50 , Y+50) > 339 then GRIDY( X+50 , Y+50) = 339
    NEXT
        ZSRT=ZSRT + 1
    NEXT
   
   
   
    DECLARE SUB FLAT_TRIANGLE( BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL X3 AS INTEGER, BYVAL Y3 AS INTEGER , BYVAL TR AS INTEGER, BYVAL TG AS INTEGER, BYVAL TB AS INTEGER)
    DECLARE SUB TRANSFORM()
   
    ' OPEN THE SCREEN;
   
        IF ( PTC_OPEN ( "COMPUTER GENERATED LANDSCAPE BY SHOCKWAVE", XRES, YRES ) = 0 ) THEN
        END -1
        END IF
   
    ' MAIN LOOP;
   
   
    WHILE(1)
        gadd=gadd+1
        zoom=.1+(.1*sin(gadd/37))
        yz=89.2*sin(gadd/47)
        xz=189.2*sin(gadd/57)
        TRANSFORM()
       
        PTC_UPDATE @ BUFFER(0)
        ERASE BUFFER
    WEND




SUB TRANSFORM()
   
    DIM AS INTEGER XL,YL,TX,TY,rv,gv,bv
    dim as double cul
    'cul=150
    FOR YL = GRY TO  -GRY  step -1
        FOR XL = -GRX TO GRX
            TX = 320 + (  xz+ GRIDX ( XL+50 , YL+50 ) / (zoom+(GRIDZ (XL+50 , YL+50 ) )))
            TY =  (   GRIDY ( XL+50 , YL+50 ) / (zoom+(GRIDZ (XL+50 , YL+50 ) )))-250

            TTX (XL+50,YL+50) = TX
            TTY (XL+50,YL+50) = TY
           
            if tx>0 and tx<xres-1 and ty>0 and ty<yres-1 then
               ' buffer(tx+(ty*xres))=rgb (cul,cul,cul)
            end if
        NEXT
     '   cul=cul+.01
    NEXT
    cul=15
   
    FOR YL = 99 TO 1 step-1
        FOR XL = 0 TO 99
            bv=cul*((gridb(XL,YL)+gridb(XL+1,YL)+gridb(XL,YL+1))/3)
            rv=cul*((gridr(XL,YL)+gridr(XL+1,YL)+gridr(XL,YL+1))/3)
            gv=cul*((gridg(XL,YL)+gridg(XL+1,YL)+gridg(XL,YL+1))/3)
           
            flat_triangle(ttx(xl,yl),tty(xl,yl),ttx(xl+1,yl),tty(xl+1,yl),ttx(xl,yl+1),tty(xl,yl+1),rv,gv,bv)
            bv=cul*((gridb(XL+1,YL)+gridb(XL+1,YL+1)+gridb(XL,YL+1))/3)
            rv=cul*((gridr(XL+1,YL)+gridr(XL+1,YL+1)+gridr(XL,YL+1))/3)
            gv=cul*((gridg(XL+1,YL)+gridg(XL+1,YL+1)+gridg(XL,YL+1))/3)
            flat_triangle(ttx(xl+1,yl),tty(xl+1,yl),ttx(xl+1,yl+1),tty(xl+1,yl+1),ttx(xl,yl+1),tty(xl,yl+1),rv,gv,bv)
        next
        cul=cul+.75
    next
   
   
   
END SUB


SUB FLAT_TRIANGLE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL X3 AS INTEGER, BYVAL Y3 AS INTEGER , BYVAL TR AS INTEGER,  BYVAL TG AS INTEGER, BYVAL TB AS INTEGER)
'-------------------------------------------------------------------------
' FLAT TRIANGLE RENDERER WITH ASSEMBLY LANGUAGE RASTERISING BY SHOCKWAVE ^ DBF ^ S!P 2006.
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
' WE NEED TO SORT THESE POINTS INTO ORDER FROM TOP TO BOTTOM, AN EXCHANGE SORT IS OK.
' AS WE ONLY HAVE GOT 3 POINTS TO ARRANGE.
'-------------------------------------------------------------------------
DIM AS INTEGER TEMPX,TEMPY,LO,LI,TC
                DIM AS INTEGER PX(3)
                DIM AS INTEGER PY(3)
                DIM TFLAG AS INTEGER
                dim pp as uinteger PTR
                DIM AS INTEGER IL1,IL2,SLICE
                TFLAG=0
        TC=rgb(tr,tg,tb)
        PX(1)= X1
        PX(2)= X2
        PX(3)= X3
       
        PY(1)= Y1
        PY(2)= Y2
        PY(3)= Y3

FOR LO = 1 TO 2
    FOR LI =1 TO 2     
        IF PY(LI+1) <= PY(LI) THEN
        TEMPX = PX(LI) : TEMPY = PY(LI)
        PX(LI) = PX(LI+1)
        PY(LI) = PY(LI+1)
        PX(LI+1) = TEMPX
        PY(LI+1) = TEMPY
        END IF   
    NEXT LI
NEXT LO

'   BOOT OUT INVISIBLE TRIANGLES!

    IF PX(1)<0 AND PX(2)<0  AND PX(3)< 0 THEN TFLAG=1
    IF PX(1)>XRES AND PX(2)>XRES  AND PX(3)>XRES THEN TFLAG=1
    IF PY(1)>YRES AND PY(2)>YRES  AND PY(3)>YRES THEN TFLAG=1
   
        DIM AS DOUBLE XP1,XP2:' SCREEN POSITIONS.
        DIM AS DOUBLE XI1,XI2:' INTERPOLATIONS.
       
'***
'*** REGULAR TRIANGLE (Y1<Y2 Y2<Y3)
'***

IF PY(1)<PY(2) AND PY(2)<PY(3) or (PY(2) = PY(3)) THEN
    TFLAG=1
XP1 = PX(1)
XP2 = PX(1)
XI1 = (PX(1)-PX(2)) / (PY(2) - PY(1))
XI2 = (PX(1)-PX(3)) / (PY(3) - PY(1))

FOR LO = PY(1) TO PY(2)-1
   
IF LO>=0 AND LO<YRES THEN

    IF XP1<=XP2 THEN
        IL1=XP1
        IL2=XP2
    ELSE
        IL1=XP2
        IL2=XP1
    END IF
   
    IF IL2>XRES THEN IL2=XRES
    IF IL1<0 THEN IL1=0

    SLICE = IL2-IL1
    IF SLICE>0 THEN
   
   
   
    PP = @BUFFER(IL1+(LO*XRES))   
    asm
        mov eax,dword ptr[TC]
        mov ecx, [slice]
        mov edi, [PP]
        rep stosd
    end asm   
    END IF
   

END IF

XP1=XP1-XI1
XP2=XP2-XI2
NEXT

XI1 = (PX(2)-PX(3)) / (PY(3) - PY(2))
XP1 = PX(2)

FOR LO = PY(2) TO PY(3)
IF LO>=0 AND LO<YRES THEN
    IF XP1<=XP2 THEN
        IL1=XP1
        IL2=XP2
    ELSE
        IL1=XP2
        IL2=XP1
    END IF

    IF IL2>XRES THEN IL2=XRES
    IF IL1<0 THEN IL1=0

    SLICE = IL2-IL1
    IF SLICE>0 THEN
 

    PP = @BUFFER(IL1+(LO*XRES))   
   
    asm
        mov eax,dword ptr[TC]
        mov ecx, [slice]
        mov edi, [PP]
        rep stosd
    end asm   
    END IF
END IF
XP1=XP1-XI1
XP2=XP2-XI2
NEXT

END IF


'***
'*** FLAT TOPPED TRIANGLE Y1=Y2
'***

IF TFLAG=0 AND PY(1) = PY(2) THEN
   
        TFLAG=1
        XP1 = PX(1)
        XP2 = PX(2)
        XI1 = (PX(1)-PX(3)) / (PY(3) - PY(1))
        XI2 = (PX(2)-PX(3)) / (PY(3) - PY(2))
FOR LO = PY(1) TO PY(3)
 IF LO>=0 AND LO<YRES THEN
    IF XP1<=XP2 THEN
        IL1=XP1
        IL2=XP2
    ELSE
        IL1=XP2
        IL2=XP1
    END IF
   
    IF IL2>XRES THEN IL2=XRES
    IF IL1<0 THEN IL1=0
   
    SLICE = IL2-IL1
    IF SLICE>0 THEN
   
    PP = @BUFFER(IL1+(LO*XRES))   
   
    asm
        mov eax,dword ptr[TC]
        mov ecx, [slice]
        mov edi, [PP]
        rep stosd
    end asm   
    END IF
END IF
    XP1=XP1-XI1
    XP2=XP2-XI2

NEXT
END IF
END SUB

Hope you like it, it needs the ptc lib by Jim and Rbraz.

[Rbz]

Fantastic 

[Shockwave]

Thanks Rbraz

[lilw4t3rdr0p]

Hey, is that UTAH? The mountains have colors like that at sunset. Very nice! ..... Are you spying on me? te he

[rdc]

Nice one.

[benny!]

I always like such computer generated landscapes ... really good!

[Ghost^BHT]

Very nice  excellent work

[Clyde]

Wow, very impressive work

[taj]

Extremely smooth on my laptop, is that soft rendering shockie?

[Shockwave]

Yep, all softrendered

[slinks]

Very nice, I wouldn't expect anything less

[Shockwave]

Cheers