sparse fill 2D

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Posts: 1238
Joined: Jun 04, 2005 9:51

sparse fill 2D

Postby dafhi » Jun 13, 2018 12:44

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   ''
#Define floor(x) (((x)*2.0-0.5)shr 1)
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))

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
  declare sub       min_max_common(as myint, as myint)
  as myint          min, max

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

' ------ 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
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
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
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
  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
        line (.px0,.py0)-(.px1, h),0,bf
        color 15
        locate 2,4:  ? "banding test"
        for i as long = 1 to .c * .02
        '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
    end with
    sleep 1

end sub


Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 0 guests