## sparse fill 2D

Source-code only - please, don't post questions here.
dafhi
Posts: 1031
Joined: Jun 04, 2005 9:51

### sparse fill 2D

Code: Select all

`'#include "general.bas"/' ---- sparse fill 2d - 2018 June 12 - by dafhi   fill 2d space with the following conditions:   1. large step  2. no holes or overlap (modulus-bound position)  3. minimal banding (please with current result)   this project is inspired by my interest in global illumination rendering,  and my brief exposre to PCG (random numbers) data '/type myint as integer#Ifndef floor   '' http://www.freebasic.net/forum/viewtopic.php?p=118633#Define floor(x) (((x)*2.0-0.5)shr 1)#define ceil(x) (-((-(x)*2.0-0.5)shr 1))  #EndIftype tSparse2D  as myint          incr  declare sub       calculate(as ushort, as ushort)  declare function  gcf(as myint, as myint) as myint  declare function  lcm(as myint, as myint) as myint private:  declare sub       min_max_common(as myint, as myint)  as myint          min, maxEND TYPEsub tSparse2D.min_max_common(n1 as myint, n2 as myint)  max = n1:  min = n2:  if min > max then swap min, maxEnd subfunction tSparse2D.gcf(n1 as myint, n2 as myint) as myint  min_max_common n1, n2  for divi as myint = 1 to min    n2 = min \ divi    if n2 = min / divi andalso max mod n2 = 0 then return n2  next  return 1end functionfunction tSparse2D.lcm(n1 as myint, n2 as myint) as myint  min_max_common n1, n2  for n1 = max to min * max step max    if n1 mod min = 0 then return n1  Nextend functionsub tSparse2D.calculate(w as ushort, h as ushort)   var c = w * h   min_max_common w, h   var d1 = max, rd1=sqr(d1)  var d2 = min, rd2=sqr(d2)   for i as myint = (d1-14)\2 to 1 step -1    if gcf(i, d1)=1 then      if gcf(i, c) = 1 then        incr = i: exit for      endif    EndIf  Next END SUB' ------ testconst   TwoPi = 8*atn(1)function modu(in as double, m as double=1) as double  return in - m * floor(in / m)End Functiontype test_rect  as short          x0, y0, x1, y1  as Short          px0, py0, px1, py1  as Short          w, h, wm, hm  as Long           c, ub  as Single         rad = 10, a, ia = .1  declare sub       setup(as single=10, as single=100, as single=100, as single=500, as single=400)  declare function  calculate as boolean  declare sub       dependents  as Single         _x0, _y0  as Single         _x1, _y1END TYPEsub test_rect.setup(_rad as single, x0 as single, y0 as single, x1 as single, y1 as single)  rad = _rad:  ia = .997/(twopi*rad)  this._x0 = x0:  this._x1 = x1  this._y0 = y0:  this._y1 = y1END SUBsub test_rect.dependents  w = abs(x1-x0) + 1:  wm = w-1  h = abs(y1-y0) + 1:  hm = h-1  c = w*h: ub = c-1END SUBfunction test_rect.calculate as boolean  px0 = x0:  x0 = floor(_x0 + .5)  py0 = y0:  y0 = floor(_y0 + .5)  px1 = x1:  x1 = floor(_x1 + rad * cos(a) + .5)  py1 = y1:  y1 = floor(_y1 + rad * sin(a) + .5) ' y invert  dependents  a += ia:  a = modu(a, twopi)  if px0<>x0 or py0<>y0 or px1<>x1 or py1<>y1 then return true  return falseend functionsub Main  dim as test_rect  trec  var rad = 90  trec.setup rad, 20,20, 400, 200   dim as tSparse2D  sparse  var w = 800  var h = 600   screenres w, h,, 2  screenset 1,0  var offs = 0  while inkey = ""    with trec      var changed = .calculate()      if changed then               sparse.calculate .w, .h               #macro filling(y_off)          offs mod= .c          var y = offs \ .w          var x = offs - y * .w          pset (x + .x0, y + y_off)          offs += sparse.incr        #endmacro               line (.px0,.py0)-(.px1, h),0,bf        'cls        color 15        locate 2,4:  ? "banding test"        for i as long = 1 to .c * .02          filling(.y0)        NEXT        'line (.x0,.y0)-(.x1,.y1),,b               color 13        locate 2,26:  ? "perfect fill"', .c, sparse.incr, .w,.h        var y_off = .y0 + trec.h+5        for i as long = 1 to .c          filling(y_off)        NEXT               flip           endif       end with       sleep 1  WENDend subMain`

### Who is online

Users browsing this forum: dafhi and 2 guests