Squares

[Richard]

@ 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]

@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]

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 t
end type

function 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[0]-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 a
end function

dim 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 ";d
print
print "Short divide"

dim as pair ans
ans= shortdiv(n,d,1000000) ' a million places
print "answer = "
print mid(ans.s,1,200) + " ------ "
print "Length of answer = ";len(ans.s)
print
print "time = ";
print ans.t
print
print "float answer"
print str(val(mid(n,1,20))/val(d))
print "done"

sleep
 

[albert]

@Dodicat

Thanks , that's what I wanted to know about , now its on to finding away to undo the compression..

[Stonemonkey]

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]

@ 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]

@ 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]

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 picture
Dim Shared As Uinteger Pointer Tim
Dim Shared As Uinteger Pointer im
Dim Shared As Integer gray
Dim Shared As String g
dim shared as single blurr=.7
picture="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)
#endmacro

Type v2
    As Integer x,y
    col As Uinteger
End Type
Type colour
    As Integer r,g,b
End Type

Function 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 #2
consolePrint(stuff)
input #2,variable
Close #2
#endmacro

#macro consoleprint(stuff)
Open Cons For Output As #1
Print #1, (stuff) & "  ";
Close #1
#endmacro
#macro map(a,b,_x_,c,d)
((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
#endmacro
Function 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))
    #endmacro

Sub 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 If
End Sub
'================ RUN =========================================
dim as integer xres,yres
screeninfo xres,yres
Dim As Integer xresolution,yresolution
Dim As String save,a,d,grayflag
start:
Screen 0
gray=0
a=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 " + d
If size(picture).x=0 Or size(picture).y=0 Then Print "No bitmap, press a key":Sleep:End

Screenres 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>0
if 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 start
end if
If xresolution>size(picture).x or yresolution>size(picture).y Then
do
   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=0

Screenres 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 If
If save="n" Then Goto start
If save="q" Then imagedestroy im:imagedestroy tim: End
consoleprint(chr(10))
consoleprint ("Click on image and Press a key")

resize(picture,xresolution,yresolution,save)
Imagedestroy im
Imagedestroy tim
sleep

[dafhi]

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

[Updates]
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 pi
Const                             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 FALSE
Const FALSE = 0
Const TRUE = not FALSE
  #EndIf

'' http://www.freebasic.net/forum/viewtopic.php?f=3&t=20669#p181983
Function get_fpu_control_word()as integer
    asm fstcw [function]
end function
Sub set_fpu_control_word(byval cw as integer)
    asm fldcw [cw]
end sub
Sub 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 Sub
dim as integer original_fpu_control_word=get_fpu_control_word()

''  rounding mode:
'' 0=nearest
'' 1=round down
'' 2=round up
'' 3=truncate
set_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
#EndIf

Type srSngPoint
    As Single                     x,y
End Type

Type 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 Destructor
End Type
Operator ImageInfo.cast () As Any Ptr
  Return img
End Operator
Destructor ImageInfo
  Destroy
End Destructor
Sub 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.5
End Sub
Function 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 img

End Function
Sub ImageInfo.ScrInfo
  ScreenInfo wid ,hgt  , , bypp, pitch
  pixels = ScreenPtr
  varsCommon
End Sub
Function 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 pixels
End Function
Sub ImageInfo.Destroy()
  If img = 0 Then Exit Sub
  ImageDestroy img
  img = 0
End Sub
Sub 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 stosd
End Sub
Sub 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,Img
End 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
#EndMacro
Sub 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
  Next

End Sub
Sub 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 Sub

Sub 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, Tex

OutputBuf.ScreenInit  640,480

Tex.LoadBMP filename

Dim As Single                   scale = 0.7
Dim As Single                   angle = -pi / 15

#Include "fbgfx.bi"
Using FB
Dim As EVENT  e

Dim As Single                   t1 = Timer

Do 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 was
set_fpu_rounding_mode(original_fpu_control_word)

? "Demo finished.  Exiting .."

Sleep 1600

[Gonzo]

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]

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 picture
Dim Shared As Integer gray
Dim Shared As String g
Dim Shared As Single blurr=.7
picture="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)
#endmacro

Type v2
    As Integer x,y
    col As Uinteger
End Type
Type colour
    As Integer r,g,b
End Type

Function 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 #2
consolePrint(stuff)
Input #2,variable
Close #2
#endmacro

#macro consoleprint(stuff)
Open Cons For Output As #1
Print #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)
#endmacro

Function 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=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))
#endmacro

Sub 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,yres
Screeninfo xres,yres
Dim As Integer xresolution,yresolution
Dim As String save,a,d,grayflag
start:
Screen 0
gray=0
a=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:End

Print "Please keep this screen active to write to it"
Print "Your picture is " + picture + "  @  " + a + " X " + d
'Show the bitmap without any processing
Screenres 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 resize
If 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 start
End If
If 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 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=0
'Set up a graphics screen the same dimensions as the bitmap at 0,0
Screenres 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 If
If save="n" Then Goto start
If save="q" Then End
consoleprint(Chr(10))
consoleprint ("Click on image and Press a key")
'final save if requested
resize(picture,xresolution,yresolution,save)
Sleep


 

[Gonzo]

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]

@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]

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]

@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.