Image=ImageScale(SrcImage,width,height) (8,15,16,24,32 bpp)

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Image=ImageScale(SrcImage,width,height) (8,15,16,24,32 bpp)

Post by D.J.Peters »

Download: fbimagescale.zip with 2 tests

I's simple without filtering.

Joshy

Code: Select all

' NewImage = ImageScale(SourceImage,width,height)
#include "fbgfx.bi"
function ImageScale(s as fb.Image ptr, _
                    w as integer, _
                    h as integer) as fb.Image ptr
  if s        =0 then return 0
  if s->width <1 then return 0
  if s->height<1 then return 0
  if w<4 then w=4
  if h<4 then h=4
  dim as fb.Image ptr t=ImageCreate(w,h)
  dim as integer xs=(s->width /t->Width ) * (1024*64)
  dim as integer ys=(s->height/t->height) * (1024*64)
  dim as integer x,y,sy
  select case as const s->bpp
    case 1
      dim as ubyte ptr ps=cptr(ubyte ptr,s)+32
      dim as uinteger   sp=s->pitch
      dim as ubyte ptr pt=cptr(ubyte ptr,t)+32
      dim as uinteger   tp=t->pitch-t->width
      for ty as integer = 0 to t->height-1
        dim as ubyte ptr src=ps+(sy shr 16)*sp
        for tx as integer = 0 to t->width-1
          *pt=src[x shr 16]:pt+=1:x+=xs
        next
        pt+=tp:sy+=ys:x=0
      next
    case 2
      dim as ushort ptr ps=cptr(ushort ptr,s)+16
      dim as uinteger   sp=(s->pitch shr 1)
      dim as ushort ptr pt=cptr(ushort ptr,t)+16
      dim as uinteger   tp=(t->pitch shr 1)-t->width
      for ty as integer = 0 to t->height-1
        dim as ushort ptr src=ps+(sy shr 16)*sp
        for tx as integer = 0 to t->width-1
          *pt=src[x shr 16]:pt+=1:x+=xs
        next
        pt+=tp:sy+=ys:x=0
      next
    case 4
      dim as uinteger ptr ps=cptr(uinteger ptr,s)+8
      dim as uinteger     sp=(s->pitch shr 2)
      dim as uinteger ptr pt=cptr(uinteger ptr,t)+8
      dim as uinteger     tp=(t->pitch shr 2)-t->width
      for ty as integer = 0 to t->height-1
        dim as uinteger ptr src=ps+(sy shr 16)*sp
        for tx as integer = 0 to t->width-1
          *pt=src[x shr 16]:pt+=1:x+=xs
        next
        pt+=tp:sy+=ys:x=0
      next
  end select
  return t
end function
Last edited by D.J.Peters on Oct 12, 2022 19:25, edited 2 times in total.
notthecheatr
Posts: 1759
Joined: May 23, 2007 21:52
Location: Cut Bank, MT
Contact:

Post by notthecheatr »

Was ist das algorithmik? Nearest neighbour, I assume?
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:

Post by cha0s »

Nice.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

notthecheatr wrote:Was ist das algorithmik? Nearest neighbour, I assume?
Nothing of this no filter it's simple resizing get for every target pixel one source pixel.
Of course the source coords are shifted integer's (roundet down)

loop over TargetX,TargetY
pset(TargetX,TargetY)=point(SourceX shr 16,SourceY shr 16)
SourceX+=XStep:SourceY+=YStep

Joshy
Last edited by D.J.Peters on Jan 31, 2008 7:09, edited 1 time in total.
reaktor
Posts: 18
Joined: Jan 17, 2008 21:01

Post by reaktor »

How hard would it be to make filtering for this kind of scaler, so that it would smoothen all edges such as HQ2X does? HQ2X / SuperSai and similar filters can make games look nice without putting lots of time for generating graphics?
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

reaktor@
HQ2X is a very good algo for scaling up
you can translate it to FreeBASIC
or make a static C lib with gcc.

Joshy
notthecheatr
Posts: 1759
Joined: May 23, 2007 21:52
Location: Cut Bank, MT
Contact:

Post by notthecheatr »

Most of those fast scaling filters only work for 2x, 3x, or 4x - i.e., there is no general filter for any-sized images (like D.J. Peters algorithm which simply performs Nearest Neighbour with no filtering whatsoever).

HQ2x, SuperSAI, Eagle, and all the others are all 2x scalers. General scaling filters like Bicubic for example are going to be much slower and not at all useful for real-time game applications (not to mention the fact that game graphics is generally supposed to look crisp and the general filters usually make things look rather blurry).

One solution might be to use one of those algorithms separately to make the image large, then use this scaler to make it more exact. The image won't look perfect, but it might look better. This might be the best solution if you want to resize things larger.


@D.J.Peters:
It would be nice if you optimized it - maybe in assembly? It gets 27 fps resizing the sample image to 1024x768x24... I bet it can do faster than that ;)
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

notthecheatr wrote:@D.J.Peters:
It would be nice if you optimized it - maybe in assembly? It gets 27 fps resizing the sample image to 1024x768x24... I bet it can do faster than that ;)
it's not good optimized but ok
how many fps count's your box?
and how many fps if you only use PUT() alone
i mean if you comment out only "ImageScale32(t,s)"

i get on my older box
29-31 fps with put and ImageScale32
49-56 fps with put alone

Joshy

Code: Select all

#include "fbgfx.bi"
const fshifts = 16
const fmul    = (1 shl fshifts)-1

'ImageScale(TargetImage,SourceImage)
sub ImageScale32(t as fb.Image ptr, _
                 s as fb.Image ptr)
  if t =0 then return 
  if s =0 then return
  if s->width <4 then return
  if s->height<4 then return
  if t->width <4 then return
  if t->height<4 then return
  dim as integer  w=t->width
  dim as integer  h=t->height
  dim as integer  xstep=(s->width /w) * fmul
  dim as integer  ystep=(s->height/h) * fmul
  dim as uinteger spitch=s->pitch
  dim as uinteger tpitch=(t->pitch shr 2)-w
  asm
    mov edi,[t]
    add edi,28 ' !!! not 32 
    mov ecx,[h]
    xor ebx,ebx
    yloop:
      push ecx
      mov  esi,[s]
      mov  ecx,[w]
      add  esi,32
      push ebx
      mov  eax,ebx
      shr  eax,fshifts
      mul  dword ptr [spitch]
      add  esi,eax
      mov  edx,[xstep]

      xor  ebx,ebx
      xloop:
        add  edi,4
        mov  eax,ebx
        shr  eax,fshifts
        mov  eax,[esi+eax*4]
        mov  [edi],eax
        add  ebx,edx

        dec  ecx
      jnz xloop

      pop  ebx
      add  edi,[tpitch]
      pop  ecx
      add  ebx,[ystep]

      dec  ecx
    jnz yloop
  end asm
end sub

dim as double t1,t2
dim as integer frames,fps
Screenres 1024,768,32,,1 '' 8,15,16,24,32
dim as fb.Image ptr s,t
s=ImageCreate(512,512,12345)
t=ImageCreate(1024,768)
bload "test24.bmp",s
t1=timer
while inkey=""
  ImageScale32(t,s) ' <-- comment it out too
  screenlock
  put(0,0),t,PSET
  locate 1,1:? "fps=" & fps
  screenunlock
  frames+=1
  if frames = 50 then
    t2=timer
    fps=frames/(t2-t1)
    t1=t2:frames=0
  end if
wend
end
notthecheatr
Posts: 1759
Joined: May 23, 2007 21:52
Location: Cut Bank, MT
Contact:

Post by notthecheatr »

On my home box (which is apparently quite faster than the school computer, which is really sad considering how slow my home box is):
-With scaling: 42-45 fps
-Without scaling: 66-81 fps

I'll check the school computer tomorrow, but that actually isn't too bad. I guess the school computer is just a really sucky computer :P
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

this means the scaling is a litle bit faster as the simple and fast MMX rectangle blit from put funy :-)

Joshy
spartacus13012
Posts: 18
Joined: Nov 30, 2014 12:37
Location: FRANCE

Re: Image=ImageScale(SrcImage,width,height) (8,15,16,24,32 bpp)

Post by spartacus13012 »

Hello from france


Since the release of version 1.05.00 of FB I use it in 64bits.
I just tried 'ImageScale' and it crashes in 64
On the other hand it works perfectly in 32
I use fbimage to load 'PNG' which works as well in 32 and 64.
An idea of the problem

my code

Code: Select all

	#include once "fbgfx.bi"
	#INCLUDE once "FBImage.BI"
	ScreenRes 1024, 768, 32
	DIM As UInteger col = RGB(128, 128, 128)
	LINE (10, 10)-(800, 600),  RGB(128, 128, 128),  BF

	function loadImage(BYVAL filename_ AS String) AS ANY PTR
		RETURN LoadRGBAFile(filename_)
	END FUNCTION
	
	SUB drawImage(BYVAL x_ AS UINTEGER, _ 
				  BYVAL y_ AS UINTEGER, _
				  BYVAL img_ AS ANY ptr)
		dim as integer i, w, h, spitch, dpitch
		dim as ubyte ptr s
		
		imageinfo img_, w, h, , spitch, s
		for y as integer = 1 to h
			i = 0
			for x as integer = 0 to w - 1
				IF s[i + 3] THEN 
					PSET(x + x_, y + y_), RGBA(s[i], s[i + 1], s[i + 2], s[i + 3])
				ENDIF
				
				i += 4 ' next source pixel
			next
			
			s += spitch ' next src row
		next
	END SUB
	
	FUNCTION scaleImage(s as Image ptr, _
						w as integer, _
						h as integer) as Image ptr
		if s = 0 then return 0
		if s->width < 1 then return 0
		if s->height < 1 then return 0
		if w < 4 then w = 4
		if h < 4 then h = 4
		
		dim as Image ptr 		t = ImageCreate(w, h)
		dim as integer 			xs = (s->width / t->Width ) * (1024 * 64)
		dim as integer 			ys = (s->height / t->height) * (1024 * 64)
		dim as integer 			x, y, sy
		
		select case as const s->bpp
			case 1
				dim as ubyte ptr 	ps = cptr(ubyte PTR, s) + 32
				dim as uinteger   	sp = s->pitch
				dim as ubyte ptr 	pt = cptr(ubyte ptr, t) + 32
				dim as uinteger   	tp = t->pitch - t->width
				
				for ty as integer = 0 to t->height - 1
					dim as ubyte ptr src = ps + (sy shr 16) * sp
					for tx as integer = 0 to t->width - 1
						*pt = src[x shr 16]
						pt += 1
						x += xs
					next
					
					pt += tp
					sy += ys
					x = 0
				next
			case 2
				dim as ushort ptr 		ps = cptr(USHORT ptr, s) + 16
				dim as uinteger  		sp = (s->pitch shr 1)
				dim as ushort ptr 		pt = cptr(ushort ptr, t) + 16
				dim as uinteger   		tp = (t->pitch shr 1) - t->width
				
				for ty as integer = 0 to t->height-1
					dim as ushort ptr src = ps + (sy shr 16) * sp
					for tx as integer = 0 to t->width - 1
						*pt = src[x shr 16]
						pt += 1
						x += xs
					next
					
					pt += tp
					sy += ys
					x = 0
				next
			case 4
				dim as uinteger ptr 	ps = cptr(UINTEGER ptr, s) + 8
				dim as uinteger     	sp = (s->pitch shr 2)
				dim as uinteger ptr 	pt = cptr(uinteger ptr, t) + 8  '
				dim as uinteger     	tp = (t->pitch shr 2) - t->width
				
				for ty as integer = 0 to t->height - 1
					dim as uinteger ptr src = ps + (sy shr 16) * sp
					for tx as integer = 0 to t->width - 1
						*pt = src[x shr 16]
						pt += 1
						x += xs
					next
					
					pt += tp
					sy += ys
					x = 0
				next
		END select	
		
		RETURN t
	END FUNCTION
	
		DIM AS STRING  		nom = "fblogo.png"
		DIM AS ANY PTR 		imgSrc = loadImage(nom)	
		DIM AS ANY PTR 		t	
		DRAWIMAGE(20, 20, imgSrc)	
		
		t = SCALEIMAGE(imgsrc, 200, 100)
		DRAWIMAGE(400, 300, t)
		
		IMAGEDESTROY imgSrc
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Image=ImageScale(SrcImage,width,height) (8,15,16,24,32 bpp)

Post by Tourist Trap »

spartacus13012 wrote:Hello from france
Hello compatriote. Have you tried to change every occurences of integer with long? Not sure if it can change anything. I still have a 32bits machine so I can not test your crash.
spartacus13012
Posts: 18
Joined: Nov 30, 2014 12:37
Location: FRANCE

Re: Image=ImageScale(SrcImage,width,height) (8,15,16,24,32 bpp)

Post by spartacus13012 »

Tourist Trap wrote:
spartacus13012 wrote:Hello from france
Hello compatriote. Have you tried to change every occurences of integer with long? Not sure if it can change anything. I still have a 32bits machine so I can not test your crash.
Thanks I will try in a few days
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Image=ImageScale(SrcImage,width,height) (8,15,16,24,32 bpp)

Post by UEZ »

D.J.Peters wrote:Download: fbimagescale.zip with 2 tests

I's simple without filtering.

Joshy

Code: Select all

' NewImage = ImageScale(SourceImage,width,height)
#include "fbgfx.bi"
function ImageScale(s as fb.Image ptr, _
                    w as integer, _
                    h as integer) as fb.Image ptr
  if s        =0 then return 0
  if s->width <1 then return 0
  if s->height<1 then return 0
  if w<4 then w=4
  if h<4 then h=4
  dim as fb.Image ptr t=ImageCreate(w,h)
  dim as integer xs=(s->width /t->Width ) * (1024*64)
  dim as integer ys=(s->height/t->height) * (1024*64)
  dim as integer x,y,sy
  select case as const s->bpp
    case 1
      dim as ubyte ptr ps=cptr(ubyte ptr,s)+32
      dim as uinteger   sp=s->pitch
      dim as ubyte ptr pt=cptr(ubyte ptr,t)+32
      dim as uinteger   tp=t->pitch-t->width
      for ty as integer = 0 to t->height-1
        dim as ubyte ptr src=ps+(sy shr 16)*sp
        for tx as integer = 0 to t->width-1
          *pt=src[x shr 16]:pt+=1:x+=xs
        next
        pt+=tp:sy+=ys:x=0
      next
    case 2
      dim as ushort ptr ps=cptr(ushort ptr,s)+16
      dim as uinteger   sp=(s->pitch shr 1)
      dim as ushort ptr pt=cptr(ushort ptr,t)+16
      dim as uinteger   tp=(t->pitch shr 1)-t->width
      for ty as integer = 0 to t->height-1
        dim as ushort ptr src=ps+(sy shr 16)*sp
        for tx as integer = 0 to t->width-1
          *pt=src[x shr 16]:pt+=1:x+=xs
        next
        pt+=tp:sy+=ys:x=0
      next
    case 4
      dim as uinteger ptr ps=cptr(uinteger ptr,s)+8
      dim as uinteger     sp=(s->pitch shr 2)
      dim as uinteger ptr pt=cptr(uinteger ptr,t)+8
      dim as uinteger     tp=(t->pitch shr 2)-t->width
      for ty as integer = 0 to t->height-1
        dim as uinteger ptr src=ps+(sy shr 16)*sp
        for tx as integer = 0 to t->width-1
          *pt=src[x shr 16]:pt+=1:x+=xs
        next
        pt+=tp:sy+=ys:x=0
      next
  end select
  return t
end function
I've an issue with your ImageScale function - at least I assume it. ^^
When I run the code below as x86 then the result is as expected but running the code below as x64 then the colors will be dithered (see screenshots below the code).

Code: Select all

'Ported from https://www.dwitter.net/d/9920 by cantelope to FB by UEZ build 2020-12-30

#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

Randomize
Dim As Integer w = 1920 Shr 0, h = 1080 Shr 0, w2 = w Shr 1, h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_FULLSCREEN
Screenset 1, 0

#Define Min(a, b)	(Iif(a < b, a, b))
#Define Max(a, b)	(Iif(a > b, a, b))
#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)
	   
Const f23 = 2 / 3, f13 = 1 / 3, f16 = 1 / 6

Function HUE2RGB(p As Single, q As Single, t As Single) As Single
	If t < 0 Then t += 1
	If t > 1 Then t -= 1
	If t < f16 Then Return p + (q - p) * 6 * t
	If t < 0.5 Then Return q
	If t < f23 Then Return p + (q - p) * (f23 - t) * 6
	Return p
End Function

Function HSL2RGB(H As Single, S As Single, L As Single, a As Ubyte = &hFF) As Ulong
	#Define to255(v)	(Max(0, Min(255, 256 * v)))
	Dim As Single r, g, b
	If S = 0 Then
		r = L : g = L : b = L
	Else
		Dim As Single p, q
		q = Iif(L < 0.5, L * (1 + S), L + S - L * S)
		p = 2 * L - q
		r = HUE2RGB(p, q, H + f13)
		g = HUE2RGB(p, q, H)
		b = HUE2RGB(p, q, H - f13)
	End If
	Return a Shl 24 Or to255(r) Shl 16 Or to255(g) Shl 8 Or to255(b) Shl 0
End Function

Function ImageScale(s As Image Ptr, w As Integer, h As Integer) As Image Ptr 'by D.J. Peters aka Joshy (https://www.freebasic.net/forum/viewtopic.php?t=10533#p91780)
	If s         = 0 Then Return 0
	If s->Width  < 1 Then Return 0
	If s->height < 1 Then Return 0
	If w < 4 Then w = 4
	If h < 4 Then h = 4
	Dim As Image Ptr t = Imagecreate(w, h)
	Dim As Long xs = (s->Width  / t->Width ) * &h10000 '(1024*64)
	Dim As Long ys = (s->height / t->height) * &h10000 '(1024*64)
	Dim As Integer x, y, sy
	Select Case As Const s->bpp
		Case 1
			Dim As Ubyte Ptr  ps = Cptr(Ubyte Ptr, s) + 32
			Dim As Uinteger   sp = s->pitch
			Dim As Ubyte Ptr  pt = Cptr(Ubyte Ptr, t) + 32
			Dim As Uinteger   tp = t->pitch - t->Width
			For ty As Integer = 0 To t->height - 1
				Dim As Ubyte Ptr src = ps + (sy Shr 16) * sp
				For tx As Integer = 0 To t->Width - 1
					*pt = src[x Shr 16] : pt += 1 : x += xs
				Next
				pt += tp : sy += ys : x = 0
			Next
		Case 2
			Dim As Ushort Ptr ps = Cptr(Ushort Ptr, s) + 16
			Dim As Uinteger   sp = (s->pitch Shr 1)
			Dim As Ushort Ptr pt = Cptr(Ushort Ptr, t) + 16
			Dim As Uinteger   tp = (t->pitch Shr 1) - t->Width
			For ty As Integer = 0 To t->height - 1
				Dim As Ushort Ptr src = ps + (sy Shr 16) * sp
				For tx As Integer = 0 To t->Width - 1
					*pt = src[x Shr 16] : pt += 1 : x + = xs
				Next
				pt += tp : sy += ys : x = 0
			Next
		Case 4
			Dim As Ulong Ptr ps= Cptr(Ulong Ptr,s) + 8
			Dim As Ulong     sp= (s->pitch Shr 2)
			Dim As Ulong Ptr pt= Cptr(Ulong Ptr,t) + 8
			Dim As Ulong     tp= (t->pitch Shr 2) - t->Width
			For ty As Long = 0 To t->height - 1
				Dim As Ulong Ptr src = ps + (sy Shr 16) * sp
				For tx As Long = 0 To t->Width - 1
					*pt = src[x Shr 16] : pt += 1 : x += xs
				Next
				pt += tp : sy += ys : x = 0
			Next
	End Select
	Return t
End Function

Dim As ULong iFPS, cfps = 0
Dim As Double fTimer = Timer, t = 0
Dim As Single x, y, dx = (w * 1.08333 - w) / 2 + 0.5, dy = (h * 1.08333 - h) / 2 + 0.5, wx = w * 1.08333, wy = h * 1.08333
Dim As Any Ptr pImage1 = Imagecreate(w, h, 0, 32), pImage2

Do
	x = Sin(t) * 3
	y = Cos(t) * 3
	Circle pImage1, (w2, h2), 5, HSL2RGB(fmod(t * 350, 719) / 360, 0.9, fmod(t, 99) / 100, &hCF),,,, F
	pImage2 = ImageScale(pImage1, wx, wy)
	Put pImage1, (-dx + x, -dy + y), pImage2, Alpha
	Imagedestroy(pImage2)
	t += 1
	Put (0, 0), pImage1, Pset

	Draw String(4, 4), iFPS & " fps", &hFFFFFFFF
	
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())

Imagedestroy(pImage1)
x86:
Image

x64:
Image

Do you acknowledge it?
Post Reply