Math, Graphics & Demos Thread

[anonymous1337]

An experimental thread ongoing discussions of math, graphics, demos, etc. can take place. For now, an alternative to Tips & Tricks for this kind of thing, but I have been thinking recently it would be better if every "topic" could get its own thread.

Inspired by this: http://freebasic.net/forum/viewtopic.php?f=17&t=23476

Post in it with your code, or give feedback on the idea! Thanks!

[D.J.Peters]

Code: Select all

const as integer scr_w=800
const as integer scr_h=800
const as integer hmin=-(scr_h/2-1)
const as integer hmax= scr_h/2
const as integer wmin=-(scr_w/2-1)
const as integer wmax= scr_w/2
const as single RMAX3 = 4000
const as single RMAX2 = 2000
const as single RMAX1 =  500
const as single VMAX  =  200
const as single ZMAX  = 0.1

type EP_T
  as single c
  as single s
  as single v
  as single e
end type

type V_T
  as single x,y
end type

type SD_T
  as single  a
  as integer r
end type

type S_T
  as integer  n
  as V_T  ptr pV
  as SD_T ptr pSD
end type

dim as EP_T   EL(0 to RMAX3-1)
dim as S_T    S(1)
dim as single er
dim as single et
'
' main
'
for r as integer=0 to RMAX3-1
  dim as single ang=et*r/RMAX3
  EL(r).s=r*sin(ang)
  EL(r).c=r*cos(ang)
  EL(r).v=VMAX/(r*10)
  EL(r).e=er
next
for j as integer=0 to 1
  with S(j)
    .n=(2-j)*3000
    .pV=new V_T[.n]
    .pSD=new SD_T[.n]
    for i as integer = 0 to .n-1
      dim as single a=6.283*rnd()
      dim as integer r=rnd*(RMAX3-1)
      .pSD[i].a=a
      .pSD[i].r=r
    next
  end with
next

screenres scr_w,scr_h,8
dim as integer pitch
screeninfo ,,,,pitch

dim as integer frames
dim as single  w=3.1
while inkey=""
  if frames mod 10=0 then
    er=1.0+0.5*sin(w)
    et=7.5+5.0*sin(w*3)
    w+=0.001
    for r as integer=0 to RMAX3-1
      dim as single ang=et*r/RMAX3
      EL(r).s=r*sin(ang)
      EL(r).c=r*cos(ang)
      EL(r).v=VMAX/(r*10)
      EL(r).e=er
    next
  end if
  for j as integer = 0 to 1
    with S(j)
      dim as integer n=.n-1
      for i as integer = 0 to n
        var r=.pSD[i].r
        var e=EL(r)
        .pSD[i].a+=e.v
        var a=.pSD[i].a
        dim as single x = sin(a)
        dim as single y = cos(a)*e.e
        .pV[i].x = e.s*x+e.c*y
        .pV[i].y = e.c*x-e.s*y
      next
    end with
  next
  dim as integer i1=(S(0).n-1)*rnd
  var a=S(0).pSD[i1].a
  var r=S(0).pSD[i1].r
  dim as V_T v1=S(0).pV[i1]
  dim as integer i2 = (S(1).n-1)*rnd
  dim as V_T v2 = S(1).pV[i2]
  S(0).pSD[i1]=S(1).pSD[i2]
  S(0).pV[i1]=v2
  i1=i2
  S(1).pSD[i1].a=a
  S(1).pSD[i1].r=r
  S(1).pV[i1]=v1 


frames+=1
  screenlock 
  dim as ubyte ptr p=screenptr()
  line (0,0)-step(scr_w-1,scr_h),0,BF
  for i as integer=0 to 1
    with S(i)
      dim as integer n = .n-1
      while n
        with .pV[n]
          dim as integer y = .y*ZMAX
          if y>hmin then
            if y<hmax then
              dim as integer x = .x*ZMAX
              if x>wmin then
                if x<wmax then
                  x+=wmax:y+=hmax
                  p[y*pitch+x]=15
                end if
              end if
            end if
          end if
        end with
        n-=1
      wend
    end with
  next
  screenunlock
  sleep 1
wend

[BasicCoder2]

This adds some color to your display,

replace

Code: Select all

p[y*pitch+x]=15

with

Code: Select all

p[y*pitch+x]=12
p[y*pitch+(800-x)] = 10

[dafhi]

@anonymous1337 - Here I intend to reply specifically to D.J. Peters' post which brings to mind the value of Tips & Tricks. However this is already feeling like the Squares thread :)

@DJ Peters - here i have independent frame control

Code: Select all

const as integer scr_w=800
const as integer scr_h=800
const as integer hmin=-(scr_h/2-1)
const as integer hmax= scr_h/2
const as integer wmin=-(scr_w/2-1)
const as integer wmax= scr_w/2
const as single RMAX3 = 4000
const as single RMAX2 = 2000
const as single RMAX1 =  500
const as single VMAX  =  200
const as single ZMAX  = 0.1

type EP_T
  as single c
  as single s
  as single v
  as single e
end type

type V_T
  as single x,y
end type

type SD_T
  as single  a
  as integer r
end type

type S_T
  as integer  n
  as V_T  ptr pV
  as SD_T ptr pSD
end type

dim as EP_T   EL(0 to RMAX3-1)
dim as S_T    S(1)
dim as single er
dim as single et


' - gtPhysicsAnim ---------------------
'
dim shared as double    gt

type gtPhysicsAni  '' by dafhi 2015 04 27

  /' - usage -
  Dim as gtPhysicsAni anim
  Do: gt = Timer
    If anim.ready then
      '..
      Print "fps: "; anim.fps_report
    end if: sleep 1
    dim as integer i = anim.physics_frames
    angle += 0.001 * i
  Loop until inkey = chr(27) '/
  
  as single             ready_fps = 60
  as single             phys_fps = 243.0
  as double             td, tp
  as string             fps_report
  declare function      ready as integer
  declare function      physics_frames as integer
  as single             ianim, anim_f, anim_tdsum, anim_framesum, anim_tp
  as single             iphys, phys_f
 private:
  declare sub           calc_fps
end type
sub gtPhysicsAni.calc_fps
  anim_framesum += 1:  anim_tdsum += gt-anim_tp:  anim_tp = gt
  if anim_tdsum > 1.0 then:fps_report = str( anim_framesum / anim_tdsum )
    anim_tdsum=0: anim_framesum=0:end if:end sub
function gtPhysicsAni.ready as integer
  if tp=0 then tp=Timer-0.01: anim_tp = gt
  ianim=1/ready_fps
  if anim_f > 0 then: calc_fps
    while anim_f>0: anim_f-=ianim: wend
    return -1
  else
    return 0
  end if
end function
function gtPhysicsAni.physics_frames as integer
  td=gt-tp: tp=gt: anim_f+=td: phys_f+=td: iphys=1/phys_fps
  dim as integer i
  while phys_f>0:phys_f-=iphys:i+=1:wend
  Return i
end function
' ------------------

'
' main
'
for r as integer=0 to RMAX3-1
  dim as single ang=et*r/RMAX3
  EL(r).s=r*sin(ang)
  EL(r).c=r*cos(ang)
  EL(r).v=VMAX/(r*10)
  EL(r).e=er
next
for j as integer=0 to 1
  with S(j)
    .n=(2-j)*3000
    .pV=new V_T[.n]
    .pSD=new SD_T[.n]
    for i as integer = 0 to .n-1
      dim as single a=6.283*rnd()
      dim as integer r=rnd*(RMAX3-1)
      .pSD[i].a=a
      .pSD[i].r=r
    next
  end with
next

screenres scr_w,scr_h,8
dim as integer pitch
screeninfo ,,,,pitch

dim as gtPhysicsAni anim,phys_array,phys
anim.ready_fps = 17
phys_array.ready_fps = 26
phys.ready_fps = 60
'dim as integer frames
dim as single  w=3.1
while inkey<> chr(27)

  gt=Timer
  if phys_array.ready then
  'if frames = 10 then
    er=1.0+0.5*sin(w)
    et=7.5+5.0*sin(w*3)
    w+=0.001
    for r as integer=0 to RMAX3-1
      dim as single ang=et*r/RMAX3
      EL(r).s=r*sin(ang)
      EL(r).c=r*cos(ang)
      EL(r).v=VMAX/(r*10)
      EL(r).e=er
    next': frames=0
  end if: phys_array.physics_frames
  
  if phys.ready then
    for j as integer = 0 to 1
      with S(j)
        dim as integer n=.n-1
        for i as integer = 0 to n
          var r=.pSD[i].r
          var e=EL(r)
          .pSD[i].a+=e.v
          var a=.pSD[i].a
          dim as single x = sin(a)
          dim as single y = cos(a)*e.e
          .pV[i].x = e.s*x+e.c*y
          .pV[i].y = e.c*x-e.s*y
        next
      end with
    next
    dim as integer i1=(S(0).n-1)*rnd
    var a=S(0).pSD[i1].a
    var r=S(0).pSD[i1].r
    dim as V_T v1=S(0).pV[i1]
    dim as integer i2 = (S(1).n-1)*rnd
    dim as V_T v2 = S(1).pV[i2]
    S(0).pSD[i1]=S(1).pSD[i2]
    S(0).pV[i1]=v2
    i1=i2
    S(1).pSD[i1].a=a
    S(1).pSD[i1].r=r
    S(1).pV[i1]=v1 
  end if: phys.physics_frames

'frames+=1
  if anim.ready then
  screenlock 
  dim as ubyte ptr p=screenptr()
  line (0,0)-step(scr_w-1,scr_h),0,BF
  for i as integer=0 to 1
    with S(i)
      dim as integer n = .n-1
      while n
        with .pV[n]
          dim as integer y = .y*ZMAX
          if y>hmin then
            if y<hmax then
              dim as integer x = .x*ZMAX
              if x>wmin then
                if x<wmax then
                  x+=wmax:y+=hmax
                  p[y*pitch+x]=15
                end if
              end if
            end if
          end if
        end with
        n-=1
      wend
    end with
  next
  screenunlock
  end if: anim.physics_frames
  sleep 1
wend

[dodicat]

D.J.Peters.
You asked how it works (somewhere).

I don't know but a similarity is at hand.

Point density varies as distance from the centre (galaxy fashion)

The rotation speed likewise. (Solar system fashion, excepting it is not inverse square)
But I'm not sure if the Solar system IS inverse square -- must have a Google--

Code: Select all

Screenres 700,700,32,2
screenset 1,0
Color ,Rgb(50,50,50)
Dim Shared As long xres,yres
Dim As long pitch,radius
Dim As Any Ptr row=Screenptr
Dim As ulong Ptr pixel
Screeninfo xres,yres,,,pitch
radius=yres/2.3
Type v2
    As Single x,y
End Type
Dim As v2 centre=Type<v2>(xres\2,yres\2)
Redim As v2 a()

Operator *(f As Single,b As v2) As v2
var q=Type<v2>(f*(b.x-xres\2),f*(b.y-yres\2))
Return Type<v2>(q.x+xres\2,q.y+yres\2)
End Operator

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            var t=Timer
            frames+=1
            If (t-t3)>=1 Then t3=t:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=T
            Return sleeptime
        End Function
        
#macro ppset(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
*pixel=(colour)
#endmacro
#define incircle(p,c,r) (p.x-c.x)*(p.x-c.x)+ (p.y-c.y)*(p.y-c.y)<r*r
#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define dst(a,b) sqr((a.x-b.x)*(a.x-b.x)+(a.y-b.y)*(a.y-b.y))
#macro rotate(pivot,p,cosa,sina)
Type<v2>((Cosa*(p.x-pivot.x)-Sina*(p.y-pivot.y))+pivot.x, _
(Sina*(p.x-pivot.x)+Cosa*(p.y-pivot.y))+pivot.y)
#endmacro
#define delta Rnd*5-Rnd*5
'create points
Dim As long ctr
For x As long=0 To xres Step 4
    For y As long=0 To yres Step 4
        If incircle(Type<v2>(x,y),centre,radius) Then 
            var df=dst(Type<v2>(x,y),centre)
            var dd=map(0,radius,df,0,1)
            ctr+=1
            Redim Preserve a(1 To ctr)
            a(ctr)=dd*Type<v2>(x+delta,y+delta)
        End If
    Next y
Next x

Dim As Single s,ca,sa,Yv=radius
dim as ulong white=rgb(255,255,255)
dim as long fps
Do
    Cls
    draw string (10,10),"FPS= " &fps,rgb(200,200,255)
    For n As long=Lbound(a) To Ubound(a)
        var d=dst(a(n),centre)
        s=map(0,Yv,d,.06,.002)
        ca=Cos(s):sa=Sin(s)
        a(n)=rotate(centre,a(n),ca,sa)
        ppset(Cint(a(n).x),Cint(a(n).y),white)
    Next n
    flip
    Sleep regulate (65,fps),1
Loop Until Len(Inkey)
Sleep 

P.S.
I didn't expand the macros with -pp here, it makes the code look cryptic when it is not.

[BasicCoder2]

@dafhi,
This needs to be moved to say a computer generated art section?
To add some color. The Hubble telescope produces some eye candy images.

Code: Select all

p[y*pitch+x]= sqr( ((abs(x-400))/25)^2 + ( (abs(y-400)) / 25)^2 )

@dodicat,
A common problem I have is not being able to run programs without updating to the latest FB version.
C:\FreeBasic\dodi.bas(51) error 7: Expected ')', found '.' in 'If incircle(Type<v2>(x,y),centre,radius) Then'
C:\FreeBasic\dodi.bas(52) error 7: Expected ')', found '.' in 'var df=dst(Type<v2>(x,y),centre)'

[dafhi]

@dodicat - fb64:
Dim Shared As integer xres,yres
Dim As integer pitch,radius

also in many cases (including your post) i've seen pset perform better than 'direct'

[fxm]

@dodicat,
A common problem I have is not being able to run programs without updating to the latest FB version.
C:\FreeBasic\dodi.bas(51) error 7: Expected ')', found '.' in 'If incircle(Type<v2>(x,y),centre,radius) Then'
C:\FreeBasic\dodi.bas(52) error 7: Expected ')', found '.' in 'var df=dst(Type<v2>(x,y),centre)'

You always work with fbc 0.24.0!
Nevertheless, a workaround:

Code: Select all

        If incircle((Type<v2>(x,y)),centre,radius) Then
            var df=dst((Type<v2>(x,y)),centre)

[anonymous1337]

@dafhi

While I appreciate the value of Tips & Tricks and the Squares thread, here's my response to each:

Tips & Tricks - generally for one off demos. People do get responses, but only for a short period of time. There's DOZENS of "mouse locked to grid" demos, rather than just a few threads on the topic. Ideally, we would have ONE thread for each general topic or specialized topic that is added to and archived in GitHub as time goes on.

As far as replying to specific posts, the forum idea I have in mind would allow that, but responses (especially code modifications and suggestions) would reflect the evolution of code samples over an individual thread. Long-term evolution, vs the sometimes rampant, short-term bursts of individual threads that pop up in Tips & Tricks.

For example, posting too much in someone else's thread could be seen as "hijacking". No such thing would exist in the forum I have in mind.

I'm not sure that would prevent people from making their own threads. Someone would need to moderate it :-/ So there's definitely things to consider...

Squares thread - A perfect example of what I want, but could you imagine the "General" forum cluttered with similar threads that receive new activity? I'm not sure that would flow with the forum structure well... I considered it, however! :)

[dafhi]

@anonymous1337 - fun read. Well I like this thread already, seeing as how the undeniably brilliant demo codeist himself has used it. So the value that I mentioned of 'Tips & Tricks' is the organization. Which you've touched upon.

I'd totally join a forum like what you propose. I'd gut a few things in fbc source if i knew how :-)

What I think any forum could use is a search with tags feature. It would solve so many things.

Like to add that I also enjoy audio programming. I don't understand external APIs for the most part. All i've ever wanted is access to low latency streams.

[BasicCoder2]

You always work with fbc 0.24.0!

Because I don't want my old code to break with a later version. I feel no need for all the new additions to FreeBASIC beyond the version I am currently using. Because dodicat uses advanced programming techniques I can't actually read his code. I think dodicat mentioned something about giving each version its own folder. I don't understand the implications of having more than one version because when you click a source code icon how does it know which version to fire up? I think all you have to do is extract the latest version into the folder holding the previous version to update. I have no knowledge of what goes on behind the scenes. All I know is I have an editor into which I can type some code and run it. FreeBASIC appears to be a very powerful version of BASIC in the hands of those with the knowledge to use that power but I am limited to using it much like I used QBASIC.

[dodicat]

BasicCoder2

I use fbide to point to the Freebasic version in use.

I can click a .bas file of course and it opens, but I prefer to use fbide to open a file by navigating to it.
Or, just copying and pasting from the forum.

I have a couple of short cuts on my desktop to two instances of fbide.
One I use for the downloadable fb version, the other for the latest GIT build.

Not having fbc.exe on path does have disadvantages, I cannot use Geany or Scite editors.
Also some projects e.g, fbfrog by dkl seems to require the compiler on path.

I agree, fb24 was a good compiler, but each update is a little better.

[BasicCoder2]

I use fbide to point to the Freebasic version in use.

So how do you point Fbide to a particular version of FreeBasic?
Is that done in the FBide settings, tag FreeBASIC, Compiler and path setting?
All that setting up can be frustrating for anyone not knowing exactly how it all works and is one of the reasons I haven't been able to get SDL2 working with CODE::BLOCKS. Other amateurs must have similar issues as there are u-tube and articles, all badly presented, trying to explain how to set CODE::BLOCKS up to use SDL2. When you get "x can't be found" you feel like saying to the program "well find it then it is there somewhere because I just downloaded it"!! The need is there for that was the reason for Dev-paks for Dev-CPP although they can also be tricky when deciding what dev-pak you needed.

The BASIC language "was written to enable students in fields other than science and mathematics to use computers" and of course that made it available to self taught amateurs like myself without any form education in computer science.

[D.J.Peters]

BasicCoder2 of course the problem are not codeblocks.
It's the order in witch you give the gnu compiler the libs.
In the linker settings tab of your SDL or SDL2 project be sure you have this order.

- link libraries: -
mingw32 <- must be the first lib (on 64bit too)
SDLmain <- must be the first SDL lib entry
... <- than all other libs you use (SDL/SDL2, opengl, png ...)
...
...

If i use any other order linking will fail here.

Joshy

[BasicCoder2]

BasicCoder2 of course the problem are not codeblocks.

The problem is me! I haven't had the time and perhaps motivation to learn all that setting stuff up. I try to follow the steps given but without any understanding of the what or why and it either works or it doesn't. Ultimately you have to ask what really interests you. The mechanics of the car or driving the car. It is nice to have both but driving the car is the fun part and I will leave the fixing of the car to the mechanics. Of course in the old days I didn't need to include a file for graphics all I needed was the hardware manual :)