Here's the finished article.
'
' Filled tunnel by Shockwave.
'
' Uncredited ripping is lamer behaviour and puts people off sharing their code.
' Props to you if you share credit.
'
' http://www.dbfinteractive.com/index.php
'
'
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'>> LIBS:
'-------------------------------------------------------------------------------
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
OPTION STATIC
OPTION EXPLICIT
'-------------------------------------------------------------------------------
'>> SCREENSIZE;
'-------------------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
'-------------------------------------------------------------------------------
'>> VARIABLES;
'-------------------------------------------------------------------------------
DIM SHARED AS INTEGER RINGS = 40
DIM SHARED AS INTEGER STEP_SIZE = 10
DIM SHARED AS INTEGER RADIUS = 1600
DIM SHARED AS INTEGER HALFX
DIM SHARED AS INTEGER HALFY
HALFX=XRES/2
HALFY=YRES/2
DIM SHARED AS DOUBLE PX(360/STEP_SIZE)
DIM SHARED AS DOUBLE PY(360/STEP_SIZE)
DIM SHARED AS DOUBLE RAD2DEG
DIM SHARED AS DOUBLE RAD2DEG2
DIM SHARED AS DOUBLE RAD2DEG3
DIM SHARED AS DOUBLE MOVE,CLICKM
DIM SHARED AS INTEGER T_PX( 360 / STEP_SIZE , RINGS )
DIM SHARED AS INTEGER T_PY( 360 / STEP_SIZE , RINGS )
MOVE=0
RAD2DEG = ((4 * ATN ( 1 ))/180)
RAD2DEG2 = ((4 * ATN ( 1 ))/270)
RAD2DEG3 = ((4 * ATN ( 1 ))/720)
DECLARE SUB PRECALCRING()
DECLARE SUB DRAWTUNNEL()
DECLARE SUB 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)
DIM SHARED AS DOUBLE OLD,TICK,ADD
'-------------------------------------------------------------------------------
'>> INITIALISE SCREEN;
'-------------------------------------------------------------------------------
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"WWW.DBFINTERACTIVE.COM"+CHR$(13)+"FULL SCREEN?",0,1)
IF (PTC_OPEN("By Shockwave",XRES,YRES)=0) THEN
END-1
END IF
SLEEP 5
'-------------------------------------------------------------------------------
'>> MAIN LOOP;
'-------------------------------------------------------------------------------
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
OLD=TIMER
precalcring()
DRAWTUNNEL()
PTC_UPDATE@BUFFER(0)
ERASE BUFFER
SLEEP 1
TICK=(TIMER-OLD)*10
ADD=ADD+(TICK * 10)
WEND
EXITPROCESS(0)
SUB DRAWTUNNEL()
DIM AS DOUBLE DEPTH
DIM AS DOUBLE DADD
DIM AS DOUBLE XSINE,YSINE
DIM AS INTEGER O,L,C,X,Y,ADDITIVE
DEPTH=20
DADD=DEPTH/RINGS
DEPTH=DEPTH+MOVE
MOVE=MOVE-TICK
CLICKM=CLICKM-TICK
ADDITIVE=CLICKM
IF MOVE<=0 THEN
MOVE=MOVE+(DADD*2)
CLICKM=CLICKM-(DADD*59)
END IF
'-------------------------------------------------------------------------------
' CALCULATE WHERE ALL THE POINTS ARE FOR THE TUNNEL!
'-------------------------------------------------------------------------------
dim as double xsine2,ysine2
dim as double lme
lme=3+2.3*sin(add*rad2deg3)
FOR O=1 TO RINGS
C=0
XSINE=500*SIN(ADDITIVE*(RAD2DEG2))
YSINE=500*COS(ADDITIVE*(RAD2DEG2))
xsine2=xsine/lme
ysine2=ysine/lme
FOR L=0 TO 360 STEP STEP_SIZE
T_PX(C,O)=INT((PX(C)+XSINE)/DEPTH)+(HALFX-(xsine2))
T_PY(C,O)=INT((PY(C)+YSINE)/DEPTH)+(HALFY-(ysine2))
C+=1
NEXT
ADDITIVE=ADDITIVE+15
DEPTH=DEPTH-DADD
NEXT
'-------------------------------------------------------------------------------
' AND NOW WE MUST DRAW IT!
'-------------------------------------------------------------------------------
DIM AS INTEGER X1,X2,X3,X4,Y1,Y2,Y3,Y4,INC,INCS,mover
DIM AS UINTEGER TC1,TC2,TC3,tc4,oo
INCS=0
mover=move/2
FOR O=1 TO RINGS-1
C=0
OO=(O+mover)/3
TC1=(O+mover)*2
TC2=(O+mover)*2.1
TC3=(O+mover)*2.2
TC4=(O+mover)*2.3
INCS=INCS+1
IF INCS>1 THEN INCS=0
INC=INCS
FOR L=0 TO 360-STEP_SIZE STEP STEP_SIZE
X1=T_PX(C,O)
X2=T_PX(C+1,O)
X3=T_PX(C+1,O+1)
X4=T_PX(C,O+1)
Y1=T_PY(C,O)
Y2=T_PY(C+1,O)
Y3=T_PY(C+1,O+1)
Y4=T_PY(C,O+1)
SELECT CASE INC
CASE 1
TRIANGLE(X1,Y1,X2,Y2,X3,Y3,tc1,oo,oo)
TRIANGLE(X1,Y1,X3,Y3,X4,Y4,tc1,oo,oo)
CASE 2
TRIANGLE(X1,Y1,X2,Y2,X3,Y3,TC2,tc4,oo)
TRIANGLE(X1,Y1,X3,Y3,X4,Y4,TC2,tc4,oo)
CASE 3
TRIANGLE(X1,Y1,X2,Y2,X3,Y3,tc3,oo,oo)
TRIANGLE(X1,Y1,X3,Y3,X4,Y4,tc3,oo,oo)
CASE ELSE
TRIANGLE(X1,Y1,X2,Y2,X3,Y3,tc4,oo,oo)
TRIANGLE(X1,Y1,X3,Y3,X4,Y4,tc4,oo,oo)
END SELECT
INC+=1
IF INC>3 THEN INC=0
C+=1
NEXT
NEXT
END SUB
SUB PRECALCRING()
DIM AS INTEGER L,C,x,y
DIM AS DOUBLE XX,YY,RADDY,RADDY2
C=0
RADDY =RADIUS+450*SIN((ADD*3)* RAD2DEG)
RADDY2=RADIUS+450*COS((ADD*2)* RAD2DEG)
FOR L=0 TO 360 STEP STEP_SIZE
XX = (RADDY * SIN ((L+(ADD)) * RAD2DEG) )
YY = (RADDY2 * COS ((L+(ADD)) * RAD2DEG) )
PX(C)=XX
PY(C)=yy
C+=1
NEXT
END SUB
SUB 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.
'
' USAGE : TRIANGLE ( X1 , Y1 , X2 , Y2 , X3 , Y3 , R , G , B )
' CLIPS TO SCREEN BOUNDARIES.
'
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
' 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
