389 lines
12 KiB
QBasic
389 lines
12 KiB
QBasic
$console
|
|
_screenhide
|
|
if command$=""then _echo"please specify image file to process":system 1
|
|
_screenshow
|
|
|
|
type point2d
|
|
x as long
|
|
y as long
|
|
end type
|
|
|
|
type statetype
|
|
change as _byte
|
|
levels as _unsigned _byte
|
|
threshold as _unsigned _byte
|
|
mode as _byte
|
|
handle as long
|
|
orgimg as long
|
|
overlay as long
|
|
end type
|
|
|
|
dim shared state as statetype
|
|
dim file as string
|
|
dim shared done as _byte
|
|
dim shared mouseclicked as _byte
|
|
dim shared mbd as _byte
|
|
|
|
' Global polygon trace registers
|
|
redim shared contour(4999) as point2d
|
|
dim shared totalpoints as long
|
|
|
|
if _fileexists(command$) then file=command$
|
|
state.orgimg=_loadimage(file,32)
|
|
state.handle=_copyimage(state.orgimg)
|
|
state.overlay=_newimage(_width(state.orgimg),_height(state.orgimg),32)
|
|
state.levels=10
|
|
state.threshold=127
|
|
updateimage
|
|
|
|
screen _newimage(_width(state.orgimg)+200,_height(state.orgimg)+200,32)
|
|
|
|
do until done
|
|
cls
|
|
while _mouseinput:wend
|
|
mouseclicked=not _mousebutton(1) and mbd
|
|
mbd=_mousebutton(1)
|
|
|
|
if state.change then
|
|
updateimage
|
|
state.change=0
|
|
end if
|
|
|
|
' Render quantized base image
|
|
_putimage (0,0),state.handle
|
|
|
|
' Render the vector transparent overlay shapes on top
|
|
_putimage (0,0),state.overlay
|
|
|
|
' Process interactive trace when clicking inside image viewport
|
|
if mouseclicked then
|
|
dim clickx as long,clicky as long
|
|
clickx=_mousex
|
|
clicky=_mousey
|
|
|
|
' Verify click coordinates are safely within the source image canvas bounding box
|
|
if clickx>=0 and clickx<_width(state.orgimg) and clicky>=0 and clicky<_height(state.orgimg) then
|
|
dim targetcolor as _unsigned long
|
|
|
|
' Fetch look-up color index from the generated active handle
|
|
_source state.handle
|
|
targetcolor=point(clickx,clicky)
|
|
_source 0 ' Restore background source monitor pointer
|
|
|
|
' SAFEGUARD 1: Do not attempt to parse pure black background/borders
|
|
if targetcolor<>_rgb32(0,0,0) and targetcolor<>_rgba32(0,0,0,0) then
|
|
totalpoints=0
|
|
tracecontour targetcolor,clickx,clicky
|
|
|
|
if totalpoints>=3 and totalpoints<(_width(state.orgimg)*_height(state.orgimg)) then
|
|
redim _preserve contour(totalpoints-1) as point2d
|
|
simplifypolygon
|
|
|
|
if totalpoints>=3 then
|
|
' Build flat 1D coordinate matrix map array (X1, Y1, X2, Y2...)
|
|
dim polypoints(0 to (totalpoints*2)-1) as long
|
|
dim i as long
|
|
dim clipstr as string
|
|
|
|
clipstr="fpolygon("
|
|
for i=0 to totalpoints-1
|
|
polypoints(i*2)=contour(i).x
|
|
polypoints(i*2+1)=contour(i).y
|
|
|
|
clipstr=clipstr+ltrim$(str$(contour(i).x))+","+ltrim$(str$(contour(i).y))
|
|
if i<totalpoints-1 then clipstr=clipstr+","
|
|
next i
|
|
clipstr=clipstr+")"
|
|
|
|
' Send string array payload safely to system clipboard hardware
|
|
_clipboard$=clipstr
|
|
|
|
' Render transparent vector overlay on overlay handler sheet
|
|
dim olddest as long
|
|
olddest=_dest
|
|
_dest state.overlay
|
|
|
|
' Render with a semi-transparent green color (Alpha = 100)
|
|
filledpolygon polypoints(),_rgba32(0,255,0,100)
|
|
|
|
_dest olddest
|
|
end if
|
|
end if
|
|
end if
|
|
end if
|
|
mouseclicked=0
|
|
end if
|
|
|
|
ol=state.levels
|
|
ot=state.threshold
|
|
interface
|
|
if ol<>state.levels then state.change=-1
|
|
if ot<>state.threshold then state.change=-1
|
|
|
|
_limit 30
|
|
_display
|
|
loop
|
|
system
|
|
'$include: '../include/ui.bm'
|
|
|
|
sub interface
|
|
if button(10,_height-34,60,23,"exit") then done=-1
|
|
color highlightcolor
|
|
_printstring (10,_height(state.handle)+10),"levels"
|
|
state.levels=slider(10,_height(state.handle)+28,100,state.levels*10)/10
|
|
color highlightcolor
|
|
_printstring (118,_height(state.handle)+28),str$(state.levels)
|
|
_printstring (10,_height(state.handle)+40),"threshold"
|
|
state.threshold=slider(10,_height(state.handle)+58,100,state.threshold/255*100)/100*255
|
|
color highlightcolor
|
|
_printstring (118,_height(state.handle)+58),str$(state.threshold)
|
|
end sub
|
|
|
|
sub updateimage
|
|
dim odest as long
|
|
dim osource as long
|
|
odest=_dest
|
|
osource=_source
|
|
_source state.orgimg
|
|
_dest state.handle
|
|
|
|
dim x as long,y as long,l as integer
|
|
dim numsteps as integer
|
|
|
|
if state.levels<2 then state.levels=2
|
|
numsteps=state.levels-1
|
|
|
|
for y=0 to _height-1
|
|
for x=0 to _width-1
|
|
l=luma(point(x,y))
|
|
|
|
dim adjustedl as single
|
|
if state.threshold=0 or state.threshold=255 then
|
|
adjustedl=l
|
|
elseif l<=state.threshold then
|
|
adjustedl=(l/state.threshold)*127.5
|
|
else
|
|
adjustedl=127.5+((l-state.threshold)/(255-state.threshold))*127.5
|
|
end if
|
|
|
|
dim currentstep as integer
|
|
currentstep=int((adjustedl/256)*state.levels)
|
|
|
|
if currentstep<0 then currentstep=0
|
|
if currentstep>numsteps then currentstep=numsteps
|
|
|
|
l=int(currentstep*(255/numsteps))
|
|
|
|
pset (x,y),_rgb32(l)
|
|
next x
|
|
next y
|
|
|
|
_source osource
|
|
_dest odest
|
|
end sub
|
|
|
|
function luma (col as _unsigned long)
|
|
luma=0.21*_red(col)+0.72*_green(col)+0.07*_blue(col)
|
|
end function
|
|
|
|
' =========================================================================
|
|
' SUBROUTINE: Solid Filled Scanning Polygon Vector Renderer
|
|
' =========================================================================
|
|
sub filledpolygon (points() as long,col as long)
|
|
dim i as integer,j as integer
|
|
dim x1 as single,y1 as single,x2 as single,y2 as single
|
|
dim intersectx as single
|
|
dim numpoints as integer
|
|
numpoints=(ubound(points)+1) \ 2
|
|
|
|
dim intersections(4999) as single ' SAFEGUARD 2: Larger intersection limit
|
|
dim numintersections as integer
|
|
dim y as long
|
|
|
|
for y=0 to _height-1
|
|
numintersections=0
|
|
for i=0 to numpoints-1
|
|
x1=points(i*2)
|
|
y1=points(i*2+1)
|
|
x2=points(((i+1) mod numpoints)*2)
|
|
y2=points(((i+1) mod numpoints)*2+1)
|
|
|
|
if ((y1>y and y2<=y) or (y2>y and y1<=y)) then
|
|
if y2-y1<>0 then
|
|
intersectx=x1+(y-y1)*(x2-x1)/(y2-y1)
|
|
' SAFEGUARD 3: Array bounds protection
|
|
if numintersections<=ubound(intersections) then
|
|
intersections(numintersections)=intersectx
|
|
numintersections=numintersections+1
|
|
end if
|
|
end if
|
|
end if
|
|
next i
|
|
|
|
for i=0 to numintersections-1
|
|
for j=i+1 to numintersections-1
|
|
if intersections(i)>intersections(j) then
|
|
swap intersections(i),intersections(j)
|
|
end if
|
|
next j
|
|
next i
|
|
|
|
for i=0 to numintersections-1 step 2
|
|
if i+1<numintersections then
|
|
line (intersections(i),y)-(intersections(i+1),y),col
|
|
end if
|
|
next i
|
|
next y
|
|
end sub
|
|
|
|
' =========================================================================
|
|
' SUBROUTINE: Moore-Neighbor Contour Tracer
|
|
' =========================================================================
|
|
sub tracecontour (targcolor as _unsigned long,mx as long,my as long)
|
|
dim startx as long,starty as long
|
|
dim foundstart as _byte
|
|
|
|
dim oldsource as long
|
|
oldsource=_source
|
|
_source state.handle
|
|
|
|
dim y&
|
|
for y&=my to 0 step -1
|
|
if point(mx,y&)<>targcolor then
|
|
startx=mx
|
|
starty=y&+1
|
|
foundstart=-1
|
|
exit for
|
|
end if
|
|
next y&
|
|
|
|
if not foundstart then
|
|
startx=mx:starty=my
|
|
end if
|
|
|
|
dim dx(0 to 7) as integer
|
|
dim dy(0 to 7) as integer
|
|
dx(0)=-1:dx(1)=0:dx(2)=1:dx(3)=1:dx(4)=1:dx(5)=0:dx(6)=-1:dx(7)=-1
|
|
dy(0)=-1:dy(1)=-1:dy(2)=-1:dy(3)=0:dy(4)=1:dy(5)=1:dy(6)=1:dy(7)=0
|
|
|
|
dim currentx as long,currenty as long
|
|
dim backtrackdir as integer,checkdir as integer
|
|
dim startbacktrackdir as integer
|
|
|
|
currentx=startx
|
|
currenty=starty
|
|
totalpoints=0
|
|
|
|
backtrackdir=1
|
|
startbacktrackdir=1
|
|
|
|
dim firststep as _byte
|
|
firststep=-1
|
|
|
|
' Calculate absolute ceiling area parameter to handle escape routes
|
|
dim maxallowedpoints as long
|
|
maxallowedpoints=_width(state.handle)*_height(state.handle)
|
|
|
|
do
|
|
contour(totalpoints).x=currentx
|
|
contour(totalpoints).y=currenty
|
|
totalpoints=totalpoints+1
|
|
|
|
' SAFEGUARD 4: Break if loop gets stuck spinning in empty coordinates
|
|
if totalpoints>=maxallowedpoints then
|
|
totalpoints=0
|
|
exit do
|
|
end if
|
|
|
|
if totalpoints>=ubound(contour) then
|
|
redim _preserve contour(ubound(contour)+1000) as point2d
|
|
end if
|
|
|
|
checkdir=(backtrackdir+1) mod 8
|
|
dim steps as integer
|
|
steps=0
|
|
|
|
do while steps<8
|
|
dim nx as long,ny as long
|
|
nx=currentx+dx(checkdir)
|
|
ny=currenty+dy(checkdir)
|
|
|
|
if nx>=0 and nx<_width(state.handle) and ny>=0 and ny<_height(state.handle) then
|
|
if point(nx,ny)=targcolor then
|
|
backtrackdir=(checkdir+4) mod 8
|
|
currentx=nx
|
|
currenty=ny
|
|
|
|
if firststep then
|
|
startbacktrackdir=backtrackdir
|
|
firststep=0
|
|
end if
|
|
exit do
|
|
end if
|
|
end if
|
|
|
|
checkdir=(checkdir+1) mod 8
|
|
steps=steps+1
|
|
loop
|
|
|
|
if steps=8 then exit do
|
|
|
|
loop until (currentx=startx and currenty=starty and backtrackdir=startbacktrackdir)
|
|
_source oldsource
|
|
end sub
|
|
|
|
' =========================================================================
|
|
' SUBROUTINE: SimplifyPolygon
|
|
' =========================================================================
|
|
sub simplifypolygon
|
|
dim numpoints as long
|
|
numpoints=totalpoints
|
|
|
|
if numpoints>2 then
|
|
if contour(numpoints-1).x=contour(0).x and contour(numpoints-1).y=contour(0).y then
|
|
numpoints=numpoints-1
|
|
end if
|
|
end if
|
|
|
|
if numpoints<3 then exit sub
|
|
|
|
dim temp(0 to numpoints-1) as point2d
|
|
dim keepcount as long
|
|
|
|
temp(0)=contour(0)
|
|
keepcount=1
|
|
|
|
dim i as long
|
|
for i=1 to numpoints-1
|
|
dim previdx as long:previdx=i-1
|
|
dim nextidx as long:nextidx=i+1
|
|
if nextidx>numpoints-1 then nextidx=0
|
|
|
|
dim dx1 as single:dx1=contour(i).x-contour(previdx).x
|
|
dim dy1 as single:dy1=contour(i).y-contour(previdx).y
|
|
dim dx2 as single:dx2=contour(nextidx).x-contour(i).x
|
|
dim dy2 as single:dy2=contour(nextidx).y-contour(i).y
|
|
|
|
dim crossproduct as single
|
|
crossproduct=(dx1*dy2)-(dy1*dx2)
|
|
|
|
if abs(crossproduct)>0.05 then
|
|
temp(keepcount)=contour(i)
|
|
keepcount=keepcount+1
|
|
end if
|
|
next i
|
|
|
|
if keepcount>=3 then
|
|
redim contour(keepcount-1) as point2d
|
|
for i=0 to keepcount-1
|
|
contour(i)=temp(i)
|
|
next i
|
|
totalpoints=keepcount
|
|
else
|
|
redim contour(numpoints-1) as point2d
|
|
for i=0 to numpoints-1
|
|
contour(i)=temp(i)
|
|
next i
|
|
totalpoints=numpoints
|
|
end if
|
|
end sub
|