This was written to make sure I understood how to transform images by geometric matrix multiplications. It is ridiculously slow, and with no interpolation/aliassing can produce very patchy quality results.
-
' ********** Affine transforms of 2D figures. GUI5b Jan 2012 **************
' uses ( corrected)
' ********** MaTricks11 v15 tenochtitlanuk June 2011 **************
'mainwin 80 30
nomainwin
WindowWidth =840
WindowHeight =660
graphicbox #w.gb1, 10, 50, 400, 400
graphicbox #w.gb2, 420, 50, 400, 400
texteditor #w.te, 10, 480, 550, 80
global x, y
Open "gdi32" for DLL as #gdi
gopen =1
open "Affine transforms" for window as #w
#w.gb1 "down"
#w.gb2 "down ; fill black ; size 2 ; flush"
#w "trapclose [quit]"
#w.te "!font courier_new 10"
sze =1
hW = hwnd( #w.gb1)
open "user32" for DLL as #user
callDLL #user, "GetDC", hW as long, hDC as long
close #user
loadbmp "tempscr", "400x400.bmp"
#w.gb1 "down ; drawbmp tempscr 0 0"
#w.gb1 "flush ; size sze"
unloadbmp "tempscr"
MatM$ ="3,3, 0.9,0,0, 0,0.9,0, 0,0,1"
'MatM$ ="3,3, 0.7071,-0.7071,0, 0.7071,0.7071,0, 0,0,1"
call DisplayMatrix MatM$
for x =1 to 400 step sze
for y =1 to 400 step sze
xx =( x -200) /100
yy =( y -200) /100
MatA$ ="3,1, " +str$( xx) +"," +str$( yy) +",1"
'MatM$ ="3,3, " +str$( 1 +( y -200) /400)+ ",0,0, 0,1,0, 0,0,1"
MatP$ =MatrixMultiply$( MatA$, MatM$)
xtr =GetTerm( MatP$, 1, 1)
ytr =GetTerm( MatP$, 2, 1)
call plot xtr, ytr, 2, getCol$( PixelLong( hDC, x, y))
'print x, y, xx, yy, longPixel, xtr, ytr,
'call DisplayMatrix MatM$
scan
next y
next x
#w.gb2 "flush"
wait
[quit]' h$
if gopen =1 then close #gdi
close #w
end
'end sub
function getCol$( color)
blue =int( color / 2^16)
green =int( ( color- blue *2^16) /2^8)
red =color -blue *2^16 -green *2^8
getCol$ =str$( red) +" " +str$( green) +" " +str$( blue)
'print getCol$
end function
Function PixelLong( hDC, xVar, yVar)
CallDLL #gdi, "GetPixel", hDC as Ulong, xVar as uLong, yVar as uLong, PixelLong as Long
PixelLong =( PixelLong + 16777216) mod 16777216
End Function
Function hDC(handle)
CallDLL #user32, "GetDC", handle as Ulong, hDC as Ulong
End Function
Sub ReleaseDC hW, hDC
CallDLL#user32,"ReleaseDC", _
hW as Ulong, _
hDC as Ulong, _
result as Long
End Sub
sub plot x, y, screen, cl$
sx =200 +int( 100 *x)
sy =200 +int( 100 *y)
if screen =1 then
#w.gb1 "color "; cl$; " ; set "; sx; " "; sy
else
#w.gb2 "color "; cl$; " ; set "; sx; " "; sy
end if
end sub
function GetTerm( in$, i, j) ' Return element( i, j) first =w column#, second =h row#
w =eval( word$( in$, 1, ","))
h =eval( word$( in$, 2, ","))
if (w BRow) then notice "Matrix dimensions unsuitable. Not conformable": end
n$ =str$( AColumn); ","; str$( ARow); ","
for AnsColumn =1 to AColumn
for AnsRow =1 to ARow
trm =0
for i =1 to BRow '3
j1 =GetTerm( inA$, i, AnsRow)
j2 =GetTerm( inB$, AnsColumn, i )
trm =trm + j1 *j2
next i
n$ =n$ +str$( trm) +","
next AnsRow
next AnsColumn
MatrixMultiply$ =left$( n$, len( n$) -1) ' ############## trailing ',' to remove
end function
'"Matrix G is reflect x coords across y =0"
'MatG$ ="3,3, -1,0,0, 0,1,0, 0,0,1"
'"Matrix H is rotate 45 degrees round origin"
'MatH$ ="3,3, cos gama,-sin gamma,0,sin gamma,cos gamma,0,0,0,1"
'MatH$ ="3,3, 0.7071,-0.7071,0, 0.7071,0.7071,0, 0,0,1"
'"Matrix I is translate +1 +1"
'MatI$ ="3,3, 1,0,0, 0,1,0, xt,yt,,1"
'MatI$ ="3,3, 1,0,0, 0,1,0, 1,1,1"
'Matrix J is scale up 50% along x-axis
'MatJ$ ="3,3, 1.5,0,0, 0,1,0, 0,0,1"
'Matrix K is scale up 50% along y-axis
'MatK$ ="3,3, 1,0,0, 0,1.5,0, 0,0,1"
'Matrix M is scale up ( zoom)
'MatM$ ="3,3, 1.5,0,0, 0,1.5,0, 0,0,1"
'Matrix L is shear parallel to x-axis. NB needs evaluating inside the loop.
'MatL$ ="3,3, "+ str$( 1 +abs( y))+ ",0,0, 0,1,0, 0,0,1"
tenochtitlanuk ------- JohnF ------ April 2020 ------ mr dot john dot f at gmail.com