' Image Scaler
' Original by D.J.Peters
' fork mieki256

#ifndef __IMAGESCALE__
#define __IMAGESCALE__

#lang "fb"
#include "fbgfx.bi"
Using fb

' Image scaler draw to screen
Function ImageScale2Screen(byval s as fb.Image ptr, ByVal ox As Integer, ByVal oy As Integer, byval w as integer, byval h as integer) As Boolean

    if s = 0 then Return False

    ' get image information
    Dim As any ptr srcpixdata
    ImageInfo s, , , , , srcpixdata

    if s->width  < 1 then Return False
    if s->height < 1 then return False

    if w < 2 then w = 1
    if h < 2 then h = 1

    ' get screen information
    Dim As long tw, th, tdepth, tbpp, tpitch
    ScreenInfo tw, th, tdepth, tbpp, tpitch
    Dim As Any Ptr tgtpixdata = Screenptr()

    ' check out of area
    If ox < 0 Then Return False
    If oy < 0 Then Return False
    If (ox + w - 1) >= tw Then Return False
    If (oy + h - 1) >= th Then Return False

    ' fixed point 12:20
    dim as integer xs = (s->width  / w) * (&H100000)
    dim as integer ys = (s->height / h) * (&H100000)

    dim as uinteger sp = (s->pitch / s->bpp)
    dim as uinteger tp = (tpitch / s->bpp) - w
    dim as integer x = 0, sy = 0

#macro SCALELOOP()
    pt += cast(uinteger, (((tpitch / s->bpp) * oy) + ox))
    for ty as integer = 0 to h - 1
        src = ps + (sy shr 20) * sp
        x = 0
        for tx as integer = 0 to w - 1
            *pt = src[x shr 20]
            pt +=1
            x += xs
        next
        pt += tp
        sy += ys
    next
#endmacro

    select case as const s->bpp
    case 1
        ' 8bit mode
        dim as ubyte ptr ps = cptr(ubyte ptr, srcpixdata)
        dim as ubyte ptr pt = cptr(ubyte ptr, tgtpixdata)
        dim as ubyte ptr src
        SCALELOOP()
    case 2
        ' 16bit mode
        dim as ushort ptr ps = cptr(ushort ptr, srcpixdata)
        dim as ushort ptr pt = cptr(ushort ptr, tgtpixdata)
        dim as ushort ptr src
        SCALELOOP()
    case 4
        ' 32bit mode
        dim as ulong ptr ps = cptr(ulong ptr, srcpixdata)
        dim as ulong ptr pt = cptr(ulong ptr, tgtpixdata)
        dim as ulong ptr src
        SCALELOOP()
    End Select

#undef SCALELOOP
    Return True
End Function

#endif