|
|
Post by bplus on Sept 7, 2023 16:08:25 GMT
Color in the G2D.Ellipse routine is the 6th argument, not 5th!
So watchout for argument matches between my draw subs and QBJS substitutes with G2D.drawsub
|
|
|
|
Post by bplus on Sept 25, 2023 1:19:25 GMT
Make sure array indexes are integers, QBJS does not fix floaters like QB64.
|
|
|
|
Post by bplus on Sept 25, 2023 16:26:25 GMT
dbox we had this working in QBJS, I forgot how it was fixed. It is really nice one if works as well in QBJS Still working in QB64: 'Option _Explicit
'_Title "Cheese + Sphere = Moon" 'b+ 2022-05-20
' 2023-09-25 testing code in qBJS not working because
' circle? no fixed added Plasma Snake fix for circles
$If WEB Then
import G2D From "lib/graphics/2d.bas"
$End If
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
FCirc hx(i), hy(i), radius, _RGBA32(0, 0, 0, 80)
Next
Next
_Dest curr
growCheese = map
End Function
' modified for QBJS AND QB64
Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
' put this at top of QB64 to QBJS code
'$If WEB Then
' import G2D From "lib/graphics/2d.bas"
'$End If
$If WEB Then
G2D.FillCircle CX, CY, R, C
$Else
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, 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), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
$End If
End Sub
QBJS error:
|
|
dbox
Junior Member
Posts: 89
|
Post by dbox on Sept 25, 2023 16:56:37 GMT
You can fix it by "Fix"ing or "_Round"ing the parameters sent to PSet on line 57: |
|
|
|
Post by bplus on Sept 25, 2023 18:21:29 GMT
You can fix it by "Fix"ing or "_Round"ing the parameters sent to PSet on line 57: Yes fix() or int() works thanks! dboxSo Point() demands integers for arguments like array indexes And that reminds me, _RGB32() needs >= 0 and <=255 |
|
|
|
Post by bplus on Oct 19, 2023 17:51:03 GMT
At the top before any line of code:
$IF WEB Then...
eg when using Circle Fill sub
Also something about Chr$ or Asc of an K$ = Inkey$ is off, Len(K$) works.
|
|
