Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on March 24, 2007
-
Does what it says on teh tin :)
'
' Vitality V2.
' By Cock Shave
'-------------------------------------------------------------------------------
' STATIC ARRAYS, ALL VARIABLES TO BE DEFINED.
'-------------------------------------------------------------------------------
#DEFINE PTC_WIN
#INCLUDE "TINYPTC.BI"
OPTION STATIC
OPTION EXPLICIT
'-------------------------------------------------------------------------------
' SCREEN DIMENSIONS;
'-------------------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
'-------------------------------------------------------------------------------
' VARIABLE DEFINITIONS;
'-------------------------------------------------------------------------------
DIM SHARED AS UINTEGER BUFFER ( XRES * YRES ):' SCREEN BUFFER.
DIM SHARED AS DOUBLE OLDTIME = 0:' STORES OLD TIMER READING.
DIM SHARED AS UINTEGER TICKS = 0:' COUNTS ELAPSED FRAMES.
CONST PI AS DOUBLE = 3.1415926535897932
CONST POINTS = 5000
CONST STEPS = 20
DIM SHARED AS DOUBLE PX(POINTS):' HOLDS X POINTS
DIM SHARED AS DOUBLE PY(POINTS):' HOLDS Y POINTS
DIM SHARED AS DOUBLE PZ(POINTS):' HOLDS Z POINTS
DIM SHARED AS DOUBLE PTX(POINTS):' HOLDS TRANSFORMED X POINTS
DIM SHARED AS DOUBLE PTY(POINTS):' HOLDS TRANSFORMED Y POINTS
DIM SHARED AS DOUBLE PTZ(POINTS):' HOLDS TRANSFORMED Z POINTS
'-------------------------------------------------------------------------------
' SUBROUTINES;
'-------------------------------------------------------------------------------
DECLARE SUB FPS()
DECLARE SUB CALCULATE_OBJECT()
DECLARE SUB DRAW_OBJECT()
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)
'-------------------------------------------------------------------------------
' OPEN THE SCREEN;
'-------------------------------------------------------------------------------
IF (PTC_OPEN("VITALITY",XRES,YRES)=0) THEN
END-1
END IF
OLDTIME = TIMER
'-------------------------------------------------------------------------------
' PRECALCULATION;
'-------------------------------------------------------------------------------
CALCULATE_OBJECT()
DIM SHARED GADD AS DOUBLE
'-------------------------------------------------------------------------------
' THE MAIN LOOP;
'-------------------------------------------------------------------------------
WHILE(1)
GADD=GADD+.5
CALCULATE_OBJECT()
DRAW_OBJECT()
PTC_UPDATE@BUFFER(0)
ERASE BUFFER
TICKS=TICKS+1
FPS()
WEND
'-------------------------------------------------------------------------------
' END OF MAIN LOOP.
'-------------------------------------------------------------------------------
END
SUB DRAW_OBJECT
DIM AS INTEGER A,TX,TY
'
' TRANSFORM OBJECT
'
FOR A = 1 TO (STEPS*2)+13
PTX(A)=INT((PX(A)) + 400)
PTY(A)=INT((PY(A)) + 300)
NEXT
'
' DRAW OBJECT
'
FOR A=1 TO STEPS
TRIANGLE(PTX(A),PTY(A),PTX(A+1),PTY(A+1),PTX(A+STEPS+1),PTY(A+STEPS+1),0,0,50)
TRIANGLE(PTX(A+1),PTY(A+1),PTX(A+STEPS+2),PTY(A+STEPS+2),PTX(A+STEPS+1),PTY(A+STEPS+1),0,0,50)
NEXT
A=(STEPS*2)+3
TRIANGLE(PTX(A),PTY(A),PTX(A+2),PTY(A+2),PTX(A+5),PTY(A+5),0,0,50)
TRIANGLE(PTX(A+5),PTY(A+5),PTX(A+2),PTY(A+2),PTX(A+7),PTY(A+7),0,0,50)
TRIANGLE(PTX(A+2),PTY(A+2),PTX(A+4),PTY(A+4),PTX(A+9),PTY(A+9),0,0,50)
TRIANGLE(PTX(A+7),PTY(A+7),PTX(A+2),PTY(A+2),PTX(A+9),PTY(A+9),0,0,50)
TRIANGLE(PTX(A+4),PTY(A+4),PTX(A+1),PTY(A+1),PTX(A+6),PTY(A+6),0,0,50)
TRIANGLE(PTX(A+4),PTY(A+4),PTX(A+9),PTY(A+9),PTX(A+6),PTY(A+6),0,0,50)
TRIANGLE(PTX(A+1),PTY(A+1),PTX(A+3),PTY(A+3),PTX(A+8),PTY(A+8),0,0,50)
TRIANGLE(PTX(A+1),PTY(A+1),PTX(A+6),PTY(A+6),PTX(A+8),PTY(A+8),0,0,50)
TRIANGLE(PTX(A),PTY(A),PTX(A+3),PTY(A+3),PTX(A+5),PTY(A+5),0,0,50)
TRIANGLE(PTX(A+5),PTY(A+5),PTX(A+8),PTY(A+8),PTX(A+3),PTY(A+3),0,0,50)
END SUB
'-------------------------------------------------------------------------------
' CALCULATE THE VECTOR OBJECT.
'-------------------------------------------------------------------------------
SUB CALCULATE_OBJECT()
DIM AS INTEGER A
DIM AS DOUBLE ANG
DIM AS DOUBLE ADD
ANG = GADD
ADD = 361 / STEPS
FOR A=1 TO STEPS+1
PX(A) = 200*SIN(ANG*PI/180)
PY(A) = 200*COS(ANG*PI/180)
PX(A+STEPS+1) = 210*SIN(ANG*PI/180)
PY(A+STEPS+1) = 210*COS(ANG*PI/180)
ANG=ANG+ADD
NEXT
ADD=72
ANG=GADD
for a=(STEPS*2)+3 TO (STEPS*2)+7
PX(A) = 170*SIN(ANG*PI/180)
PY(A) = 170*COS(ANG*PI/180)
PX(A+5) = 200*SIN(ANG*PI/180)
PY(A+5) = 200*COS(ANG*PI/180)
ANG=ANG+ADD
NEXT
END SUB
'-------------------------------------------------------------------------------
' DOES NOTHING UNLESS ONE SECOND HAS PASSED, IF SO DISPLAY FPS AND RESET COUNT.
'-------------------------------------------------------------------------------
SUB FPS()
IF TIMER - OLDTIME >=1 THEN
PRINT STR(TICKS)
TICKS=0
OLDTIME = TIMER
END IF
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
-
Exe attached :P
Very basic effect..
-
Cool..... looks pretty fast to.... nice job
-
Cool. Very Doomish. :)
-
I was watching old Scoopex intros and was feeling nostalgic.. I must have been drunk last night! :D My head hurts anyhow.
-
Great work! :)
A possible (and logical) extension for your great softrender lib would be a function
'fatline()' or 'fatedge()' with a parameter 'linewidth in pixels'
Greetings
stef