Thanks for the update!
Ofcoarse, excitingly, I had to throw my 2 cents in with my revisions to the code below:
1 - matrix dlls free ( I don't have it installed "yet" )
2 - Added fullscreen tiled texture view ( Pressing the spacebar toggles it on and off )
3 - Added "Redo overlapping %" ( Press "R" )
* Seeing the option of pressing 1,2 or "3", I deleted the "default case" in the select/case so it will not automatically go back to 3 after pressing 1 or 2.
* because I don't have the "find free dll/memblock" commands, I just simply hard coded ID's for them. Also! made sure that the memblocks were deleted at the end of each function they were created in to eliminate memory leaks( ofcoarse when ending the program DBPro will delete all used memblocks anyways. But, here we re-use memblocks as we don't need to save the contents of them after leaving the functions they were used in )
* And I simply put in a "Processing" message after entering an overlapping percent so we can see something must be happening.
stitch.dba
` Program to "stitch" the edges of a texture to make it seem seamless
`
` uses simple interpolation with blending of edges with middle of texture
` plus contrast adjustment for each colour component (this prevents blurring caused by averaging)
`
` Created 3 May 2010, edited 3 May 2010.
` Author Green Gandalf.
// Edited by Stab In The Dark Software
// February 16 2011
// Added File Open/Save Dlg Box
` Now supports non-square images with improved file opening and saving.
` Code tidied up somewhat and image viewing simplified.
` Edited by Green Gandalf 22 February 2011.
rem ################################# Lee's magic app directory code
GLOBAL apppath$
app$=appname$()
for n=len(app$) to 1 step -1
if mid$(app$,n)="\" or mid$(app$,n)="/"
apppath$=left$(app$,n)
appfile$=right$(app$,len(app$)-n)
exit
endif
next n
set dir apppath$
set display mode desktop width(), desktop height(), 0
sync on : sync rate 60 : sync
#Constant FALSE = 0
#Constant TRUE = 1
//Variables for File Open Dlg
global filePath$ as String
global bDlgOK as boolean
global appDir as string
appDir = apppath$
// Variables for Seamless texture maker.
global width as integer
global height as integer
global overlap# as float
dim image$(3)
image$(1) = "Displaying original image"
image$(2) = "Displaying seamless version without contrast adjustment"
image$(3) = "Displaying seamless version with contrast adjustment"
// Main loop
saved = 0
key_spacebar=0
toggle_tiledscreen=0
tiled_x=0
tiled_y=0
im=3
do
cls
key$ = inkey$()
//We only want to run this once per image
//Call function for open file dialogue
if openOnce = 0
filePath$ = openFileBox("PNG|*.png|JPEG|*.jpg|BMP|*.bmp|DDS|*.dds|TGA|*.tga|All Files|*.*|", AppDir, "Open Texture", ".png", 1)
if bDlgOK = TRUE
//filePath$ = trim$(filePath$)
makeSeamlessTex(FilePath$)
else
end
endif
openOnce = 1
key$ = ""
cls
endif
if upper$(key$) = "O" then openOnce = 0 : saved = 0
if openOnce = 1
text 20, 20, "Press S To Save Seamless Texture"
text 20, 40, " O to Open another Texture"
text 20, 60, " R to Redo overlapping %"
text 20, 80, " 1, 2 or 3 to display textures tiled 2x2"
text 20, 100, " spacebar to toggle fullscreen tiled texture"
text 20, 120, " or Q to Quit Program"
select key$
case "1"
im = 1 ` original image
endcase
case "2"
im = 2 ` seamless without contrast adjustment
endcase
case "3"
im = 3 ` contrast adjusted seamless image
endcase
endselect
if spacekey()=1 and key_spacebar=0
key_spacebar=1
toggle_tiledscreen=1-toggle_tiledscreen
endif
if spacekey()=0 and key_spacebar=1
key_spacebar=0
endif
if toggle_tiledscreen=0
set current bitmap 0
paste image im+10, screen width()/2-256, 160
center text screen width()/2, 130, image$(im)
tiled_x=0
tiled_y=0
else
set current bitmap 0
repeat
repeat
paste image im+10,tiled_x,tiled_y
tiled_x=tiled_x+image width(im+10)
until tiled_x>screen width()
tiled_x=0
tiled_y=tiled_y+image height(im+10)
until tiled_y>screen height()
tiled_x=0
tiled_y=0
endif
endIf
if upper$(key$) = "R"
key$=""
saved=0
im=3
cls
sync
makeSeamlessTex(FilePath$)
endif
if upper$(key$) = "S" and saved = 0 then saveTexture(): saved = 1
if upper$(key$) = "Q" then end
sync
loop
end
function saveTexture()
// Save New Seamless Texture including contrast adjustment
filePath$ = openFileBox ("PNG|*.png|JPEG|*.jpg,*.jpeg|BMP|*.bmp|DDS|*.dds|TGA|*.tga|All Files|*.*|",AppDir,"Save Seamless Texture",".png",0)
if bDlgOK = TRUE
//filePath$ = trim$(filePath$)
if file exist(filePath$) then delete file filePath$
save image filePath$, 3
endif
endFunction
function makeSeamlessTex(fname$ as string)
cls
set cursor 20, 60: input "Enter overlapping %: ", overlap#
sync
cls
set cursor 20, 60: print "Processing..."
sync
load image fname$, 1, 1
width = image width(1)
height = image height(1)
create bitmap 1, width, height
paste image 1, 0, 0
create bitmap 2, width*2, height*2
create bitmap 3, 512, 512 ` doesn't allow for non-square images yet
`pW = max(overlap# * width * 0.01, 5.0)
`pH = max(overlap# * height * 0.01, 5.0)
if (overlap# * width * 0.01)>5.0
max#=(overlap# * width * 0.01)
else
max#=5.0
endif
pW = max#
if (overlap# * height * 0.01)>5.0
max#=(overlap# * height * 0.01)
else
max#=5.0
endif
pH = max#
width1 = width-1
height1 = height-1
widthM = width/2
heightM = height/2
set current bitmap 1
lock pixels
` calculate mean colours first (needed later in contrast adjustment)
sumR = 0
sumG = 0
sumB = 0
for x = 0 to width1
for y = 0 to height1
pixel = point(x, y)
inc sumR, rgbr(pixel)
inc sumG, rgbg(pixel)
inc sumB, rgbb(pixel)
next y
next x
factor# = 1.0/(width*height)
meanR# = sumR*factor#
meanG# = sumG*factor#
meanB# = sumB*factor#
` now make seamless without contrast adjustment
` do horizontal blend first
for x = 0 to pW
xR = width1+x-pW
xLB = widthM+x
xRB = widthM-pW+x-1
px = pW-x
for y = 0 to height1
pixelL = point(x, y) ` left hand pixel
pixelLB = point(xLB, y) ` pixel to blend with left pixel
pixelR = point(xR, y) ` right hand pixel
pixelRB = point(xRB, y) ` pixel to blend with right pixel
` compute raw blended pixels componentwise
redL = blend(pixelL, pixelLB, x, px, pW, "red")
greenL = blend(pixelL, pixelLB, x, px, pW, "green")
blueL = blend(pixelL, pixelLB, x, px, pW, "blue")
redR = blend(pixelR, pixelRB, px, x, pW, "red")
greenR = blend(pixelR, pixelRB, px, x, pW, "green")
blueR = blend(pixelR, pixelRB, px, x, pW, "blue")
dot x, y, rgb(redL, greenL, blueL)
dot xR, y, rgb(redR, greenR, blueR)
next y
next x
` now do exactly the same for the vertical blend - i.e. just swap roles of x and y
for y = 0 to pH
yR = height1+y-pH
yLB = heightM+y
yRB = heightM-pH+y-1
py = pH-y
for x = 0 to width1
pixelL = point(x, y) ` left hand pixel
pixelLB = point(x, yLB) ` pixel to blend with left pixel
pixelR = point(x, yR) ` right hand pixel
pixelRB = point(x, yRB) ` pixel to blend with right pixel
` compute raw blended pixels componentwise
redL = blend(pixelL, pixelLB, y, py, pH, "red")
greenL = blend(pixelL, pixelLB, y, py, pH, "green")
blueL = blend(pixelL, pixelLB, y, py, pH, "blue")
redR = blend(pixelR, pixelRB, py, y, pH, "red")
greenR = blend(pixelR, pixelRB, py, y, pH, "green")
blueR = blend(pixelR, pixelRB, py, y, pH, "blue")
dot x, y, rgb(redL, greenL, blueL)
dot x, yR, rgb(redR, greenR, blueR)
next x
next y
unlock pixels
get image 2, 0, 0, width, height, 3
` now create a second copy with contrast adjustment
lock pixels
` do horizontal adjustment first
for x = 0 to pW
` contrast adjustment step (assumes pixels are i.i.d. for each component)
` increase contrast of each component of each blended pixel
xR = width1+x-pW
px = pW-x
inflate# = pW/sqrt(0.0+x*x + px*px)
for y = 0 to height1
pixelL = point(x,y)
pixelR = point(xR,y)
rL = adjustContrast(meanR#, pixelL, inflate#, "red")
gL = adjustContrast(meanG#, pixelL, inflate#, "green")
bL = adjustContrast(meanB#, pixelL, inflate#, "blue")
dot x, y, rgb(rL, gL, bL)
rR = adjustContrast(meanR#, pixelR, inflate#, "red")
gR = adjustContrast(meanG#, pixelR, inflate#, "green")
bR = adjustContrast(meanB#, pixelR, inflate#, "blue")
dot xR, y, rgb(rR, gR, bR)
next y
next x
` now do the same for the vertical pass
for y = 0 to pH
` contrast adjustment step (assumes pixels are iid for each component)
` increase contrast of each component of each blended pixel
yR = height1+y-pH
py = pH-y
inflate# = pH/sqrt(0.0+y*y + py*py)
for x = 0 to width1
pixelL = point(x,y)
pixelR = point(x,yR)
rL = adjustContrast(meanR#, pixelL, inflate#, "red")
gL = adjustContrast(meanG#, pixelL, inflate#, "green")
bL = adjustContrast(meanB#, pixelL, inflate#, "blue")
dot x, y, rgb(rL, gL, bL)
rR = adjustContrast(meanR#, pixelR, inflate#, "red")
gR = adjustContrast(meanG#, pixelR, inflate#, "green")
bR = adjustContrast(meanB#, pixelR, inflate#, "blue")
dot x, yR, rgb(rR, gR, bR)
next x
next y
unlock pixels
get image 3, 0, 0, width, height, 3
for im = 1 to 3
set current bitmap 2
cls
paste image im, 0, 0
paste image im, width, 0
paste image im, 0, height
paste image im, width, height
` now copy down to convenient size for display
copy bitmap 2, 0, 0, width*2, height*2, 3, 0, 0, 512, 512
set current bitmap 3
get image im+10, 0, 0, 512, 512, 3
next im
set current bitmap 0
delete bitmap 1
delete bitmap 2
delete bitmap 3
endfunction
function blend(pixA, pixB, xA, xB, p, colour$)
select colour$
case "red"
result = (rgbr(pixA)*xA + rgbr(pixB)*xB)/p
endcase
case "green"
result = (rgbg(pixA)*xA + rgbg(pixB)*xB)/p
endcase
case "blue"
result = (rgbb(pixA)*xA + rgbb(pixB)*xB)/p
endcase
case default
result = 0
endcase
endselect
endfunction result
function adjustContrast(mean#, pix, inflate#, colour$)
select colour$
case "red"
result = mean# +(rgbr(pix) - mean#)*inflate#
endcase
case "green"
result = mean# +(rgbg(pix) - mean#)*inflate#
endcase
case "blue"
result = mean# +(rgbb(pix) - mean#)*inflate#
endcase
case default
result = 0
endcase
endselect
result = validRGB(result)
endfunction result
function validRGB(c)
if c<0
c = 0
else
if c>255 then c = 255
endif
endfunction c
file open dlg.dba
function openFileBox(filter As String ,initdir As String ,dtitle As String ,defext As String ,open As Boolean )
//filter = "Text Documents ( *.txt )|*.txt|All Files ( *.* )|*.*|"
//initdir = "C:"
//dtitle = "Open ~ Test"
//defext = "txt"
//open = 1 For open Dialog, 0 for save dialog
bDlgOK = FALSE
//Get DLL numbers
user32 As Integer
comdlg32 As Integer
//Load in required DLL's
user32 = 1 //Find Free Dll()
Load DLL "user32.dll",user32
comdlg32 = 2 //Find Free Dll()
Load DLL "comdlg32.dll",comdlg32
//Get handle ( unique ID ) to the calling ( this ) window
hwnd As DWord
hwnd = Call DLL(user32,"GetActiveWindow")
//Unload DLL as it is no longer needed
Delete DLL user32
//Get the Memblock Number
OPENFILENAME As Integer
OPENFILENAME = 1 //Find Free Memblock()
//Make The Memblock containing the OPENFILENAME structure
Make MemBlock OPENFILENAME,76
//Get the pointer to the just created Structure
lpofn As DWord
lpofn = Get MemBlock Ptr(OPENFILENAME)
//Declare temp variables to hold data for OPENFILENAME structure
size As Integer
filebuffer As String
filebufferptr As DWord
flags As DWord
filter = filter + "|"
initdir = initdir + "|"
dtitle = dtitle + "|"
defext = defext + "|"
filebuffer = "|" + Space$(255) + "|"
filebufferptr = get_str_ptr(filebuffer)
flags = 0x00001000 || 0x00000004 || 0x00000002
size = 0
Write MemBlock DWord OPENFILENAME,0,76 : `lStructSize
Write MemBlock DWord OPENFILENAME,4,hwnd : `hwndOwner
`Write MemBlock DWord OPENFILENAME,8,NULL : `hInstance
Write MemBlock DWord OPENFILENAME,12,get_str_ptr(filter) : `lpstrFilter
`Write MemBlock DWord OPENFILENAME,16,0 : `lpstrCustomFilter
`Write MemBlock DWord OPENFILENAME,20,NULL : `nMaxCustFilter
Write MemBlock DWord OPENFILENAME,24,1 : `nFilterIndex
Write MemBlock DWord OPENFILENAME,28,filebufferptr : `lpstrFile
Write MemBlock DWord OPENFILENAME,32,256 : `nMaxFile
`Write MemBlock DWord OPENFILENAME,36,0 : `lpstrFileTitle
`Write MemBlock DWord OPENFILENAME,40,NULL : `nMaxFileTitle
Write MemBlock DWord OPENFILENAME,44,get_str_ptr(initdir) : `lpstrInitialDir
Write MemBlock DWord OPENFILENAME,48,get_str_ptr(dtitle) : `lpstrTitle
Write MemBlock DWord OPENFILENAME,52,flags : `Flags
`Write MemBlock Word OPENFILENAME,56,NULL : `nFileOffset
`Write MemBlock Word OPENFILENAME,58,NULL : `nFileExtension
Write MemBlock DWord OPENFILENAME,60,get_str_ptr(defext) : `lpstrDefExt
`Write MemBlock DWord OPENFILENAME,64,NULL : `lCustData
`Write MemBlock DWord OPENFILENAME,68,NULL : `lpfnHook
`Write MemBlock DWord OPENFILENAME,72,0 : `lpTemplateName
//Call the Command to open the dialogue
retval As DWord
If open
retval = Call DLL(comdlg32,"GetOpenFileNameA",lpofn)
Else
retval = Call DLL(comdlg32,"GetSaveFileNameA",lpofn)
EndIf
//Check if it was sucecfull
If retval <> 0
code$ = get_str(filebufferptr,256)
bDlgOK = TRUE
Else
retval = Call DLL(comdlg32,"CommDlgExtendedError")
Select retval
Case 0xFFFF : code$ = "The dialog box could not be created. The common dialog box function's call to the DialogBox function failed. For example, this error occurs if the common dialog box call specifies an invalid window handle." : EndCase
Case 0x0006 : code$ = "The common dialog box function failed to find a specified resource." : EndCase
Case 0x0004 : code$ = "The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding instance handle." : EndCase
Case 0x0002 : code$ = "The common dialog box function failed during initialization. This error often occurs when sufficient memory is not available." : EndCase
Case 0x000B : code$ = "The ENABLEHOOK flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a pointer to a corresponding hook procedure." : EndCase
Case 0x0008 : code$ = "The common dialog box function failed to lock a specified resource." : EndCase
Case 0x0003 : code$ = "The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding template." : EndCase
Case 0x0007 : code$ = "The common dialog box function failed to load a specified string." : EndCase
Case 0x0001 : code$ = "The lStructSize member of the initialization structure for the corresponding common dialog box is invalid." : EndCase
Case 0x0005 : code$ = "The common dialog box function failed to load a specified string." : EndCase
Case 0x3003 : code$ = "The buffer pointed to by the lpstrFile member of the OPENFILENAME structure is too small for the file name specified by the user. The first two bytes of the lpstrFile buffer contain an integer value specifying the size, in TCHARs, required to receive the full name." : EndCase
Case 0x0009 : code$ = "The common dialog box function was unable to allocate memory for internal structures." : EndCase
Case 0x3002 : code$ = "A file name is invalid." : EndCase
Case 0x000A : code$ = "The common dialog box function was unable to lock the memory associated with a handle." : EndCase
Case 0x3001 : code$ = "An attempt to subclass a list box failed because sufficient memory was not available." : EndCase
Case Default : code$ = "WHOOPS!" : EndCase
EndSelect
EndIF
Delete DLL comdlg32
Delete Memblock 1
EndFunction code$
Function get_str_ptr(pstr As String )
`pstr$ should be a "|" ( NULL ) seperated string.
memnum As Integer
strlen As Integer
char As Byte
memptr As DWord
strptr As DWord
memnum = 2 //Find Free Memblock()
strlen = Len(pstr)
Make MemBlock memnum,strlen
For i = 1 To strlen
If Mid$(pstr,i) = "|"
char = 0
Else
char = Asc(Mid$(pstr,i))
EndIf
Write MemBlock Byte memnum,(i - 1),char
Next i
memptr = Get MemBlock Ptr(memnum)
strptr = Make Memory(strlen)
Copy Memory strptr,memptr,strlen
Delete MemBlock memnum
EndFunction strptr
Function get_str(strptr As DWord ,strsize As Integer )
`strptr is the pointer returned by _get_str_ptr()
`strsize is the Integer length of the string specified by the pointer
memnum As Integer
memptr As DWord
str As String
char As String
memnum = 2 //Find Free Memblock()
Make MemBlock memnum,strsize
memptr = Get MemBlock Ptr(memnum)
Copy Memory memptr,strptr,strsize
For i = 1 To strsize
str = str + Chr$(MemBlock Byte(memnum,i - 1))
Next i
Delete MemBlock memnum
EndFunction str