Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - rdc

Pages: [1] 2 3 4 5 6 7 8 ... 47
1
Projects / Re: [Android]Crappy Fish
« on: April 14, 2014 »
Boy, that Flappy was a strange story. Cool stuff Rel.

2
General chat / Re: CryEngine
« on: March 20, 2014 »
The Torque engine is open source: http://www.garagegames.com/products/torque-3d
There is also a Torque 2D engine as well: http://www.garagegames.com/products/torque-2d

3
General chat / Re: Hi
« on: March 03, 2014 »
Welcome!

4
Projects / Re: Automation 445 Remake
« on: February 23, 2014 »
Cool stuff.

5
General chat / Re: Planetary Annihilation
« on: February 22, 2014 »
That looks like a lot of fun.

6
Projects / Re: Dasher is Late for Work (WebGL version)
« on: February 19, 2014 »
That is awesome, works well. I really need to look at that WebGL stuff when I get a chance. You should make this into a game. :)

7
Freebasic / Re: Chladni w/ Glass Effect
« on: February 15, 2014 »

8
General chat / Re: Hello all!
« on: February 10, 2014 »
Welcome! I am just back myself after a long hiatus. Need to relearn myself. :)

9
Freebasic / Re: Chladni w/ Glass Effect
« on: February 07, 2014 »
Really nice to look at rdc. Chladni patterns are rather fascinating, indeed :)


I appreciate it.

10
Freebasic / Re: Chladni w/ Glass Effect
« on: February 07, 2014 »
Nice to have you back Rick!  Chladni, now there's a word I haven't seen since a long time!

Jim


Haha. I bet not. Thanks man.

11
General chat / Re: Humble Sid Meier Bundle
« on: February 06, 2014 »
Yeah, I got that one too. Had to get that bundle. :)

12
Freebasic / Re: Chladni w/ Glass Effect
« on: February 03, 2014 »
Thanks man. Appreciate the welcome. Yeah the attachment is fine. I should have thought of that myself. I need to relearn this demo stuff again, but I am looking forward to it. :)

13
Freebasic / Chladni w/ Glass Effect
« on: February 02, 2014 »
Hey guys, it has been a long, long time. Not sure if anyone even remembers me but my logon still worked. :) I hope everyone is well.

I have been out of touch for a while; had quite a few major things come up in the past couple years so I haven't really done anything much or kept up with much either. I am finally getting back into programming and such again though as life has settled down some. Thought I would post a little tidbit. Not sure if I posted this before, but I have done a bit of tinkering on it recently. Compiles with the latest version and probably older versions as well. Yeah, I am still messing around with Chladni. :)

I am looking forward to getting caught up here. I have forgotten just about everything, so it is back to the books so to speak.

Keys

space : new image
s (lowercase) : save bmp
ESC]: quit

Code: [Select]
'Chladni Glass Demo
'http://local.wasp.uwa.edu.au/~pbourke/modelling/chladni/
'Richard D. Clark
'Public Domain



#Define sw 1024
#define sh 768

'Jofers
Type Pixel_Color
    B As Ubyte
    G As Ubyte
    R As Ubyte
    A As Ubyte
End Type

Union Pixel
    Channel As Pixel_Color
    Value   As Uinteger
End Union

const pi = Atn(1.0) * 4

dim shared tex(0 to sw - 1, 0 to sh - 1) as uinteger
dim shared ctex(0 to sw - 1, 0 to sh - 1) as uinteger
dim shared ntex(0 to sw - 1, 0 to sh - 1) as uinteger
dim shared pal(0 to 255) as uinteger
dim as string key
Dim As Integer ret

Function GetRandom(lowerbound as integer, upperbound as integer) as integer
   return Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
end function
 
'Interpolation code by Rattrapmax6
Sub DoPalette(pal() as UInteger, sr as integer, sg as integer, sb as integer, er as integer, eg as integer, eb as integer)
    Dim As Integer i
    Dim iStart(3) As Integer
    Dim iEnd(3) As Integer
    Dim iShow(3) As Integer
    Dim Rend(3) As Double
    Dim InterPol(3) As Double
   
    InterPol(0) = Ubound(pal)
    iStart(1) = sr
    iStart(2) = sg
    iStart(3) = sb
    iEnd(1) = er
    iEnd(2) = eg
    iEnd(3) = eb
    InterPol(1) = (iStart(1) - iEnd(1)) / InterPol(0)
    InterPol(2) = (iStart(2) - iEnd(2)) / InterPol(0)
    InterPol(3) = (iStart(3) - iEnd(3)) / InterPol(0)       
    Rend(1) = iStart(1)
    Rend(2) = iStart(2)
    Rend(3) = iStart(3)   
   
    For i = 0 To Ubound(pal)
        iShow(1) = Rend(1)
        iShow(2) = Rend(2)
        iShow(3) = Rend(3)

        pal(i) = Rgb(iShow(1),iShow(2),iShow(3))

        Rend(1) -= InterPol(1)
        Rend(2) -= InterPol(2)
        Rend(3) -= InterPol(3)
    Next
   
End Sub

sub GeneratePalette(pal() as integer)
    dim as integer rs, gs, bs, re, ge, be
   
    rs = GetRandom(0, 255)
    gs = GetRandom(0, 255)
    bs = GetRandom(0, 255)
    re = 255
    ge = 255
    be = 255   
    DoPalette pal(), rs, gs, bs, re, ge, be
end sub

sub LoadChladni
    dim as integer x, y, n, m, x2, y2, l, i, nx, ny
    dim as integer clr1, clr2, r, g, b, iterations
    dim as integer rmax, chs
    dim as double hh, h, ambient, dif, spec
    dim as uinteger cc
    dim clr as Pixel
   
    chs = GetRandom(200, 512)           
    iterations = 10
    rmax = 15
    'Clear to 255
    for x = 0 to sw - 1
        for y = 0 to sh - 1
            tex(x, y) = 255
        next
    next
    'Generate chladni texture filling in 255 areas
    for i = 1 to iterations
        do
            n = rnd * rmax
            m = rnd * rmax
            sleep 1
        loop until (m <> n) 'and (m mod 2 <> 0) and (n mod 2 <>0)
        GeneratePalette pal()
        for x = 0 to sw - 1
            for y = 0 to sh - 1
                ambient = 0.4
                dif = 2.5
                spec = 1.0
                x2 = ( cos( n*pi*x/chs ) * cos( m*pi*y/chs ) ) * 128
                y2 = ( cos( m*pi*x/chs ) * cos( n*pi*y/chs ) ) * 128
                cc = x2 - y2
                if cc < 0 then cc = 0
                if cc > 255 then cc = 255
                if tex(x, y) = 255 then
                    tex(x, y) = cc
                    ctex(x, y) = pal(cc)
                end if
            next
        next
    next
    'Glassify image
    for x = 0 to sw - 1
        for y = 0 to sh - 1
            if (x + 1) <= sw - 1 then clr1 = tex(x + 1, y)
            if (x - 1) >= 0 then clr2 = tex(x - 1, y)
            nx = clr1 - clr2
            if (y + 1) <= sh - 1 then clr1 = tex(x, y + 1)
            if (y - 1) >= 0 then clr2 = tex(x, y - 1)
            ny = clr1 - clr2
            hh = 1 / sqr(nX * nX + nY * nY + 1)
            'shading = ambient + dif*dot + dot^2 * spec
            h = ambient + (dif * hh) + (hh * hh) * spec
            clr.Value = ctex(x, y)
            r = Int(clr.channel.r * h)
            g = Int(clr.channel.g * h)
            b = Int(clr.channel.b * h)
            if r < 0 then r = 0
            if g < 0 then g = 0
            if b < 0 then b = 0
            if r > 255 then r = 255
            if g > 255 then g = 255
            if b > 255 then b = 255
            ntex(x, y) = RGB(r, g, b)
        next
    next
    'Print Image
    screenlock
    cls   
    for x = 0 to sw - 1
        for y = 0 to sh - 1
            pset (x, y), ntex(x, y)
        next
    next
       
    screenunlock
end sub


Randomize timer

screenres sw, sh, 32,,1
if screenptr = 0 then
    end -1
end if
windowtitle "Chladni 3D"
setmouse ,,0
LoadChladni
do
    key = inkey
    if key = chr(32) then
        LoadChladni
    ElseIf key = "s" Then
    ret = BSave(Str(Timer) & ".bmp", 0)
    end if
    sleep 1
loop until key = chr(27)
setmouse ,,1
end

14
General chat / Re: Pixels
« on: May 05, 2011 »
Yeah, that is a classic.

15
Freebasic / Inheritance Branch
« on: May 05, 2011 »
v1ctor has added inheritance to FB and you can get the branch from this post on the FB forum. You will probably need to have the current official build installed before applying this. Back up your current installation before applying this though just to be safe.

I have been playing around with it, and it seems to work. Some examples are found in the examples\classes folder. Here is what the new syntax looks like from one of the examples:

Code: [Select]
type Foo
declare function DoSomething() as integer
declare function DoIt() as integer
declare function DoItFromBase() as integer

private:
dim unused as byte
end type

function Foo.DoSomething() as integer
return 1
end function

function Foo.DoIt() as integer
return DoSomething()
end function

function Foo.DoItFromBase() as integer
return DoSomething()
end function

type SuperFoo extends Foo
declare function DoSomething() as integer
declare function DoIt() as integer
end type

function SuperFoo.DoSomething() as integer
return 2
end function

function SuperFoo.DoIt() as integer
return DoSomething()
end function

sub main
dim as SuperFoo inst

assert( inst.DoIt() = 2 )
assert( cast( Foo, inst ).DoIt() = 1 )
assert( inst.DoItFromBase() = 1 )

print "all tests ok"
end sub

main

Notice the extends keyword here. In the above example, SuperFoo inherits from Foo.

I'll be beating on this some and post my findings.

16
Freebasic / Re: Inheritance via Pointers
« on: April 29, 2011 »
Adding more OOP stuff:

Code: [Select]
'Inheritance using pointers.

Type base
   Private:
an As ZString * 20
a As Integer
Public:
Declare Constructor ()
Declare Destructor ()
Declare Property anGet () As String
Declare Property aGet() As Integer
End Type

Constructor base ()
   Print "Constructor base"
   an = "Hello World!"
   a = 20
End Constructor

Destructor base ()
   Print "Destructor base"
End Destructor

Property base.anGet () As String
   Return an
End Property

Property base.aGet() As Integer
   Return a
End Property

Type dr1
inherit As base
b As Integer
End Type

Type dr2
inherit2 As dr1
c As Integer
End Type

Sub PrintBase(b As base Ptr)
Print "an (base): " & b->anGet
Print "a (base): " & b->aGet
Print
End Sub

Sub PrintD1(d1 As dr1 Ptr)
Print "an (base): " & CPtr(base Ptr, d1)->anGet
Print "a (base): " & CPtr(base Ptr, d1)->aGet
Print "b (dr1):" & d1->b
Print
End Sub

Sub PrintD2(d2 As dr2 Ptr)
Print "an (base): " & CPtr(base Ptr, d2)->anGet
Print "a (base): " & CPtr(base Ptr, d2)->aGet
Print "b (dr1): " & CPtr(dr1 Ptr, d2)->b
Print "c (dr2): " & d2->c
Print
End Sub

Dim dp2 As dr2 Ptr = New dr2
Dim dp1 As dr1 Ptr = CPtr(dr1 Ptr, dp2)
Dim bp As base Ptr = CPtr(base Ptr, dp2)

'Set the base values.
'bp->an = "Hello World!"
'bp->a = 20
'Set the d2 value.
dp1->b = 30
'Set the d1 value.
dp2->c = 40

'Print the values.
PrintBase bp
PrintD1 dp1
PrintD2 dp2
Delete dp2
Sleep

Output:

Quote
Constructor base
an (base): Hello World!
a (base): 20

an (base): Hello World!
a (base): 20
b (dr1):30

an (base): Hello World!
a (base): 20
b (dr1): 30
c (dr2): 40

Destructor base

17
I use Code::Blocks on both my Vista and XP box. It works just fine on both, has excellent coding facilities, very good debug support, and a lot of ways to manage your project. The default distro comes with MinGW on Windows, but it has support for several other compilers. It is definitely worth a look.

18
Freebasic / Re: Inheritance via Pointers
« on: April 29, 2011 »
Thanks.

It is interesting that according to the research I have done on this, C++ implements inheritance in a similar manner. That was actually the point of the code in the book; showing that inheritance is really just a set of pointers that point to the different class (struct) definitions. You just don't have to use the cast operator since the compiler does that for you.

Until inheritance finally makes it into FreeBasic, I think this could be useful.

19
Freebasic / Inheritance via Pointers
« on: April 28, 2011 »
I saw this technique in the book C++ Pointers and Dynamic Memory Management and thought it was very cool, so I thought I would see if this worked in FB. It seems to.

Code: [Select]
'Inheritance using pointers.

Type base
an As ZString * 20
a As Integer
End Type

Type dr1
inherit As base
b As Integer
End Type

Type dr2
inherit2 As dr1
c As Integer
End Type

Sub PrintBase(b As base Ptr)
Print "an (base): " & b->an
Print "a (base): " & b->a
Print
End Sub

Sub PrintD1(d1 As dr1 Ptr)
Print "an (base): " & CPtr(base Ptr, d1)->an
Print "a (base): " & CPtr(base Ptr, d1)->a
Print "b (dr1):" & d1->b
Print
End Sub

Sub PrintD2(d2 As dr2 Ptr)
Print "an (base): " & CPtr(base Ptr, d2)->an
Print "a (base): " & CPtr(base Ptr, d2)->a
Print "b (dr1): " & CPtr(dr1 Ptr, d2)->b
Print "c (dr2): " & d2->c
Print
End Sub

Dim dp2 As dr2 Ptr = New dr2
Dim dp1 As dr1 Ptr = CPtr(dr1 Ptr, dp2)
Dim bp As base Ptr = CPtr(base Ptr, dp2)

'Set the base values.
bp->an = "Hello World!"
bp->a = 20
'Set the d1 value.
dp1->b = 30
'Set the d2 value.
dp2->c = 40

'Print the values.
PrintBase bp
PrintD1 dp1
PrintD2 dp2
Sleep

Delete dp2

Output:

Quote
an (base): Hello World!
a (base): 20

an (base): Hello World!
a (base): 20
b (dr1):30

an (base): Hello World!
a (base): 20
b (dr1): 30
c (dr2): 40

20
General chat / Re: It's been 10 years!
« on: April 28, 2011 »
10 years is an amazing achievement on the Internet. That has got to be a 1000 regular years right? :) Congrats!

Pages: [1] 2 3 4 5 6 7 8 ... 47