Affine Transformation

Scale, shear, translate- by matrix

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.

Asymmetric scaling and shearing 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