## Squares

General FreeBASIC programming questions.
Richard
Posts: 2964
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@ Albert.
If you use other than (carry * 256) then you are implementing a form of cyclic polynomial.
Cyclic polynomials are used to hash data, to scramble communications links or to generate random numbers.
http://en.wikipedia.org/wiki/Rolling_ha ... polynomial

An entire file can be hashed using binary polynomials into just a few CRC bits. This is very lossy compression.
If the CRC of the file now has a different CRC to the original file then the file data has been corrupted.
http://en.wikipedia.org/wiki/Cyclic_redundancy_check

If you use cyclic polynomials to reduce the data volume then you will be unable to recover all the original data.
The original data is guaranteed to be lost and any recognisable patterns in the data will be scrambled to become white noise.
White noise cannot be compressed as efficiently as raw data, so you are actually going backwards on the path to compression.
albert
Posts: 5313
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

I found a way to undo it but; it requires every carry to be saved and not just the end carry of the entire string.

But then saving every carry requires as many bits as the original input length..
dodicat
Posts: 6030
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Hi Albert.
I'll just keep to simple stuff, I haven't read many of the previous compressor stuff posts.
You wanted an example of a function returning a type.

I'll keep it in the realm of bignumbers.
I've made up a short division, that is the denominator is just one number, 1 to 9.
The function gives the answer and the time taken to get the answer.
I haven't optimised much and the answer is correct to the number of places requested.
The string answer is easily got, producing the correct number of places is a bit dodgy.

Code: Select all

`type pair    as string s    as double tend typefunction shortdiv(n as string,s2 as string,numplaces as integer=0) as pair    if s2="0" then exit function    var t=timer    var s=n    var ii=instr(s,".")    if ii=0 then s=s+"."    ii=instr(s,".")    var i= len(s)-ii    if len(s)<numplaces+ii then    s=s+string(numplaces-i,"0")    end if    dim as ubyte main,carry,d=s2-48,temp    dim as string ans=s    for z as integer=0 to len(s)-1        if s[z]<>46 then        temp=(s[z]-48+carry)       main=temp\d      carry=(temp mod d)*10      ans[z]=main+48  end if  if z>numplaces+ii then exit for    next z    var t2=timer-t    dim as pair a    a.s=mid(ltrim(ans,"0"),1,numplaces+ii)    a.t=t2    return aend functiondim as string n=string(5,"9")+ "." + string(2000000,"3")dim as string d="7"print "Numerator = ";mid(n,1,50) + " -------"print "Length of numerator ";len(n)print "denominator ";dprintprint "Short divide"dim as pair ansans= shortdiv(n,d,1000000) ' a million placesprint "answer = "print mid(ans.s,1,200) + " ------ "print "Length of answer = ";len(ans.s)printprint "time = ";print ans.tprintprint "float answer"print str(val(mid(n,1,20))/val(d))print "done"sleep `
albert
Posts: 5313
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Thanks , that's what I wanted to know about , now its on to finding away to undo the compression..
Stonemonkey
Posts: 587
Joined: Jun 09, 2005 0:08

### Re: Squares

Hi, going back to the image scaling problem there's something that I've realised, it might be really obvious but I hadn't thought much about it before. Bilinear and the bicubic that I was looking at have a problem, in the situation of doubling the image each pixel is divided in to 4 (2*2), with the top left pixel retaining the colour of the original and the other 3 being interpolated. But when an image is scaled down to half size the pixel colour in the result is (usually) an average of the 4 meaning that the result doesn't correspond directly to any of the pixels used to calculate it.
So when doubling, I'm wondering if there's a way using the surrounding pixels along with the fact that the original pixel is the average, to calculate new pixel values.
Richard
Posts: 2964
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@ Stonemonkey.
You raise one of many questions.

FB employs integers to index pixels in rows and columns. But sample rate conversions need to be done with pixel positions in x and y using floating point. A problem arises in defining where the pixels are on an image. Do you define the position of the pixel as it's top left corner on the screen, or do you use the centre of that pixel's area. Does the grid define the centres or the corners of pixels. It also matters how you decide to drop the re-sampled grid onto the original sample grid. This becomes a more involved decision when you include a slight rotation of the new pixel grid.

It also matters if you are scaling a B&W line art or a 24 bit RGB image. Some B&W lines could change their width or disappear altogether. You might need to adjust line density by dithering. Some lines may cease to be continuous. When increasing the resolution of an image, how do you reconstruct a dithered line into a continuous line, is it really a dithered line, or could it be the windows on a distant aircraft.

Changing the number of pixels employed to represent an image is analogous to up-sampling or down-sampling in signal processing. If the sample rates are exact multiples then there should be no aliasing generated by the re-sampling. If there is a slight variation of sample pitch then a significant aliasing beat may be generated.

Up-sampling conversions contain redundant information, so they can be engineered to be reversed precisely. That is not possible with down-sampling since information has been immediately lost.

Signal processing theory says that there is no requirement that any pixel in the re-sampled image will have exactly the same value as any pixel in the original image. You can expect a contrast reduction when re-sampling, and you may have to correct for that with a Sinc=Sin(x)/x function, while at the same time managing to avoid overflow of individual pixel values. Saturation arithmetic is now supported by advanced processor assembler instructions.

How you handle the boundary of the image is also a necessary decision, does it wrap around to the other side of the image, does it reflect back at the edges or are the boundary values clamped at the edge to the value of the pixel at the edge. There are several other possibilities.

Since images are usually 2D grids it can make a difference how a re-sampling is performed. An independent Fourier transform of each row converts the image to Fourier coefficients. The transform of those columns of coefficients can then be performed before reverse transforms to generate the re-sampled image. The operations employed and the order of those operations is very important but the transform method can be used to control high frequency noise and aliasing. This begins to enter the field of Cosine transforms and digital video compression techniques.

You must select your method based on artistic and technical grounds. There is no one correct solution to re-sampling, every method will satisfy some requirements while failing in others.
Stonemonkey
Posts: 587
Joined: Jun 09, 2005 0:08

### Re: Squares

Richard wrote:@ Stonemonkey.
You raise one of many questions.

FB employs integers to index pixels in rows and columns. But sample rate conversions need to be done with pixel positions in x and y using floating point. A problem arises in defining where the pixels are on an image. Do you define the position of the pixel as it's top left corner on the screen, or do you use the centre of that pixel's area. Does the grid define the centres or the corners of pixels. It also matters how you decide to drop the re-sampled grid onto the original sample grid. This becomes a more involved decision when you include a slight rotation of the new pixel grid.

Yep, I've done quite a bit of software 3d rendering, dealing with sub pixel accuracy and different fill conventions so I have a fairly good grasp on that side of things.

It also matters if you are scaling a B&W line art or a 24 bit RGB image. Some B&W lines could change their width or disappear altogether. You might need to adjust line density by dithering. Some lines may cease to be continuous. When increasing the resolution of an image, how do you reconstruct a dithered line into a continuous line, is it really a dithered line, or could it be the windows on a distant aircraft.

I'm only considering 24 bit images for now and looking for ways to scale without or with less blurring than blilinear or bicubic interpolation gives.

Changing the number of pixels employed to represent an image is analogous to up-sampling or down-sampling in signal processing. If the sample rates are exact multiples then there should be no aliasing generated by the re-sampling. If there is a slight variation of sample pitch then a significant aliasing beat may be generated.

Up-sampling conversions contain redundant information, so they can be engineered to be reversed precisely. That is not possible with down-sampling since information has been immediately lost.

Signal processing theory says that there is no requirement that any pixel in the re-sampled image will have exactly the same value as any pixel in the original image. You can expect a contrast reduction when re-sampling, and you may have to correct for that with a Sinc=Sin(x)/x function, while at the same time managing to avoid overflow of individual pixel values. Saturation arithmetic is now supported by advanced processor assembler instructions.

This is what I was getting at, with the interpolation in doubling an image then the top/left (depending on convention) pixel was being given the value of the original pixel.
How you handle the boundary of the image is also a necessary decision, does it wrap around to the other side of the image, does it reflect back at the edges or are the boundary values clamped at the edge to the value of the pixel at the edge. There are several other possibilities.

Again this is something I'm quite familiar with from texturing, particularly with filtering textures.
Since images are usually 2D grids it can make a difference how a re-sampling is performed. An independent Fourier transform of each row converts the image to Fourier coefficients. The transform of those columns of coefficients can then be performed before reverse transforms to generate the re-sampled image. The operations employed and the order of those operations is very important but the transform method can be used to control high frequency noise and aliasing. This begins to enter the field of Cosine transforms and digital video compression techniques.

You must select your method based on artistic and technical grounds. There is no one correct solution to re-sampling, every method will satisfy some requirements while failing in others.

I'm just looking around for some ideas at the moment and see what I can come up with.
dodicat
Posts: 6030
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

I've included a blurring option in my simple averaging on re sizing.
To print to the console keep it the active screen (of course).
If the bitmap is reduced both in width and height then no averaging or blurring needs done, so it is skipped.
Just swing larger bitmaps out of the way to get at the console.
No pixel keeps it's original colour during enlarging, unless by extraordinary coincidence which will remain forever unknown.
A large blur takes a bit longer to process, it averages out more pixels.

Code: Select all

` Dim  As String pictureDim Shared As Uinteger Pointer TimDim Shared As Uinteger Pointer imDim Shared As Integer grayDim Shared As String gdim shared as single blurr=.7picture="parrot.bmp" ' <---  set your bitmap name or path to your bitmap name here#macro ppoint(_x,_y,colour)pixel=row+pitch*(_y)+4*(_x)(colour)=*pixel#endmacro#macro ppset(_x,_y,colour)pixel=row+pitch*(_y)+4*(_x)*pixel=(colour)#endmacroType v2    As Integer x,y    col As UintegerEnd TypeType colour    As Integer r,g,bEnd TypeFunction size(bmp As String) As v2     Dim As Integer w,h    Open bmp For Binary As #1    Get #1, 19, w    Get #1, 23, h    Close #1    Return Type<v2>(w,h)End Function#macro consoleinput(stuff,variable)Open Cons For input As #2consolePrint(stuff)input #2,variableClose #2#endmacro#macro consoleprint(stuff)Open Cons For Output As #1Print #1, (stuff) & "  ";Close #1#endmacro#macro map(a,b,_x_,c,d)((d)-(c))*((_x_)-(a))/((b)-(a))+(c)#endmacroFunction grey(c As Uinteger) As Uinteger    Var v=.299*((c Shr 16)And 255)+.587*((c Shr 8)And 255)+.114*(c And 255)    Return Rgb(v,v,v)End Function    #macro average()    ar=0:ag=0:ab=0:inc=0    xmin=x:if xmin>rad then xmin=rad    xmax=rad:if x>=(_x-1-rad) then xmax=_x-1-x    ymin=y:if ymin>rad then ymin=rad    ymax=rad:if y>=(_y-1-rad) then ymax=_y-1-y    For y1 As Integer=-ymin To ymax        For x1 As Integer=-xmin To xmax            inc=inc+1             ar=ar+(picture2(x+x1,y+y1).col Shr 16 And 255)            ag=ag+(picture2(x+x1,y+y1).col Shr 8 And 255)            ab=ab+(picture2(x+x1,y+y1).col And 255)        Next x1    Next y1    averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))    #endmacroSub resize(picture As String,_x As Integer,_y As Integer,flag As String="")        Dim As v2 dimension=size(picture)    Dim Scale_x As Double=_x/dimension.x    Dim Scale_y As Double=_y/dimension.y    If flag<>"y" Then        im=Imagecreate(dimension.x,dimension.y)        If im=0 Then            Print"No bitmap, press a key to exit"            Imagedestroy im            Sleep            End        End If        Bload picture,im        tim=Imagecreate(_x,_y)        Dim As Double radius=.5*(Scale_x+Scale_y)        Dim As Integer pitch        Dim  As Any Pointer row        Dim As Uinteger Pointer pixel        Dim As Uinteger col        Imageinfo im,,,,pitch,row        For y As Integer=0 To (dimension.y-1)            For x As Integer=0 To (dimension.x-1)                Dim As Integer xx=map(0,dimension.x,x,0,_x)                Dim As Integer yy=map(0,dimension.y,y,0,_y)                ppoint(x,y,col)                If gray=1 Then col=grey(col)                Line tim,(xx-scale_x,yy-scale_y)-(xx+scale_x,yy+scale_y),col,bf            Next x        Next y        If scale_x<=1 And scale_y<=1 Then 'no blurr for scaling down.            Goto fin        End If        'blurr stuff        Scope            Dim As Integer pitch            Dim  As Any Pointer row            Dim As Uinteger Pointer pixel            Imageinfo tim,,,,pitch,row            Dim As v2 picture2(_x,_y)            Dim As Uinteger col            For y As Integer=0 To (_y)-1                For x As Integer=0 To (_x)-1                    ppoint(x,y,col)                    picture2(x,y)=Type<v2>(x,y,col)                Next x            Next y            dim as uinteger averagecolour            dim as integer ar,ag,ab            dim as integer xmin,xmax,ymin,ymax,inc            dim as integer rad=int(blurr*radius)'.7                For y As Integer=0 To _y-1                For x As Integer=0 To _x-1                      average()                    picture2(x,y).col=averagecolour                Next x            Next y                        For y As Integer=0 To _y                For x As Integer=0 To _x                    ppset(picture2(x,y).x,picture2(x,y).y,picture2(x,y).col)                 Next x            Next y        End Scope        fin:        Put(0,0),tim    End If        If flag="y" Then        Bsave ( g+picture + "(" + Str(_x) + "," + Str(_y)+").bmp",0)    End IfEnd Sub'================ RUN =========================================dim as integer xres,yresscreeninfo xres,yresDim As Integer xresolution,yresolutionDim As String save,a,d,grayflagstart:Screen 0gray=0a=Str(size(picture).x)d=Str(size(picture).y)print "Please keep this screen active to write to it"Print "Your picture is " + picture + "  @  " + a + " X " + dIf size(picture).x=0 Or size(picture).y=0 Then Print "No bitmap, press a key":Sleep:EndScreenres valint(a),valint(d),32 SCREENCONTROL(100, .5*xres, 00)resize(picture,valint(a),valint(d),"")do    consoleinput("Enter new  width ",xresolution)    consoleinput("Enter new height ",yresolution)loop until xresolution>0 and yresolution>0if xresolution>xres or yresolution>yres then    var w=""    do    consoleprint ("WARNING --  one choice is greater than your screen resolution")    consoleprint(chr(10))    consoleinput("Do you want to continue with this?  (y/n) ",w)    w=lcase(w)loop until w="y" or w="n"if w="n" then goto startend ifIf xresolution>size(picture).x or yresolution>size(picture).y Thendo   consoleinput("Enter blur (1 to 10)",blurr)   loop until blurr>=1 and blurr<=10   blurr=map(1,10,blurr,.45,.9)   ''consoleprint(str(blurr))   end if   Do    consoleinput("Do you want Gray image (y/n)",grayflag)    grayflag=Lcase(grayflag)Loop Until grayflag = "y" Or grayflag ="n"If grayflag="y" Then gray=1 Else gray=0Screenres xresolution,yresolution,32 screencontrol(100,0,0)resize(picture,xresolution,yresolution,"")Do    consoleinput("Do you want to save (y/n) or q to quit",save)    save=Lcase(save)Loop Until save = "y" Or save ="n" Or save="q"If save="y" Then    If grayflag="y" Then g=" GRAY "    consoleprint("you new bitmap is  " +g+ picture + "(" + Str(xresolution) + "," + Str(yresolution)+").bmp")End IfIf save="n" Then Goto startIf save="q" Then imagedestroy im:imagedestroy tim: Endconsoleprint(chr(10))consoleprint ("Click on image and Press a key")resize(picture,xresolution,yresolution,save)Imagedestroy imImagedestroy timsleep`
dafhi
Posts: 1276
Joined: Jun 04, 2005 9:51

### Re: Squares

Here''s a nice method: anti-aliased sample points

Dec 5 - integrated rot and scale sub into my ImageInfo udt
Dec 4 - many renames (thanks Gonzo for feedback)

Code: Select all

`Dim As String                     filename = "MyBmp.bmp"' anti-aliased grid sampling by dafhi' - UPDATES -' === 2012 ===' - 12/5 -' adapted to new rounding mode' integrated SkewRect with ImageInfo' - 12/4 -'' renamings:' 1. QuickInit()    ScaleRot()' 2. y__            yDest'    y_             yGrid'    x__            xDest'    x_             xGrid' 3. LayerSource()  BoundsCheckSource()' 4. uARGB          UnionARGB' 5. destPixel      ptrDest'    src_pel        ptrSource' 6. ResInf()       ScreenInit()' 7. aa_            aa_fractional' 8. src_pos        src_floatpos#Ifndef piConst                             TwoPi = 8 * Atn(1)Const                             pi    = 4 * Atn(1)  #EndIf#Ifndef floor#Define floor(x) (((x)*2.0-0.5)shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633#define ceil(x) (-((-(x)*2.0-0.5)shr 1))  #EndIf#Ifndef FALSEConst FALSE = 0Const TRUE = not FALSE  #EndIf'' http://www.freebasic.net/forum/viewtopic.php?f=3&t=20669#p181983Function get_fpu_control_word()as integer    asm fstcw [function]end functionSub set_fpu_control_word(byval cw as integer)    asm fldcw [cw]end subSub set_fpu_rounding_mode(byval mode as integer)    mode=(get_fpu_control_word() and &hf3ff)or((mode and 3)shl 10)    asm fldcw [mode]end Subdim as integer original_fpu_control_word=get_fpu_control_word()''  rounding mode:'' 0=nearest'' 1=round down'' 2=round up'' 3=truncateset_fpu_rounding_mode(1)' ------------------------------- ''           ImageInfo             ''                                 '#Ifndef UnionARGB  Union UnionARGB    Type      As UByte  B      As UByte  G      As UByte  R      As UByte  A    End Type    As UInteger ARGB  End Union#EndIfType srSngPoint    As Single                     x,yEnd TypeType ImageInfo  As Any ptr                      img = 0  As Any ptr                      pixels  As Any ptr                      botleft  As Integer                      pitchm  As Integer                      pitch  As Integer                      wid  As Integer                      hgt  As Integer                      widM  As Integer                      hgtM  As single                       midx  As single                       midy  As Single                       diagonal  As Single                       aaL,aaR,aaT,aaB  As Integer                      bypp  As Integer                      pitchBy4  As Integer                      UB1D  As Integer                      w_plus_h  As srSngPoint                   ptA,ptB,ptC,ptD  Declare Operator                Cast () As Any Ptr  Declare Function                Create(ByVal pWid As UShort=1,ByVal pHgt As UShort=1,ByVal bpp_ as UInteger=32,ByVal pRed As UByte=127,ByVal pGrn As UByte=127,ByVal pBlu As UByte=127,ByVal pAph As UByte=255,ByVal NoImage As Integer=0) As Any ptr  Declare Function                ScreenInit(ByVal pWid As UShort=1,ByVal pHgt As UShort=1,ByVal bpp_ as UInteger=32,ByVal pRed As UByte=127,ByVal pGrn As UByte=127,ByVal pBlu As UByte=127,ByVal pAph As UByte=255) As Any Ptr  Declare sub                     LoadBMP(ByRef filename As String)  Declare Sub                     Blit(ByRef Dest As ImageInfo,ByVal X As Integer = 0,ByVal Y As Integer = 0, ByVal Wid As Integer = -1, ByVal Hgt As Integer = -1)  Declare Sub                     SkewRect_ScaleRotate(ByVal scale_ As Single = 1.0, ByVal angle_ As Single = 0.0)  Declare Sub                     SkewRect_Render(ByRef pDest As ImageInfo, _    ByVal x As Integer = 0, _    ByVal y As Integer = 0, _    ByVal wid As Integer = -1, _    ByVal hgt As Integer = -1)  Declare Sub ScrInfo  Declare Sub Cls( ByVal pColor As UInteger=RGBA(0,0,0,0) )  Declare Sub Destroy  Declare Sub varsCommon  Declare DestructorEnd TypeOperator ImageInfo.cast () As Any Ptr  Return imgEnd OperatorDestructor ImageInfo  DestroyEnd DestructorSub ImageInfo.varsCommon  widM = wid - 1  hgtM = hgt - 1  midx = widM * 0.5  midy = hgtM * 0.5  UB1D = wid * hgt - 1  pitchm = pitch - 1  pitchBy4 = pitch \ 4  botleft = pixels + pitch * hgtm  w_plus_h = wid + hgt  diagonal = Sqr(wid * wid + hgt * hgt)  aaL = -0.5  aaR = widM + 0.5  aaB = -0.5  aaT = hgtM + 0.5End SubFunction ImageInfo.Create(ByVal pWid As UShort, ByVal pHgt As UShort, _  ByVal bpp_ as UInteger, _  ByVal pRed As UByte, _  ByVal pGrn As UByte, _  ByVal pBlu As UByte, _  ByVal pAph As UByte, _  ByVal NoImage As Integer) As Any Ptr    If NoImage Then    wid = pWid    hgt = pHgt  Else    img = ImageCreate( pWid, pHgt, RGBA(pRed,pGrn,pBlu,pAph), bpp_ )    ImageInfo img, wid, hgt, bypp, pitch, pixels  EndIf  varsCommon  Return imgEnd FunctionSub ImageInfo.ScrInfo  ScreenInfo wid ,hgt  , , bypp, pitch  pixels = ScreenPtr  varsCommonEnd SubFunction ImageInfo.ScreenInit(ByVal pWid As UShort,ByVal pHgt As UShort,ByVal bpp_ as UInteger,ByVal pRed As UByte,ByVal pGrn As UByte,ByVal pBlu As UByte,ByVal pAph As UByte) As Any Ptr  ScreenRes pWid,pHgt,bpp_  ScrInfo  Return pixelsEnd FunctionSub ImageInfo.Destroy()  If img = 0 Then Exit Sub  ImageDestroy img  img = 0End SubSub ImageInfo.Cls( ByVal pColor As UInteger)  Dim As UInteger cpy_ = (pitch * hgt) Shr 2  Dim As UInteger Ptr dest = pixels  ''http://www.freebasic.net/forum/viewtopic.php?t=15809&  Asm mov eax, [pcolor]  Asm mov edi, [dest]  Asm mov ecx, [cpy_]  Asm rep stosdEnd SubSub ImageInfo.LoadBMP(ByRef filename As String)    Open filename For Input As #1    If Lof(1) = 0 Then      Close #1      Exit sub    EndIf    Dim As Integer w,h    Open filename For Binary As #1    Get #1, 19, w    Get #1, 23, h    Close #1    Create w,h    Bload filename,ImgEnd Sub#Macro ClipVars()  Dim As Integer  clipLeft,clipTop,xLeft=x,yTop=y    If x < 0 Then clipLeft = -x: xLeft = 0  If y < 0 Then clipTop = -y: yTop = 0    Dim As Integer  widM_ = wid_ - 1  Dim As Integer  hgtM_ = hgt_ - 1    Dim As Integer  xRight = x + widM_  Dim As Integer  yBot = y + hgtM_    If xRight > pDest.widM Then xRight = pDest.widM  If yBot > pDest.hgtM Then yBot = pDest.hgtM#EndMacroSub ImageInfo.Blit(ByRef pDest As ImageInfo, ByVal X As Integer, ByVal Y As Integer, ByVal Wid_ As Integer, ByVal Hgt_ As Integer)  If Wid_ < 0 Then Wid_ = This.wid  If Hgt_ < 0 Then Hgt_ = This.hgt  ClipVars()    For yDest As Integer = yTop To yBot    Dim As Integer  ySrc = yDest - yTop + ClipTop    Dim As UInteger Ptr ptrSrc = pixels + ySrc * pitch    ptrSrc += ClipLeft    Dim As UInteger Ptr ptrDestL = pDest.pixels + yDest * pDest.pitch    ptrDestL += xLeft    For ptrDest As UInteger Ptr = ptrDestL To ptrDestL + (xRight - xLeft)      *ptrDest = *ptrSrc      ptrSrc += 1    Next  NextEnd SubSub ImageInfo.SkewRect_ScaleRotate(ByVal scale_ As Single, ByVal angle_ As Single)    If scale_ = 0 Then Exit Sub  scale_ = 1 / scale_    Dim As Single xLeft = midx * -scale_  Dim As Single xRight = midx * scale_  Dim As Single yTop = midy * -scale_  Dim As Single yBot = midy * scale_  Dim As Single cos_ = Cos( -angle_ )  Dim As single sin_ = Sin( -angle_ )  Dim As Single tmpA,tmpB    #Macro Rot8_Trans(init_a,init_b,dsta, dstb)     dsta = init_a     dstb = init_b     tmpA = cos_ * dsta + sin_ * dstb     tmpB = cos_ * dstb - sin_ * dsta     dsta = tmpA + midx     dstb = tmpB + midy  #EndMacro    Rot8_Trans( xLeft, yTop, ptA.x, ptA.y )  Rot8_Trans( xRight, yTop, ptB.x, ptB.y )  Rot8_Trans( xLeft, yBot, ptC.x, ptC.y )  Rot8_Trans( xRight, yBot, ptD.x, ptD.y )  End SubSub ImageInfo.SkewRect_Render(ByRef pDest As ImageInfo, _  ByVal x As Integer, ByVal y As Integer, _  ByVal wid_ As Integer, ByVal hgt_ As Integer)    #Macro InterpolatePoint(dest_,from_,to_)    dest_.x = from_.x + lerp * (to_.x - from_.x)    dest_.y = from_.y + lerp * (to_.y - from_.y)  #EndMacro    #Macro LayerSource_Components(aa_mul1, aa_mul2)    aa_fractional = aa_mul1 * aa_mul2    sRed += aa_fractional * ptrSource->R    sGrn += aa_fractional * ptrSource->G    sBlu += aa_fractional * ptrSource->B  #EndMacro    #Macro BoundsCheckSource(aa_mul1, aa_mul2)    If srcY >= 0 Then      If srcX >= 0 Then        If srcY < hgt Then          If srcX < wid Then            LayerSource_Components( aa_mul1, aa_mul2 )          EndIf        EndIf      EndIf    EndIf  #EndMacro    ClipVars()    Dim As Single aa_fractional, xGridStep = 1 / widM_    For yDest As Integer = yTop To yBot      Dim As Integer  yGrid = yDest + ClipTop        Dim As single     lerp = (yGrid - yTop) / hgtM_    Dim As srSngPoint ptAC = Any    Dim As srSngPoint ptBD = Any    InterpolatePoint( ptAC, ptA, ptC )    InterpolatePoint( ptBD, ptB, ptD )        Dim As UnionARGB Ptr ptrDest = pDest.pixels + yDest * pDest.pitch        For xDest As Integer = xLeft To xRight          Dim As Integer  xGrid = xDest + ClipLeft          Dim As srSngPoint srcFloatPos = Any            lerp = (xGrid - xLeft) * xGridStep ''div is slow      'lerp = (xGrid - xLeft) / widM_            InterpolatePoint( srcFloatPos, ptAC, ptBD )            Dim As Integer  srcX = srcFloatPos.x      Dim As Integer  srcY = srcFloatPos.y      Dim As Single   aa_Left = srcX + 1 - srcFloatPos.x      Dim As Single   aa_Top = srcY + 1 - srcFloatPos.y      Dim As Single   aa_Right = 1 - aa_Left      Dim As Single   aa_Bot = 1 - aa_Top            Dim As Single   sRed = 0.5      Dim As Single   sGrn = 0.5      Dim As Single   sBlu = 0.5            Dim As UnionARGB ptr ptrSource = pixels      ptrSource += srcY * pitchBy4 + srcX      BoundsCheckSource( aa_Left, aa_Top ) ''A            srcX += 1      ptrSource += 1      BoundsCheckSource( aa_Right, aa_Top ) ''B            srcY += 1      ptrSource += pitchBy4      BoundsCheckSource( aa_Right, aa_Bot ) ''D            srcX -= 1      ptrSource -= 1      BoundsCheckSource( aa_Left, aa_Bot ) ''C      ptrDest[xDest].B = sBlu      ptrDest[xDest].G = sGrn      ptrDest[xDest].R = sRed    Next  Next  End Sub'                             ''          ImageInfo          '' --------------------------- ''' ------------'     Main' ------------Dim as ImageInfo                OutputBuf, TexOutputBuf.ScreenInit  640,480Tex.LoadBMP filenameDim As Single                   scale = 0.7Dim As Single                   angle = -pi / 15#Include "fbgfx.bi"Using FBDim As EVENT  eDim As Single                   t1 = TimerDo While 1        If (ScreenEvent(@e)) Then      if e.type = EVENT_KEY_PRESS Then        Select Case e.scancode        Case SC_ESCAPE        End Select      Elseif e.type = EVENT_KEY_RELEASE Then                    Exit Do      End If    End If        Tex.SkewRect_ScaleRotate( scale, angle )    angle += 0.0005    scale += 0.0005            Dim As Integer  OutWid = Tex.wid / 2    Dim As Integer  OutHgt = Tex.hgt / 2        ScreenLock      Tex.SkewRect_Render( OutputBuf,1,1,OutWid,OutHgt )    ScreenUnLock            Sleep 20        If Timer - t1 > 25 Then Exit do    Loop'put the fpu back the way it wasset_fpu_rounding_mode(original_fpu_control_word)? "Demo finished.  Exiting .."Sleep 1600`
Last edited by dafhi on Dec 06, 2012 0:52, edited 4 times in total.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

### Re: Squares

very nice, dafhi, you are writing better (and readable) code
i can't give you full score, because the number #1 rule states: there's no better explanation given than code that explains itself
use self-explanatory variable names, and you can avoid many comments (and instead document usage and pitfalls)!
but, if there were a thumbs up feature, you'd have it

overall, the more advanced and complicated the code is, the greater the need to spam comments regardless of good variable naming
to make ourselves sane now, and in the future :)

you could also enclose functions and methods with () to emphasize it's a call or "jump" to another place in the code

edit: timers are double precision!
and on the subject of algorithms, this method can get a serious boost by for example a voxel traversal algorithm
which eliminates the need for lots of flops and trigonometry except in the setup stage (for each scanline)
it may be a significant net boost for larger images
here is the research paper (with implementation): http://www.cse.yorku.ca/~amana/research/grid.pdf
i also didn't particularly like all the if's that can be avoided per subpixel (including the variable)
the voxel traversal will work with 90 degrees as well, and we can assume the subpixels are its immediate (voxel-ray) neighbors
no need to use star pattern or rotated rings (like in improved ambience occlusion)
dodicat
Posts: 6030
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Thanks Dafhi.
I tried it out with an 1024 by 768 screen and just enlarging a small bitmap with angle=0.
The enlarged image is as good as or better than any previously coded for here in squares.
And you have speed.

I don't know about your machine, but If I enlarge (with my own thingy), then even if the new dimensions are 2000 by 1500 (way bigger than my windows settings), then the image still remains 1024 by 768 (My windows screen settings) and I can see all of it.
The bitmap, if saved is 2000 by 1500 though, and if I open it with PAINT I can only see part of it, as expected.

I've updated my own a bit, just creating and destroying images inside the resizer sub, which I should have done previously.
I can't get screen0 on top of the graphics screen, I think I'll try a little windows GUI with edit boxes and clickers to input new sizes e.t.c.
Anyway, I'll do that some other time.
Here's the update:

Code: Select all

`Dim  As String pictureDim Shared As Integer grayDim Shared As String gDim Shared As Single blurr=.7picture="parrot.bmp" ' <---  set your bitmap name or path to your bitmap name here'point and pset speeded up#macro ppoint(_x,_y,colour)pixel=row+pitch*(_y)+4*(_x)(colour)=*pixel#endmacro#macro ppset(_x,_y,colour)pixel=row+pitch*(_y)+4*(_x)*pixel=(colour)#endmacroType v2    As Integer x,y    col As UintegerEnd TypeType colour    As Integer r,g,bEnd TypeFunction size(bmp As String) As v2     Dim As Integer w,h    Open bmp For Binary As #1    Get #1, 19, w    Get #1, 23, h    Close #1    Return Type<v2>(w,h)End Function#macro consoleinput(stuff,variable)Open Cons For Input As #2consolePrint(stuff)Input #2,variableClose #2#endmacro#macro consoleprint(stuff)Open Cons For Output As #1Print #1, (stuff) & "  ";Close #1#endmacro'linear map from one range to another#macro map(a,b,_x_,c,d)((d)-(c))*((_x_)-(a))/((b)-(a))+(c)#endmacroFunction grey(c As Uinteger) As Uinteger    Var v=.299*((c Shr 16)And 255)+.587*((c Shr 8)And 255)+.114*(c And 255)    Return Rgb(v,v,v)End Function'could be inside the resize sub, doesn't matter#macro average()ar=0:ag=0:ab=0:inc=0xmin=x:If xmin>rad Then xmin=radxmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-xymin=y:If ymin>rad Then ymin=radymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-yFor y1 As Integer=-ymin To ymax    For x1 As Integer=-xmin To xmax        inc=inc+1         ar=ar+(picture2(x+x1,y+y1).col Shr 16 And 255)        ag=ag+(picture2(x+x1,y+y1).col Shr 8 And 255)        ab=ab+(picture2(x+x1,y+y1).col And 255)    Next x1Next y1averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))#endmacroSub resize(picture As String,_x As Integer,_y As Integer,flag As String="")    Dim  As Uinteger Pointer Tim    Dim  As Uinteger Pointer im    Dim As v2 dimension=size(picture)    Dim Scale_x As Double=_x/dimension.x    Dim Scale_y As Double=_y/dimension.y    im=Imagecreate(dimension.x,dimension.y)    tim=Imagecreate(_x,_y)        If flag<>"y" Then         'initial bitmap        If scale_x=1 And scale_y=1 Then             If gray=0 Then Bload picture,tim: Goto fin 'just bload instead of processing        End If                Scope 'Go through the processes            Bload picture,im            Dim As Double radius=.5*(Scale_x+Scale_y)            Dim As Integer pitch            Dim  As Any Pointer row            Dim As Uinteger Pointer pixel            Dim As Uinteger col            Imageinfo im,,,,pitch,row            For y As Integer=0 To (dimension.y-1)                For x As Integer=0 To (dimension.x-1)                    Dim As Integer xx=map(0,dimension.x,x,0,_x)                    Dim As Integer yy=map(0,dimension.y,y,0,_y)                    ppoint(x,y,col)                    If gray=1 Then col=grey(col)                    Line tim,(xx-scale_x,yy-scale_y)-(xx+scale_x,yy+scale_y),col,bf                Next x            Next y            If scale_x<=1 And scale_y<=1 Then 'no blur for scaling down.                Goto fin            End If            'blur stuff            Imageinfo tim,,,,pitch,row            Dim As v2 picture2(_x,_y)            'get points into an array            For y As Integer=0 To (_y)-1                For x As Integer=0 To (_x)-1                    ppoint(x,y,col)                    picture2(x,y)=Type<v2>(x,y,col)                Next x            Next y            'variables for the average macro            Dim As Uinteger averagecolour            Dim As Integer ar,ag,ab            Dim As Integer xmin,xmax,ymin,ymax,inc            Dim As Integer rad=Int(blurr*radius)'.7            For y As Integer=0 To _y-1                For x As Integer=0 To _x-1                      average()                    picture2(x,y).col=averagecolour                Next x            Next y            'final drawing to the image            For y As Integer=0 To _y                For x As Integer=0 To _x                    ppset(picture2(x,y).x,picture2(x,y).y,picture2(x,y).col)                 Next x            Next y        End Scope        fin:        Put(0,0),tim    End If '(flag <> "y")        If flag="y" Then        Bsave ( g+Rtrim(picture,".bmp") + "(" + Str(_x) + "," + Str(_y)+").bmp",0)    End If    If im Then Imagedestroy im    If tim Then Imagedestroy tim  End Sub'================ RUN =========================================Dim As Integer xres,yresScreeninfo xres,yresDim As Integer xresolution,yresolutionDim As String save,a,d,grayflagstart:Screen 0gray=0a=Str(size(picture).x)d=Str(size(picture).y)If a="0" Or d="0" Then Print Ucase(picture) + " not found, press a key":Sleep:EndPrint "Please keep this screen active to write to it"Print "Your picture is " + picture + "  @  " + a + " X " + d'Show the bitmap without any processingScreenres Valint(a),Valint(d),32 SCREENCONTROL(100, .5*xres,0)resize(picture,Valint(a),Valint(d),"")Do    'the bitmap is on a graphics screen now, but need the console to input.    consoleinput("Enter new  width ",xresolution)    consoleinput("Enter new height ",yresolution)Loop Until xresolution>0 And yresolution>0'In case of a typo error with some silly resizeIf xresolution>xres Or yresolution>yres Then    var w=""    Do        consoleprint ("NOTE --  A width or height is greater than your screen resolution")        consoleprint(Chr(10))        consoleinput("Do you want to continue with this?  (y/n) ",w)        w=Lcase(w)    Loop Until w="y" Or w="n"    If w="n" Then Goto startEnd IfIf xresolution>size(picture).x Or yresolution>size(picture).y Then    'go through the whole process if in here    Do        consoleinput("Enter blur (1 to 10)",blurr)    Loop Until blurr>=1 And blurr<=10    blurr=map(1,10,blurr,.45,.9)End IfDo    consoleinput("Do you want Gray image (y/n)",grayflag)    grayflag=Lcase(grayflag)Loop Until grayflag = "y" Or grayflag ="n"If grayflag="y" Then gray=1 Else gray=0'Set up a graphics screen the same dimensions as the bitmap at 0,0Screenres xresolution,yresolution,32 screencontrol(100,0,0)resize(picture,xresolution,yresolution,"")Do    consoleinput("Do you want to save (y/n) or q to quit",save)    save=Lcase(save)Loop Until save = "y" Or save ="n" Or save="q"If save="y" Then    If grayflag="y" Then g="gray "    consoleprint("you new bitmap is  " +g+ Rtrim(picture,".bmp") + "(" + Str(xresolution) + "," + Str(yresolution)+").bmp")End IfIf save="n" Then Goto startIf save="q" Then Endconsoleprint(Chr(10))consoleprint ("Click on image and Press a key")'final save if requestedresize(picture,xresolution,yresolution,save)Sleep `
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

### Re: Squares

Stonemonkey wrote:Hi, going back to the image scaling problem there's something that I've realised, it might be really obvious but I hadn't thought much about it before. Bilinear and the bicubic that I was looking at have a problem, in the situation of doubling the image each pixel is divided in to 4 (2*2), with the top left pixel retaining the colour of the original and the other 3 being interpolated. But when an image is scaled down to half size the pixel colour in the result is (usually) an average of the 4 meaning that the result doesn't correspond directly to any of the pixels used to calculate it.
So when doubling, I'm wondering if there's a way using the surrounding pixels along with the fact that the original pixel is the average, to calculate new pixel values.

if you want to do it right, it gets complex (but still very doable)
creating a kernel that correctly distributes weights according to the information lost or gained, centroidal sampling etc.
resizing 0.5x1.0 means you'll get 2 pixels on the x-side and no change on the y side
a possible solution is to determine number of weights needed, for example 1 for x and 0 for y, where 0 means do nothing
the 1 weight would be in between 2 pixels and thus 50% from each, and 100% from y using standard bilinear

with a resize of 0.5x0.5 there would be 2 weights, one for each dimension, using bilinear it would be equal to sampling 1 point in the center of 4 points

so you'll deal with variably sized kernels.. creating a static kernel is equal to blurring, which isn't what you wanted
it's straightforward for this simple approach :)
but it won't work when you want to do what equals to resampling, and i don't think you can get correct data when upsampling to say 1.1 x 1.0
i haven't thought long and hard about it, so maybe someone else can fill in :)

edit: see richard has already answered.. i haven't dealt with fft's but it's just filling a matrix with the proper coefficients
i imagine the order of operations does matter, but i'd have to read about it =)
rotation and AA is more interesting though :)

/me goes back to dealing with exams..
i wish i had exam in ... something related to this :/
dafhi
Posts: 1276
Joined: Jun 04, 2005 9:51

### Re: Squares

@Gonzo. Updated my code with renamings and such. Thanks for the pdf link. I like the fact that it's a short piece. I am dreaming about writing an anti-aliased line routine and intersections are huge.

@dodicat - Always great to read your glowing reviews. About the seeing-whole-image thing at high res, I've encountered that before :)
albert
Posts: 5313
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I think they need to put a "DEC" keyword to go with OCT , HEX , BIN

where you could do a

DEC( number , digits ) like BIN( number , digits ) or HEX( number , digits)

Right now to print out a certain number of decimal digits you have to use , Right( string( ?? , "0") + str(number) , digits)
dafhi
Posts: 1276
Joined: Jun 04, 2005 9:51

### Re: Squares

@Gonzo - I've made things more oo-friendly. Complex decision structures (not related to traversal) to remove about 10 bounds checks proved inconclusive, so am sticking with simplicity.
Last edited by dafhi on Dec 06, 2012 0:46, edited 3 times in total.