Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: relsoft on May 12, 2006
-
Basically additive blended lines. This should be easier with OpenGL using belnding and forward kinematics.Â
ie.
for each "tentacle"
Push
transform
pop
Enough rant. here's the demo:
'//640 x 480 madness!!!
'//Lines in mono
'//Relsoft 2004
'//v3cz0r is da man!
'//
defint a-z
'$include: 'tinyptc.bi'
type point3d
   x   as single
   y   as single
   z   as single
   sx   as integer
   sy   as integer
   color as integer
end type
declare sub Rel_cls( buffer())
declare sub xpcopy ( dest() as integer, source() as integer)
declare sub smooth(Â buffer())
declare sub Rel_pset( buffer(), byval x as integer, byval y as integer, byval col as integer)
declare sub draw_line_B( buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
option explicit
const SCR_WIDTH = 320Â * 2
const SCR_HEIGHT = 240 * 2
const SCR_SIZE = SCR_WIDTH*SCR_HEIGHT
const PI = 3.141593
const LENS = 256
const XMID = SCR_WIDTH \2
const YMID = SCR_HEIGHT \2
dim shared buffer( 0 to SCR_SIZE-1 ) as integer
dim shared points(3,2) as point3d
  dim i as integer
  dim sx as single
  dim sy as single
  dim sz as single
  dim cx as single
  dim cy as single
  dim cz as single
  dim xx as single
  dim xy as single
  dim xz as single
  dim yx as single
  dim yy as single
  dim yz as single
  dim zx as single
  dim zy as single
  dim zz as single
  dim rx as single
  dim ry as single
  dim rz as single
  dim ang as integer
  dim angx as uinteger
  dim angy as uinteger
  dim angz as uinteger
  dim ax as single
  dim ay as single
  dim az as single
  dim rad as integer
  dim x as single
  dim y as single
  dim z as single
  dim dist as integer
  dim ox as integer
  dim oy as integer
  dim tx as integer
  dim ty as integer
  dim r, g , b as integer
if( ptc_open( "freeBASIC v0.01 - RelGFX win demo(Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
end -1
end if
  points(0,0).x = -1
  points(0,0).y = -1
  points(0,0).z = 0
  points(1,0).x = -1
  points(1,0).y = 1
  points(1,0).z = 0
  points(2,0).x = 1
  points(2,0).y = 1
  points(2,0).z = 0
  points(3,0).x = 1
  points(3,0).y = -1
  points(3,0).z = 0
  points(0,1).z = -1
  points(0,1).y = -1
  points(0,1).x = 0
  points(1,1).z = -1
  points(1,1).y = 1
  points(1,1).x = 0
  points(2,1).z = 1
  points(2,1).y = 1
  points(2,1).x = 0
  points(3,1).z = 1
  points(3,1).y = -1
  points(3,1).x = 0
  points(0,2).z = -1
  points(0,2).x = -1
  points(0,2).y = 0
  points(1,2).z = -1
  points(1,2).x = 1
  points(1,2).y = 0
  points(2,2).z = 1
  points(2,2).x = 1
  points(2,2).y = 0
  points(3,2).z = 1
  points(3,2).x = -1
  points(3,2).y = 0
  for i = 0 to 3
    points(i,0).x = points(i,0).x * 9.5
    points(i,0).y = points(i,0).y * 9.5
    points(i,0).z = points(i,0).z * 9.5
    r = 4
    g = 0
    b = 1
    points(i,0).color = r shl 16 or g shl 8 or b
    points(i,1).x = points(i,1).x * 9.5
    points(i,1).y = points(i,1).y * 9.5
    points(i,1).z = points(i,1).z * 9.5
    r = 1
    g = 0
    b = 4
    points(i, 1).color = r shl 16 or g shl 8 or b
    points(i,2).x = points(i,2).x * 9.5
    points(i,2).y = points(i,2).y * 9.5
    points(i,2).z = points(i,2).z * 9.5
    r = 0
    g = 4
    b = 1
    points(i, 2).color = r shl 16 or g shl 8 or b
  next i
  dim s as single
  dim j,k, x1, x2, y1, y2 as integer
  dim t as single, dt as single, ti as single, tt as single
  dim sinc as single
  sinc = .05
  do
   dim counter as integer
   Rel_cls buffer()
   s = 0
   ti = timer * 0.008
   t = ti * 2.5 * (sin(timer/3150) + cos(timer/4150) + sin(timer/3140))
   dt = 0.00130 + 0.00024 * (sin(timer/140) * sin(timer/1240) * cos(timer/540))
   for counter = 0 to 200 step 1
    ax = 4 * t
    ay = 8 * t
    az = 9 * t
    cx = cos(ax)
    sx = sin(ax)
    cy = cos(ay)
    sy = sin(ay)
    cz = cos(az)
    sz = sin(az)
    xx = cy * cz
    xy = sx * sy * cz - cx * sz
    xz = cx * sy * cz + sx * sz
    yx = cy * sz
    yy = cx * cz + sx * sy * sz
    yz = -sx * cz + cx * sy * sz
    zx = -sy
    zy = sx * cy
    zz = cx * cy
    ox = xmid
    oy = ymid
    for i = 0 to 3
      for j = 0 to 2
       x = points(i, j).x * s
       y = points(i, j).y * s
       z = points(i, j).z * s
       rx = (x * xx + y * xy + z * xz)
       ry = (x * yx + y * yy + z * yz)
       rz = (x * zx + y * zy + z * zz)
       dist = LENS - rz
       IF dist > 0 THEN
         tx = XMID + (rx * LENS / dist)
         ty = YMID - (ry * LENS / dist)
         points(i, j).sx = tx
         points(i, j).sy = ty        Â
         draw_line_b buffer(), tx, ty, ox, oy, points(i,j).color
         draw_line_b buffer(), tx, ty, xmid, ymid, points(i,2-j).color        Â
         draw_line_b buffer(), ox, oy, xmid, ymid, points(3-i,2-j).color
         ox = tx
         oy = ty
       END IF
      next j
    next i
      s = s + sinc
      t = t + dt
   next counter
   ptc_update @buffer(0)
  loop until inkey$<>""
ptc_close
'*******************************************************************************************
'GFX subs/Funks
'
'*******************************************************************************************
private sub Rel_Pset( buffer(), byval x as integer, byval y as integer, byval col as integer)
    if x > -1 and x <SCR_WIDTH and y > -1 and Y < SCR_HEIGHT then
      buffer(y * SCR_WIDTH + x) = col
    end if
end sub
private sub Rel_Cls( buffer())
  dim p as integer ptr
  dim s as integer
  s = SCR_SIZE
  p = @buffer(0)
  asm
    mov edi, dword ptr [p]
    mov ecx, dword ptr [s]
    xor eax, eax
    rep stosd
  end asm
end sub
private sub xpcopy ( dest() as integer, source() as integer)
  dim offset as long
  for offset = 0 to SCR_SIZE -1
    dest( offset ) = source( offset )
  next offset
end sub
private sub smooth(Â buffer())
  dim maxpixel as uinteger
  dim offset as integer
  dim pixel as uinteger
  dim r as uinteger
  dim g as uinteger
  dim b as uinteger
  dim nr as uinteger
  dim ng as uinteger
  dim nb as uinteger
  maxpixel = ubound(buffer)
  for offset = SCR_WIDTH to maxpixel-SCR_WIDTH
    pixel = buffer(offset-1)
    r = pixel shr 16
    g = pixel shr 8 and 255
    b = pixel and 255
    nr = r shr 2
    ng = g shr 2
    nb = b shr 2
    pixel = buffer(offset+1)
    r = pixel shr 16
    g = pixel shr 8 and 255
    b = pixel and 255
    nr = nr + ( r shr 2 )
    ng = ng + ( g shr 2 )
    nb = nb + ( b shr 2 )
    pixel = buffer(offset+SCR_WIDTH)
    r = pixel shr 16
    g = pixel shr 8 and 255
    b = pixel and 255
    nr = nr + ( r shr 2 )
    ng = ng + ( g shr 2 )
    nb = nb + ( b shr 2 )
    pixel = buffer(offset-SCR_WIDTH)
    r = pixel shr 16
    g = pixel shr 8 and 255
    b = pixel and 255
    nr = nr + ( r shr 2 )
    ng = ng + ( g shr 2 )
    nb = nb + ( b shr 2 )
    buffer(offset) = nr shl 16 or ng shl 8 or nb
  next i
end sub
private sub draw_line_B( buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
dim i as integer
dim slope as integer
dim eterm as integer
dim dx as integer
dim dy as integer
dim sx as integer
dim sy as integer
dim notclip as integer
dim temp as integer
const scrxmax = SCR_WIDTHÂ - 1
const scrymax = SCR_HEIGHT - 1
I = 0
Slope = 0
Eterm = 0
IF (X2 - X) > 0 THEN
   SX = 1
ELSE
   SX = -1
END IF
Dx = ABS(X2 - X)
IF (Y2 - Y) > 0 THEN
   SY = 1
ELSE
   SY = -1
END IF
Dy = ABS(Y2 - Y)
IF (Dy > Dx) THEN
    Slope = 1
    temp = x
    x = y
    y = temp
    temp = dx
    dx = dy
    dy = temp
    temp = sx
    sx = sy
    sy = temp
END IF
Eterm = 2 * Dy - Dx
dim pixel, pixel2, r, g, b, nr, ng, nb as integer
pixel = col
FOR I = 0 TO Dx - 1
  IF Slope = 1 THEN
   NotClip = (((Y < 0) + (X < 0) + (Y > scrxmax) + (X > scrymax)) = 0)
   IF NotClip THEN
    r = pixel shr 16
    g = pixel shr 8 and 255
    b = pixel and 255
    pixel2 = buffer(x * SCR_WIDTH + y )
    nr = pixel2 shr 16
    ng = pixel2 shr 8 and 255
    nb = pixel2 and 255
    r = (r + nr)
    if r > 255 then r = 255
    g = (g + ng)
    if g > 255 then g = 255
    b = (b + nb)
    if b > 255 then b = 255
    buffer(x * SCR_WIDTH + y ) = r shl 16 or g shl 8 or b
   end if
  ELSE
   NotClip = (((X < 0) + (Y < 0) + (X > scrxmax) + (Y > scrymax)) = 0)
   IF NotClip THEN
    r = pixel shr 16
    g = pixel shr 8 and 255
    b = pixel and 255
    pixel2 = buffer(y * SCR_WIDTH + x )
    nr = pixel2 shr 16
    ng = pixel2 shr 8 and 255
    nb = pixel2 and 255
    r = (r + nr)
    if r > 255 then r = 255
    g = (g + ng)
    if g > 255 then g = 255
    b = (b + nb)
    if b > 255 then b = 255
    buffer(y * SCR_WIDTH + x ) = r shl 16 or g shl 8 or b
   end if
  END IF
  WHILE Eterm >= 0
   Y = Y + SY: Eterm = Eterm - 2 * Dx
  WEND
  X = X + SX: Eterm = Eterm + 2 * Dy
NEXTÂ I
   NotClip = (((X2 < 0) + (Y2 < 0) + (X2 > scrxmax) + (Y2 > scrymax)) = 0)
   IF NotClip THEN
    r = pixel shr 16
    g = pixel shr 8 and 255
    b = pixel and 255
    pixel2 = buffer(y2 * SCR_WIDTH + x2 )
    nr = pixel2 shr 16
    ng = pixel2 shr 8 and 255
    nb = pixel2 and 255
    r = (r + nr)
    if r > 255 then r = 255
    g = (g + ng)
    if g > 255 then g = 255
    b = (b + nb)
    if b > 255 then b = 255
    buffer(y2 * SCR_WIDTH + x2 ) = r shl 16 or g shl 8 or b
   end if
end sub
-
Here's the pixel ver so that you can see the "tentacles".
'//640 x 480 madness!!!
'//Lines
'//Relsoft 2004
'//v3cz0r is da man!
'//
defint a-z
'$include: 'tinyptc.bi'
type point3d
x as single
y as single
z as single
sx as integer
sy as integer
color as integer
end type
declare sub Rel_cls( buffer())
declare sub xpcopy ( dest() as integer, source() as integer)
declare sub smooth( buffer())
declare sub Rel_pset( buffer(), byval x as integer, byval y as integer, byval col as integer)
declare sub draw_line_B( buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
option explicit
const SCR_WIDTH = 320 * 2
const SCR_HEIGHT = 240 * 2
const SCR_SIZE = SCR_WIDTH*SCR_HEIGHT
const PI = 3.141593
const LENS = 256
const XMID = SCR_WIDTH \2
const YMID = SCR_HEIGHT \2
dim shared buffer( 0 to SCR_SIZE-1 ) as integer
dim shared points(3,2) as point3d
dim i as integer
dim sx as single
dim sy as single
dim sz as single
dim cx as single
dim cy as single
dim cz as single
dim xx as single
dim xy as single
dim xz as single
dim yx as single
dim yy as single
dim yz as single
dim zx as single
dim zy as single
dim zz as single
dim rx as single
dim ry as single
dim rz as single
dim ang as integer
dim angx as uinteger
dim angy as uinteger
dim angz as uinteger
dim ax as single
dim ay as single
dim az as single
dim rad as integer
dim x as single
dim y as single
dim z as single
dim dist as integer
dim ox as integer
dim oy as integer
dim tx as integer
dim ty as integer
dim r, g , b as integer
if( ptc_open( "freeBASIC v0.01 - RelGFX win demo(Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
end -1
end if
points(0,0).x = -1
points(0,0).y = -1
points(0,0).z = 0
points(1,0).x = -1
points(1,0).y = 1
points(1,0).z = 0
points(2,0).x = 1
points(2,0).y = 1
points(2,0).z = 0
points(3,0).x = 1
points(3,0).y = -1
points(3,0).z = 0
points(0,1).z = -1
points(0,1).y = -1
points(0,1).x = 0
points(1,1).z = -1
points(1,1).y = 1
points(1,1).x = 0
points(2,1).z = 1
points(2,1).y = 1
points(2,1).x = 0
points(3,1).z = 1
points(3,1).y = -1
points(3,1).x = 0
points(0,2).z = -1
points(0,2).x = -1
points(0,2).y = 0
points(1,2).z = -1
points(1,2).x = 1
points(1,2).y = 0
points(2,2).z = 1
points(2,2).x = 1
points(2,2).y = 0
points(3,2).z = 1
points(3,2).x = -1
points(3,2).y = 0
for i = 0 to 3
points(i,0).x = points(i,0).x * 19.5
points(i,0).y = points(i,0).y * 19.5
points(i,0).z = points(i,0).z * 19.5
r = 18
g = 0
b = 12
points(i,0).color = r shl 16 or g shl 8 or b
points(i,1).x = points(i,1).x * 19.5
points(i,1).y = points(i,1).y * 19.5
points(i,1).z = points(i,1).z * 19.5
r = 8
g = 18
b = 0
points(i, 1).color = r shl 16 or g shl 8 or b
points(i,2).x = points(i,2).x * 19.5
points(i,2).y = points(i,2).y * 19.5
points(i,2).z = points(i,2).z * 19.5
r = 8
g = 2
b = 18
points(i, 2).color = r shl 16 or g shl 8 or b
next i
dim s as single
dim j,k, x1, x2, y1, y2 as integer
dim t as single, dt as single, ti as single
dim sinc as single
sinc = .05
dim as integer frame = 0
do
dim counter as integer
smooth( buffer())
s = 0
ti = timer * 0.008
t = ti * 1.5 *sin(timer/3150)
dt = 0.00130 + 0.0024 * sin(timer/40)
for counter = 0 to 100 step 1
ax = 15 * t
ay = 25 * t
az = 20 * t
cx = cos(ax)
sx = sin(ax)
cy = cos(ay)
sy = sin(ay)
cz = cos(az)
sz = sin(az)
xx = cy * cz
xy = sx * sy * cz - cx * sz
xz = cx * sy * cz + sx * sz
yx = cy * sz
yy = cx * cz + sx * sy * sz
yz = -sx * cz + cx * sy * sz
zx = -sy
zy = sx * cy
zz = cx * cy
ox = xmid
oy = ymid
for i = 0 to 3
for j = 0 to 2
x = points(i, j).x * s
y = points(i, j).y * s
z = points(i, j).z * s
rx = (x * xx + y * xy + z * xz)
ry = (x * yx + y * yy + z * yz)
rz = (x * zx + y * zy + z * zz)
dist = LENS - rz
IF dist > 0 THEN
tx = XMID + (rx * LENS / dist)
ty = YMID - (ry * LENS / dist)
points(i, j).sx = tx
points(i, j).sy = ty
Rel_pset buffer(),tx, ty, points(i,j).color * 13
'draw_line_b buffer(), tx, ty, ox, oy, points(i,j).color
ox = tx
oy = ty
END IF
next j
next i
s = s + sinc
t = t + dt
next counter
ptc_update @buffer(0)
loop until inkey$<>""
ptc_close
'*******************************************************************************************
'GFX subs/Funks
'
'*******************************************************************************************
private sub Rel_Pset( buffer(), byval x as integer, byval y as integer, byval col as integer)
if x > -1 and x <SCR_WIDTH and y > -1 and Y < SCR_HEIGHT then
buffer(y * SCR_WIDTH + x) = col
end if
end sub
private sub Rel_Cls( buffer())
dim p as integer ptr
dim s as integer
s = SCR_SIZE
p = @buffer(0)
asm
mov edi, dword ptr [p]
mov ecx, dword ptr [s]
xor eax, eax
rep stosd
end asm
end sub
private sub xpcopy ( dest() as integer, source() as integer)
dim offset as long
for offset = 0 to SCR_SIZE -1
dest( offset ) = source( offset )
next offset
end sub
private sub draw_line_B( buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
dim i as integer
dim slope as integer
dim eterm as integer
dim dx as integer
dim dy as integer
dim sx as integer
dim sy as integer
dim notclip as integer
dim temp as integer
const scrxmax = SCR_WIDTH - 1
const scrymax = SCR_HEIGHT - 1
I = 0
Slope = 0
Eterm = 0
IF (X2 - X) > 0 THEN
SX = 1
ELSE
SX = -1
END IF
Dx = ABS(X2 - X)
IF (Y2 - Y) > 0 THEN
SY = 1
ELSE
SY = -1
END IF
Dy = ABS(Y2 - Y)
IF (Dy > Dx) THEN
Slope = 1
temp = x
x = y
y = temp
temp = dx
dx = dy
dy = temp
temp = sx
sx = sy
sy = temp
END IF
Eterm = 2 * Dy - Dx
dim pixel, pixel2, r, g, b, nr, ng, nb as integer
pixel = col
FOR I = 0 TO Dx - 1
IF Slope = 1 THEN
NotClip = (((Y < 0) + (X < 0) + (Y > scrxmax) + (X > scrymax)) = 0)
IF NotClip THEN
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
pixel2 = buffer(x * SCR_WIDTH + y )
nr = pixel2 shr 16
ng = pixel2 shr 8 and 255
nb = pixel2 and 255
r = (r + nr)
if r > 255 then r = 255
g = (g + ng)
if g > 255 then g = 255
b = (b + nb)
if b > 255 then b = 255
buffer(x * SCR_WIDTH + y ) = r shl 16 or g shl 8 or b
end if
ELSE
NotClip = (((X < 0) + (Y < 0) + (X > scrxmax) + (Y > scrymax)) = 0)
IF NotClip THEN
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
pixel2 = buffer(y * SCR_WIDTH + x )
nr = pixel2 shr 16
ng = pixel2 shr 8 and 255
nb = pixel2 and 255
r = (r + nr)
if r > 255 then r = 255
g = (g + ng)
if g > 255 then g = 255
b = (b + nb)
if b > 255 then b = 255
buffer(y * SCR_WIDTH + x ) = r shl 16 or g shl 8 or b
end if
END IF
WHILE Eterm >= 0
Y = Y + SY: Eterm = Eterm - 2 * Dx
WEND
X = X + SX: Eterm = Eterm + 2 * Dy
NEXT I
NotClip = (((X2 < 0) + (Y2 < 0) + (X2 > scrxmax) + (Y2 > scrymax)) = 0)
IF NotClip THEN
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
pixel2 = buffer(y2 * SCR_WIDTH + x2 )
nr = pixel2 shr 16
ng = pixel2 shr 8 and 255
nb = pixel2 and 255
r = (r + nr)
if r > 255 then r = 255
g = (g + ng)
if g > 255 then g = 255
b = (b + nb)
if b > 255 then b = 255
buffer(y2 * SCR_WIDTH + x2 ) = r shl 16 or g shl 8 or b
end if
end sub
private sub smooth( buffer())
dim maxpixel as integer
dim offset as integer
dim pixel as integer
dim r as integer
dim g as integer
dim b as integer
dim nr as integer
dim ng as integer
dim nb as integer
maxpixel = ubound(buffer)
for offset = SCR_WIDTH to maxpixel-SCR_WIDTH
pixel = buffer(offset-1)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = r shr 2
ng = g shr 2
nb = b shr 2
pixel = buffer(offset+1)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
pixel = buffer(offset+SCR_WIDTH)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
pixel = buffer(offset-SCR_WIDTH)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
buffer(offset) = nr shl 16 or ng shl 8 or nb
next i
end sub
-
Nice stuff, I like it.
-
Yet again, 2 really cool and smart effects. Nice one cheif. 8)
-
Don't know which version I like better, they are both cool.
It reminds me of the old shadebob and shadeline demos on the Amiga, only much nicer colours and that the patterns move around in a nice way makes it better too.
-
I found the effect in tinyptc's site and somehow understanding by looking at the fx on how to do it, I made my own. Not the same effect thouhgh. But the same approach(I think) :*)
-
You've given me an idea that I will hopefully be able to put to good use, I'll credit you for the inspiration of course :)
-
No problem. Do as you wish mate. :*)
-
Got to code a line draw routine first :)