Metatunnel demo JAVA to FreeBASIC port.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
D.J.Peters
Posts: 8631
Joined: May 28, 2005 3:28
Contact:

Metatunnel demo JAVA to FreeBASIC port.

Post by D.J.Peters »

only 100x100 pixels but is nice it's an 1:1 port not speed optimized

Joshy

Code: Select all

/'
 * Metatunnel demo effect
 * Original by FRequency
 * http://www.pouet.net/prod.php?which=52777
 * 
 * Canvas 2D version by PauloFalcao
 * http://demoscene.appjet.net/
 * 
 * Canvas 3D port by vlad
 * http://people.mozilla.com/~vladimir/misc/metatunnel-3d.html
 * 
 * Processing.org port by luis2048
 * http://luis.net/projects/processing/metatunnel/
 *
 * FreeBasic port by D.J.Peters
 * http://www.freebasic.net/forum/viewtopic.php?p=140112
 '/
#include "fbgfx.bi"
using fb

type float as single

dim shared as float time_ 
dim shared as float maxrX 
dim shared as float maxrY 
dim shared as Image ptr megatunnelEffect
dim shared as float dxx,dyy,dzz
dim shared as float vy,ox,oy,oz,dx,dy,dz,tt,g,kolor,dxtt,dytt,dztt,nx,ny,nz,d,f,px,py,objd',nx,ny,nz
dim shared as float cost,cost07,cost05,cost0505p2,costm03,sint,sint07,sint05,sint05p2,sint02,sint0205,costsint02
dim shared as integer rr,gg,bb
'dim shared as float dxtt,dytt,dztt 
const SCR_W = 640
const SCR_H = 480
const IMG_W = 100
const IMG_H = 100

sub setup()
  screenres SCR_W,SCR_H,32,,1
  megatunnelEffect = ImageCreate(IMG_W,IMG_H)
  maxrX=megatunnelEffect->width 
  maxrY=megatunnelEffect->height 
end sub



function distance(ax as float,ay as float,az as float,bx as float,by as float,bz as float) as float
  dxx = bx-ax
  dyy = by-ay
  dzz = bz-az
  return sqr(dxx*dxx + dyy*dyy + dzz*dzz)
end function

function obj(x as float,y as float,z as float,t as float) as float
  dim as float f=1.0
  dxx=x-costsint02:dyy=y-0.3:dzz=z-cost0505p2
  f*=sqr(dxx*dxx + dyy*dyy + dzz*dzz)
  dxx=x- -cost07:dyy=y-0.3:dzz=z-sint05p2
  f*=sqr(dxx*dxx + dyy*dyy + dzz*dzz)
  dxx=x- -sint0205:dyy=y-sint:dzz=z-2.0
  f*=sqr(dxx*dxx + dyy*dyy + dzz*dzz)

  'f*=distance(x,y,z,costsint02,0.3,cost0505p2)
  'f*=distance(x,y,z,-cost07,0.3,sint05p2)
  'f*=distance(x,y,z,-sint0205,sint,2.0)
  f*=cos(y)*cos(x)-0.1-cos(z*7.0+t*7.0)*cos(x*3.0)*cos(y*4.0)*0.1 
  return f
end function


function max(a as float, b as float) as float
  if a>b then return a
  return b
end function
  
function eval(xx as integer,yy as integer,t as float) as uinteger
  px = xx / maxrX
  ox=px*2.0-1.0
  oz=0.0
  dx=(ox+costm03)/64.0

  'dz=1.0/64.0
  dz=0.015625
  tt=0.0
  g=1.0

  while((g>0.4) and (tt<375))
    g=obj(ox+dx*tt,oy+dy*tt,oz+dz*tt,t)     
    tt+=g*4
  wend

  kolor=0.0



  dxtt=ox+dx*tt
  dytt=oy+dy*tt
  dztt=oz+dz*tt
  objd=obj(dxtt,dytt,dztt,t)
  nx=objd-obj(dxtt+0.01,dytt,dztt,t)
  ny=objd-obj(dxtt,dytt+0.01,dztt,t)
  nz=objd-obj(dxtt,dytt,dztt+0.01,t)

  d=sqr(nx*nx+ny*ny+nz*nz)
  ny=ny/d
  nz=nz/d
  kolor+=max(-0.5*nz,0.0) + max(-0.5*ny+0.5*nz,0.0)*0.5   
  dim as float mult = tt*0.025
  rr=max((kolor+0.1*mult)*240,0):if rr>255 then rr=255
  gg=max((kolor+0.2*mult)*240,0):if gg>255 then gg=255
  bb=max((kolor+0.5*mult)*240,0):if bb>255 then bb=255
  
  return rgb(rr,gg,bb)
end function

' integer based bit shift multiplication
function mul(m as integer,n as integer) as integer
  if (n>0) then
    dim as integer mp = m shl 1
    dim as integer np = n shr 1
    return mul(mp,np) + iif((n and 1)>0,m,0)
  end if
  return 0
end function

sub DrawIt()
  dim as float t = time_
  cost       = cos(t)
  cost07     = cos(t*.7)
  cost05     = cos(t*.5)
  cost0505p2 = cost05 * 0.5 + 2
  costm03    = cost * 0.3
  sint       = sin(t)
  sint07     = sin(t*.7)
  sint05     = sin(t*.5)
  sint05p2   = sint05 + 2
  sint02     = sin(t*.2)
  sint0205   = sint02*0.5
  costsint02 = cost+sint02
  dim as uinteger ptr pixels = cptr(uinteger ptr,megatunnelEffect)
  pixels+=8
  for y as integer = 0 to megatunnelEffect->height-1 
    py = y / maxrY
    vy=-py*2.0+1.0
    oy=vy*1.25
    dy=vy/maxrY
    for x as integer = 0 to megatunnelEffect->width-1 
      *pixels = eval(x,y,time_)
      pixels+=1
    next 
  next 
  put (0,0),megatunnelEffect,PSET
  time_+=0.05 
end sub 


Setup()
while inkey()=""
  DrawIt()
  sleep 10
wend
angros47
Posts: 2385
Joined: Jun 21, 2005 19:04

Post by angros47 »

It compiles only with -gen gcc

If compiled with ASM, it fails with error:

Code: Select all

tunnel.asm: Assembler messages:
tunnel.asm:250: Error: `dword ptr [DX]' is not a valid base/index expression
tunnel.asm:283: Error: `dword ptr [DX]' is not a valid base/index expression
tunnel.asm:305: Error: `dword ptr [DX]' is not a valid base/index expression
I believe this is a critical bug of FreeBasic: if a variable has the same name of an assembly register, it fails.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Post by rolliebollocks »

@angros

I didn't have a problem compiling. AMD Phenom II x4 910.

Compiled under fb version .20

@Joshy

Very cool. I'm still trying to hack multiput. Now tht I have access to the internet I can look at the UV projection stuff while I code, I may be close. Then I add shearing.
angros47
Posts: 2385
Joined: Jun 21, 2005 19:04

Post by angros47 »

rolliebollocks wrote:@angros

I didn't have a problem compiling. AMD Phenom II x4 910.

Compiled under fb version .20
Using Windows or Linux? (I am using linux: the problem is both with .20 and .21)
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Post by rolliebollocks »

Oh. Windows 7.
D.J.Peters
Posts: 8631
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

I tryed the current FB download 0.21 without any problems.

here are 160x120 pixels with only one slow SQR()

Joshy

Code: Select all

/'
 * Metatunnel demo effect
 * Original by FRequency
 * http://www.pouet.net/prod.php?which=52777
 *
 * Canvas 2D version by PauloFalcao
 * http://demoscene.appjet.net/
 *
 * Canvas 3D port by vlad
 * http://people.mozilla.com/~vladimir/misc/metatunnel-3d.html
 *
 * Processing.org port by luis2048
 * http://luis.net/projects/processing/metatunnel/
 *
 * FreeBasic port by D.J.Peters
 * http://www.freebasic.net/forum/viewtopic.php?p=140112
 '/
#include "fbgfx.bi"
Using fb

Type float As Single

Dim Shared As float time_
Dim Shared As float maxrX
Dim Shared As float maxrY
Dim Shared As Image Ptr megatunnelEffect
Dim Shared As float dxx,dyy,dzz
Dim Shared As float vy,ox,oy,oz,dx,dy,dz,tt,g,kolor,dxtt,dytt,dztt,nx,ny,nz,d,f,px,py,objd',nx,ny,nz
Dim Shared As float cost,cost07,cost05,cost0505p2,costm03,sint,sint07,sint05,sint05p2,sint02,sint0205,costsint02
Dim Shared As Integer rr,gg,bb
'dim shared as float dxtt,dytt,dztt
Const SCR_W = 640
Const SCR_H = 480
Const IMG_W = 160
Const IMG_H = 120

Sub setup()
  screenres SCR_W,SCR_H,32,,1
  megatunnelEffect = ImageCreate(IMG_W,IMG_H)
  maxrX=megatunnelEffect->width
  maxrY=megatunnelEffect->height
End Sub

Function obj(x As float,y As float,z As float,t As float) As float
  Dim As float f=1.0
  dxx=x-costsint02:dyy=y-0.3:dzz=z-cost0505p2
  f*=(dxx*dxx + dyy*dyy + dzz*dzz)
  dxx=x- -cost07:dyy=y-0.3:dzz=z-sint05p2
  f*=(dxx*dxx + dyy*dyy + dzz*dzz)
  dxx=x- -sint0205:dyy=y-sint:dzz=z-2.0
  f*=(dxx*dxx + dyy*dyy + dzz*dzz)
  f=sqr(f) 
  f*=Cos(y)*Cos(x)-0.1-Cos(z*7.0+t*7.0)*Cos(x*3.0)*Cos(y*4.0)*0.1
  Return f
End Function


Function max(a As float, b As float) As float
  If a>b Then Return a
  Return b
End Function
 
Function eval(xx As Integer,yy As Integer,t As float) As Uinteger
  px = xx / maxrX
  ox=px*2.0-1.0
  oz=0.0
  dx=(ox+costm03)/64.0

  'dz=1.0/64.0
  dz=0.015625
  tt=0.0
  g=1.0

  While((g>0.4) And (tt<275))
    g=obj(ox+dx*tt,oy+dy*tt,oz+dz*tt,t)     
    tt+=g*4
  Wend
  dxtt=ox+dx*tt
  dytt=oy+dy*tt
  dztt=oz+dz*tt
  objd=obj(dxtt,dytt,dztt,t)
  nx=objd-obj(dxtt+0.1,dytt,dztt,t)
  ny=objd-obj(dxtt,dytt+0.1,dztt,t)
  nz=objd-obj(dxtt,dytt,dztt+0.1,t)

  d=Sqr(nx*nx+ny*ny+nz*nz)
  ny=ny/d
  nz=nz/d
  kolor=max(-0.5*nz,0.0) + max(-0.5*ny+0.5*nz,0.0)*0.5   
  Dim As float mult = tt*0.025
  rr=max((kolor+0.2*mult)*240,0):If rr>255 Then rr=255
  gg=max((kolor+0.1*mult)*240,0):If gg>255 Then gg=255
  bb=max((kolor+0.5*mult)*240,0):If bb>255 Then bb=255
 
  Return rgb(rr,gg,bb)
End Function


Sub DrawIt()
  Dim As float t = time_
  cost       = Cos(t)
  cost07     = Cos(t*.7)
  cost05     = Cos(t*.5)
  cost0505p2 = cost05 * 0.5 + 2
  costm03    = cost * 0.3
  sint       = Sin(t)
  sint07     = Sin(t*.7)
  sint05     = Sin(t*.5)
  sint05p2   = sint05 + 2
  sint02     = Sin(t*.2)
  sint0205   = sint02*0.5
  costsint02 = cost+sint02
  Dim As Uinteger Ptr pixels = cptr(Uinteger Ptr,megatunnelEffect)
  pixels+=8
  For y As Integer = 0 To megatunnelEffect->height-1
    py = y / maxrY
    vy=py*-2.0+1.0
    oy= vy*1.25
    dy= vy/maxrY
    For x As Integer = 0 To megatunnelEffect->width-1
      *pixels = eval(x,y,time_)
      pixels+=1
    Next
  Next
  Put (240,190),megatunnelEffect,Pset
  time_+=0.05
End Sub


Setup()
While Inkey()=""
  DrawIt()
  Sleep 10
Wend
 
Last edited by D.J.Peters on Jul 29, 2010 2:29, edited 1 time in total.
angros47
Posts: 2385
Joined: Jun 21, 2005 19:04

Post by angros47 »

maybe it's a linux version issue... i'll have to test with a windows machine.
D.J.Peters
Posts: 8631
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

angros47 wrote:maybe it's a linux version issue... i'll have to test with a windows machine.
for linux you have to rename the var dx
i changed dx,dy,dz in _dx,_dy,_dz

Joshy

Code: Select all

/'
 * Metatunnel demo effect
 * Original by FRequency
 * http://www.pouet.net/prod.php?which=52777
 *
 * Canvas 2D version by PauloFalcao
 * http://demoscene.appjet.net/
 *
 * Canvas 3D port by vlad
 * http://people.mozilla.com/~vladimir/misc/metatunnel-3d.html
 *
 * Processing.org port by luis2048
 * http://luis.net/projects/processing/metatunnel/
 *
 * FreeBasic port by D.J.Peters
 * http://www.freebasic.net/forum/viewtopic.php?p=140112
 '/
#include "fbgfx.bi"
Using fb

Type float As Single

Dim Shared As float time_
Dim Shared As float maxrX
Dim Shared As float maxrY
Dim Shared As Image Ptr megatunnelEffect
Dim Shared As float dxx,dyy,dzz
Dim Shared As float vy,ox,oy,oz,dx_,dy_,dz_,tt,g,kolor,dxtt,dytt,dztt,nx,ny,nz,d,f,px,py,objd',nx,ny,nz
Dim Shared As float cost,cost07,cost05,cost0505p2,costm03,sint,sint07,sint05,sint05p2,sint02,sint0205,costsint02
Dim Shared As Integer rr,gg,bb
'dim shared as float dxtt,dytt,dztt
Const SCR_W = 640
Const SCR_H = 480
Const IMG_W = 160
Const IMG_H = 120

Sub setup()
  screenres SCR_W,SCR_H,32,,1
  megatunnelEffect = ImageCreate(IMG_W,IMG_H)
  maxrX=megatunnelEffect->width
  maxrY=megatunnelEffect->height
End Sub

Function obj(x As float,y As float,z As float,t As float) As float
  Dim As float f=1.0
  dxx=x-costsint02:dyy=y-0.3:dzz=z-cost0505p2
  f*=(dxx*dxx + dyy*dyy + dzz*dzz)
  dxx=x- -cost07:dyy=y-0.3:dzz=z-sint05p2
  f*=(dxx*dxx + dyy*dyy + dzz*dzz)
  dxx=x- -sint0205:dyy=y-sint:dzz=z-2.0
  f*=(dxx*dxx + dyy*dyy + dzz*dzz)
  f=sqr(f) 
  f*=Cos(y)*Cos(x)-0.1-Cos(z*7.0+t*7.0)*Cos(x*3.0)*Cos(y*4.0)*0.1
  Return f
End Function


Function max(a As float, b As float) As float
  If a>b Then Return a
  Return b
End Function
 
Function eval(xx As Integer,yy As Integer,t As float) As Uinteger
  px = xx / maxrX
  ox=px*2.0-1.0
  oz=0.0
  dx_=(ox+costm03)/64.0

  'dz=1.0/64.0
  dz_=0.015625
  tt=0.0
  g=1.0

  While((g>0.4) And (tt<275))
    g=obj(ox+dx_*tt,oy+dy_*tt,oz+dz_*tt,t)     
    tt+=g*4
  Wend
  dxtt=ox+dx_*tt
  dytt=oy+dy_*tt
  dztt=oz+dz_*tt
  objd=obj(dxtt,dytt,dztt,t)
  nx=objd-obj(dxtt+0.1,dytt,dztt,t)
  ny=objd-obj(dxtt,dytt+0.1,dztt,t)
  nz=objd-obj(dxtt,dytt,dztt+0.1,t)

  d=Sqr(nx*nx+ny*ny+nz*nz)
  ny=ny/d
  nz=nz/d
  kolor=max(-0.5*nz,0.0) + max(-0.5*ny+0.5*nz,0.0)*0.5   
  Dim As float mult = tt*0.025
  rr=max((kolor+0.2*mult)*240,0):If rr>255 Then rr=255
  gg=max((kolor+0.1*mult)*240,0):If gg>255 Then gg=255
  bb=max((kolor+0.5*mult)*240,0):If bb>255 Then bb=255
 
  Return rgb(rr,gg,bb)
End Function


Sub DrawIt()
  Dim As float t = time_
  cost       = Cos(t)
  cost07     = Cos(t*.7)
  cost05     = Cos(t*.5)
  cost0505p2 = cost05 * 0.5 + 2
  costm03    = cost * 0.3
  sint       = Sin(t)
  sint07     = Sin(t*.7)
  sint05     = Sin(t*.5)
  sint05p2   = sint05 + 2
  sint02     = Sin(t*.2)
  sint0205   = sint02*0.5
  costsint02 = cost+sint02
  Dim As Uinteger Ptr pixels = cptr(Uinteger Ptr,megatunnelEffect)
  pixels+=8
  For y As Integer = 0 To megatunnelEffect->height-1
    py = y / maxrY
    vy=py*-2.0+1.0
    oy= vy*1.25
    dy_= vy/maxrY
    For x As Integer = 0 To megatunnelEffect->width-1
      *pixels = eval(x,y,time_)
      pixels+=1
    Next
  Next
  Put (240,190),megatunnelEffect,Pset
  time_+=0.05
End Sub


Setup()
While Inkey()=""
  DrawIt()
  Sleep 10
Wend
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

O.O

OMG.. freaky!

That's really .... what's the word..

neat?



~Kiyote!
badmrbox
Posts: 664
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:

Post by badmrbox »

Looks cool.
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Post by anonymous1337 »

Some people are so smart. That's really cool.
Post Reply