@dbox
I have code down to an error about a token, but where? what line is it finding this?
I got rid of &'s and then the GOSUB, still has a problem.
All I think of is the Function GrowCheese was supposed to return a long type but without & can't do it
This code still works fine in QB64pe, Almost QBJS acceptable (I think):
Nope, still allot more stuff to change eg, get rid of BF's that only draw lines or is it the , ,BF it doesn't like?
Everything Dim'd and still problems with code that runs fine in QB64 PE
I have code down to an error about a token, but where? what line is it finding this?
I got rid of &'s and then the GOSUB, still has a problem.
All I think of is the Function GrowCheese was supposed to return a long type but without & can't do it
This code still works fine in QB64pe, Almost QBJS acceptable (I think):
Code: (Select All)
_Title "Cheese + Sphere = Moon" 'b+ 2022-05-20
Randomize Timer
Const wW = 1280, wH = 720
Screen _NewImage(wW, wH, 32)
'_ScreenMove 80, 0
'_MouseHide
Dim stars As Long
stars = _LoadImage("stars.png")
Dim map(1 To 2) As Long
For i = 1 To 2
map(i) = growCheese
_PutImage , map(i), 0
Next
Do While _KeyDown(27) = 0
Cls
For i = 1 To 2
Select Case i
Case 1: x = 300: y = 175: rr = 120
Case 2: x = 900: y = 500: rr = 350
Case 3: x = 1175: y = 525: rr = 90
Case 4: x = 300: y = 540: rr = 151
End Select
xoff = (_Width(map(i)) + xoff - _Height(map(i)) / 360) Mod _Width(map(i))
projectImagetoSphere map(i), x, y, rr, xoff
Next
_Display
_Limit 60
Loop
Sub projectImagetoSphere (image, x0, y0, sr, xo)
Dim pc As _Unsigned Long
r = _Height(image) / 2
iW = _Width(image) - 20
iH = _Height(image)
scale = sr / r
For y = -r To r
x1 = Sqr(r * r - y * y)
tv = (_Asin(y / r) + 1.5) / 3
For x = -x1 + 1 To x1
tu = (_Asin(x / x1) + 1.5) / 6
_Source image
pc = Point((xo + tu * iW) Mod iW, tv * iH)
_Dest 0
PSet (x * scale + x0, y * scale + y0), pc
Next x
Next y
End Sub
Function growCheese () 'make this more self contained than first version, all hole stuff just in here
Dim As Long curr, map
curr = _Dest
map = _NewImage(wW, wH, 32)
_Dest map
nHoles = Rnd * 200 + 50: maxHoleLife = 10: maxHoleRadius = Rnd * 10 + 7: tfStart = 1
Dim hx(nHoles), hy(nHoles), hLife(nHoles)
For i = 1 To nHoles
hx(i) = wW * Rnd
hy(i) = wH * Rnd
If tfStart Then hLife(i) = Int(Rnd * maxHoleLife) Else hLife(i) = 1
Next
r = Rnd * 155 + 100: g = Rnd * 255: b = Int(Rnd * 2) * (Rnd * 155 + 100)
tfStart = 0
For layr = 1 To 30
Line (0, 0)-(wW, wH), _RGBA32(r, g, b, 50), BF 'layer of cheese
For i = 1 To nHoles 'holes in layer
If hLife(i) + 1 > maxHoleLife Then
hx(i) = wW * Rnd
hy(i) = wH * Rnd
If tfStart Then hLife(i) = Int(Rnd * maxHoleLife) Else hLife(i) = 1
Else
hLife(i) = hLife(i) + 1
End If
hx(i) = hx(i) + Rnd * 2 - 1
hy(i) = hy(i) + Rnd * 2 - 1
If hLife(i) < maxHoleRadius Then
radius = hLife(i)
ElseIf maxHoleLife - hLife(i) < maxHoleRadius Then
radius = maxHoleLife - hLife(i)
Else
radius = maxHoleRadius
End If
Color _RGBA32(0, 0, 0, 80)
fcirc hx(i), hy(i), radius
Next
Next
_Dest curr
growCheese = map
End Function
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), , BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
Wend
End SubNope, still allot more stuff to change eg, get rid of BF's that only draw lines or is it the , ,BF it doesn't like?
Everything Dim'd and still problems with code that runs fine in QB64 PE
Code: (Select All)
Option _Explicit
_Title "Cheese + Sphere = Moon" 'b+ 2022-05-20
Randomize Timer
Const wW = 1280, wH = 720
Screen _NewImage(wW, wH, 32)
'_ScreenMove 80, 0
'_MouseHide
Dim As Long stars, i
stars = _LoadImage("stars.png")
Dim map(1 To 2) As Long
For i = 1 To 2
map(i) = growCheese
_PutImage , map(i), 0
Next
Dim As Long xoff, x, y, rr
Do While _KeyDown(27) = 0
Cls
For i = 1 To 2
Select Case i
Case 1: x = 300: y = 175: rr = 120
Case 2: x = 900: y = 500: rr = 350
Case 3: x = 1175: y = 525: rr = 90
Case 4: x = 300: y = 540: rr = 151
End Select
xoff = (_Width(map(i)) + xoff - _Height(map(i)) / 360) Mod _Width(map(i))
projectImagetoSphere map(i), x, y, rr, xoff
Next
_Display
_Limit 60
Loop
Sub projectImagetoSphere (image, x0, y0, sr, xo)
Dim pc As _Unsigned Long
Dim r, iW, IH, y, x
Dim scale, x1, tv, tu
r = _Height(image) / 2
iW = _Width(image) - 20
IH = _Height(image)
scale = sr / r
For y = -r To r
x1 = Sqr(r * r - y * y)
tv = (_Asin(y / r) + 1.5) / 3
For x = -x1 + 1 To x1
tu = (_Asin(x / x1) + 1.5) / 6
_Source image
pc = Point((xo + tu * iW) Mod iW, tv * IH)
_Dest 0
PSet (x * scale + x0, y * scale + y0), pc
Next x
Next y
End Sub
Function growCheese () 'make this more self contained than first version, all hole stuff just in here
Dim As Long curr, map, nHoles, maxHoleLife, maxHoleRadius, tfStart, i, r, g, b, layr, radius
curr = _Dest
map = _NewImage(wW, wH, 32)
_Dest map
nHoles = Rnd * 200 + 50: maxHoleLife = 10: maxHoleRadius = Rnd * 10 + 7: tfStart = 1
Dim hx(nHoles), hy(nHoles), hLife(nHoles)
For i = 1 To nHoles
hx(i) = wW * Rnd
hy(i) = wH * Rnd
If tfStart Then hLife(i) = Int(Rnd * maxHoleLife) Else hLife(i) = 1
Next
r = Rnd * 155 + 100: g = Rnd * 255: b = Int(Rnd * 2) * (Rnd * 155 + 100)
tfStart = 0
For layr = 1 To 30
Line (0, 0)-(wW, wH), _RGBA32(r, g, b, 50), BF 'layer of cheese
For i = 1 To nHoles 'holes in layer
If hLife(i) + 1 > maxHoleLife Then
hx(i) = wW * Rnd
hy(i) = wH * Rnd
If tfStart Then hLife(i) = Int(Rnd * maxHoleLife) Else hLife(i) = 1
Else
hLife(i) = hLife(i) + 1
End If
hx(i) = hx(i) + Rnd * 2 - 1
hy(i) = hy(i) + Rnd * 2 - 1
If hLife(i) < maxHoleRadius Then
radius = hLife(i)
ElseIf maxHoleLife - hLife(i) < maxHoleRadius Then
radius = maxHoleLife - hLife(i)
Else
radius = maxHoleRadius
End If
Color _RGBA32(0, 0, 0, 80)
fcirc hx(i), hy(i), radius
Next
Next
_Dest curr
growCheese = map
End Function
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY)
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X)
Line (CX - Y, CY + X)-(CX + Y, CY + X)
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y)
Line (CX - X, CY + Y)-(CX + X, CY + Y)
Wend
End SubCode: (Select All)
WARN : 1 : Missing or unsupported method: 'Option' - ignoring line
ERROR : 26 :
Cannot read properties of undefined (reading 'toString')
TypeError: Cannot read properties of undefined (reading 'toString')
at Object.toString (https://qbjs.org/qb.js:545:40)
at isNaN ()
at _color (https://qbjs.org/qb.js:801:19)
at Object.sub_PSet (https://qbjs.org/qb.js:1815:21)
at sub_projectImagetoSphere (eval at runProgram (https://qbjs.org/:100:30), :66:13)
at eval (eval at runProgram (https://qbjs.org/:100:30), :42:16)
at async runProgram (https://qbjs.org/:356:17)
b = b + ...
