line rasterizer

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

line rasterizer

Post by dafhi »

my own bresenham thingy

Code: Select all

/' -- line rasterizer  2024 June 15 u1 by dafhi

  update: my clipper isn't perfect .. added line2d_loopS / E  bounds check
  update: adjusted bounds

'/

#define dbl  as double '' reduced text
#define sng  as single

#define min( a, b)    iif( (a)<(b), (a), (b) )
#define max( a, b)    iif( (a)>(b), (a), (b) )
  
function modu( in as double, m as double = 1 ) as double
  return in - m * int( in / m )
end function

#macro sw( a, b, tmp )
  tmp = a: a = b: b = tmp
#endmacro

#Macro Alpha256( ret, back, fore, a256) 'blend colors. alpha max = 256  (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

  dim shared as ulong ptr p32
  dim shared as long      wm, hm, pitchBy
Sub ppset( x As long, y As long, c As Ulong )
'    if x < 0 orelse x>wm orelse y<0 orelse y>hm then exit sub '2018 Aug 25
    x = x + y * pitchBy
    y = ((c shr 24)/255) * 257 - .5 '' 0..256
    Alpha256( p32[x], p32[x], c, y )
End Sub

sub _gfx_release( byref im as any ptr )
  if imageinfo(im) = 0 then imagedestroy im
  im = 0
end sub

'' image class
''
type t_image_info
  dim as long     w,h, bypp, pitch,rate
  dim as any ptr  pixels, im
  dim as string   driver_name
  declare sub     get_info( as any ptr = 0 )
end type

  sub _get_screen( byref i as t_image_info )
    _gfx_release i.im
    ScreenInfo i.w, i.h, , i.bypp, i.pitch, i.rate, i.driver_name
    i.pixels = screenptr
  end sub

  sub _get_image( byref i as t_image_info, im as any ptr )
    if im<>i.im then _gfx_release i.im '' 2024 June 3
    ImageInfo im, i.w, i.h, i.bypp, i.pitch, i.pixels
    i.im = im
  end sub
  
sub t_image_info.get_info( im as any ptr )
  if im = 0 then _get_screen this: exit sub
  _get_image this, im
end sub

' --------------


  namespace line2d '' rasterizer  2024 June 14  by dafhi
  
/'

  example:

  screenres 800,600,32
  myline.render_target 0
  myline.draw rnd*800,rnd*600,rnd*800,rnd*600, rgba(255,255,255,50)

  update: my clipper isn't perfect .. added line2d_loopS / E  bounds check

'/

dim as t_image_info   im

sub render_target( _i as any ptr )
  im.get_info _i
  pitchBy = im.pitch \ 4 '' integer divide
  p32 = im.pixels
  wm = im.w - 1
  hm = im.h - 1
end sub

  
    function _no_intersect( byref x sng, byref y sng, byref x1 sng, byref y1 sng, slope sng, _max sng, _min sng = 0 ) as long
  static sng ptr xmin, xmax, ymin, ymax, xmin_y, xmax_y, ymin_x, ymax_x
  if x1 < x then
    xmin = @x1: xmax = @x
    xmin_y = @y1: xmax_y = @y
  else
    xmin = @x: xmax = @x1
    xmin_y = @y: xmax_y = @y1
  endif
  dim as long retval = *xmin >= _max orelse *xmax < _min
  if *xmin < _min then
    *xmin_y += (_min - *xmin) * slope
    *xmin = _min
  endif
  _max -= .0001
  if *xmax > _max then
    *xmax_y -= (*xmax - _max) * slope
    *xmax = _max
  endif
  return retval
  end function

sub _make_unrenderable( byref x sng, byref x1 sng )
  x = 1
  x1 = 0
end sub

  type t_returns
    sng ptr px,py
    sng     x,y, _x, _y, x1, slope
  end type
  
  dim as t_returns  ret

  dim sng   slope, s_temp, dx, dy
  
sub _absdxdy_sorted( byref x sng, byref y sng, byref x1 sng, byref y1 sng, byref px sng, byref py sng, _im_w sng, _im_h sng, border_test sng = 10 )
    if x > x1 then
  sw( x, x1, s_temp )
  sw( y, y1, s_temp )
  endif
  dx = x1 - x
  dy = y1 - y:  slope = dy / dx
  if _no_intersect( x,y, x1,y1, slope, _im_w-border_test, border_test ) then _make_unrenderable ret._x, ret.x1: exit sub
  if _no_intersect( y,x, y1,x1, dx/dy, _im_h-border_test, border_test ) then _make_unrenderable ret._x, ret.x1: exit sub
  ret._x = x - .4999
  ret._y = y - .4999
  ret.x1 = x1 - .4999
  ret.slope = slope
end sub

  sub _common( byref x sng, byref y sng, byref x1 sng, byref y1 sng )
    const sng border_test = 0.0
    if abs(y1 - y) > abs(x1 - x) then
      ret.px = @ret.y:  ret.py = @ret.x
      _absdxdy_sorted y, x, y1, x1, x,y, im.h, im.w, border_test
    else
      ret.px = @ret.x:  ret.py = @ret.y
      _absdxdy_sorted x, y, x1, y1, x,y, im.w, im.h, border_test
    endif
  end sub

  #define line2d_loopS  _common x, y, x1, y1: ret.x=ret._x: ret.y=ret._y:  while ret.x < ret.x1: _
  if *ret.px < (wm+.5) andalso *ret.py < (hm+.5) andalso _
  *ret.px > -0.5 andalso *ret.py > -0.5 then
  
  #define line2d_loopE  endif: ret.y += ret.slope: ret.x += 1:  wend


sub draw( x sng, y sng, x1 sng, y1 sng, col as ulong)

    line2d_loopS '' requires sub / func with  x y x1 y1
    
  ppset *ret.px, *ret.py, col
  line2d_loopE
end sub

end namespace


  ' ------------------------
 
screenres 800,600,32

line2d.render_target 0

const tau = 8 * atn(1)

dim dbl t0 = timer, t, cx, cy

var win_ext = 190
dim as long mx, my, mb, mw


  while t < 150
  
t = timer - t0
randomize 0

getmouse mx,my,mw,mb

  screenlock
line (0,0)-(line2d.im.w, line2d.im.h), rgb(0,0,0), bf

  for i as long = 1 to 499
dim sng r = 9999*rnd + .07 * line2d.im.h * t * (rnd - .5)
dim sng a = rnd * tau

cx = line2d.im.w/2 + r*cos(a)
cy = line2d.im.h/2 + r*sin(a)

a = rnd*tau + .4 * rnd*(rnd-.5)*t
'a = -tau * 1/7.5

r = 3 + rnd * win_ext / 2.5
'r = 50

cx = modu(cx + win_ext, line2d.im.w + 2 * win_ext) - win_ext
cy = modu(cy + win_ext, line2d.im.h + 2 * win_ext) - win_ext
'cx = mx - 50
'cy = line2d.im.h - my

dim sng rcos = r*cos(a)
dim sng rsin = r*sin(a)
var x0 = cx-rcos, y0 = cy-rsin
var x1 = cx+rcos, y1 = cy+rsin
var col = rgba(rnd*255,rnd*255,rnd*255,255)

line2d.draw x0,y0,x1,y1,col
'line(x0,y0)-(x1,y1),col

next
screenunlock

var kstr = inkey
if kstr<>"" then exit while

sleep 1
wend

locate 2,2
? "fin!"

sleep

Last edited by dafhi on Jun 15, 2024 7:17, edited 7 times in total.
paul doe
Moderator
Posts: 1746
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: line rasterizer

Post by paul doe »

Tried the Liang-Barsky line clipping algo?

Code: Select all

'' Liang-Barsky line clipping algorithm
'' Can also be used for a fast line segment vs rectangle intersection test
'' If the function result is true, the clipped line segments can be
'' calculated as:
'' p0 = ( x0 + t0 * (x1 - x0), y0 + t0 * (y1 - y0) )
'' p1 = ( x0 + t1 * (x1 - x0), y0 + t1 * (y1 - y0) )

function LiangBarsky( _
  xmin as single, ymin as single, xmax as single, ymax as single, _
  x0 as single, y0 as single, x1 as single, y1 as single, _
  byref t0 as single, byref t1 as single ) as boolean
  
  t0 = 0 : t1 = 1
  
  dim dx as single = x1 - x0, dy as single = y1 - y0
  dim p as single, q as single, r as single
  
  for edge as integer = 0 to 3
    if( edge = 0 ) then p = -dx : q = -( xmin - x0 )
    if( edge = 1 ) then p =  dx : q =  ( xmax - x0 )
    if( edge = 2 ) then p = -dy : q = -( ymin - y0 )
    if( edge = 3 ) then p =  dy : q =  ( ymax - y0 )
    
    r = q / p
    
    if( p = 0 andAlso q < 0 ) then return( false )
    
    if( p < 0 ) then
      if( r > t1 ) then
        return( false )
      else
        if( r > t0 ) then t0 = r
      end if
    elseif( p > 0 ) then
      if( r < t0 ) then
        return( false )
      else
        if( r < t1 ) then t1 = r
      end if
    end if
  next
  
  return( true )
end function
dodicat
Posts: 8011
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: line rasterizer

Post by dodicat »

Draw a line by an Irish method.

Code: Select all


Function segment_distance(lx1 As Single, _
    ly1 As Single, _
    lx2 As Single, _
    ly2 As Single, _
    px As Single,_
    py As Single, _
    Byref ox As Single=0,_
    Byref oy As Single=0) As Single
    
    Dim As Single M1,M2,C1,C2,B
    B=(Lx2-Lx1):If B=0 Then B=1e-20
    M2=(Ly2-Ly1)/B:If M2=0 Then M2=1e-20
    M1=-1/M2
    C1=py-M1*px
    C2=(Ly1*Lx2-Lx1*Ly2)/B
    Var L1=((px-lx1)*(px-lx1)+(py-ly1)*(py-ly1)),L2=((px-lx2)*(px-lx2)+(py-ly2)*(py-ly2))
    Var a=((lx1-lx2)*(lx1-lx2) + (ly1-ly2)*(ly1-ly2))
    Var a1=a+L1
    Var a2=a+L2
    Var f1=a1>L2,f2=a2>L1
    If f1 Xor f2 Then
        Var d1=((px-Lx1)*(px-Lx1)+(py-Ly1)*(py-Ly1))
        Var d2=((px-Lx2)*(px-Lx2)+(py-Ly2)*(py-Ly2))
        If d1<d2 Then Ox=Lx1:Oy=Ly1 : Return Sqr(d1) Else  Ox=Lx2:Oy=Ly2:Return Sqr(d2)
    End If
    Var M=M1-M2:If M=0 Then M=1e-20
    Ox=(C2-C1)/(M1-M2)
    Oy=(M1*C2-M2*C1)/M
    Return Sqr((px-Ox)*(px-Ox)+(py-Oy)*(py-Oy))
End Function

Function Regulate(Byval MyFps As Integer,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


dim as long x1,y1,x2,y2,mx,my,mb,mw,fps
const pi=4*atn(1)
dim as single delta
screen 19,32

do
   
    getmouse mx,my,mw,mb
    delta+=.01 +mw/1000
x2=mx
y2=my
x1=mx+(300)*cos(delta)
y1=my+(300)*sin(delta)
if mb=1 then delta-=.01 +mw/1000'stop
if mb=2 then delta-=(.01 +mw/1000)*2'back
var cx=(x1+x2)\2,cy=(y1+y2)/2,lngth=sqr((x1-x2)^2 + (y1-y2)^2)
dim as single ipx,ipy
screenlock
cls
for z as single=0 to 2*pi step 2*pi/(360*2)
    var r=segment_distance(x1,y1,x2,y2,cx+lngth/2*cos(z),cy+lngth/2*sin(z),ipx,ipy)
    circle(ipx,ipy),2,rgb(r,(255-r),(r/10)),,,,f
next
draw string (10,10),"Framerate = "& fps
screenunlock
sleep regulate(60,fps)
loop until len(inkey)
sleep
    
    

 
dafhi
Posts: 1682
Joined: Jun 04, 2005 9:51

Re: line rasterizer

Post by dafhi »

updated first post w/ own solution

---
intuitive LiangBarsky implementation, however the lines blink

[edit] (i think) it's because i need to recalc x,x1 to skip While Loop for offscreen lines

[June 8 update 2]
[improved some by swapping min max x x1 following LiangBarsky]

Code: Select all

sub render_target( _i as any ptr ) '' namespace subs
  if _i = 0 then: _get_screen
  else: _get_image _i
  endif
  pitchBy = pitch \ 4 '' integer divide
  p32 = pixels
  wm = im_w - 1
  hm = im_h - 1
end sub

  sub _make_unrenderable( byref ix as long, byref ix_end as long )
    ix = 1: ix_end = 0
  end sub
  
  function no_hit( _
    byref _min sng ptr, byref _max sng ptr, _
    byref min2 sng ptr, byref max2 sng ptr, _
    xy sng, xy1 sng, xyx sng, xyx1 sng, byref wh sng ) as long
    
    if xy1 < xy then
      _min = @xy1: _max = @xy
      min2 = @xyx1: max2 = @xyx
    else
      _min = @xy: _max = @xy1
      min2 = @xyx: max2 = @xyx1
    endif
    
    return *_min >= wh orelse *_max < 0
  end function

  dim sng   slope, s_temp, clip, dx, dy, t0, t1

sub _absdxdy_sorted( byref x sng, byref y sng, byref x1 sng, byref y1 sng, byref ix as long, byref ix1 as long, _im_w sng, _im_h sng, c as long )
  
  dx = x1 - x
  dy = y1 - y:  slope = dy / dx
  
  #if 1
  
    #if 1
      dim as long clipped = LiangBarsky( 0,0, _im_w - .0001, _im_h - .0001, x,y, x1,y1, t0, t1 )

      if clipped then
      x = x + t0 * dx
      x1 = x + t1 * dx
      
      y = y + t0 * dy
      y1 = y + t1 * dy
      endif
    
    #else  '' half-baked June 7 approach
      
      static sng ptr  y_min, y_max, x_min, x_max
      static sng ptr  yx_min, yx_max, xy_min, xy_max
      
      if no_hit( y_min, y_max, yx_min, yx_max, y,y1, x,x1, _im_h ) then _make_unrenderable ix, ix1: exit sub
      if no_hit( x_min, x_max, xy_min, xy_max, x,x1, y,y1, _im_w ) then _make_unrenderable ix, ix1: exit sub
      
    #endif
    
      if x > x1 then
    sw( x, x1, s_temp )
    sw( y, y1, s_temp )
    endif
  
  #else '' original
  
      if x > x1 then
    sw( x, x1, s_temp )
    sw( y, y1, s_temp )
    endif
    
    if x < 0 then
      y += slope * -x
      x = 0
    endif
    
    _im_w -= .0001
    if x1 > _im_w then
      y1 -= slope * (x1 - _im_w)
      x1 = _im_w
    endif
    
  #endif

  ix = int(x)
  ix1 = int( x1 - (x - ix) )
 
  y -= .5 '' y will get rounded up when passed to ppset

end sub

sub draw( x sng, y sng, x1 sng, y1 sng, col as ulong)
  static as long i, i_end
  
    if abs(y1 - y) > abs(x1 - x) then
    
  _absdxdy_sorted y, x, y1, x1, i, i_end, im_h, im_w, col
  
    while i <= i_end
  ppset x,i, col
  i += 1
  x += slope
  wend
    
    else
    
  _absdxdy_sorted x, y, x1, y1, i, i_end, im_w, im_h, col
  
    while i <= i_end
  ppset i,y, col
  i += 1
  y += slope
  wend
    
  endif
end sub
Post Reply