Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on September 04, 2008
-
Dreadfully embarrasing but for the sake of completeness here's the other entry I binned :)
'
'REDUCED RESOLUTION TWISTER IN 4 COLOURS
'
'FUCKING SHITTTTTTTTTTTTTTTTTTTTTTTT!!!!!!!!!!!!!!!!!!!!!!!!!!
'
'FUCKING CRAP CODE BY SHOCKIE... BINNED!!!!!!!!!!!!!!!!!!!!
'
'-------------------------------------------------------------------------------
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
OPTION STATIC
OPTION EXPLICIT
' RESOLUTION VARIABLES;
DIM SHARED AS UINTEGER BXRES,BYRES,PIXSIZE,XRES,YRES,PIXSIZY
' COLOUR PALETTE HERE;
DIM SHARED C_PALETTE(3) AS UINTEGER=> {&H000000,&H444444,&H999999,&HEEEEEE}
'-------------------------------------------------------------------------------
XRES=640:' ACTUAL WIDTH
YRES=480:' ACTUAL HEIGHT
BXRES=160:' FRAMEBUFFER WIDTH
BYRES=120:' FRAMEBUFFER HEIGHT
PIXSIZE=4:' PIXEL WIDTH
PIXSIZY=4:' PIXEL HEIGHT
'-------------------------------------------------------------------------------
DIM SHARED AS DOUBLE THETA =0
DIM SHARED AS DOUBLE THETA2=0
DIM SHARED AS DOUBLE THETA3=0
'-------------------------------------------------------------------------------
' DEFINE FRAME BUFFER AND RENDER BUFFER
'-------------------------------------------------------------------------------
DIM SHARED AS UINTEGER FRBUFFER ( BXRES * BYRES )
DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
'-------------------------------------------------------------------------------
' SUBROUTINES
'-------------------------------------------------------------------------------
DECLARE SUB UPDATE_SCREEN()
DECLARE SUB TWISTER()
DECLARE SUB DITHE(BYVAL START AS INTEGER, BYVAL FINISH AS INTEGER, BYVAL YPOS AS INTEGER)
'-------------------------------------------------------------------------------
' OPEN SCREEN;
'-------------------------------------------------------------------------------
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"Reduced Resolution"+CHR$(13)+"FULL SCREEN?",0,0)
IF (PTC_OPEN("Reduced Res",XRES,YRES)=0) THEN
END-1
END IF
'-------------------------------------------------------------------------------
' MAIN LOOP;
'-------------------------------------------------------------------------------
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 AND PTC_GETLEFTBUTTON = FALSE)
THETA =THETA+1.4
THETA2=THETA2+1.2
THETA3=THETA3+1.3
'IF THETA<0 THEN THETA=THETA+360
'IF THETA2>360 THEN THETA2=THETA2-360
'IF THETA3>360 THEN THETA3=THETA3-360
TWISTER()
UPDATE_SCREEN()
PTC_UPDATE@BUFFER(0)
WEND
END
SUB TWISTER()
DIM AS INTEGER Y,Q
DIM AS DOUBLE X1,X2,X3,X4,X5,X6,X7,X8,R2D,LO,W,SLICE
R2D=3.14/180
LO=0
FOR Y=0 TO BYRES-1
LO=30*SIN((Y-THETA3)/17)
W=40+1*SIN((Y-THETA2)*R2D)
X1=W*SIN((((Y+LO)+THETA)*R2D)/2)
X2=W*SIN((((Y+LO)+180+THETA)*R2D)/2)
X3=W*SIN((((Y+LO)+360+THETA)*R2D)/2)
X4=W*SIN((((y+LO)+540+THETA)*R2D)/2)
IF X2>X1 THEN
FOR Q=X1 TO X2
SLICE=INT(X2-X1)
IF SLICE<20 THEN FRBUFFER(80+(Y*BXRES)+Q)=1
IF SLICE>=20 AND SLICE<= 40 THEN FRBUFFER(80+(Y*BXRES)+Q)=2
IF SLICE>40 THEN FRBUFFER(80+(Y*BXRES)+Q)=3
NEXT
'DITHE(INT(X1)+80,INT(X2)+80,Y)
END IF
IF X3>X2 THEN
FOR Q=X2 TO X3
SLICE=INT(X3-X2)
IF SLICE<20 THEN FRBUFFER(80+(Y*BXRES)+Q)=1
IF SLICE>=20 AND SLICE<= 40 THEN FRBUFFER(80+(Y*BXRES)+Q)=2
IF SLICE>40 THEN FRBUFFER(80+(Y*BXRES)+Q)=3
'FRBUFFER(80+(Y*BXRES)+Q)=2
NEXT
'DITHE(INT(X2)+80,INT(X3)+80,Y)
END IF
IF X4>X3 THEN
FOR Q=X3 TO X4
FRBUFFER(80+(Y*BXRES)+Q)=3
NEXT
'DITHE(INT(X3)+80,INT(X4)+80,Y)
END IF
IF X1>X4 THEN
FOR Q=X4 TO X1
FRBUFFER(80+(Y*BXRES)+Q)=2
NEXT
'DITHE(INT(X4)+80,INT(X1)+80,Y)
END IF
NEXT
END SUB
SUB DITHE(BYVAL START AS INTEGER, BYVAL FINISH AS INTEGER, BYVAL YPOS AS INTEGER)
DIM AS INTEGER DIFF,DITH,LL
'
YPOS=YPOS*BXRES
DIFF=FINISH-START
DITH=0
'
SELECT CASE DIFF
'
CASE 1 TO 20
DITH=2
CASE 20 TO 40
DITH=4
END SELECT
IF DITH>0 THEN
FOR LL= START TO FINISH STEP DITH
if LL MOD 2 =0 THEN FRBUFFER( LL +ypos)=0
NEXT
END IF
'
END SUB
'-------------------------------------------------------------------------------
' EXPAND SCREEN DISPLAY AND ERASE FRAMEBUFFER
'-------------------------------------------------------------------------------
SUB UPDATE_SCREEN()
DIM AS INTEGER XL,YL,I,TC,SLICE
DIM PP1 AS UINTEGER PTR
DIM PP2 AS UINTEGER PTR
FOR YL=0 TO BYRES-1
FOR I=0 TO PIXSIZY-1
pp1=@BUFFER(((YL*PIXSIZY)+I)*XRES)
PP2=@FRBUFFER(YL*BXRES)
FOR XL=0 TO BXRES-1
TC=C_PALETTE(*PP2)
SLICE=PIXSIZE
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP1]
rep stosd
end asm
PP1+=4
PP2+=1
NEXT
NEXT
NEXT
FOR YL=0 TO BYRES-1
PP1=@FRBUFFER(YL*BXRES)
FOR XL=0 TO BXRES-1
*PP1=0
PP1+=1
NEXT
NEXT
END SUB
-
Umm...
My laptop is probably misbehaving, but if that ran more smoothly and with some dithering it might look fun.
-
Oh, as a twister it works I guess... I just felt it was quite uninspired and after the screen is full of a twister I didn't know what else to do.
-
hehe, I had the same problem when I did that column thing. Half the screen was filled with the darn thing leaving little room for anything else.