10-02-2024, 03:29 PM
I found this little gem on an archived qb64.net forum post and cleaned it up for QB64-PE. There is still a lot of room for optimizations to make the code more performant.
Code: (Select All)
' The Lord of the Julia Rings
' The Fellowship of the Julia Ring
' Free Basic
' Relsoft
' Rel.BetterWebber.com
' Converted to QB64 format by Galleon
' Optimized for QB64-PE by a740g
_DEFINE A-Z AS LONG
OPTION _EXPLICIT
CONST FALSE = 0, TRUE = NOT FALSE
CONST SCR_WIDTH = 320 * 3
CONST SCR_HEIGHT = 200 * 3
CONST SCR_MAXX = SCR_WIDTH - 1
CONST SCR_MAXY = SCR_HEIGHT - 1
CONST SCR_MIDX = SCR_WIDTH \ 2
CONST SCR_MIDY = SCR_HEIGHT \ 2
CONST MAXITER = 20
CONST MAXSIZE = 4
CONST XMIN! = -1! * 2.0!
CONST XMAX! = 2.0!
CONST YMIN! = -1! * 1.5!
CONST YMAX! = 1.5!
CONST DELTAX! = (XMAX - XMIN) / SCR_MAXX
CONST DELTAY! = (YMAX - YMIN) / SCR_MAXY
$RESIZE:SMOOTH
SCREEN _NEWIMAGE(SCR_WIDTH, SCR_HEIGHT, 32)
_ALLOWFULLSCREEN _SQUAREPIXELS , _SMOOTH
_TITLE "QB64-PE Julia (Relsoft)"
DIM px AS LONG, py AS LONG
DIM p AS SINGLE, q AS SINGLE
DIM theta AS SINGLE
DIM x AS SINGLE, y AS SINGLE
DIM xsquare AS SINGLE, ysquare AS SINGLE
DIM ytemp AS SINGLE
DIM i AS LONG, pixel AS LONG
DIM frame AS _UNSIGNED LONG
DIM ty AS SINGLE
DIM red AS LONG, grn AS LONG, blu AS LONG
DIM tmp AS LONG, i_last AS LONG
DIM cmag AS SINGLE
DIM cmagsq AS SINGLE
DIM zmag AS SINGLE
DIM drad AS SINGLE
DIM ztot AS SINGLE
DIM drad_l AS SINGLE, drad_h AS SINGLE
DIM lx(0 TO SCR_MAXX) AS SINGLE, ly(0 TO SCR_MAXY) AS SINGLE
FOR i = 0 TO SCR_MAXX
lx(i) = XMIN + i * DELTAX
NEXT i
FOR i = 0 TO SCR_MAXY
ly(i) = YMAX - i * DELTAY
NEXT i
DIM stime AS LONG, fps AS SINGLE, fps2 AS SINGLE
stime = TIMER
DO
frame = (frame + 1) AND &H7FFFFFFF
theta = frame * _PI(0.01!)
p = COS(theta) * SIN(theta * 0.7!) * 0.6!
q = (SIN(theta) + SIN(theta)) * 0.6!
cmagsq = p * p + q * q
cmag = SQR(cmagsq)
drad = 0.04!
drad_l = (cmag - drad) * (cmag - drad)
drad_h = (cmag + drad) * (cmag + drad)
FOR py = 0 TO SCR_MIDY - 1
ty = ly(py)
FOR px = 0 TO SCR_MAXX
x = lx(px)
y = ty
xsquare = 0!
ysquare = 0!
ztot = 0!
i = 0
i_last = 0
WHILE (i < MAXITER) _ANDALSO ((xsquare + ysquare) < MAXSIZE)
xsquare = x * x
ysquare = y * y
ytemp = 2! * x * y
x = xsquare - ysquare + p
y = ytemp + q
zmag = x * x + y * y
IF zmag < drad_h _ANDALSO zmag > drad_l _ANDALSO i > 0 THEN
ztot = ztot + (1! - (ABS(zmag - cmagsq) / drad))
i_last = i
END IF
i = i + 1
IF zmag > 4.0! THEN EXIT WHILE
WEND
IF ztot > 0! THEN
i = SQR(ztot) * 500!
ELSE
i = 0
END IF
IF i < 256 THEN
red = i
ELSE
red = 255
END IF
IF i >= 256 _ANDALSO i < 512 THEN
grn = i - 256
ELSEIF i >= 512 THEN
grn = 255
ELSE
grn = 0
END IF
IF i >= 512 _ANDALSO i <= 768 THEN
blu = i - 512
ELSEIF i > 768 THEN
blu = 255
ELSE
blu = 0
END IF
tmp = ((red + grn + blu) \ 3)
red = ((red + grn + tmp) \ 3)
grn = ((grn + blu + tmp) \ 3)
blu = ((blu + red + tmp) \ 3)
tmp = red
SELECT CASE (i_last MOD 3)
CASE 1
red = grn: grn = blu: blu = tmp
CASE 2
red = blu: blu = grn: grn = tmp
END SELECT
pixel = _RGB32(red, grn, blu)
PSET (px, py), pixel
PSET (SCR_MAXX - px, SCR_MAXY - py), pixel
NEXT px
NEXT py
fps = fps + 1
IF stime + 1 < TIMER THEN
fps2 = fps
fps = 0
stime = TIMER
END IF
LOCATE 1, 1: PRINT "FPS:" + STR$(fps2);
_DISPLAY
_LIMIT 60
LOOP UNTIL _KEYHIT = 27
SYSTEM