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)