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