A list of my FreeBASIC activities of the past 10 years.

General discussion for topics related to the FreeBASIC project or its community.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

A list of my FreeBASIC activities of the past 10 years.

Post by D.J.Peters »

All my download links never changed and are active since ten years
but in near future my ISP must change the alice-net.de domain (it's owned by O2)

So I created a list with all links for my private use but I think it can be usefull for others to.

Joshy

A list of my FreeBASIC activities of the past 10 years.

Libraries and include files:
Tips and Tricks (source codes):
Last edited by D.J.Peters on Nov 05, 2023 0:49, edited 4 times in total.
JohnK
Posts: 279
Joined: Sep 01, 2005 5:20
Location: Earth, usually
Contact:

Re: A list of my FreeBASIC activities of the past 10 years.

Post by JohnK »

Big thanks DJ !!
I always look forward to your library update. I wished I had more time to play but I am excited about VCL.
Keep up the great work, as always.
jdebord
Posts: 547
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

Re: A list of my FreeBASIC activities of the past 10 years.

Post by jdebord »

Very useful collection of links ! Thank you very much !
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: A list of my FreeBASIC activities of the past 10 years.

Post by badidea »

Amazing. Where do you find the time and motivation for all this work?
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: A list of my FreeBASIC activities of the past 10 years.

Post by h4tt3n »

Second the above!
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: A list of my FreeBASIC activities of the past 10 years.

Post by BasicCoder2 »

It was Joshy's escapi.bi that pulled me into using FreeBASIC as it enabled me to capture webcam images which could be displayed with FreeBASICs inbuilt graphics library.
http://www.freebasic.net/forum/viewtopi ... lit=escapi
His other contribution I have on hand is multiput.bi because it is so fast.
http://www.freebasic.net/forum/viewtopi ... ultiput.bi
Although he has also given FreeBASIC programmers access to many things you need the talent and time to learn and use them all.
.
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: A list of my FreeBASIC activities of the past 10 years.

Post by dafhi »

Code: Select all

dim shared as double    gt, gdt ''global time & delta

#ifndef pi
const   TwoPi = 8*atn(1)
const   Pi = 4*atn(1)
const   piBy2 = 2*atn(1)
#EndIf

function clamp(in as single, hi as single=1, lo as single=0) as single
  if in < lo then return lo
  if in > hi then return hi
  return in
End Function

type float as double

type v3
  as float          x,y,z
  declare sub       norm
  declare property  len as float
  declare property  len(in as float)
  declare function  dot(r as v3) as float
  declare function  perp(in as float=1) as v3
  declare function  cross(in as v3, slen as float=1) as v3
  declare sub       rand
  declare property  n as v3
end type
property v3.len as float: return sqr(x*x+y*y+z*z): end property
function v3.dot(r as v3) as float: return x*r.x+y*r.y+z*r.z: end function
sub v3.norm:  dim as float s=1/sqr(x*x+y*y+z*z): x*=s:y*=s:z*=s: end sub
property v3.len(in as float)
  var s = in/sqr(x*x+y*y+z*z): x*=s: y*=s: z*=s
End Property
property v3.n as v3
  var s = x*x+y*y+z*z
  if s<>0 then s=1/sqr(s)
  return type(x*s,y*s,z*s)
End Property
function v3.perp(in as float) as v3
  if y=0 then return type(0, in, 0)
  var s=z*z+x*x: if s=0 then return type(in,0,0)
  s=in/sqr(s):  return type(-z*s, 0, x*s)
End function
function v3.cross(r as v3, slen as float) as v3
  var xx=y*r.z - z*r.y
  var yy=z*r.x - x*r.z
  var zz=x*r.y - y*r.x
  var s = xx*xx+yy*yy+zz*zz
  if s=0 then return type(0,0,0)
  s=slen/sqr(s):  return type(xx*s,yy*s,zz*s)
End function
operator -(r as v3) as v3: return type(-r.x, -r.y, -r.z): end operator
operator -(l as v3,r as v3) as v3: return type(l.x-r.x,l.y-r.y,l.z-r.z): end operator
operator +(l as v3,r as v3) as v3: return type(l.x+r.x, l.y+r.y, l.z+r.z): end operator
operator /(l as v3,r as float) as v3: dim as float s = 1/r: return type(l.x*s,l.y*s,l.z*s): end operator
operator *(l as v3,r as float) as v3: return type(l.x*r,l.y*r,l.z*r): end operator
operator *(l as float, r as v3) as v3: return type(l*r.x,l*r.y,l*r.z): end operator
operator *(l as v3,r as v3) as v3: return type(l.x*r.x,l.y*r.y,l.z*r.z): end operator
sub v3.rand
  y=2*(rnd-.5):  var r=sqr(1-y*y)
  z=rnd*twopi: x=r*cos(z): z=r*sin(z)
End Sub

function hsv(h as single, s as single, v as single) as v3
  h -= 6*int(h/6)
  dim as single x = clamp(2 - h - 2*(h-3)*(h>3))
  dim as single y = clamp(h +     2*(h-2)*(h>2))
  dim as single z = clamp(h - 2 + 2*(h-4)*(h>4))
  dim as single ptr  lo=@x, mi=@y, hi=@z
  if *lo > *mi then swap lo, mi
  if *mi > *hi then swap mi, hi
  if *lo > *hi then swap lo, hi
  *lo = v * (*hi - s * (*hi - *lo))
  *mi = v * (*hi - s * (*hi - *mi))
  *hi *= v
  return type(x,y,z)
End function


type tPar           '2017 Sep 20
  as long           col
  as v3             p, vel, acc
  as single         k, fuel, lifetime, fps
  declare sub       ini(k as single = .5, lifetime as single=3, fps as single=67)
  declare property  age as single
  declare sub       new_kinetics
  declare sub       frame
  declare sub       backup
  declare sub       restore
  as single         ifps
  as long           idx_specie
 private:
  as single         ik, iok
  as single         j, kj, sv_j, sv_kj
End Type
property tPar.age as single: return lifetime-fuel
End Property
sub tPar.backup: sv_j=j: sv_kj=kj
End Sub
sub tPar.restore: j=sv_j: kj=sv_kj
End Sub
sub tPar.ini(_k as single, _lifetime as single, _fps as single):  fps = _fps
  ifps = 1/fps:  k=_k:  lifetime=_lifetime
  new_kinetics:  j=0: kj=1
  :  fuel=lifetime-rnd*ifps
End Sub
sub tPar.new_kinetics:  ik = 1/(1-k):  iok = 1/(1-1/k)
End Sub
sub tPar.frame:  var i=lifetime-fuel
  var ki = k^i, v = k*(kj-ki)
  p += ik*( vel*v + acc*( (i-j)*k + v*iok ) )
  j=i: kj=ki
  fuel -= gdt
End sub


type StatRand 'randomize units within group constraints
  as single           avg, vari, v
  declare operator    cast as single
  declare sub         rand
  declare sub         def(avg as single=.5, rad as single=.25, vari_avg as single=1, var_rad as single=1)
  declare             constructor(avg as single=.5, rad as single=.25, vari_avg as single=1, var_rad as single=1)
 private:
  as single           avg_avg, avg_vari, var_avg, var_vari
end type
constructor.StatRand(avg as single, rad as single, vari_avg as single, var_rad as single)
  def avg, rad, vari_avg, var_rad
end constructor
operator StatRand.cast as single
  v=avg+vari*(rnd-0.5): return v
end operator
sub StatRand.rand
  avg  = avg_avg + avg_vari*(rnd-0.5)
  vari = var_avg + var_vari*(rnd-0.5)
end sub
sub StatRand.def(avg as single, rad as single, _vari_avg as single, vari_rad as single)
  avg_avg = avg:  avg_vari=rad*2
  var_avg = _vari_avg
  var_vari = vari_rad*2
  rand: v=avg+vari*(rnd-0.5)
end sub


type imagevars '2017 Aug 31 - by dafhi
  '1. quick reference for ScreenInfo & ImageInfo
  '2. encapsulate standard metrics
  '3. convenient additional vars, subs and functions
  as integer            w,h, bpp,bypp,pitch, rate
  as string             driver_name
  as any ptr            im
  as any ptr            pixels    'same address
  as ulong ptr          p32       '
  as single             midx,midy
  as integer            pitchBy, wm = -1, hm = -1, ub = -1, is_screen
  declare sub           screen_init(w as integer=0, h as integer=0, bpp as integer=32, npages as integer=1, flags as integer=0)
  declare sub           create(w as integer=0, h as integer=0, col as ulong=&HFF000000)
  declare sub           get_info(im as any ptr=0)
  declare               destructor
  declare sub           release
 private:
  declare sub           destroy
  as any ptr            hRelease
end type
Destructor.imagevars:  release
End Destructor
sub imagevars.release                             '2016 Aug 30
  w=0: h=0: bpp=0: bypp=0: im=0: pixels=0
  If ImageInfo(hRelease) = 0 Then ImageDestroy hRelease:  hRelease = 0
End Sub
sub imagevars.get_info(im as any ptr)
  if im=0 then
    ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name:  pixels=screenptr
    is_screen = -1: im=0
  elseif Imageinfo(im)=0 then
    ImageInfo im, w, h, bypp, pitch, pixels:  bpp = bypp * 8
    this.im = im:  is_screen = 0
  endif: hRelease = im:  p32=pixels
  wm=w-1:  midx=w/2:  pitchBy=pitch/bypp '' crashes if \ and bypp = 0
  hm=h-1:  midy=h/2:  ub = h*pitchBy - 1
end sub
sub imagevars.screen_init(w as integer, h as integer, bpp as integer, npages as integer, flags as integer)
  release '2017 July 3
  if w=0 or h=0 then get_info: w=this.w: h=this.h
  screenres w,h,bpp,npages,flags: pixels = screenptr
  get_info:  if npages > 1 then screenset 0,1
end sub
sub imagevars.create(_w as integer, _h as integer, col as ulong) '2017 sep 1
  if _w<1 or _h<1 then exit sub
  release:  get_info imagecreate(_w,_h,col)
End Sub

#Macro Alpha256(ret,back, fore, a256) '2017 Mar 26
  ret=((_
  (fore And &Hff00ff) * a256 + _
  (back And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_
  (fore And &H00ff00) * a256 + _
  (back And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8
#EndMacro



type dotvars
  as ulong            col=-1
  as single           rad=1,slope=1
End Type


type AaDot
  as dotvars          o
  as dotvars ptr      p
  declare sub         render_target(byref buf as imagevars ptr)
  declare sub         draw(x as single=0, y as single=0)
  declare constructor
 private:
  as single           dy,dxLeft,salpha,cone_h,coneSq,sq,salpha0
  as long             x0,y0,x1,y1,alph,alpha_max
  as imagevars ptr    pim
end type
constructor.AaDot: p=@o
end constructor
sub AaDot.render_target(byref buf as imagevars ptr)
  pim = buf
end sub
sub AaDot.draw(x as single, y as single)

  salpha0=(p->col shr 24)/255:  alpha_max=salpha0*256
  var slope = p->slope
 
  'slope = 1 .. 1 pixel aa edge
  'slope = 2 .. 1/2 pixel (sharp)
  'slope = 1/p->rad .. max blur
  'slope < 1/p->rad .. rendering artifact
 
  'sq=1/p->rad                   '' clamp prevents artifact
  'slope=iif(slope<sq,sq,slope)  ''
 
  cone_h=slope*(p->rad+.5)     'pre-inverted aadot imagined as cone \/
  coneSq=cone_h*cone_h    'avoid sqr() at blit corners
  sq=(cone_h-1)*(cone_h-1)'avoid sqr() in dot center at max brightness
  dim as long x0=(x-p->rad):  if x0<0 then x0=0
  dim as long y0=(y-p->rad):  if y0<0 then y0=0
  dim as long x1=(x+p->rad):  if x1>pim->wm then x1=pim->wm
  dim as long y1=(y+p->rad):  if y1>pim->hm then y1=pim->hm
  dy=(y0-y)*slope: dxLeft=(x0-x)*slope
  for py as long ptr = @pim->p32[ y0*pim->pitchBy ] to @pim->p32[ y1*pim->pitchBy ] step pim->pitchBy
    dim as single dx=dxleft, dySq=dy*dy
    for px as ulong ptr = @py[x0] to @py[x1]
      salpha = dx*dx+dySq
      if salpha<sq then
          Alpha256(*px,*px,p->col,alpha_max)
      elseif salpha<=coneSq then
          alph=(cone_h-sqr(salpha))*alpha_max
          Alpha256(*px,*px,p->col,alph)
      endif:  dx+=slope
    next: dy+=slope
  next
end sub


#macro set_sort(datatype,fname,b1,b2,dot) 'my new quicksort, dodicats macro
sub fname(a() as datatype, ub as long=-1, lb as long=0) 'lb=0, ub=-1
  '2017 Sep 21
  #macro sw(x,y)
    if a(x)dot b2 a(y)dot then swap a(x), a(y)
  #EndMacro
  var j=(lb+ub)\2, i=lb
  sw(j,ub)
  sw(j,lb)
  sw(lb,ub)
  j=ub
  while i<j
    while a(j)dot b2 a(lb)dot: j-=1: wend
    i+=1
    while a(i)dot b1 a(lb)dot: i+=1: wend
    if j<=i then i=j: exit while 'Sep 21
    sw(i,j)
    j-=1
  Wend
  'sw(lb,i) - Sep 20
  sw(lb,j)
  i-=1: if lb<i then fname a(), i,lb 'lb,i
  j+=1: if j<ub then fname a(), ub,j 'j,ub
End Sub
#endmacro

#define up <,>
#define down >,<

set_sort(tPar,_sort,down,.p.z)


type ParticleClique
  as statrand k=type(.07,.01,0,0)
  as statrand vel=type(650,700,0,0)
  as statrand acc=type(10, 10, 0,0)
  as statrand lifetime=type(9, 7, 1.3, 1.2)
  as statrand fps=type(35, 34)
  as statrand hue=type(0,3,.5,.5)
  as statrand sat=type(.65,.25,.05,.05)
  as statrand emi_win=type(3, 3)
  as v3       throw_vel
  as v3       throw_acc
  declare constructor
End Type
constructor.ParticleClique
  throw_vel.rand
  throw_acc.rand
end constructor


function round(in as single, places as ubyte = 2) as string
  dim as integer mul = 10 ^ places
  return str(csng(int(in * mul + .5) / mul))
End Function


const                   _UB = 15000
dim shared as tPar      a(_UB)


const                   w = 640, wm=w-1, midx = wm/2
const                   h = 480, hm=h-1, midy = hm/2

sub Main


  var c_ps = 50
  dim as ParticleClique ps(c_ps-1)
 
  var ub = _UB
  for i as long = 0 to ub
    var si_ps = rnd*c_ps
    var p_ps = @ps(int(si_ps))
    with a(i)
      .ini p_ps->k, p_ps->lifetime, p_ps->fps 'motion blur
      .vel.rand
      .vel += type(0,.5,90) + p_ps->throw_vel*4'3.5
      .vel *= p_ps->vel * .7
      .acc += p_ps->throw_acc*12
      .acc *= p_ps->acc * 1
      var c = hsv(6*int(si_ps)/c_ps, rnd, 1)
      .col = rgb(int(c.x*255.999), int(c.y*255.999), int(c.z*255.999))
      .idx_specie = int(si_ps)
    end with
  next

  dim as imagevars buf:  buf.screen_init w,h
  dim as aadot dot:  dot.render_target @buf
 
  dim as v3 v
 
  var tp=timer, t0 = tp, tDemoTime = 7, phase = 0
  do
 
    gt=timer:  gdt=gt-tp:  tp=gt
   
    dim as long i
    while i<=ub
      a(i).frame
      if a(i).fuel < 0 then swap a(i), a(ub): ub-=1: i-=1
      i+=1
    Wend
   
    if ub>0 then _sort a(), ub

    screenlock
      cls
      draw string (buf.midx-60, buf.midy-20), "Happy birthday"
      draw string (buf.midx-55, buf.midy-0), "D.J. Peters !"
      for i as long = 0 to ub
        with a(i)
          if .p.z > -2500 then
            var s=2500/(.p.z+2500)
            var x = midx+.p.x*s
           
            if x >= 0 and x < w then
              var y = hm-midy-.p.y*s
              if y >= 0 and y < h then
                dot.o.rad = 1.0*s
                dot.o.slope = 1.4/dot.o.rad
                dot.o.col=.col
                dot.draw x,y
              endif
            endif
          endif
         
          if phase=0 then
            if .age > 0.9 then
              if rnd < .003 then
                v.rand
                v *= ps(.idx_specie).vel*.5
              endif
              if rnd < .07 then
                .acc += type(0, 0, -1500) + v/2
              endif
            endif
          endif
        end with
      Next
    screenunlock
   
    sleep 1
   
    dim as string kstr = inkey
    if kstr = chr(27) then exit do
   
    if gt-t0 > tDemoTime then exit do
   
  Loop

  sleep 1100
end sub

Main
Last edited by dafhi on Oct 02, 2017 18:43, edited 2 times in total.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: A list of my FreeBASIC activities of the past 10 years.

Post by srvaldez »

hello dafhi
didn't know it was D.J.Peters BD
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: A list of my FreeBASIC activities of the past 10 years.

Post by D.J.Peters »

@dafhi thank you :-)

compile with -exx and you will see:
Aborting due to runtime error 6 (out of bounds array access) at line 361 of tmp.bas::MAIN()

Joshy
St_W
Posts: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: A list of my FreeBASIC activities of the past 10 years.

Post by St_W »

You probably didn't notice, but most (if not all) of your work doesn't contain a license. That makes your work practically useless as it is illegal to use it without you explicitly granting a license. If you are not aware yet, why it is so important to choose a license, see https://blog.codinghorror.com/pick-a-li ... y-license/
Also see https://choosealicense.com/no-license/ for the implications of not providing a license and https://choosealicense.com/ as a help for choosing an appropriate license.

I want to kindly request to think about it and adding a license to your work. Of course if you choose to grant no license that's also fine. You just shouldn't leave potential users of your projects unaware of this.
oyster
Posts: 274
Joined: Oct 11, 2005 10:46

Re: A list of my FreeBASIC activities of the past 10 years.

Post by oyster »

nice list and thank you for your work on them

Since you have write so many libs/codes, I think it could be more convenient for user to download and for you to update if these works are placed on http://www.github.com or some other website.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: A list of my FreeBASIC activities of the past 10 years.

Post by D.J.Peters »

After the hospital I made a break from coding but to day
I collected all my hand written *.bi and *.bas files on a USB stick believe it or not it's 1.6 GB !

20% are same stuff in different versions but hey it's about 1 GB of hand written source codes.

Maybe I'm a machine and don't know it. (if so the doctors must be are liars) :lol:

Fun by side
this days often you must click on "I'm not a robot" machines ask you this s_h_i_t ;-)

Joshy
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: A list of my FreeBASIC activities of the past 10 years.

Post by badidea »

D.J.Peters wrote:After the hospital I made a break from coding but to day
I collected all my hand written *.bi and *.bas files on a USB stick believe it or not it's 1.6 GB !

20% are same stuff in different versions but hey it's about 1 GB of hand written source codes.

Maybe I'm a machine and don't know it. (if so the doctors must be are liars) :lol:

Fun by side
this days often you must click on "I'm not a robot" machines ask you this s_h_i_t ;-)

Joshy
Assumption: 50 years coding (wild guess)
For 1 GB of code, You must have been writing 0.7 bytes of code per second, 24 hours/day, 365 days/year, for 50 years uninterrupted.
My conclusion: You must be a robot :-)
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: A list of my FreeBASIC activities of the past 10 years.

Post by D.J.Peters »

@badidea thank you for your rough calculation you are right there is an error
I copy all "*.b*" files on stick but that includes all "*.bmp" backgroud's and sprite animations also.

Now I know I'm not a robot :-)

Dr. Dr. Sheldon Lee Cooper (The Big Bang Theory) knows we are not living in a matrix.

He said "In a matrix food in a university would be better" :-)

Joshy
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: A list of my FreeBASIC activities of the past 10 years.

Post by badidea »

My calculation is wrong. I read in the topic "Playing modules MOD XM IT S3M" that you have been coding for a thousand years.
Adjusted conclusion: You must be a time-traveling robot from the future.
Post Reply