Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on March 15, 2007
-
Could be optimised, sorry for the quick code :P
'
' Twisty bar thing
' By Shockwave ^ S!P For Va!n
'
' This is lame so leech to your hearts content.. No credit needed :-)
'
'--------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
'--------------------------------------------------------------------
' #DEFINE PTC_WIN
#INCLUDE "TINYPTC.BI"
'--------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
DIM SHARED AS UINTEGER BUFFER( XRES * YRES ): ' Screen Memory.
DIM SHARED AS UINTEGER CPAL (1000)
CONST LINES = 10
DIM SHARED AS UINTEGER TSTART(LINES)
DECLARE SUB MAKE_COLOURS()
DECLARE SUB DO_TWISTY()
'--------------------------------------------------------------------
' Open Screen;
'--------------------------------------------------------------------
IF (PTC_OPEN("TWISTY THING",XRES,YRES)=0) THEN
END-1
END IF
MAKE_COLOURS()
'--------------------------------------------------------------------
' Main Loop;
'--------------------------------------------------------------------
WHILE (1)
DO_TWISTY()
PTC_UPDATE@BUFFER(0)
ERASE BUFFER
WEND
SUB DO_TWISTY()
DIM AS INTEGER A,Y1,Y2
FOR Y1=1 TO LINES
DIM AS DOUBLE VV
VV=TSTART(Y1)
FOR A=0 TO XRES-1
BUFFER(A+(XRES*Y1)) = CPAL(INT(VV))
BUFFER(A+((YRES*XRES)-(XRES*Y1))) = CPAL(INT(VV))
VV=VV+.5
IF VV>1000 THEN VV=VV-1000
NEXT
NEXT
FOR A=1 TO LINES
TSTART(A)=TSTART(A)+15
IF TSTART(A)>1000 THEN TSTART(A)=TSTART(A)-1000
NEXT
END SUB
'--------------------------------------------------------------------
' Make Some Nice Colours For The Twisty Bar;
'--------------------------------------------------------------------
SUB MAKE_COLOURS()
DIM AS DOUBLE R,G,B
DIM AS INTEGER L
FOR L=1 TO LINES
TSTART(L) = L*60
NEXT
R=0:G=0:B=0
FOR L=0 TO 499
IF L<=250 THEN
R=R+1
G=G+1
B=B+.3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-1
G=G-1
B=B-.3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
R=0:G=0:B=0
FOR L=500 TO 999
IF L<=750 THEN
R=R+.3
G=G+1
B=B+1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-.3
G=G-1
B=B-1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
END SUB
EXE Attached..
-
nice twisty , i think if you make it more than 2 bars it will look more better.
-
Yep, probably would :) I made it quickly for va!n who just wanted to know how to code the effect, I think that he'll add some more bars to it because the example he showed had about 4. It's easy to do, just increase the number of lines to draw.
-
Rasters, now thats going back a bit! Nice Job Shockwave :)
-
Nice one indeed. Well done, mate. And so fast !!!
-
Lol, I wouldn't have even remembered the effect Clyde! Va!n jogged my memory.. And this is the first time I've ever made one of these twisty effects :) It needs a little bit of playing around to get it looking like it's rotating and when it is done it jogs the old memory a bit :D All those old amiga intros....
-
With some more colours..
'
' Twisty bar thing
' By Shockwave ^ S!P For Va!n
'
' This is lame so leech to your hearts content.. No credit needed :-)
'
'--------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
'--------------------------------------------------------------------
' #DEFINE PTC_WIN
#INCLUDE "TINYPTC.BI"
'--------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
DIM SHARED AS UINTEGER BUFFER( XRES * YRES ): ' Screen Memory.
DIM SHARED AS UINTEGER CPAL (2001)
CONST LINES = 15
DIM SHARED AS UINTEGER TSTART(LINES)
DECLARE SUB MAKE_COLOURS()
DECLARE SUB DO_TWISTY()
'--------------------------------------------------------------------
' Open Screen;
'--------------------------------------------------------------------
IF (PTC_OPEN("TWISTY THING",XRES,YRES)=0) THEN
END-1
END IF
MAKE_COLOURS()
'--------------------------------------------------------------------
' Main Loop;
'--------------------------------------------------------------------
WHILE (1)
DO_TWISTY()
PTC_UPDATE@BUFFER(0)
ERASE BUFFER
WEND
SUB DO_TWISTY()
DIM AS INTEGER A,Y1,Y2
FOR Y1=1 TO LINES
DIM AS DOUBLE VV
VV=TSTART(Y1)
FOR A=0 TO XRES-1
BUFFER(A+(XRES*Y1)) = CPAL(INT(VV))
BUFFER(A+((YRES*XRES)-(XRES*Y1))) = CPAL(INT(VV))
VV=VV+1
IF VV>2000 THEN VV=VV-2000
NEXT
NEXT
FOR A=1 TO LINES
TSTART(A)=TSTART(A)+13
IF TSTART(A)>2000 THEN TSTART(A)=TSTART(A)-2000
NEXT
END SUB
'--------------------------------------------------------------------
' Make Some Nice Colours For The Twisty Bar;
'--------------------------------------------------------------------
SUB MAKE_COLOURS()
DIM AS DOUBLE R,G,B
DIM AS INTEGER L
FOR L=1 TO LINES
TSTART(L) = L*40
NEXT
R=0:G=0:B=0
FOR L=0 TO 499
IF L<=250 THEN
R=R+1
G=G+1
B=B+.3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-1
G=G-1
B=B-.3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
R=0:G=0:B=0
FOR L=500 TO 999
IF L<=750 THEN
R=R+.3
G=G+1
B=B+1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-.3
G=G-1
B=B-1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
R=0:G=0:B=0
FOR L=1000 TO 1499
IF L<=1250 THEN
R=R+.3
G=G+.3
B=B+ 1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-.3
G=G-.3
B=B- 1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
R=0:G=0:B=0
FOR L=1500 TO 1999
IF L<=1750 THEN
R=R+ 1
G=G+.3
B=B+.3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R- 1
G=G-.3
B=B-.3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
END SUB
Essentially the same effect as before but with two extra coloured copper bars.
-
Nifty. I have never seen this before. Very cool.
-
Now that does look very cool :)
Nice one Shockwave.
Cheers,
Clyde.
-
Perhaps we'll have a "copper" comp in the future... :D
Should bring out the plasma lovers amongst us..
-
This one really looks like it's spinning :)
Source only;
'
' Twisty bar thing
' By Shockwave ^ S!P For Va!n
'
' This is lame so leech to your hearts content.. No credit needed :-)
'
'--------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
'--------------------------------------------------------------------
' #DEFINE PTC_WIN
#INCLUDE "TINYPTC.BI"
'--------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
DIM SHARED AS UINTEGER BUFFER( XRES * YRES ): ' Screen Memory.
DIM SHARED AS UINTEGER CPAL (2001)
CONST LINES = 8
DIM SHARED AS UINTEGER TSTART(LINES)
DECLARE SUB MAKE_COLOURS()
DECLARE SUB DO_TWISTY()
'--------------------------------------------------------------------
' Open Screen;
'--------------------------------------------------------------------
IF (PTC_OPEN("TWISTY THING",XRES,YRES)=0) THEN
END-1
END IF
MAKE_COLOURS()
'--------------------------------------------------------------------
' Main Loop;
'--------------------------------------------------------------------
WHILE (1)
DO_TWISTY()
PTC_UPDATE@BUFFER(0)
ERASE BUFFER
WEND
SUB DO_TWISTY()
DIM AS INTEGER A,Y1,Y2,YT,YB,cntt
cntt=100
FOR Y1=1 TO LINES
DIM AS DOUBLE VV
VV=TSTART(Y1)
if y1<=lines/2 then
'cntt=cntt-10
else
'cntt=cntt+10
end if
FOR A=0 TO XRES-1
YT=50+Y1
YB=50-Y1
y2=CPAL(INT(VV))
BUFFER(A+(XRES*YT)) = y2
BUFFER(A+((YRES*XRES)-(XRES*YB))) = y2
VV=VV+1
IF VV>2000 THEN VV=VV-2000
NEXT
NEXT
FOR A=1 TO LINES
TSTART(A)=TSTART(A)+15
IF TSTART(A)>2000 THEN TSTART(A)=TSTART(A)-2000
NEXT
END SUB
'--------------------------------------------------------------------
' Make Some Nice Colours For The Twisty Bar;
'--------------------------------------------------------------------
SUB MAKE_COLOURS()
DIM AS DOUBLE R,G,B
DIM AS INTEGER L
FOR L=1 TO LINES
TSTART(L) = L*120
NEXT
R=0:G=0:B=0
FOR L=0 TO 499
IF L<=250 THEN
R=R+.2
G=G+.3
B=B+.1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-.2
G=G-.3
B=B-.1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
R=0:G=0:B=0
FOR L=500 TO 999
IF L<=750 THEN
R=R+.3
G=G+.2
B=B+.1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-.3
G=G-.2
B=B-.1
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
R=0:G=0:B=0
FOR L=1000 TO 1499
IF L<=1250 THEN
R=R+.1
G=G+.2
B=B+ .3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-.1
G=G-.2
B=B-.3
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
R=0:G=0:B=0
FOR L=1500 TO 1999
IF L<=1750 THEN
R=R+.1
G=G+.3
B=B+.2
CPAL(L) = RGB(INT(R),INT(G),INT(B))
ELSE
R=R-.1
G=G-.3
B=B-.2
CPAL(L) = RGB(INT(R),INT(G),INT(B))
END IF
NEXT
END SUB
-
is there any way to get download link for the exe versions? Btw, for all OGL coders around here... someone an idea, how to create the fx in just a few bytes (very small) using OGL? 4x4 texure looking something like this...?
1000
0100
0010
0001
and stretch this? (i have some more OGL questions... but will follow soon ^^)
-
I think, to get something looking like that you would need a larger texture than 4x4 to make it look decent. I think, you may get away with it using something like 32x32. Not sure the 'rolling' effect would come through though. I'll have an experiment and see if I can come up with something.
Slightly off topic,
but here is a Cobra version ;)
program
uses
cobramini,keyset
const
xres = 800
yres = 600
lines= 8
procedure MakeColours
var
r,g,b:real
l:integer
begin
FOR L=1 TO LINES
TSTART[L] = L*120
NEXT
R=0;G=0;B=0
FOR L=0 TO 499
IF L<=250 THEN
R=R+0.6
G=G+0.9
B=B+0.3
CPAL[L] = toRGB(R,G,B)
ELSE
R=R-0.6
G=G-0.9
B=B-0.3
CPAL[L] = toRGB(R,G,B)
ENDIF
NEXT
R=0;G=0;B=0
FOR L=500 TO 999
IF L<=750 THEN
R=R+0.9
G=G+0.6
B=B+0.3
CPAL[L] = toRGB(R,G,B)
ELSE
R=R-0.9
G=G-0.6
B=B-0.3
CPAL[L] = toRGB(R,G,B)
ENDIF
NEXT
R=0;G=0;B=0
FOR L=1000 TO 1499
IF L<=1250 THEN
R=R+0.3
G=G+0.6
B=B+ 0.9
CPAL[L] = toRGB(R,G,B)
ELSE
R=R-0.3
G=G-0.6
B=B-0.9
CPAL[L] = toRGB(R,G,B)
ENDIF
NEXT
R=0;G=0;B=0
FOR L=1500 TO 1999
IF L<=1750 THEN
R=R+0.3
G=G+0.9
B=B+0.6
CPAL[L] = toRGB(R,G,B)
ELSE
R=R-0.3
G=G-0.9
B=B-0.6
CPAL[L] = toRGB(R,G,B)
ENDIF
NEXT
end
procedure do_twisty
var
a,y1,y2,yt,yb,cntt:integer
vv:real
begin
cntt=100
FOR Y1=1 TO LINES
VV=TSTART[Y1]
FOR A=0 TO XRES-1
YT=50+Y1
YB=50-Y1
y2=CPAL[VV]
Pixel(buffer,a+(xres*yt),y2)
Pixel(buffer,a+((yres*xres)-(xres*yb)),y2)
VV=VV+1
IF VV>2000 THEN VV=VV-2000
NEXT
NEXT
FOR A=1 TO LINES
TSTART[A]=TSTART[A]+15
IF TSTART[A]>2000 THEN TSTART[A]=TSTART[A]-2000
NEXT
end
procedure main
begin
OpenScreen(xres,yres)
buffer=currentmembuffer
makecolours
while not KeyDown(VK_ESCAPE)
do_twisty
flip
wend
closescreen
end
var
buffer:integer
cpal:array[2001] of integer
tstart:array[lines] of integer
begin
main
end
-
cool :clap:
almost the older Amiga copper Fx ever, created by Corsair I think.
also called RollerCopper
I done a C GDI version last year, and it seems to be almost the same rout ;)
the difference is the roller effect cause I have used the original Amiga assembler algo :
I don't use a pointer on tstart(H), but use 2 cpal arrays and "roll" the cpal arrays by shifting all values to the right (top roller) and to the left (bottom roller).
the problem is the 2 colours arrays. The pointer is better (but not in the case of the Amiga version because of the 2 copperlist palettes equivalent of the 2 arrays)
savecpal=cpal(0)
for a=0 to 1999: cpal(a)=cpal(a+1)
cpal(2000)=savecpal
savecpal=cpal2(2000)
for a=2000 to 1: cpal2(a)=cpal2(a-1)
cpal(0)=savecpal