When I'm using the DrawLineAAWu function instead then it works without crashing.
Code: Select all
'Ported from https://www.dwitter.net/d/7495 by jylikangas to FB by UEZ build 2023-12-12
#Include "crt/math.bi"
#Include "fbgfx.bi"
Using FB
#Define _Alpha(iCol) ((iCol And &hFF000000) Shr 24)
#Define _Red(iCol) ((iCol And &h00FF0000) Shr 16)
#Define _Green(iCol) ((iCol And &h0000FF00) Shr 8)
#Define _Blue(iCol) ((iCol And &h000000FF))
'#Define Floor(x) (((x) * 2.0 - 0.5) Shr 1)
Function ColBlend(col1 As Ulong, col2 As Ulong, blend As Single) As Ulong
Dim As Single bl = 1 - blend
Return Rgba(_Red(col1) * blend + _Red(col2) * bl, _Green(col1) * blend + _Green(col2) * bl, _Blue(col1) * blend + _Blue(col2) * bl, _Alpha(col1) * blend + _Alpha(col2) * bl)
End Function
#Define fpart(x) (Frac(x))
#Define rfpart(x) (1 - Frac(x))
'https://en.wikipedia.org/wiki/Xiaolin_Wu%27s_line_algorithm
Sub DrawLineAAWu(x0 As Long, y0 As Long, x1 As Long, y1 As Long, _col As Ulong, pImage As Any Ptr = 0)
Dim As Boolean steep = Abs(y1 - y0) > Abs(x1 - x0)
If steep Then
Swap x0, y0
Swap x1, y1
End If
If x0 > x1 Then
Swap x0, x1
Swap y0, y1
End If
Dim As Long dx_, dy, xend, yend, xgap, xpxl1, ypxl1, xpxl2, ypxl2
Dim As Single gradient, intery, f
Dim As Ulong _rgb = _col And &h00FFFFFF
Dim As Ubyte a = _Alpha(_col)
dx_ = x1 - x0
dy = y1 - y0
gradient = dy / dx_
If dx_ = 0 Then gradient = 1
'handle first endpoint
xend = Round(x0)
yend = y0 + gradient * (xend - x0)
xgap = rfpart(x0)
xpxl1 = xend
ypxl1 = Floor(yend)
If steep Then
f = rfpart(yend) * xgap
Pset pImage, (ypxl1, xpxl1), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
Pset pImage, (ypxl1 + 1, xpxl1), (a * f) Shl 24 Or _rgb
Else
f = rfpart(yend) * xgap
Pset pImage, (xpxl1, ypxl1), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
Pset pImage, (xpxl1, ypxl1 + 1), (a * f) Shl 24 Or _rgb
End If
intery = yend + gradient
'handle second endpoint
xend = Round(x1)
yend = y1 + gradient * (xend - x1)
xgap = rfpart(x1)
xpxl2 = xend
ypxl2 = Floor(yend)
If steep Then
f = rfpart(yend) * xgap
Pset pImage, (ypxl2, xpxl2), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
Pset pImage, (ypxl2 + 1, xpxl2), (a * f) Shl 24 Or _rgb
Else
f = rfpart(yend) * xgap
Pset pImage,(xpxl2, ypxl2), (a * f) Shl 24 Or _rgb
f = fpart(yend) * xgap
Pset pImage, (xpxl2, ypxl2 + 1), (a * f) Shl 24 Or _rgb
End If
'main line
If steep Then
For x As Short = xpxl1 + 1 to xpxl2 - 1
f = rfpart(intery)
Pset pImage, (Floor(intery), x), (a * f) Shl 24 Or _rgb
f = fpart(intery)
Pset pImage, (Floor(intery) + 1, x), (a * f) Shl 24 Or _rgb
intery += gradient
Next
Else
For x As Short = xpxl1 + 1 to xpxl2 - 1
f = rfpart(intery)
Pset pImage, (x, Floor(intery)), (a * f) Shl 24 Or _rgb
f = fpart(intery)
Pset pImage, (x, Floor(intery) + 1), (a * f) Shl 24 Or _rgb
intery += gradient
Next
End If
End Sub
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 Long x, y, sy
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
Return t
End Function
Const _t = 1 / 60
Dim As Long _s = 4, iw = 198 * 2, ih = Int(iw * 9 / 16), iw2 = iw Shr 1, ih2 = ih Shr 1
Screenres _s * iw, _s * ih, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH 'Or GFX_NO_FRAME 'Or GFX_ALWAYS_ON_TOP 'Or GFX_FULLSCREEN
Screenset 1, 0
Dim Shared As Any Ptr pImage, pImage_scaled, pImage2
pImage = Imagecreate(iw, ih, 0, 32)
pImage2 = Imagecreate(iw, ih, 0, 32)
Dim As Ulong iFPS, cfps = 0
Dim As Double t = 0, tt, fTimer = Timer
Dim As Single px, py, pxo, pyo, x, y, z
Dim As Long i
Do
tt = t
Line pImage, (0, 0) - (iw, ih), &h18FFFFFF, BF
pImage2 = Imagecreate(iw, ih, &h01FFFFFF, 32)
For i = 15 To 0 Step -1
t += ((7 - i) Mod 2) / 0.64
z = Cos(t) + 1 + IIf(t < 6, 1, 0)
x = iw2 + Sin(t) * iw2 / z
y = ih2 + (((i Mod 4) \ 2 Shl 7) - 50) / z
'If i < 15 Then Line pImage2, (pxo, pyo) - (Cshort(x), Cshort(y)), &h88000000
'pxo = Cshort(x)
'pyo = Cshort(y)
If i < 15 Then DrawLineAAWu(pxo, pyo, x, y, &h60000000, pImage2)
pxo = x
pyo = y
Put pImage2, (0 , i), pImage2, Alpha
Next
t = tt
t += _t
Put pImage, (0 , 0), pImage2, Alpha
pImage_scaled = ImageScale(pImage, _s * iw, _s * ih)
Put (0, 0), pImage_scaled, PSet
Imagedestroy(pImage_scaled)
Imagedestroy(pImage2)
Draw String(4, 4), iFPS & " fps", &hFF000000
Flip
cfps += 1
If Timer - fTimer > 0.99 Then
iFPS = cfps
cfps = 0
fTimer = Timer
End If
Sleep (1)
Loop Until Len(Inkey())
Imagedestroy(pImage)