line rasterizer

[dafhi]

my own bresenham thingy

Code: Select all

/' -- line rasterizer  2024 July 14 by dafhi

  update: renamed mydraw -> myline

'/

' =======================================================================

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

  '' image class
  ''
type imvars
  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 )
  declare destructor
end type

  sub _get_screen( byref i as imvars )
    _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 imvars, 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 imvars.get_info( im as any ptr )
  if im = 0 then _get_screen this: exit sub
  _get_image this, im
end sub

destructor imvars
  _gfx_release im
end destructor

' =======================================================================

  dim shared as ulong ptr p32
  dim shared as long      wm, hm, pitchBy

#define sng  as single '' reduced text

#define min( a, b)    iif( (a)<(b), (a), (b) )
#define max( a, b)    iif( (a)>(b), (a), (b) )
  
#macro sw( a, b, tmp )
  tmp = a: a = b: b = tmp
#endmacro
' =======================================================================


  namespace line2d '' rasterizer  2024 July 14  by dafhi
  
/'
  example:  screenres 800,600,32
  line2d.render_target 0
  
  sub myline( x sng, y sng, x1 sng, y1 sng, col as ulong)
      using line2d
    line2d_loopS
    pset (*px, *py), col
    line2d_loopE
  end sub

  myline rnd*800,rnd*600,rnd*800,rnd*600, rgb(255,255,255)
'/

dim as imvars   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 ) as long
    static sng ptr xmin, xmax, ymin, ymax, xmin_y, xmax_y, ymin_x, ymax_x
    
    static sng     _min '' dummy variable atm
    
    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     x,y, _x, _y, x1, slope
    end type
  
    dim as t_returns  ret

    dim sng     slope, s_temp, dx, dy
    dim sng ptr px,py
  
  
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 )
    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 ) then _make_unrenderable ret._x, ret.x1: exit sub
  if _no_intersect( y,x, y1,x1, dx/dy, _im_h ) 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 )
  if abs(y1 - y) > abs(x1 - x) then
    px = @ret.y:  py = @ret.x
    _absdxdy_sorted y, x, y1, x1, x,y, im.h, im.w
  else
    px = @ret.x:  py = @ret.y
    _absdxdy_sorted x, y, x1, y1, x,y, im.w, im.h
  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 *px > -0.5 andalso *py > -0.5 andalso _
   *px < (wm+.5) andalso *py < (hm+.5) then
  
  #define line2d_loopE  endif: ret.y += ret.slope: ret.x += 1:  wend

end namespace


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

line2d.render_target 0

sub mydraw( x sng, y sng, x1 sng, y1 sng, col as ulong)
    using line2d
  line2d_loopS
  pset (*px, *py), col
  line2d_loopE
end sub

mydraw rnd*800,rnd*600,rnd*800,rnd*600, rgba(255,255,255,50)
  
sleep

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

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]

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

[dafhi]

found 2 mistakes in my LiangBarsky attempt .. got it working

simplified part of the LiangBarsky() itself

Code: Select all

    if p < 0 then
        if (r > t1) then return false
        if r > t0 then t0 = r
    elseif p > 0 then
        if r < t0 then return false
        if r < t1 then t1 = r
    endif