10.03.2019 - Round 1 results of our "A Love Letter For FreeBASIC" game dev competition have been published. Please be sure to check the results thread: http://games.freebasic.net/forum/index.php?topic=629.0. Don't forget that the competition is continuing with a round 2, lasting till 29th of April, 300 USD first prize. Stay tuned!

Author Topic: ScaleHalf  (Read 3596 times)

notthecheatr

  • Global Moderator
  • Forum Sage
  • *****
  • Posts: 351
  • Who's the guy from 21 Jump Street?
    • AOL Instant Messenger - notthecheatr
    • Yahoo Instant Messenger - TheMysteriousStrangerFromMars
    • View Profile
    • notthecheatr Home
    • Email
ScaleHalf
« on: January 22, 2008, 03:58:20 PM »
This takes an image and scales it to one-fourth its original size (one half on each dimension);  works best if the original dimensions are even, otherwise an extra row of pixels might be ignored.  Only 32-bit colour supported, since it's much easier (I can just grab a whole uInteger at a time from the buffer, rather than trying to figure out the individual r, g, and b components byte-by-byte - and don't even think about 16-bit, too darned complicated.  I'm not an assembly wizard, sorry!)

The example program loads two 800x600x32 images (named "img.bmp" and "test.bmp" - if you've tried my Special FX objects you can use the same images) and scales them down one or more times (it asks how many times you want it to repeat the procedure - anything higher than 9 is unnoticeable, though).

Code: [Select]
#Include Once "fbgfx.bi"

Function scalehalf (origImg As FB.Image Ptr) As FB.Image Ptr

'If the image isn't 32-bit, forget it
If origImg->Bpp <> 4 Then Return 0

'Get width and height of original image
Dim As uInteger w = origImg->Width, h = origImg->Height

'If they're too small, exit
If w = 1 Then Return 0
If h = 1 Then Return 0

'Second image will be first divided by two;  shifting is always faster than dividing, and it does the same thing
Dim As uInteger nw = w Shr 1, nh = h Shr 1

'Create the second image
Dim As FB.Image Ptr newimg = ImageCreate(nw, nh, 0, 32)

'Get pointers directly to the image data
Dim As uInteger Ptr origPixels = CPtr(uInteger Ptr, origImg + 1)
Dim As uInteger Ptr newPixels = CPtr(uInteger Ptr, newImg + 1)

'Pixel values of every four pixels
Dim As uInteger p1, p2, p3, p4

'Totals for Alpha/Green and Red/Blue (calculated simultaneously for higher speed)
Dim As uInteger agTotal, rbTotal

'Amount to add to the integer pointer each time - divide the pitch by four to get
'uIntegers per line (pitch = bytes per line, uInteger = 4 bytes - addo is Shr 1 instead because
'it needs to be Shl 1 later, this way we don't need to do it inside the loop (don't ask me why
'this is the case, I can't remember)
Dim As uInteger addo = (origImg->Pitch) Shr 1, addn = (newimg->Pitch) Shr 2

  'For each row
  For y As uInteger = 0 To (nh-1)
    'For each column
    For x As uInteger = 0 To (nw-1)
      'Get the first two pixels - we multiply by 2 (that's what Shl 1 does) because the original image
      'has two pixels in each dimension for every one the destination image has
      p1 = origPixels[(x Shl 1)]
      p2 = origPixels[(x Shl 1)+1]

      'If the second two are outside of the image, just use the first two again
      If y >= nh-1 Then
      p3 = origPixels[(x Shl 1)]
        p4 = origPixels[(x Shl 1)+1]
      Else
        p3 = origPixels[(x Shl 1)+(addo)]
        p4 = origPixels[(x Shl 1)+(addo)+1]
      End If
     
      'We calculate red and blue together - since they're a byte apart each, they cannot possibly mix
      'This is faster than the other way.
      rbTotal = (p1 And &hff00ff) + (p2 And &hff00ff) + (p3 And &hff00ff) + (p4 And &hff00ff)
      'Take the average
      rbTotal Shr= 2
     'And throw out the carry bits, keeping only the bits in their proper range
      rbTotal And= &hff00ff
     
      'Now calculate green and alpha together;  this one we have to shift over 8 bits or else alpha might
      'overflow through the top
      agTotal = ((p1 And &hff00ff00) Shr 8) + ((p2 And &hff00ff00) Shr 8) + ((p3 And &hff00ff00) Shr 8) + ((p4 And &hff00ff00) Shr 8)
      'Get average
      agTotal Shr= 2
      'Once again throw out the carry bits
      agTotal And= &hff00ff
      'And shift it back up 8 bits to where it was before
      agTotal Shl= 8
     
      'Add the two results together to get the new pixel value
      newPixels[x] = rbTotal + agTotal
    Next x

    'Add the correct amount to each pointer
    origPixels += addo
    newPixels += addn
  Next y
Return newimg
End Function

Sub scaleDraw (todraw As FB.Image Ptr, x As Integer = 0, y As Integer = 0, times As uInteger = 1)
Dim As FB.Image Ptr newimg = 0, img2 = 0

If times = 0 Then
Put (x, y), todraw
Exit Sub
EndIf

newimg = scalehalf(todraw)

If times > 1 Then
While times > 1
times -= 1
img2 = scalehalf(newimg)
If img2 = 0 Then Exit While
Swap newimg, img2
ImageDestroy(img2)
img2 = 0
Wend
End If

If newimg <> 0 Then Put (x, y), newimg, PSet

ImageDestroy(newimg)
If img2 <> 0 Then ImageDestroy(img2)
End Sub

Sub loadDraw (fname As String, x As Integer = 0, y As Integer = 0, times As uInteger = 1)
Dim As FB.Image Ptr myimg = ImageCreate(800, 600, 0, 32)
BLoad fname, myimg

scaleDraw(myimg, x, y, times)

ImageDestroy(myimg)
End Sub

Dim As Single t0
Dim As Single t1

Dim As uInteger ntimes

Print "How many times shall I scale the images down?"
Input ntimes

ScreenRes 800, 600, 32

t0 = timer

loadDraw("test.bmp", 0, 0, ntimes)
loadDraw("img.bmp", 400, 0, ntimes)

t1 = Timer

Draw String (0, 500), "Quarter-scaled two 800x600 images " + Str(ntimes) + " times in " + Str(t1-t0) + " seconds."

Sleep

End

Half of that's just the example program;  if you want to scale your images in half you only need the sub scaleHalf() function which takes an image buffer pointer and returns an image buffer pointer (doesn't modify the original).  The whole thing's well-commented, though likely if you don't have a good understanding of fbgfx none of it will make sense to you.  Suffice to say that if you have an image buffer myimg and you want to make it a quarter of its total size, then draw it, you would do it like this:

Code: [Select]
Dim As FB.Image Ptr newimg = scalehalf(myimg)

Put (0, 0), myimg

And that's all you need to know!

Enjoy, and I wouldn't mind getting some feedback, comments, errata, etc.
« Last Edit: January 23, 2008, 06:37:32 PM by notthecheatr »
The funniest thing happened yesterday.

Lachie Dazdarian

  • Double dipper
  • Administrator
  • Forum Sage
  • *****
  • Posts: 1308
    • Yahoo Instant Messenger - lachie13
    • View Profile
    • The Maker Of Stuff
    • Email
Re: ScaleHalf
« Reply #1 on: January 22, 2008, 04:30:50 PM »
Cool. The results seem very good. Did you used some pre-made scaling algorithm or you came up with yours?
"Things like Basic and Free Basic provide much-needed therapy and a return to sanity and a correct appreciation of people. The arrogant folk really hate a word like 'Basic' - fine, and good riddance." ~ pragmatist

notthecheatr

  • Global Moderator
  • Forum Sage
  • *****
  • Posts: 351
  • Who's the guy from 21 Jump Street?
    • AOL Instant Messenger - notthecheatr
    • Yahoo Instant Messenger - TheMysteriousStrangerFromMars
    • View Profile
    • notthecheatr Home
    • Email
Re: ScaleHalf
« Reply #2 on: January 22, 2008, 04:45:26 PM »
Well I didn't copy anyone else's code or algorithm if that's what you mean.  How to do it is intuitively obvious (since it's just scaling in half, every pixel in the destination is the average of four from the source), though, so I wouldn't call it an original program;  I just had to figure out how to implement it properly.
The funniest thing happened yesterday.

notthecheatr

  • Global Moderator
  • Forum Sage
  • *****
  • Posts: 351
  • Who's the guy from 21 Jump Street?
    • AOL Instant Messenger - notthecheatr
    • Yahoo Instant Messenger - TheMysteriousStrangerFromMars
    • View Profile
    • notthecheatr Home
    • Email
Re: ScaleHalf
« Reply #3 on: January 23, 2008, 07:02:53 PM »
Edit:

Did some optimizations, changed all the multiplications and divisions to Shl/Shr which is much faster (I tried this earlier and it crashed, but that of course was due to other problems I've since fixed).  There's also a missing conditional, which should speed it up a bit, and a few shifts have been eliminated since they could be done outside of the loops.  Finally, thanks to Stonemonkey on the FB forums the routine now calculates Alpha/Green and Red/Blue together, using far fewer shift operations than before and working inside two uIntegers instead of four uShorts.

The difference is not very noticable, but it should help some anyways.  Both get about 98fps when scaling one 800x600 image and doing nothing else (the version of the code given above will be significantly slower since it loads an image every time it draws it, not to mention the fact that it's doing two images instead of one);  I imagine it could be even faster if registers were used, but I'm not entirely sure of my assembly skills just yet.
The funniest thing happened yesterday.

KristopherWindsor

  • Forum Sage
  • *****
  • Posts: 363
  • The Thirsty Smiley
    • View Profile
    • Reddit/r/pics
    • Email
Re: ScaleHalf
« Reply #4 on: January 24, 2008, 12:06:59 AM »
Nice. :) My image scaler had more capabilities but I'm sure this is much faster.

BTW, Timer should only be used with Doubles, and you only need one variable:

t = timer
scale()
t = timer - t

;)

notthecheatr

  • Global Moderator
  • Forum Sage
  • *****
  • Posts: 351
  • Who's the guy from 21 Jump Street?
    • AOL Instant Messenger - notthecheatr
    • Yahoo Instant Messenger - TheMysteriousStrangerFromMars
    • View Profile
    • notthecheatr Home
    • Email
Re: ScaleHalf
« Reply #5 on: January 24, 2008, 10:59:44 AM »
Well this one is very fast because it's only for halving.  You can make a more featureful one, but it likely won't be as fast.

Thanks, I'll remember that.
The funniest thing happened yesterday.