sparse fill 2D

dafhi · Post by **dafhi** » Jun 13, 2018 12:44

'#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))
  #EndIf



type 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, max
END TYPE

sub tSparse2D.min_max_common(n1 as myint, n2 as myint)
  max = n1:  min = n2:  if min > max then swap min, max
End sub

function 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 1
end function

function 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
  Next
end function

sub 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


' ------ test

const   TwoPi = 8*atn(1)

function modu(in as double, m as double=1) as double
  return in - m * floor(in / m)
End Function

type 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, _y1
END TYPE
sub 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 = y1
END SUB
sub test_rect.dependents
  w = abs(x1-x0) + 1:  wm = w-1
  h = abs(y1-y0) + 1:  hm = h-1
  c = w*h: ub = c-1
END SUB
function 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 false
end function



sub 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
  WEND

end sub

Main