Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - The Librarian

Pages: 1 2 [3]
31
2D/3D Graphics / Texel Raytracer by Antoni Gual
« on: March 17, 2018, 09:39:44 am »
Texel Raytracer

Author: Antoni Gual
Source: petesqbsite
URL: http://www.petesqbsite.com/downloads/graphics.shtml
Version: 2004
Tags: [3d], [raytrace], [poke]

Description:
Pure QB Realtime Raytracer Demo. Translated to/optimized for QB by Antoni Gual agual@eic.ictnet.es. The original was written in C by Texel, a Spanish demo coder [...]

Source Code:
Code: QB64: [Select]
  1. 'Pure QB Realtime Raytracer Demo
  2. 'Translated to/optimized for QB by Antoni Gual agual@eic.ictnet.es
  3. 'The original was written in C by Texel, a Spanish demo coder.
  4. 'It will not work in the IDE due to integer overflow errors.
  5. 'Compile with QB 4.0 or QB4.5 + ffix. It does 12.5 fps in my P4 1,4.
  6. 'The C version (DOS protected mode, DJGPP) does 50 fps :(
  7.  
  8. 'ffix
  9. CONST objnum = 4
  10.  
  11. DIM n AS INTEGER, K AS INTEGER, OBJMIN AS INTEGER, OBJMIN2 AS INTEGER
  12. DIM OBJ(objnum) AS INTEGER, l AS INTEGER, posi AS INTEGER, POS2 AS INTEGER
  13. DIM s AS INTEGER, t(8200) AS INTEGER, XX AS INTEGER, YY AS INTEGER, XQ AS INTEGER
  14. DIM YQ AS INTEGER, mmmm AS INTEGER, xx1 AS INTEGER, yy1 AS INTEGER
  15. DIM t2(8200) AS INTEGER, ipos AS INTEGER
  16.  
  17. DIM A(objnum) AS SINGLE, B(objnum) AS SINGLE, C(objnum) AS SINGLE
  18. DIM R(objnum) AS SINGLE
  19.  
  20. DEF SEG = &HA000
  21. 'Cambiar la paleta a tonos de azul
  22. OUT &H3C8, 0 '
  23. FOR n = 0 TO 127
  24.     OUT &H3C9, 0
  25.     OUT &H3C9, INT(n / 4)
  26.     OUT &H3C9, INT(n / 2)
  27. FOR n = 0 TO 127
  28.     OUT &H3C9, INT(n / 2)
  29.     OUT &H3C9, INT(31 + n / 4)
  30.     OUT &H3C9, 63
  31. D = 230
  32. l = 0
  33.    
  34. 'four objects
  35. OBJ(0) = 0: A(0) = -50 + l: B(0) = 0: C(0) = -100: R(0) = -55 * 55
  36. OBJ(1) = 0: A(1) = 50 - l: B(1) = -25: C(1) = -120: R(1) = -55 * 55
  37. OBJ(2) = 0: A(2) = 0: B(2) = 500: C(2) = -220: R(2) = -500! * 500
  38. OBJ(3) = 1: A(3) = 60: B(3) = -35: C(3) = -30
  39.  
  40. tt! = TIMER
  41. FOR l = 0 TO 199
  42.        
  43.     A(0) = -50 + l
  44.     A(1) = 50 - l
  45.     posi = 400
  46.     mmmm = -1
  47.     'calculamos uno de cada 4 pixels a buffer t()
  48.     FOR Y = -40 TO 39 STEP 2
  49.         FOR X = -80 TO 79 STEP 2
  50.             X0 = X
  51.             Y0 = Y
  52.             GOSUB raytrace
  53.             t(posi) = COL
  54.             posi = posi + 1
  55.         NEXT
  56.     NEXT
  57.     posi = 482
  58.     POS2 = 0
  59.     'calculamos pixels restantes, interpolando si podemos
  60.     FOR YQ = 6 TO 43
  61.         FOR XQ = 2 TO 77
  62.             'interpolar
  63.             IF t2(posi) = t2(posi + 1) AND t2(posi) = t2(posi + 80) AND t2(posi) = t2(posi + 81) THEN
  64.                 ipos = (YQ * 1280 + (XQ * 4))
  65.                 FOR YY = 0 TO 3
  66.                     FOR XX = 0 TO 3
  67.                         POKE ipos, (YY * (t(posi + 80) * (4 - XX) + t(posi + 81) * XX) + (t(posi) * (4 - XX) + t(posi + 1) * XX) * (4 - YY)) \ 16
  68.                         ipos = ipos + 1
  69.                     NEXT
  70.                     ipos = ipos + 316
  71.                 NEXT
  72.                 'no interpolar
  73.             ELSE
  74.                 mmmm = 0
  75.                 FOR yy1 = 0 TO 3
  76.                     FOR xx1 = 0 TO 3
  77.                         IF xx1 OR yy1 THEN
  78.                             X0 = (-160 + XQ * 4 + xx1) / 2
  79.                             Y0 = (-100 + YQ * 4 + yy1) / 2
  80.                             GOSUB raytrace
  81.                             POKE (YQ * 4 + yy1) * 320 + XQ * 4 + xx1, COL
  82.                         ELSE
  83.                             POKE YQ * 1280 + XQ * 4, t(posi)
  84.                         END IF
  85.                     NEXT
  86.                 NEXT
  87.             END IF
  88.             posi = posi + 1
  89.         NEXT
  90.         posi = posi + 4
  91.     NEXT
  92. COLOR 255: PRINT l / (TIMER - tt!)
  93. KK$ = INPUT$(1)
  94.  
  95. raytrace:
  96. Z0 = 0
  97. MD = 1 / SQR(X0 * X0 + Y0 * Y0 + D * D)
  98. X1 = X0 * MD
  99. Y1 = Y0 * MD
  100. Z1 = -(D + Z0) * MD
  101. K = 0
  102. COL = 0
  103. OBJMIN = objnum
  104. IF mmmm THEN t2(posi) = objnum
  105.     TMIN = 327680
  106.     FOR n = 0 TO 2
  107.         IF OBJ(n) = 0 AND (OBJ(n) <> OBJMIN) THEN
  108.             A0 = A(n) - X0
  109.             B0 = B(n) - Y0
  110.             C0 = C(n) - Z0
  111.             TB = A0 * X1 + B0 * Y1 + C0 * Z1
  112.             RZ = TB * TB - A0 * A0 - B0 * B0 - C0 * C0
  113.             IF RZ >= R(n) THEN
  114.                 TN = TB - SQR(RZ - R(n))
  115.                 IF TN < TMIN AND TN > 0 THEN TMIN = TN: OBJMIN2 = n
  116.             END IF
  117.         END IF
  118.     NEXT
  119.     OBJMIN = OBJMIN2
  120.     IF TMIN < 327680 AND (OBJ(OBJMIN) = 0) THEN
  121.         IF mmmm THEN t2(posi) = t2(posi) * K * objnum * 3 + OBJMIN
  122.         X0 = X0 + X1 * TMIN
  123.         Y0 = Y0 + Y1 * TMIN
  124.         Z0 = Z0 + Z1 * TMIN
  125.         NX = X0 - A(OBJMIN)
  126.         NY = Y0 - B(OBJMIN)
  127.         NZ = Z0 - C(OBJMIN)
  128.         CA = 2 * (NX * X1 + NY * Y1 + NZ * Z1) / (NX * NX + NY * NY + NZ * NZ + 1)
  129.         X1 = X1 - NX * CA
  130.         Y1 = Y1 - NY * CA
  131.         Z1 = Z1 - NZ * CA
  132.         A2 = A(3) - X0
  133.         B2 = B(3) - Y0
  134.         C2 = C(3) - Z0
  135.         MV = 1 / SQR(A2 * A2 + B2 * B2 + C2 * C2)
  136.         A2 = A2 * MV
  137.         B2 = B2 * MV
  138.         C2 = C2 * MV
  139.         s = 0
  140.         FOR n = 0 TO 2
  141.             IF OBJ(n) = 0 AND NOT s THEN
  142.                 A0 = X0 - A(n)
  143.                 B0 = Y0 - B(n)
  144.                 C0 = Z0 - C(n)
  145.                 TB = A2 * A0 + B2 * B0 + C2 * C0
  146.                 RZ = TB * TB - A0 * A0 - B0 * B0 - C0 * C0
  147.                 IF RZ >= R(n) AND TB < 0 THEN s = -1: IF mmmm THEN t2(posi) = t2(posi) * 32
  148.             END IF
  149.         NEXT
  150.         IF NOT s THEN
  151.             IF mmmm THEN t2(posi) = t2(posi) + 1
  152.             col2 = X1 * A2 + Y1 * B2 + Z1 * C2
  153.             IF col2 < 0 THEN col2 = 0
  154.             cc = col2 * col2
  155.             col2 = cc * cc
  156.             MV = SQR(NX * NX + NY * NY + NZ * NZ)
  157.             'IF COL2 < 0 THEN COL2 = 0
  158.             col2 = col2 + (NX * A2 + NY * B2 + NZ * C2) / MV
  159.             IF col2 < 0 THEN col2 = 0
  160.             COL = COL + col2 / ((K + 1) * (K + 1) * 2)
  161.             IF COL > 1 THEN COL = 1
  162.         END IF
  163.         K = K + 1
  164.     END IF
  165. LOOP WHILE TMIN < 327680 AND K <= 2
  166. IF K = 0 THEN COL = 50 ELSE COL = COL * 255
  167.  

RAYTRA1B.png

32
Utilities / Curve Smoother by STxAxTIC & FellippeHeitor
« on: March 17, 2018, 01:08:19 am »
Curve Smoother

Author: @STxAxTIC @FellippeHeitor
Source: Submission
Version: 2014
Tags: [graphics], [relaxation algorithm], [anti-aliasing]

Description:
This program demonstrates (i) linear interpolation to create a curve between points, (ii) a relaxation algorithm to "smooth over" a curve to remove sharp edges, and (iii) plotting with anti-aliasing.

Source code:
Code: QB64: [Select]
  1. ' Display
  2. SCREEN _NEWIMAGE(800, 600, 32)
  3. _SCREENMOVE (_DESKTOPWIDTH \ 2 - _WIDTH \ 2) - 3, (_DESKTOPHEIGHT \ 2 - _HEIGHT \ 2) - 29
  4. _TITLE "If these curves were smoother they'd steal your wife."
  5.  
  6. ' Meta
  7. start:
  8.  
  9. ' Data structures
  10. TYPE Vector
  11.     x AS DOUBLE
  12.     y AS DOUBLE
  13.  
  14. ' Object type
  15. TYPE Object
  16.     Elements AS INTEGER
  17.     Shade AS _UNSIGNED LONG
  18.  
  19. ' Object storage
  20. DIM SHARED Shape(300) AS Object
  21. DIM SHARED PointChain(300, 500) AS Vector
  22. DIM SHARED TempChain(300, 500) AS Vector
  23. DIM SHARED ShapeCount AS INTEGER
  24. DIM SHARED SelectedShape AS INTEGER
  25.  
  26. ' Initialize
  27. ShapeCount = 0
  28.  
  29. ' Main loop
  30.     IF (UserInput = -1) THEN GOTO start
  31.     CALL Graphics
  32.     _LIMIT 120
  33.  
  34.  
  35. FUNCTION UserInput
  36.     TheReturn = 0
  37.     ' Keyboard input
  38.     kk = _KEYHIT
  39.     SELECT CASE kk
  40.         CASE 32
  41.             DO: LOOP UNTIL _KEYHIT
  42.             WHILE _MOUSEINPUT: WEND
  43.             _KEYCLEAR
  44.             CALL NewMouseShape(7.5, 150, 15)
  45.             CLS
  46.     END SELECT
  47.     IF (kk) THEN
  48.         _KEYCLEAR
  49.     END IF
  50.     UserInput = TheReturn
  51.  
  52. SUB Graphics
  53.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 200), BF
  54.     CALL cprintstring(16 * 17, "PRESS SPACE and then drag MOUSE 1 to draw a new shape.")
  55.     FOR ShapeIndex = 1 TO ShapeCount
  56.         FOR i = 1 TO Shape(ShapeIndex).Elements - 1
  57.             CALL lineSmooth(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, PointChain(ShapeIndex, i + 1).x, PointChain(ShapeIndex, i + 1).y, Shape(ShapeIndex).Shade)
  58.         NEXT
  59.     NEXT
  60.     _DISPLAY
  61.  
  62. SUB NewMouseShape (rawresolution AS DOUBLE, targetpoints AS INTEGER, smoothiterations AS INTEGER)
  63.     ShapeCount = ShapeCount + 1
  64.     numpoints = 0
  65.     xold = 999 ^ 999
  66.     yold = 999 ^ 999
  67.     DO
  68.         DO WHILE _MOUSEINPUT
  69.             x = _MOUSEX
  70.             y = _MOUSEY
  71.             IF (x > 0) AND (x < _WIDTH) AND (y > 0) AND (y < _HEIGHT) THEN
  72.                 IF _MOUSEBUTTON(1) THEN
  73.                     x = x - (_WIDTH / 2)
  74.                     y = -y + (_HEIGHT / 2)
  75.                     delta = SQR((x - xold) ^ 2 + (y - yold) ^ 2)
  76.                     IF (delta > rawresolution) AND (numpoints < targetpoints - 1) THEN
  77.                         numpoints = numpoints + 1
  78.                         PointChain(ShapeCount, numpoints).x = x
  79.                         PointChain(ShapeCount, numpoints).y = y
  80.                         CALL cpset(x, y, _RGB(0, 255, 255))
  81.                         xold = x
  82.                         yold = y
  83.                     END IF
  84.                 END IF
  85.             END IF
  86.         LOOP
  87.         _DISPLAY
  88.     LOOP UNTIL NOT _MOUSEBUTTON(1) AND (numpoints > 1)
  89.  
  90.     DO WHILE (numpoints < targetpoints)
  91.         rad2max = -1
  92.         kmax = -1
  93.         FOR k = 1 TO numpoints - 1
  94.             xfac = PointChain(ShapeCount, k).x - PointChain(ShapeCount, k + 1).x
  95.             yfac = PointChain(ShapeCount, k).y - PointChain(ShapeCount, k + 1).y
  96.             rad2 = xfac ^ 2 + yfac ^ 2
  97.             IF rad2 > rad2max THEN
  98.                 kmax = k
  99.                 rad2max = rad2
  100.             END IF
  101.         NEXT
  102.         FOR j = numpoints TO kmax + 1 STEP -1
  103.             PointChain(ShapeCount, j + 1).x = PointChain(ShapeCount, j).x
  104.             PointChain(ShapeCount, j + 1).y = PointChain(ShapeCount, j).y
  105.         NEXT
  106.         PointChain(ShapeCount, kmax + 1).x = (1 / 2) * (PointChain(ShapeCount, kmax).x + PointChain(ShapeCount, kmax + 2).x)
  107.         PointChain(ShapeCount, kmax + 1).y = (1 / 2) * (PointChain(ShapeCount, kmax).y + PointChain(ShapeCount, kmax + 2).y)
  108.         numpoints = numpoints + 1
  109.     LOOP
  110.  
  111.     FOR j = 1 TO smoothiterations
  112.         FOR k = 2 TO numpoints - 1
  113.             TempChain(ShapeCount, k).x = (1 / 2) * (PointChain(ShapeCount, k - 1).x + PointChain(ShapeCount, k + 1).x)
  114.             TempChain(ShapeCount, k).y = (1 / 2) * (PointChain(ShapeCount, k - 1).y + PointChain(ShapeCount, k + 1).y)
  115.         NEXT
  116.         FOR k = 2 TO numpoints - 1
  117.             PointChain(ShapeCount, k).x = TempChain(ShapeCount, k).x
  118.             PointChain(ShapeCount, k).y = TempChain(ShapeCount, k).y
  119.         NEXT
  120.     NEXT
  121.  
  122.     Shape(ShapeCount).Elements = numpoints
  123.     Shape(ShapeCount).Shade = _RGB(100 + INT(RND * 155), 100 + INT(RND * 155), 100 + INT(RND * 155))
  124.     SelectedShape = ShapeCount
  125.  
  126. SUB cpset (x1, y1, col AS _UNSIGNED LONG)
  127.     PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
  128.  
  129. SUB cprintstring (y, a AS STRING)
  130.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y + _HEIGHT / 2), a
  131.  
  132. SUB lineSmooth (x0, y0, x1, y1, c AS _UNSIGNED LONG)
  133.     'translated from
  134.     'https://en.wikipedia.org/w/index.php?title=Xiaolin_Wu%27s_line_algorithm&oldid=852445548
  135.  
  136.     DIM plX AS INTEGER, plY AS INTEGER, plI
  137.  
  138.     DIM steep AS _BYTE
  139.     steep = ABS(y1 - y0) > ABS(x1 - x0)
  140.  
  141.     IF steep THEN
  142.         SWAP x0, y0
  143.         SWAP x1, y1
  144.     END IF
  145.  
  146.     IF x0 > x1 THEN
  147.         SWAP x0, x1
  148.         SWAP y0, y1
  149.     END IF
  150.  
  151.     DIM dx, dy, gradient
  152.     dx = x1 - x0
  153.     dy = y1 - y0
  154.     gradient = dy / dx
  155.  
  156.     IF dx = 0 THEN
  157.         gradient = 1
  158.     END IF
  159.  
  160.     'handle first endpoint
  161.     DIM xend, yend, xgap, xpxl1, ypxl1
  162.     xend = _ROUND(x0)
  163.     yend = y0 + gradient * (xend - x0)
  164.     xgap = (1 - ((x0 + .5) - INT(x0 + .5)))
  165.     xpxl1 = xend 'this will be used in the main loop
  166.     ypxl1 = INT(yend)
  167.     IF steep THEN
  168.         plX = ypxl1
  169.         plY = xpxl1
  170.         plI = (1 - (yend - INT(yend))) * xgap
  171.         GOSUB plot
  172.  
  173.         plX = ypxl1 + 1
  174.         plY = xpxl1
  175.         plI = (yend - INT(yend)) * xgap
  176.         GOSUB plot
  177.     ELSE
  178.         plX = xpxl1
  179.         plY = ypxl1
  180.         plI = (1 - (yend - INT(yend))) * xgap
  181.         GOSUB plot
  182.  
  183.         plX = xpxl1
  184.         plY = ypxl1 + 1
  185.         plI = (yend - INT(yend)) * xgap
  186.         GOSUB plot
  187.     END IF
  188.  
  189.     DIM intery
  190.     intery = yend + gradient 'first y-intersection for the main loop
  191.  
  192.     'handle second endpoint
  193.     DIM xpxl2, ypxl2
  194.     xend = _ROUND(x1)
  195.     yend = y1 + gradient * (xend - x1)
  196.     xgap = ((x1 + .5) - INT(x1 + .5))
  197.     xpxl2 = xend 'this will be used in the main loop
  198.     ypxl2 = INT(yend)
  199.     IF steep THEN
  200.         plX = ypxl2
  201.         plY = xpxl2
  202.         plI = (1 - (yend - INT(yend))) * xgap
  203.         GOSUB plot
  204.  
  205.         plX = ypxl2 + 1
  206.         plY = xpxl2
  207.         plI = (yend - INT(yend)) * xgap
  208.         GOSUB plot
  209.     ELSE
  210.         plX = xpxl2
  211.         plY = ypxl2
  212.         plI = (1 - (yend - INT(yend))) * xgap
  213.         GOSUB plot
  214.  
  215.         plX = xpxl2
  216.         plY = ypxl2 + 1
  217.         plI = (yend - INT(yend)) * xgap
  218.         GOSUB plot
  219.     END IF
  220.  
  221.     'main loop
  222.     DIM x
  223.     IF steep THEN
  224.         FOR x = xpxl1 + 1 TO xpxl2 - 1
  225.             plX = INT(intery)
  226.             plY = x
  227.             plI = (1 - (intery - INT(intery)))
  228.             GOSUB plot
  229.  
  230.             plX = INT(intery) + 1
  231.             plY = x
  232.             plI = (intery - INT(intery))
  233.             GOSUB plot
  234.  
  235.             intery = intery + gradient
  236.         NEXT
  237.     ELSE
  238.         FOR x = xpxl1 + 1 TO xpxl2 - 1
  239.             plX = x
  240.             plY = INT(intery)
  241.             plI = (1 - (intery - INT(intery)))
  242.             GOSUB plot
  243.  
  244.             plX = x
  245.             plY = INT(intery) + 1
  246.             plI = (intery - INT(intery))
  247.             GOSUB plot
  248.  
  249.             intery = intery + gradient
  250.         NEXT
  251.     END IF
  252.  
  253.     EXIT SUB
  254.  
  255.     plot:
  256.     ' Change to regular PSET for standard coordinate orientation.
  257.     CALL cpset(plX, plY, _RGB32(_RED32(c), _GREEN32(c), _BLUE32(c), plI * 255))
  258.     RETURN
  259.  

heart.png

33
2D/3D Graphics / Matrix Effect by TylerDarko
« on: March 16, 2018, 06:33:50 am »
Matrix Effect

Author: TylerDarko
Source: [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] Forum
URL: /forum/index.php?topic=13656.msg122971#msg122971]http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=13656.msg122971#msg122971
Version: 2017
Tags: [ascii], [matrix]

Description:
I see /forum/index.php?topic=13656.msg118470]your 388-lines matrix effect and raise you mine, with only 25:

Source Code:
Code: QB64: [Select]
  1.  
  2. FOR i = 1 TO UBOUND(m)
  3.     m(i) = -INT(RND * _HEIGHT)
  4.  
  5. COLOR _RGB32(0, 255, 0)
  6.  
  7.     _LIMIT 15
  8.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 20), BF
  9.  
  10.     FOR i = 1 TO UBOUND(m)
  11.         m(i) = m(i) + _FONTHEIGHT
  12.         IF m(i) > 0 THEN
  13.             IF m(i) > _HEIGHT THEN m(i) = -INT(RND * _HEIGHT)
  14.             _PRINTSTRING (i * _FONTWIDTH - _FONTWIDTH, m(i)), CHR$(_CEIL(RND * 254))
  15.         END IF
  16.     NEXT
  17.  
  18.     _DISPLAY

DarkoMatrix.png

34
Samples / Welcome to the Samples Gallery
« on: March 12, 2018, 06:53:54 am »
Welcome to the Samples Gallery


The Samples Gallery is a curated collection of programs, games, functions, libraries, data, and other tools useful to QB64 coders of all skill levels. Here, we aim to provide a home for vetted works that would otherwise be lost to the ravages of time.

Nomination and Assimilation of New Code:
  • Code that is suitable for public consumption must be posted to the Programs board first, located here: https://www.qb64.org/forum/index.php?board=6.0
  • When published in Programs, the code is open to scrutiny, praise, and/or improvements by the QB64 community.
  • Contact @Qwerkey or @bplus if you wish to suggest a project (your own or another member's).  Contact by Forum Personal Message (Qwerkey or bplus) or at the Discord Server (Qwerkey).  Direct nominations by e-mail are discouraged but not impossible.
  • Library Staff will decide in good faith if the code should be immortalized the Samples Gallery.


While there is no strict set of rules regarding the format, structure, size, or resource consumption of a given Sample, it's been noticed that "good" programs are built in accordance with the Unix Philosophy:
  • Write programs that do one thing and do it well. (McIlroy)
  • Expect the output of every program to become the input to another, as yet unknown, program. (McIlroy)
  • Data dominates. If you've chosen the right data structures and organized things well, the algorithms will almost always be self-evident. (Pike)
  • Don't tune for speed until you've measured. (Pike)
  • Premature optimization is the root of all evil. (Knuth)




35
2D/3D Graphics / Fractal Art by Zom-B
« on: March 11, 2018, 09:58:04 am »
Fractal Art

Author: Zom-B
Source: [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] Forum
URL: /forum/index.php?topic=1124.0]http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1124.0
Version: 2010
Tags: [2d], [fractal]

Description:
This is [...] a series of fractal artworks that I ported from Ultra Fractal to Quick Basic 4.5 with the Future library, and are currently upgrading to QB64. I received permission from the author(s) of the artworks to republish their works in this particular form. The original consists of a lot of include and routine files $included in the main, which I have merged here for convenience.

(Code edited by The Librarian to run in QB64 v1.2.)

Source Code (one of four):
Code: QB64: [Select]
  1. '> Merged with Zom-B's smart $include merger 0.51
  2.  
  3. DEFSNG A-Z
  4.  
  5. '####################################################################################################################
  6. '# Math Library V1.0 (include)
  7. '# By Zom-B
  8. '####################################################################################################################
  9.  
  10. CONST sqrt2 = 1.41421356237309504880168872420969807856967187537695 ' Knuth01
  11. CONST sqrt3 = 1.73205080756887729352744634150587236694280525381038 ' Knuth02
  12. CONST sqrt5 = 2.23606797749978969640917366873127623544061835961153 ' Knuth03
  13. CONST sqrt10 = 3.16227766016837933199889354443271853371955513932522 ' Knuth04
  14. CONST cubert2 = 1.25992104989487316476721060727822835057025146470151 ' Knuth05
  15. CONST cubert3 = 1.44224957030740838232163831078010958839186925349935 ' Knuth06
  16. CONST q2pow025 = 1.18920711500272106671749997056047591529297209246382 ' Knuth07
  17. CONST phi = 1.61803398874989484820458683436563811772030917980576 ' Knuth08
  18. CONST log2 = 0.69314718055994530941723212145817656807550013436026 ' Knuth09
  19. CONST log3 = 1.09861228866810969139524523692252570464749055782275 ' Knuth10
  20. CONST log10 = 2.30258509299404568401799145468436420760110148862877 ' Knuth11
  21. CONST logpi = 1.14472988584940017414342735135305871164729481291531 ' Knuth12
  22. CONST logphi = 0.48121182505960344749775891342436842313518433438566 ' Knuth13
  23. CONST q1log2 = 1.44269504088896340735992468100189213742664595415299 ' Knuth14
  24. CONST q1log10 = 0.43429448190325182765112891891660508229439700580367 ' Knuth15
  25. CONST q1logphi = 2.07808692123502753760132260611779576774219226778328 ' Knuth16
  26. CONST pi = 3.14159265358979323846264338327950288419716939937511 ' Knuth17
  27. CONST deg2rad = 0.01745329251994329576923690768488612713442871888542 ' Knuth18
  28. CONST q1pi = 0.31830988618379067153776752674502872406891929148091 ' Knuth19
  29. CONST pisqr = 9.86960440108935861883449099987615113531369940724079 ' Knuth20
  30. CONST gamma05 = 1.7724538509055160272981674833411451827975494561224 '  Knuth21
  31. CONST gamma033 = 2.6789385347077476336556929409746776441286893779573 '  Knuth22
  32. CONST gamma067 = 1.3541179394264004169452880281545137855193272660568 '  Knuth23
  33. CONST e = 2.71828182845904523536028747135266249775724709369996 ' Knuth24
  34. CONST q1e = 0.36787944117144232159552377016146086744581113103177 ' Knuth25
  35. CONST esqr = 7.38905609893065022723042746057500781318031557055185 ' Knuth26
  36. CONST eulergamma = 0.57721566490153286060651209008240243104215933593992 ' Knuth27
  37. CONST expeulergamma = 1.7810724179901979852365041031071795491696452143034 '  Knuth28
  38. CONST exppi025 = 2.19328005073801545655976965927873822346163764199427 ' Knuth29
  39. CONST sin1 = 0.84147098480789650665250232163029899962256306079837 ' Knuth30
  40. CONST cos1 = 0.54030230586813971740093660744297660373231042061792 ' Knuth31
  41. CONST zeta3 = 1.2020569031595942853997381615114499907649862923405 '  Knuth32
  42. CONST nloglog2 = 0.36651292058166432701243915823266946945426344783711 ' Knuth33
  43.  
  44. CONST logr10 = 0.43429448190325182765112891891660508229439700580367
  45. CONST logr2 = 1.44269504088896340735992468100189213742664595415299
  46. CONST pi05 = 1.57079632679489661923132169163975144209858469968755
  47. CONST pi2 = 6.28318530717958647692528676655900576839433879875021
  48. CONST q05log10 = 0.21714724095162591382556445945830254114719850290183
  49. CONST q05log2 = 0.72134752044448170367996234050094606871332297707649
  50. CONST q05pi = 0.15915494309189533576888376337251436203445964574046
  51. CONST q13 = 0.33333333333333333333333333333333333333333333333333
  52. CONST q16 = 0.16666666666666666666666666666666666666666666666667
  53. CONST q2pi = 0.63661977236758134307553505349005744813783858296183
  54. CONST q2sqrt5 = 0.89442719099991587856366946749251049417624734384461
  55. CONST rad2deg = 57.2957795130823208767981548141051703324054724665643
  56. CONST sqrt02 = 0.44721359549995793928183473374625524708812367192231
  57. CONST sqrt05 = 0.70710678118654752440084436210484903928483593768847
  58. CONST sqrt075 = 0.86602540378443864676372317075293618347140262690519
  59. CONST y2q112 = 1.05946309435929526456182529494634170077920431749419 ' Chromatic base
  60.  
  61. '####################################################################################################################
  62. '# Screen mode selector v1.0 (include)
  63. '# By Zom-B
  64. '####################################################################################################################
  65.  
  66. videoaspect:
  67. DATA "all aspect",15
  68. DATA "4:3",11
  69. DATA "16:10",10
  70. DATA "16:9",14
  71. DATA "5:4",13
  72. DATA "3:2",12
  73. DATA "5:3",9
  74. DATA "1:1",7
  75. DATA "other",8
  76.  
  77. videomodes:
  78. DATA 256,256,7
  79. DATA 320,240,1
  80. DATA 400,300,1
  81. DATA 512,384,1
  82. DATA 512,512,7
  83. DATA 640,480,1
  84. DATA 720,540,1
  85. DATA 768,576,1
  86. DATA 800,480,2
  87. DATA 800,600,1
  88. DATA 854,480,3
  89. DATA 1024,600,8
  90. DATA 1024,640,2
  91. DATA 1024,768,1
  92. DATA 1024,1024,7
  93. DATA 1152,768,5
  94. DATA 1152,864,1
  95. DATA 1280,720,3
  96. DATA 1280,768,6
  97. DATA 1280,800,2
  98. DATA 1280,854,5
  99. DATA 1280,960,1
  100. DATA 1280,1024,4
  101. DATA 1366,768,3
  102. DATA 1400,1050,1
  103. DATA 1440,900,2
  104. DATA 1440,960,5
  105. DATA 1600,900,3
  106. DATA 1600,1200,1
  107. DATA 1680,1050,2
  108. DATA 1920,1080,3
  109. DATA 1920,1200,2
  110. DATA 2048,1152,3
  111. DATA 2048,1536,1
  112. DATA 2048,2048,7
  113. DATA ,,
  114.  
  115. '####################################################################################################################
  116. '# Ultra Fractal Gradient library v1.0 (include)
  117. '# By Zom-B
  118. '#
  119. '# Smooth Gradient algorithm from Ultra Fractal (www.ultrafractal.com)
  120. '####################################################################################################################
  121.  
  122. TYPE GRADIENTPOINT
  123.     index AS SINGLE
  124.     r AS SINGLE
  125.     g AS SINGLE
  126.     b AS SINGLE
  127.     rdr AS SINGLE
  128.     rdl AS SINGLE
  129.     gdr AS SINGLE
  130.     gdl AS SINGLE
  131.     bdr AS SINGLE
  132.     bdl AS SINGLE
  133.  
  134. '$dynamic
  135.  
  136. DIM SHARED gradientSmooth(1) AS _BYTE '_BIT <- bugged
  137. DIM SHARED gradientPoints(1) AS INTEGER
  138. DIM SHARED gradient(1, 1) AS GRADIENTPOINT
  139.  
  140.  
  141. '####################################################################################################################
  142. '# Sierpinsky Rays+aet for QB64
  143. '# By Zom-B
  144. '#
  145. '# Original art by Daniele (alcamese@libero.it)
  146. '# Tweaked by Athena Tracey (athena_1963@hotmail.com)
  147. '####################################################################################################################
  148.  
  149. CONST Doantialias = -1
  150. CONST Usegaussian = 0
  151.  
  152. '####################################################################################################################
  153.  
  154. _TITLE "Sierpinsky Rays+aet"
  155. WIDTH 80, 40
  156.  
  157. PRINT TAB(30); "Sierpinsky Rays+aet"
  158. PRINT TAB(18); "Original art by Daniele (alcamese@libero.it)"
  159. PRINT TAB(15); "Tweaked by Athena Tracey (athena_1963@hotmail.com)"
  160. PRINT TAB(19); "Converted to Quick Basic and QB64 by Zom-B"
  161.  
  162. selectScreenMode 7, 32
  163.  
  164. '####################################################################################################################
  165.  
  166. DIM SHARED sizeX%, sizeY%
  167. DIM SHARED maxX%, maxY%
  168. DIM SHARED halfX%, halfY%
  169.  
  170. sizeX% = _WIDTH
  171. sizeY% = _HEIGHT
  172. maxX% = sizeX% - 1
  173. maxY% = sizeY% - 1
  174. halfX% = sizeX% \ 2
  175. halfY% = sizeY% \ 2
  176.  
  177. DIM SHARED magX, magY
  178.  
  179. magX = 1.300052002080083203328133125325 / halfY%
  180. magY = 1.300052002080083203328133125325 / halfY%
  181.  
  182. DIM SHARED zx(149), zy(149)
  183.  
  184. '####################################################################################################################
  185.  
  186. setNumGradients 5
  187.  
  188. addGradientPoint 0, -0.0450, 0.710, 1.000, 1.000
  189. addGradientPoint 0, 0.0025, 1.000, 0.702, 0.729
  190. addGradientPoint 0, 0.0850, 0.082, 0.431, 0.000
  191. addGradientPoint 0, 0.2300, 0.812, 0.745, 0.824
  192. addGradientPoint 0, 0.5500, 0.380, 0.000, 0.000
  193. addGradientPoint 0, 0.7600, 1.000, 0.757, 1.000
  194. addGradientPoint 0, 0.8800, 0.000, 0.263, 0.000
  195. addGradientPoint 0, 0.9550, 0.710, 1.000, 1.000
  196. addGradientPoint 0, 1.0025, 1.000, 0.702, 0.729
  197. setGradientSmooth 0, -1
  198.  
  199. addGradientPoint 1, -0.0450, 0.165, 0.000, 0.184
  200. addGradientPoint 1, 0.7475, 0.718, 0.918, 1.000
  201. addGradientPoint 1, 0.8425, 0.945, 0.710, 1.000
  202. addGradientPoint 1, 0.9550, 0.165, 0.000, 0.184
  203. addGradientPoint 1, 1.7475, 0.718, 0.918, 1.000
  204. setGradientSmooth 1, -1
  205.  
  206. addGradientPoint 2, -0.2750, 0.000, 0.973, 0.114
  207. addGradientPoint 2, 0.0475, 1.000, 0.545, 0.875
  208. addGradientPoint 2, 0.1725, 0.000, 0.345, 0.000
  209. addGradientPoint 2, 0.5500, 1.000, 0.071, 1.000
  210. addGradientPoint 2, 0.7250, 0.000, 0.973, 0.114
  211. addGradientPoint 2, 1.0475, 1.000, 0.545, 0.875
  212. setGradientSmooth 2, -1
  213.  
  214. addGradientPoint 3, -0.0675, 1.000, 0.502, 1.000
  215. addGradientPoint 3, 0.0700, 0.000, 0.000, 0.698
  216. addGradientPoint 3, 0.1650, 0.725, 0.741, 0.000
  217. addGradientPoint 3, 0.3300, 0.290, 0.000, 0.757
  218. addGradientPoint 3, 0.4550, 0.000, 0.251, 0.039
  219. addGradientPoint 3, 0.6375, 0.584, 0.918, 1.000
  220. addGradientPoint 3, 0.8250, 0.000, 0.165, 0.000
  221. addGradientPoint 3, 0.9325, 1.000, 0.502, 1.000
  222. addGradientPoint 3, 1.0700, 0.000, 0.000, 0.698
  223. setGradientSmooth 3, -1
  224.  
  225. addGradientPoint 4, -0.1025, 1.000, 0.282, 0.082
  226. addGradientPoint 4, 0.0775, 0.306, 0.376, 1.000
  227. addGradientPoint 4, 0.2225, 0.333, 0.298, 0.000
  228. addGradientPoint 4, 0.3000, 1.000, 1.000, 0.208
  229. addGradientPoint 4, 0.3800, 0.337, 0.271, 0.741
  230. addGradientPoint 4, 0.6400, 0.651, 0.404, 0.220
  231. addGradientPoint 4, 0.8075, 0.000, 1.000, 1.000
  232. addGradientPoint 4, 0.8975, 1.000, 0.282, 0.082
  233. addGradientPoint 4, 1.0775, 0.306, 0.376, 1.000
  234. setGradientSmooth 4, -1
  235.  
  236. renderProgressive 256, 4
  237.  
  238. i$ = INPUT$(1)
  239.  
  240. '####################################################################################################################
  241.  
  242. SUB renderProgressive (startSize%, endSize%)
  243.     pixStep% = startSize%
  244.  
  245.     pixWidth% = pixStep% - 1
  246.     FOR y% = 0 TO maxY% STEP pixStep%
  247.         FOR x% = 0 TO maxX% STEP pixStep%
  248.             calcPoint x%, y%, r%, g%, b%
  249.             LINE (x%, y%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  250.         NEXT
  251.         IF INKEY$ = CHR$(27) THEN SYSTEM
  252.     NEXT
  253.  
  254.     DO
  255.         pixSize% = pixStep% \ 2
  256.         pixWidth% = pixSize% - 1
  257.         FOR y% = 0 TO maxY% STEP pixStep%
  258.             y1% = y% + pixSize%
  259.             FOR x% = 0 TO maxX% STEP pixStep%
  260.                 x1% = x% + pixSize%
  261.  
  262.                 IF x1% < sizeX% THEN
  263.                     calcPoint x1%, y%, r%, g%, b%
  264.                     LINE (x1%, y%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  265.                 END IF
  266.                 IF y1% < sizeY% THEN
  267.                     calcPoint x%, y1%, r%, g%, b%
  268.                     LINE (x%, y1%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  269.                     IF x1% < sizeX% THEN
  270.                         calcPoint x1%, y1%, r%, g%, b%
  271.                         LINE (x1%, y1%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  272.                     END IF
  273.                 END IF
  274.             NEXT
  275.             IF INKEY$ = CHR$(27) THEN SYSTEM
  276.         NEXT
  277.         pixStep% = pixStep% \ 2
  278.     LOOP WHILE pixStep% > 2
  279.  
  280.     FOR y% = 0 TO maxY% STEP 2
  281.         y1% = y% + 1
  282.         FOR x% = 0 TO maxX% STEP 2
  283.             x1% = x% + 1
  284.  
  285.             IF x1% < sizeX% THEN
  286.                 calcPoint x1%, y%, r%, g%, b%
  287.                 PSET (x1%, y%), _RGB(r%, g%, b%)
  288.             END IF
  289.             IF y1% < sizeY% THEN
  290.                 calcPoint x%, y1%, r%, g%, b%
  291.                 PSET (x%, y1%), _RGB(r%, g%, b%)
  292.                 IF x1% < sizeX% THEN
  293.                     calcPoint x1%, y1%, r%, g%, b%
  294.                     PSET (x1%, y1%), _RGB(r%, g%, b%)
  295.                 END IF
  296.             END IF
  297.         NEXT
  298.         IF INKEY$ = CHR$(27) THEN SYSTEM
  299.     NEXT
  300.  
  301.     IF NOT Doantialias THEN EXIT SUB
  302.  
  303.     endArea% = endSize% * endSize%
  304.  
  305.     IF Usegaussian THEN
  306.         FOR y% = 0 TO maxY%
  307.             FOR x% = 0 TO maxX%
  308.                 c& = POINT(x%, y%)
  309.                 r% = _RED(c&)
  310.                 g% = _GREEN(c&)
  311.                 b% = _BLUE(c&)
  312.                 FOR i% = 2 TO endArea%
  313.                     DO 'Marsaglia polar method for random gaussian
  314.                         u! = RND * 2 - 1
  315.                         v! = RND * 2 - 1
  316.                         s! = u! * u! + v! * v!
  317.                     LOOP WHILE s! >= 1 OR s! = 0
  318.                     s! = SQR(-2 * LOG(s!) / s!) * 0.5
  319.                     u! = u! * s!
  320.                     v! = v! * s!
  321.  
  322.                     calcPoint x% + u!, y% + v!, r1%, g1%, b1%
  323.  
  324.                     r% = r% + r1%
  325.                     g% = g% + g1%
  326.                     b% = b% + b1%
  327.                 NEXT
  328.  
  329.                 PSET (x%, y%), _RGB(CINT(r% / endArea%), CINT(g% / endArea%), CINT(b% / endArea%))
  330.                 IF INKEY$ = CHR$(27) THEN SYSTEM
  331.             NEXT
  332.         NEXT
  333.     ELSE
  334.         FOR y% = 0 TO maxY%
  335.             FOR x% = 0 TO maxX%
  336.                 r% = 0
  337.                 g% = 0
  338.                 b% = 0
  339.                 FOR v% = 0 TO endSize% - 1
  340.                     y1! = y% + v% / endSize%
  341.                     FOR u% = 0 TO endSize% - 1
  342.                         IF u% = 0 AND v& = 0 THEN
  343.                             c& = POINT(x%, y%)
  344.                         ELSE
  345.                             x1! = x% + u% / endSize%
  346.                             calcPoint x1!, y1!, r1%, g1%, b1%
  347.                         END IF
  348.                         r% = r% + r1%
  349.                         g% = g% + g1%
  350.                         b% = b% + b1%
  351.                     NEXT
  352.                 NEXT
  353.                 PSET (x%, y%), _RGB(CINT(r% / endArea%), CINT(g% / endArea%), CINT(b% / endArea%))
  354.                 IF INKEY$ = CHR$(27) THEN SYSTEM
  355.             NEXT
  356.         NEXT
  357.     END IF
  358.  
  359. '####################################################################################################################
  360.  
  361. SUB calcPoint (screenX!, screenY!, r%, g%, b%)
  362.     applyLocation screenX!, screenY!, px, py
  363.  
  364.     fractal px, py, numIter1%, numIter2%
  365.  
  366.     outside1 numIter1%, index!
  367.     getGradient 0, index!, r!, g!, b!
  368.  
  369.     outside2 numIter2%, index!
  370.     getGradient 1, index!, r2!, g2!, b2!
  371.     r! = ABS(r! - r2!): g! = ABS(g! - g2!): b! = ABS(b! - b2!)
  372.  
  373.     outside3 numIter2%, index!
  374.     getGradient 2, index!, r2!, g2!, b2!
  375.     r1! = r!: g1! = g!: b1! = b!
  376.     mergeOverlay r!, g!, b!, r2!, g2!, b2!
  377.     r! = r1! + (r! - r1!) * 0.45
  378.     g! = g1! + (g! - g1!) * 0.45
  379.     b! = b1! + (b! - b1!) * 0.45
  380.  
  381.     outside4 numIter2%, index!
  382.     getGradient 3, index!, r2!, g2!, b2!
  383.     r! = r! + r2!: g! = g! + g2!: b! = b! + b2!
  384.  
  385.     outside5 px, py, numIter2%, index!
  386.     getGradient 4, index!, r2!, g2!, b2!
  387.     r1! = r!: g1! = g!: b1! = b!
  388.     mergeColor r!, g!, b!, r2!, g2!, b2!
  389.     r! = r1! + (r! - r1!) * 0.5
  390.     g! = g1! + (g! - g1!) * 0.5
  391.     b! = b1! + (b! - b1!) * 0.5
  392.  
  393.     r% = r! * 255
  394.     g% = g! * 255
  395.     b% = b! * 255
  396.  
  397. '####################################################################################################################
  398.  
  399. SUB applyLocation (inX!, inY!, outX, outY)
  400.     x = (inX! - halfX%) * magX
  401.     y = (halfY% - inY!) * magY
  402.     outX = 0.99999998476912904932780850903444 * x - 1.7453292431333680334067268304459D-4 * y - 0.01168313399#
  403.     outY = 1.7453292431333680334067268304459D-4 * x + 0.99999998476912904932780850903444 * y - 0.00626625065#
  404.  
  405. '####################################################################################################################
  406.  
  407. SUB fractal (px, py, numIter1%, numIter2%)
  408.     xx = px * px: yy = py * py
  409.  
  410.     x = ABS(px * xx - 3 * px * yy) * 0.2
  411.     y = ABS(3 * xx * py - py * yy) * 0.2
  412.     x = x - INT(x * 2.5 + 0.5) * 0.4
  413.     y = y - INT(y * 2.5 + 0.5) * 0.4
  414.  
  415.     zx(0) = x: zy(0) = y
  416.  
  417.     numIter1% = -1
  418.     numIter2% = -1
  419.     FOR numIter% = 1 TO 149
  420.         x = x * 2: y = y * 2
  421.  
  422.         IF y > 1 THEN
  423.             y = y - 1
  424.         ELSEIF x > 1 THEN
  425.             x = x - 1
  426.         END IF
  427.  
  428.         zx(numIter%) = x: zy(numIter%) = y
  429.  
  430.         IF x * x + y * y > 127 THEN
  431.             IF numIter2% = -1 THEN numIter2% = numIter% - 1
  432.             IF numIter1% >= 0 THEN EXIT SUB
  433.         END IF
  434.  
  435.         bail = ABS(x + y)
  436.         IF bail * bail > 127 THEN
  437.             IF numIter1% = -1 THEN numIter1% = numIter% - 1
  438.             IF numIter2% >= 0 THEN EXIT SUB
  439.         END IF
  440.     NEXT
  441.  
  442.     IF numIter1% = -1 THEN numIter1% = 149
  443.     IF numIter2% = -1 THEN numIter2% = 149
  444.  
  445. '####################################################################################################################
  446.  
  447. SUB outside1 (numIter%, index!)
  448.     index! = ATN(numIter% / 25)
  449.  
  450. '####################################################################################################################
  451.  
  452. SUB outside2 (numIter%, index!)
  453.     closest = 1E+38
  454.     ix = 0
  455.     iy = 0
  456.  
  457.     FOR a% = 1 TO numIter%
  458.         x = zx(a%) * zx(a%): y = zy(a%) * zy(a%)
  459.         d = x * x + y * y
  460.  
  461.         IF d < closest THEN
  462.             closest = d
  463.             ix = zx(a%)
  464.             iy = zy(a%)
  465.         END IF
  466.     NEXT
  467.  
  468.     index! = SQR(SQR(ix * ix + iy * iy) * 2) / 2
  469.  
  470. '####################################################################################################################
  471.  
  472. SUB outside3 (numIter%, index!)
  473.     x = zx(numIter% + 1)
  474.     y = zy(numIter% + 1)
  475.     d = atan2(y, x) / pi2
  476.     index! = SQR((6.349563872353654# - 4.284804271440222# * LOG(LOG(SQR(x * x + y * y))) + ABS((d - INT(d)) * 4 - 2)) * 2) / 2
  477.  
  478. '####################################################################################################################
  479.  
  480. SUB outside4 (numIter%, index!)
  481.     closest = 1E+38
  482.  
  483.     FOR a% = 1 TO numIter%
  484.         zy2 = zy(a%) * zy(a%)
  485.         d = zx(a%) + zx(a%) * zx(a%) + zy2
  486.         d = SQR(d * d + zy2)
  487.  
  488.         IF d < closest THEN
  489.             closest = d
  490.         END IF
  491.     NEXT
  492.  
  493.     index! = asin(closest ^ .1) ^ (1 / 1.5) * .41577394#
  494.  
  495. '####################################################################################################################
  496.  
  497. SUB outside5 (px, py, numIter%, index!)
  498.     r = SQR(px * px + py * py)
  499.     cost = px / r
  500.     sint = py / r
  501.  
  502.     ave = 0
  503.     i% = 0
  504.     FOR a% = 1 TO numIter%
  505.         prevave = ave
  506.  
  507.         x = zx(a%)
  508.         y = zy(a%)
  509.         r = SQR(x * x + y * y)
  510.         x = zx(a%) / r + cost
  511.         y = zy(a%) / r + sint
  512.  
  513.         ave = ave + SQR(x * x + y * y)
  514.  
  515.         cost = -cost
  516.         sint = -sint
  517.         i% = i% + 1
  518.     NEXT
  519.  
  520.     ave = ave / numIter%
  521.     prevave = prevave / (numIter% - 1)
  522.     x = zx(numIter% + 1)
  523.     y = zy(numIter% + 1)
  524.     f = 2.2762545841680618369458486886285 - 1.4426950408889634073599246810019 * LOG(LOG(SQR(x * x + y * y)))
  525.     index! = prevave + (ave - prevave) * f
  526.  
  527.     index! = index! * 2
  528.  
  529. '####################################################################################################################
  530. '# Math Library V0.11 (routines)
  531. '# By Zom-B
  532. '####################################################################################################################
  533.  
  534. '> merger: Skipping unused FUNCTION remainder% (a%, b%)
  535.  
  536. '> merger: Skipping unused FUNCTION fRemainder (a, b)
  537.  
  538. '####################################################################################################################
  539.  
  540. '> merger: Skipping unused FUNCTION safeLog (x)
  541.  
  542. '####################################################################################################################
  543.  
  544. FUNCTION asin (y)
  545.     IF y = -1 THEN asin = -pi05: EXIT FUNCTION
  546.     IF y = 1 THEN asin = pi05: EXIT FUNCTION
  547.     asin = ATN(y / SQR(1 - y * y))
  548.  
  549. '> merger: Skipping unused FUNCTION acos (y)
  550.  
  551. '> merger: Skipping unused FUNCTION safeAcos (y)
  552.  
  553. FUNCTION atan2 (y, x)
  554.     IF x > 0 THEN
  555.         atan2 = ATN(y / x)
  556.     ELSEIF x < 0 THEN
  557.         IF y > 0 THEN
  558.             atan2 = ATN(y / x) + pi
  559.         ELSE
  560.             atan2 = ATN(y / x) - pi
  561.         END IF
  562.     ELSEIF y > 0 THEN
  563.         atan2 = pi / 2
  564.     ELSE
  565.         atan2 = -pi / 2
  566.     END IF
  567.  
  568. '####################################################################################################################
  569. '# Screen mode selector v1.0 (routines)
  570. '# By Zom-B
  571. '####################################################################################################################
  572.  
  573. SUB selectScreenMode (yOffset%, colors%)
  574.     DIM aspectName$(10), aspectCol%(10)
  575.     RESTORE videoaspect
  576.     FOR y% = 0 TO 10
  577.         READ aspectName$(y%), aspectCol%(y%)
  578.         IF aspectCol%(y%) = 0 THEN numAspect% = y% - 1: EXIT FOR
  579.     NEXT
  580.  
  581.     DIM vidX%(100), vidY%(100), vidA%(100)
  582.     RESTORE videomodes
  583.     FOR y% = 1 TO 100
  584.         READ vidX%(y%), vidY%(y%), vidA%(y%)
  585.         IF (vidX%(y%) <= 0) THEN numModes% = y% - 1: EXIT FOR
  586.     NEXT
  587.  
  588.     IF numModes% > _HEIGHT - yOffset% - 1 THEN numModes% = _HEIGHT - yOffset% - 1
  589.  
  590.     DEF SEG = &HB800
  591.     LOCATE yOffset% + 1, 1
  592.     PRINT "Select video mode:"; TAB(61); "Click "
  593.     POKE yOffset% * 160 + 132, 31
  594.  
  595.     y% = 0
  596.     lastY% = 0
  597.     selectedAspect% = 0
  598.     reprint% = 1
  599.     lastButton% = 0
  600.     DO
  601.         IF INKEY$ = CHR$(27) THEN CLS: SYSTEM
  602.         IF reprint% THEN
  603.             reprint% = 0
  604.  
  605.             FOR x% = 1 TO numModes%
  606.                 LOCATE yOffset% + x% + 1, 1
  607.                 COLOR 7, 0
  608.                 PRINT USING "##:"; x%;
  609.                 IF selectedAspect% = 0 THEN
  610.                     COLOR aspectCol%(vidA%(x%))
  611.                 ELSEIF selectedAspect% = vidA%(x%) THEN
  612.                     COLOR 15
  613.                 ELSE
  614.                     COLOR 8
  615.                 END IF
  616.                 PRINT STR$(vidX%(x%)); ","; vidY%(x%);
  617.             NEXT
  618.  
  619.             FOR x% = 0 TO numAspect%
  620.                 IF x% > 0 AND selectedAspect% = x% THEN
  621.                     COLOR aspectCol%(x%), 3
  622.                 ELSE
  623.                     COLOR aspectCol%(x%), 0
  624.                 END IF
  625.                 LOCATE yOffset% + x% + 2, 64
  626.                 PRINT "<"; aspectName$(x%); ">"
  627.             NEXT
  628.         END IF
  629.         IF _MOUSEINPUT THEN
  630.             IF lastY% > 0 THEN
  631.                 FOR x% = 0 TO 159 STEP 2
  632.                     POKE lastY% + x%, PEEK(lastY% + x%) AND &HEF
  633.                 NEXT
  634.             END IF
  635.  
  636.             x% = _MOUSEX
  637.             y% = _MOUSEY - yOffset% - 1
  638.  
  639.             IF x% <= 60 THEN
  640.                 IF y% > 0 AND y% <= numModes% THEN
  641.                     IF _MOUSEBUTTON(1) = 0 AND lastButton% THEN EXIT DO
  642.                     y% = (yOffset% + y%) * 160 + 1
  643.                     FOR x% = 0 TO 119 STEP 2
  644.                         POKE y% + x%, PEEK(y% + x%) OR &H10
  645.                     NEXT
  646.                 ELSE
  647.                     y% = 0
  648.                 END IF
  649.             ELSE
  650.                 IF y% > 0 AND y% - 1 <= numAspect% THEN
  651.                     IF _MOUSEBUTTON(1) THEN
  652.                         selectedAspect% = y% - 1
  653.                         reprint% = 1
  654.                     END IF
  655.                     y% = (yOffset% + y%) * 160 + 1
  656.                     FOR x% = 120 TO 159 STEP 2
  657.                         POKE y% + x%, PEEK(y% + x%) OR &H10
  658.                     NEXT
  659.                 ELSE
  660.                     y% = 0
  661.                 END IF
  662.             END IF
  663.             lastY% = y%
  664.             lastButton% = _MOUSEBUTTON(1)
  665.         END IF
  666.     LOOP
  667.  
  668.     CLS 'bug evasion for small video modes
  669.     SCREEN _NEWIMAGE(vidX%(y%), vidY%(y%), colors%)
  670.  
  671. '####################################################################################################################
  672. '# Ultra Fractal Gradient library v1.1 (routines)
  673. '# By Zom-B
  674. '#
  675. '# Smooth Gradient algorithm from Ultra Fractal (www.ultrafractal.com)
  676. '####################################################################################################################
  677.  
  678. '> merger: Skipping unused SUB defaultGradient (gi%)
  679.  
  680. '> merger: Skipping unused SUB grayscaleGradient (gi%)
  681.  
  682. '####################################################################################################################
  683.  
  684. SUB setNumGradients (gi%)
  685.     offset% = LBOUND(gradientPoints) - 1
  686.     REDIM _PRESERVE gradientSmooth(gi% + offset%) AS _BYTE '_BIT <- bugged
  687.     REDIM _PRESERVE gradientPoints(gi% + offset%) AS INTEGER
  688.     REDIM _PRESERVE gradient(gi% + offset%, 1) AS GRADIENTPOINT
  689.  
  690. SUB addGradientPoint (gi%, index!, r!, g!, b!)
  691.     p% = gradientPoints(gi%)
  692.  
  693.     IF UBOUND(gradient, 2) < p% THEN
  694.         REDIM _PRESERVE gradient(0 TO UBOUND(gradient, 1), 0 TO p%) AS GRADIENTPOINT
  695.     END IF
  696.  
  697.     gradient(gi%, p%).index = index!
  698.     gradient(gi%, p%).r = r!
  699.     gradient(gi%, p%).g = g!
  700.     gradient(gi%, p%).b = b!
  701.     gradientPoints(gi%) = p% + 1
  702.  
  703. SUB setGradientSmooth (gi%, s%)
  704.     gradientSmooth(gi%) = s%
  705.  
  706.     IF gradientSmooth(0) = 0 THEN EXIT SUB
  707.  
  708.     FOR i% = 0 TO gradientPoints(gi%) - 1
  709.         ip1% = i% + 1
  710.         IF ip1% = gradientPoints(gi%) THEN ip1% = 2
  711.         in1% = i% - 1
  712.         IF in1% = -1 THEN in1% = gradientPoints(gi%) - 3
  713.  
  714.         dxl! = gradient(gi%, i%).index - gradient(gi%, in1%).index
  715.         dxr! = gradient(gi%, ip1%).index - gradient(gi%, i%).index
  716.         IF dxl! < 0 THEN dxl! = dxl! + 1
  717.         IF dxr! < 0 THEN dxr! = dxr! + 1
  718.  
  719.         d! = (gradient(gi%, i%).r - gradient(gi%, in1%).r) * dxr!
  720.         IF d! = 0 THEN
  721.             gradient(gi%, i%).rdr = 0
  722.             gradient(gi%, i%).rdl = 0
  723.         ELSE
  724.             d! = (gradient(gi%, ip1%).r - gradient(gi%, i%).r) * dxl! / d!
  725.             IF d! <= 0 THEN
  726.                 gradient(gi%, i%).rdr = 0
  727.                 gradient(gi%, i%).rdl = 0
  728.             ELSE
  729.                 gradient(gi%, i%).rdr = 1 / (1 + d!)
  730.                 gradient(gi%, i%).rdl = gradient(gi%, i%).rdr - 1
  731.             END IF
  732.         END IF
  733.  
  734.         d! = (gradient(gi%, i%).g - gradient(gi%, in1%).g) * dxr!
  735.         IF d! = 0 THEN
  736.             gradient(gi%, i%).gdr = 0
  737.             gradient(gi%, i%).gdl = 0
  738.         ELSE
  739.             d! = (gradient(gi%, ip1%).g - gradient(gi%, i%).g) * dxl! / d!
  740.             IF d! <= 0 THEN
  741.                 gradient(gi%, i%).gdr = 0
  742.                 gradient(gi%, i%).gdl = 0
  743.             ELSE
  744.                 gradient(gi%, i%).gdr = 1 / (1 + d!)
  745.                 gradient(gi%, i%).gdl = gradient(gi%, i%).gdr - 1
  746.             END IF
  747.         END IF
  748.  
  749.         d! = (gradient(gi%, i%).b - gradient(gi%, in1%).b) * dxr!
  750.         IF d! = 0 THEN
  751.             gradient(gi%, i%).bdr = 0
  752.             gradient(gi%, i%).bdl = 0
  753.         ELSE
  754.             d! = (gradient(gi%, ip1%).b - gradient(gi%, i%).b) * dxl! / d!
  755.             IF d! <= 0 THEN
  756.                 gradient(gi%, i%).bdr = 0
  757.                 gradient(gi%, i%).bdl = 0
  758.             ELSE
  759.                 gradient(gi%, i%).bdr = 1 / (1 + d!)
  760.                 gradient(gi%, i%).bdl = gradient(gi%, i%).bdr - 1
  761.             END IF
  762.         END IF
  763.     NEXT
  764.  
  765. '####################################################################################################################
  766.  
  767. SUB getGradient (gi%, index!, red!, green!, blue!)
  768.     IF index! < 0 THEN x! = 0 ELSE x! = index! - INT(index!)
  769.  
  770.     FOR l% = gradientPoints(gi%) - 2 TO 1 STEP -1
  771.         IF gradient(gi%, l%).index <= x! THEN
  772.             EXIT FOR
  773.         END IF
  774.     NEXT
  775.  
  776.     r% = l% + 1
  777.     u! = (x! - gradient(gi%, l%).index) / (gradient(gi%, r%).index - gradient(gi%, l%).index)
  778.  
  779.     IF gradientSmooth(gi%) THEN
  780.         u2! = u! * u!
  781.         u3! = u2! * u!
  782.         ur! = u3! - (u2! + u2!) + u!
  783.         ul! = u2! - u3!
  784.  
  785.         red! = gradient(gi%, l%).r + (gradient(gi%, r%).r - gradient(gi%, l%).r) * (u3! + 3 * (gradient(gi%, l%).rdr * ur! + (1 + gradient(gi%, r%).rdl) * ul!))
  786.         green! = gradient(gi%, l%).g + (gradient(gi%, r%).g - gradient(gi%, l%).g) * (u3! + 3 * (gradient(gi%, l%).gdr * ur! + (1 + gradient(gi%, r%).gdl) * ul!))
  787.         blue! = gradient(gi%, l%).b + (gradient(gi%, r%).b - gradient(gi%, l%).b) * (u3! + 3 * (gradient(gi%, l%).bdr * ur! + (1 + gradient(gi%, r%).bdl) * ul!))
  788.     ELSE
  789.         red! = gradient(gi%, l%).r + (gradient(gi%, r%).r - gradient(gi%, l%).r) * u!
  790.         green! = gradient(gi%, l%).g + (gradient(gi%, r%).g - gradient(gi%, l%).g) * u!
  791.         blue! = gradient(gi%, l%).b + (gradient(gi%, r%).b - gradient(gi%, l%).b) * u!
  792.     END IF
  793.  
  794. '> merger: Skipping unused SUB testGradient (gi%)
  795.  
  796. '####################################################################################################################
  797. '# Merge modes library v0.1 (routines)
  798. '# By Zom-B
  799. '####################################################################################################################
  800.  
  801. '> merger: Skipping unused SUB testMerge
  802.  
  803. '####################################################################################################################
  804.  
  805. SUB mergeOverlay (br!, bg!, bb!, tr!, tg!, tb!)
  806.     IF br! <= 0.5 THEN br! = br! * tr! * 2 ELSE br! = 1 - (1 - br!) * (1 - tr!) * 2
  807.     IF bg! <= 0.5 THEN bg! = bg! * tg! * 2 ELSE bg! = 1 - (1 - bg!) * (1 - tg!) * 2
  808.     IF bb! <= 0.5 THEN bb! = bb! * tb! * 2 ELSE bb! = 1 - (1 - bb!) * (1 - tb!) * 2
  809.  
  810. '> merger: Skipping unused SUB mergeHardLight (br!, bg!, bb!, tr!, tg!, tb!)
  811.  
  812. '> merger: Skipping unused SUB mergeSoftLight (br!, bg!, bb!, tr!, tg!, tb!)
  813.  
  814. SUB mergeColor (r!, g!, b!, r2!, g2!, b2!)
  815.     max! = r!
  816.     min! = r!
  817.     IF max! < g! THEN max! = g!
  818.     IF min! > g! THEN min! = g!
  819.     IF max! < b! THEN max! = b!
  820.     IF min! > b! THEN min! = b!
  821.  
  822.     lum1! = max! + min!
  823.  
  824.     max! = r2!
  825.     min! = r2!
  826.     IF max! < g2! THEN max! = g2!
  827.     IF min! > g2! THEN min! = g2!
  828.     IF max! < b2! THEN max! = b2!
  829.     IF min! > b2! THEN min! = b2!
  830.  
  831.     sum! = max! + min!
  832.     dif! = max! - min!
  833.  
  834.     IF sum! < 1 THEN
  835.         sat2! = dif! / sum!
  836.     ELSE
  837.         sat2! = dif! / (2 - sum!)
  838.     END IF
  839.  
  840.     IF dif! = 0 THEN
  841.         lum1! = lum1! * 0.5
  842.         r! = lum1!: g! = lum1!: b! = lum1!
  843.         EXIT SUB
  844.     END IF
  845.  
  846.     IF lum1! < 1 THEN
  847.         chr! = sat2! * lum1!
  848.     ELSE
  849.         chr! = sat2! * (2 - lum1!)
  850.     END IF
  851.     min! = (lum1! - chr!) * 0.5
  852.  
  853.     IF max! = r2! THEN
  854.         hue2! = (g2! - b2!) / dif!
  855.         IF hue2! < 0 THEN
  856.             r! = chr! + min!: g! = min!: b! = chr! * -hue2! + min!
  857.         ELSE
  858.             r! = chr! + min!: g! = chr! * hue2! + min!: b! = min!
  859.         END IF
  860.     ELSEIF max! = g2! THEN
  861.         hue2! = (b2! - r2!) / dif!
  862.         IF hue2! < 0 THEN
  863.             r! = chr! * -hue2! + min!: g! = chr! + min!: b! = min!
  864.         ELSE
  865.             r! = min!: g! = chr! + min!: b! = chr! * hue2! + min!
  866.         END IF
  867.     ELSE
  868.         hue2! = (r2! - g2!) / dif!
  869.         IF hue2! < 0 THEN
  870.             r! = min!: g! = chr! * -hue2! + min!: b! = chr! + min!
  871.         ELSE
  872.             r! = chr! * hue2! + min!: g! = min!: b! = chr! + min!
  873.         END IF
  874.     END IF
  875.  
  876. '> merger: Skipping unused SUB mergeHSLAddition (r!, g!, b!, r2!, g2!, b2!)
  877.  
  878. '####################################################################################################################
  879.  
  880. '> merger: Skipping unused SUB mergeHue (r!, g!, b!, r2!, g2!, b2!)
  881.  
  882. '> merger: Skipping unused SUB rgb2hsl (r!, g!, b!, chr!, smallest!, hue!, sat!, lum!)
  883.  
  884. '> merger: Skipping unused SUB hsl2rgb (hue!, sat!, lum!, r!, g!, b!)
  885.  
  886. '> merger: Skipping unused SUB hsl2rgb2 (hue!, chr!, smallest!, r!, g!, b!)
  887.  

Hearts and Butterflies.png

36
Samples / Legacy Samples Package (19XX-2018)
« on: March 10, 2018, 10:52:47 am »
Attached to this post (in several zipped forms) is the /programs/samples/ folder included with the QB64 download until 2018.

37
Games / Tic Tac Toe in 3D by qbguy
« on: March 10, 2018, 10:15:17 am »
Tic Tac Toe in 3D

Author: @qbguy
Source: [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] Forum
URL: /forum/index.php?topic=56.0]http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=56.0
Version: 2008
Tags: [3d], [game], [ai], [mouse]

Description:
The goal is to get four in a row while preventing the computer from doing the same. Move by clicking the mouse.

Source Code:
Code: QB64: [Select]
  1. DECLARE SUB SHOWWIN (C%, R%, p%, COLOUR%)
  2. DECLARE SUB MAKEMOVE (X%, Y%, Z%, COLOUR%)
  3. DECLARE SUB GETMOVE (X%, Y%, Z%)
  4. DEFINT A-Z
  5. DIM E(7), PEEKB(1999)
  6. GOSUB INIT
  7. E(1) = 254: E(2) = 18: E(3) = 2: E(4) = 1: E(5) = 2: E(6) = 66: E(7) = 255
  8. Q = 564: G = 628: L = 768
  9. FOR K = G TO G + 63
  10.     PEEKB(K) = 128
  11. FOR K = S TO S + 75
  12.     PEEKB(K) = 128
  13. 100 CALL GETMOVE(C, R, p)
  14. X = 16 * (p - 1) + 4 * (R - 1) + C - 1
  15. IF PEEKB(G + X) <> 128 THEN GOTO 100
  16. CALL MAKEMOVE(C, R, p, 1)
  17. M = -1: GOSUB 1000
  18. GOSUB 2000
  19. IF W THEN CALL SHOWWIN(C, R, p, 1): END
  20. IF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": END
  21. GOSUB 3000
  22. M = 1: GOSUB 1000
  23. GOSUB 2000
  24. GOSUB 7000
  25. IF W THEN CALL SHOWWIN(C, R, p, 4): END
  26. IF T THEN LOCATE 15, 33: PRINT " --- Tie game --- ": END
  27. GOTO 100
  28.  
  29. 1000
  30. PEEKB(G + X) = 128 + M
  31. FOR K = L TO L + 303
  32.     IF PEEKB(K) <> X THEN GOTO 1001
  33.     Y = S + (K - L) \ 4: V = PEEKB(Y)
  34.     IF V = 0 THEN GOTO 1001
  35.     V = V - 128
  36.     IF V = 0 THEN
  37.         V = M + 128
  38.     ELSE
  39.         IF (SGN(V) = SGN(M)) THEN
  40.             V = V + M + 128
  41.         ELSE
  42.             V = 0
  43.         END IF
  44.     END IF
  45.     PEEKB(Y) = V
  46. 1001 NEXT
  47.  
  48. 2000
  49. W = 0: T = 1
  50. FOR K = S TO S + 75
  51.     V = PEEKB(K)
  52.     IF V THEN T = 0
  53.     IF ABS(V - 128) = 4 THEN W = 1
  54.  
  55. 3000
  56. FOR K = Q TO Q + 63
  57.     PEEKB(K) = 0
  58. FOR K = S TO S + 75
  59.     N = PEEKB(K) - 128
  60.     IF N = -128 THEN GOTO 3002
  61.     Z = E(N + 4)
  62.     F = L + 4 * (K - S)
  63.     FOR J = F TO F + 3
  64.         X = PEEKB(J)
  65.         IF PEEKB(G + X) <> 128 THEN GOTO 3001
  66.         V = PEEKB(Q + X)
  67.         IF V >= 254 THEN GOTO 3001
  68.         V = V + Z: IF Z >= 254 THEN V = Z
  69.         IF V > 255 THEN V = 255
  70.         PEEKB(Q + X) = V
  71.    3001 NEXT
  72. 3002 NEXT
  73. V9 = 0
  74. FOR K = 0 TO 63
  75.     V = PEEKB(Q + K)
  76.     IF V > 64 AND V < 128 THEN V = V - 64
  77.     IF V > 16 AND V < 32 THEN V = V - 16
  78.     IF V > V9 THEN V9 = V
  79.     PEEKB(Q + K) = V
  80. IF V9 < 32 THEN GOTO 4000
  81. 3800 X = 0
  82.     IF PEEKB(Q + X) = V9 THEN RETURN
  83.     X = X + 1
  84. 4000 P4 = 16
  85. FOR K = L TO L + 287 STEP 16
  86.     p = 0
  87.     FOR J = K TO K + 15
  88.         p = p + PEEKB(PEEKB(J) + G) - 128
  89.     NEXT
  90.     IF p > P4 THEN GOTO 4002
  91.     IF p < P4 THEN
  92.         P4 = p: V4 = 0: N4 = 0
  93.     END IF
  94.     FOR J = K TO K + 15
  95.         X1 = PEEKB(J)
  96.         V = PEEKB(Q + X1)
  97.         IF V = 0 THEN GOTO 4001
  98.         IF V < V4 THEN GOTO 4001
  99.         IF V > V4 THEN
  100.             V4 = V: N4 = 1
  101.         ELSE
  102.             N4 = N4 + 1
  103.             IF INT(RND(1) * N4) <> 0 THEN GOTO 4001
  104.         END IF
  105.         X = X1
  106.    4001 NEXT
  107. 4002 NEXT
  108. IF V4 = 0 THEN GOTO 3800
  109.  
  110. 7000
  111. p = X \ 16 + 1
  112. X = X - 16 * (p - 1)
  113. R = X \ 4 + 1
  114. C = (X MOD 4) + 1
  115. CALL MAKEMOVE(C, R, p, 4)
  116.  
  117.  
  118. INIT:
  119. L = 768
  120. FOR K = 0 TO 63
  121.     PEEKB(L + K) = K
  122. L = L + 64
  123. a = 4: B = 16
  124. FOR S = 1 TO 4
  125.     GOSUB 19000
  126. a = 16: B = 1
  127. FOR S = 1 TO 13 STEP 4
  128.     GOSUB 19000
  129. S = 1: a = 5: B = 16: GOSUB 19000
  130. S = 13: a = -3: B = 16: GOSUB 19000
  131. S = 1: a = 20: B = 1: GOSUB 19000
  132. S = 49: a = -12: B = 1: GOSUB 19000
  133. S = 1: a = 17: B = 4: GOSUB 19000
  134. S = 49: a = -15: B = 4: GOSUB 19000
  135. S = 1: D = 21: GOSUB 18000
  136. S = 16: D = 11: GOSUB 18000
  137. S = 4: D = 19: GOSUB 18000
  138. S = 13: D = 13: GOSUB 18000
  139. GOSUB DRAWBD
  140.  
  141. 18000
  142. FOR K = S TO S + 3 * D STEP D
  143.     PEEKB(L) = K - 1: L = L + 1
  144.  
  145. 19000
  146. FOR J = S TO S + 3 * B STEP B
  147.     FOR K = J TO J + 3 * a STEP a
  148.         PEEKB(L) = K - 1: L = L + 1
  149.     NEXT
  150.  
  151. DRAWBD:
  152. LINE (0, 0)-(639, 479), 7, BF
  153. LINE (23, 23)-(616, 456), 0, B
  154. LINE (24, 24)-(615, 455), 14, BF
  155. Y = 130: GOSUB GRID
  156. Y = 230: GOSUB GRID
  157. Y = 330: GOSUB GRID
  158. Y = 430: GOSUB GRID
  159. PAINT (24, 24), 3, 0
  160.  
  161. GRID:
  162. FOR K = 0 TO 4
  163.     LINE (120 + 20 * K, Y - 20 * K)-(440 + 20 * K, Y - 20 * K), 0
  164.     LINE (120 + 80 * K, Y)-(200 + 80 * K, Y - 80), 0
  165.     LINE (117 - K, Y + 2)-(201 - K, Y - 82), 0
  166.     LINE (437 + K, Y + 2)-(521 + K, Y - 82), 0
  167. FOR K = 0 TO 1
  168.     LINE (117 - K, Y + K + 1)-(437 + K, Y + K + 1), 0
  169.     LINE (201 - K, Y - 81 - K)-(521 + K, Y - 81 - K), 0
  170.  
  171. SUB GETMOVE (X, Y, Z)
  172.     GETPOS:
  173.     IF INKEY$ = CHR$(27) THEN END
  174.     CALL getmouse(XX, YY, ZZ)
  175.     Z = (YY - 30) \ 100 + 1
  176.     IF Z < 1 OR Z > 4 THEN GOTO GETPOS
  177.     Y = ((YY - 30) \ 20) MOD 5
  178.     IF Y < 1 OR Y > 4 THEN GOTO GETPOS
  179.     IF XX + YY - 150 - 100 * Z < 0 THEN GOTO GETPOS
  180.     X = (XX + YY - 150 - 100 * Z) \ 80 + 1
  181.     IF X < 1 OR X > 4 THEN GOTO GETPOS
  182.     IF ZZ = 0 THEN GOTO GETPOS
  183.  
  184. SUB MAKEMOVE (X, Y, Z, COLOUR)
  185.     CIRCLE (80 * X - 20 * Y + 170, 100 * Z + 20 * Y - 60), 35, 8, , , 4 * (8 / 35) / 3
  186.     PAINT STEP(0, 0), COLOUR, 8
  187.     CIRCLE (80 * X - 20 * Y + 170, 100 * Z + 20 * Y - 60), 15, 8, , , 4 * (3 / 15) / 3
  188.     PAINT STEP(0, 0), COLOUR + 8, 8
  189.  
  190. SUB SHOWWIN (C, R, p, COLOUR)
  191.     DIM CC(0 TO 3), RR(0 TO 3), PP(0 TO 3)
  192.     FOR DC = -1 TO 1
  193.         FOR DR = -1 TO 1
  194.             FOR DP = -1 TO 1
  195.                 IF DC <> 0 OR DR <> 0 OR DP <> 0 THEN
  196.                     NDX = 0
  197.                     FOR K = -3 TO 3
  198.                         IF C + K * DC < 1 OR C + K * DC > 4 THEN GOTO 1
  199.                         IF R + K * DR < 1 OR R + K * DR > 4 THEN GOTO 1
  200.                         IF p + K * DP < 1 OR p + K * DP > 4 THEN GOTO 1
  201.                         ID = POINT(80 * (C + K * DC) - 20 * (R + K * DR) + 170, 100 * (p + K * DP) + 20 * (R + K * DR) - 60)
  202.                         IF ID <> COLOUR + 8 THEN EXIT FOR
  203.                         CC(NDX) = C + K * DC
  204.                         RR(NDX) = R + K * DR
  205.                         PP(NDX) = p + K * DP
  206.                         NDX = NDX + 1
  207.                         IF NDX = 4 THEN GOTO SHOW
  208.                    1 NEXT
  209.                 END IF
  210.             NEXT
  211.         NEXT
  212.     NEXT
  213.     SHOW:
  214.     FOR K = 0 TO 3
  215.         CIRCLE (80 * CC(K) - 20 * RR(K) + 170, 100 * PP(K) + 20 * RR(K) - 60), 35, COLOUR + 8, , , 4 * (8 / 35) / 3
  216.         PAINT STEP(0, 0), COLOUR + 8
  217.         CIRCLE STEP(0, 0), 15, 15, , , 4 * (3 / 15) / 3
  218.         PAINT STEP(0, 0), 15
  219.     NEXT
  220.  
  221. SUB getmouse (x%, y%, b%)
  222.     b% = 0
  223.     wheel% = 0
  224.     DO
  225.         IF _MOUSEBUTTON(1) THEN b% = b% OR 1
  226.         IF _MOUSEBUTTON(2) THEN b% = b% OR 2
  227.         IF _MOUSEBUTTON(3) THEN b% = b% OR 4
  228.     x% = _MOUSEX
  229.     y% = _MOUSEY
  230.  

TicTacToe3D.png

38
2D/3D Graphics / Ray-Tracing Engine by Zom-B
« on: March 06, 2018, 09:17:41 pm »
Ray-Tracing Engine

Author: Zom-B
Source: [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] Forum
URL: /forum/index.php?topic=1145.0]http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1145.0
Version: 2010
Tags: [3d], [raytrace]

Description:
This is a ray tracer I've been working on for the past 6 years. Well, on and off of course :) It's still a beta version. 43Kb. Bet this won't run in QB45.

Source Code:
Code: QB64: [Select]
  1. '> Merged with Zom-B's smart $include merger 0.51
  2.  
  3. ' Best viewed with 120 or more columns
  4.  
  5. DEFDBL A-Z
  6.  
  7. '####################################################################################################################
  8. '# Math Library V1.0 (include)
  9. '# By Zom-B
  10. '####################################################################################################################
  11.  
  12. CONST sqrt2 = 1.41421356237309504880168872420969807856967187537695 ' Knuth01
  13. CONST sqrt3 = 1.73205080756887729352744634150587236694280525381038 ' Knuth02
  14. CONST sqrt5 = 2.23606797749978969640917366873127623544061835961153 ' Knuth03
  15. CONST sqrt10 = 3.16227766016837933199889354443271853371955513932522 ' Knuth04
  16. CONST cubert2 = 1.25992104989487316476721060727822835057025146470151 ' Knuth05
  17. CONST cubert3 = 1.44224957030740838232163831078010958839186925349935 ' Knuth06
  18. CONST q2pow025 = 1.18920711500272106671749997056047591529297209246382 ' Knuth07
  19. CONST phi = 1.61803398874989484820458683436563811772030917980576 ' Knuth08
  20. CONST log2 = 0.69314718055994530941723212145817656807550013436026 ' Knuth09
  21. CONST log3 = 1.09861228866810969139524523692252570464749055782275 ' Knuth10
  22. CONST log10 = 2.30258509299404568401799145468436420760110148862877 ' Knuth11
  23. CONST logpi = 1.14472988584940017414342735135305871164729481291531 ' Knuth12
  24. CONST logphi = 0.48121182505960344749775891342436842313518433438566 ' Knuth13
  25. CONST q1log2 = 1.44269504088896340735992468100189213742664595415299 ' Knuth14
  26. CONST q1log10 = 0.43429448190325182765112891891660508229439700580367 ' Knuth15
  27. CONST q1logphi = 2.07808692123502753760132260611779576774219226778328 ' Knuth16
  28. CONST pi = 3.14159265358979323846264338327950288419716939937511 ' Knuth17
  29. CONST deg2rad = 0.01745329251994329576923690768488612713442871888542 ' Knuth18
  30. CONST q1pi = 0.31830988618379067153776752674502872406891929148091 ' Knuth19
  31. CONST pisqr = 9.86960440108935861883449099987615113531369940724079 ' Knuth20
  32. CONST gamma05 = 1.7724538509055160272981674833411451827975494561224 '  Knuth21
  33. CONST gamma033 = 2.6789385347077476336556929409746776441286893779573 '  Knuth22
  34. CONST gamma067 = 1.3541179394264004169452880281545137855193272660568 '  Knuth23
  35. CONST e = 2.71828182845904523536028747135266249775724709369996 ' Knuth24
  36. CONST q1e = 0.36787944117144232159552377016146086744581113103177 ' Knuth25
  37. CONST esqr = 7.38905609893065022723042746057500781318031557055185 ' Knuth26
  38. CONST eulergamma = 0.57721566490153286060651209008240243104215933593992 ' Knuth27
  39. CONST expeulergamma = 1.7810724179901979852365041031071795491696452143034 '  Knuth28
  40. CONST exppi025 = 2.19328005073801545655976965927873822346163764199427 ' Knuth29
  41. CONST sin1 = 0.84147098480789650665250232163029899962256306079837 ' Knuth30
  42. CONST cos1 = 0.54030230586813971740093660744297660373231042061792 ' Knuth31
  43. CONST zeta3 = 1.2020569031595942853997381615114499907649862923405 '  Knuth32
  44. CONST nloglog2 = 0.36651292058166432701243915823266946945426344783711 ' Knuth33
  45.  
  46. CONST logr10 = 0.43429448190325182765112891891660508229439700580367
  47. CONST logr2 = 1.44269504088896340735992468100189213742664595415299
  48. CONST pi05 = 1.57079632679489661923132169163975144209858469968755
  49. CONST pi2 = 6.28318530717958647692528676655900576839433879875021
  50. CONST q05log10 = 0.21714724095162591382556445945830254114719850290183
  51. CONST q05log2 = 0.72134752044448170367996234050094606871332297707649
  52. CONST q05pi = 0.15915494309189533576888376337251436203445964574046
  53. CONST q13 = 0.33333333333333333333333333333333333333333333333333
  54. CONST q16 = 0.16666666666666666666666666666666666666666666666667
  55. CONST q2pi = 0.63661977236758134307553505349005744813783858296183
  56. CONST q2sqrt5 = 0.89442719099991587856366946749251049417624734384461
  57. CONST rad2deg = 57.2957795130823208767981548141051703324054724665643
  58. CONST sqrt02 = 0.44721359549995793928183473374625524708812367192231
  59. CONST sqrt05 = 0.70710678118654752440084436210484903928483593768847
  60. CONST sqrt075 = 0.86602540378443864676372317075293618347140262690519
  61. CONST y2q112 = 1.05946309435929526456182529494634170077920431749419 ' Chromatic base
  62.  
  63. '####################################################################################################################
  64. '# Vector math library v0.1 (include part)
  65. '# By Zom-B
  66. '####################################################################################################################
  67.  
  68. TYPE VECTOR
  69.     x AS DOUBLE
  70.     y AS DOUBLE
  71.     z AS DOUBLE
  72.  
  73. '####################################################################################################################
  74. '# Screen mode selector v1.0 (include)
  75. '# By Zom-B
  76. '####################################################################################################################
  77.  
  78. videoaspect:
  79. DATA "all aspect",15
  80. DATA "4:3",11
  81. DATA "16:10",10
  82. DATA "16:9",14
  83. DATA "5:4",13
  84. DATA "3:2",12
  85. DATA "5:3",9
  86. DATA "1:1",7
  87. DATA "other",8
  88.  
  89. videomodes:
  90. DATA 256,256,7
  91. DATA 320,240,1
  92. DATA 400,300,1
  93. DATA 512,384,1
  94. DATA 512,512,7
  95. DATA 640,480,1
  96. DATA 720,540,1
  97. DATA 768,576,1
  98. DATA 800,480,2
  99. DATA 800,600,1
  100. DATA 854,480,3
  101. DATA 1024,600,8
  102. DATA 1024,640,2
  103. DATA 1024,768,1
  104. DATA 1024,1024,7
  105. DATA 1152,768,5
  106. DATA 1152,864,1
  107. DATA 1280,720,3
  108. DATA 1280,768,6
  109. DATA 1280,800,2
  110. DATA 1280,854,5
  111. DATA 1280,960,1
  112. DATA 1280,1024,4
  113. DATA 1366,768,3
  114. DATA 1400,1050,1
  115. DATA 1440,900,2
  116. DATA 1440,960,5
  117. DATA 1600,900,3
  118. DATA 1600,1200,1
  119. DATA 1680,1050,2
  120. DATA 1920,1080,3
  121. DATA 1920,1200,2
  122. DATA 2048,1152,3
  123. DATA 2048,1536,1
  124. DATA 2048,2048,7
  125. DATA ,,
  126.  
  127.  
  128. '####################################################################################################################
  129. '# Ray Tracer (Beta version)
  130. '# By Zom-B
  131. '####################################################################################################################
  132.  
  133. CONST Doantialias = -1
  134. CONST Usegaussian = 0
  135.  
  136. CONST FLOOR = 1
  137. CONST SPHERE = 2
  138.  
  139. TYPE TEXTURE
  140.     image AS LONG
  141.     w AS INTEGER
  142.     h AS INTEGER
  143.     scaleU AS SINGLE
  144.     scaleV AS SINGLE
  145.     offsetU AS SINGLE
  146.     offsetV AS SINGLE
  147.     bumpfactor AS SINGLE
  148.  
  149. DIM SHARED sizeX%, sizeY%
  150. DIM SHARED maxX%, maxY%
  151. DIM SHARED halfX%, halfY%
  152.  
  153. DIM SHARED texture&(4)
  154.  
  155. DIM SHARED camPos AS VECTOR
  156. DIM SHARED camDir AS VECTOR
  157. DIM SHARED camUp AS VECTOR
  158. DIM SHARED camRight AS VECTOR
  159.  
  160. 'Speed required with these variables, so not using TYPEs here
  161. DIM SHARED objectType%(7) '                                 Object type
  162. DIM SHARED positionX(7), positionY(7), positionZ(7) '       Object position
  163. DIM SHARED size(7) '                                        Radius (in case of a sphere)
  164. DIM SHARED colorR!(7), colorG!(7), colorB!(7), colorA!(7) ' RGBA color
  165. DIM SHARED specular!(7), highlight!(7) '                    Phong parameters
  166. DIM SHARED reflection!(7) '                                 Ray reflection amount
  167. DIM SHARED textures(7) AS TEXTURE, bumpmap(7) AS TEXTURE '  image handle
  168. DIM SHARED numObjects%
  169.  
  170. DIM SHARED lightX(4), lightY(4), lightZ(4) '                Light position
  171. DIM SHARED lightR!(4), lightG!(4), lightB!(4) '             Light color
  172. DIM SHARED numLights%
  173.  
  174. init
  175. main
  176.  
  177. worldMap:
  178. DATA "!~#!~#!~#!-#(.69AEGFC@5.224;DJMORQND:)(*$!:#'#$!e#+.+1WX\_`ab\MCOZ!/baaQ5&!)#'<;CB=,&!&#$06,8@6/$!%#&&##$8NL"
  179. DATA ":1%!P#-=@@D25CGHIKJYZ]A)=^b`!0b]:!+#$0M?80!.#*-6.!&#%#%#/6?VR=6)!*#'%!B#,DDID?>>/LLPRINQE,!%#$#'F!.bZ0!;#=P="
  180. DATA "-%$'$%)7GV^!)bA/)&6.##-BL/0+!,#/!'#$/80)&!'#$)5NA\]^]W3EQZ,[]baaN>0!&#J_!+bZ2!%#$$!+#$/3-!)#8V*##+R]PUV\!/ba"
  181. DATA "bb8CBN[XRF26/!(#(=*##&B`!'b_YQPYaaVVMTVVX]YJY]YFMaZ_!%b9$##/Q!(b]TJ6$!-#%>V`ba`UJ<),2;<DCSTL[`O]!%ba!:baSTVT"
  182. DATA "[XOOWT06OZ!.b_PNa!+b`WH._a]aOP%#&[!%baP@%##1@CF&!*#Dab\Mba\FFLQ`!*b\_!Gb##*--VS!1baa^ab_`abN0?E.=8GVT'!%#1_bb"
  183. DATA "<!(#8=/##&!%#$9RbbN=Ya^aV\!,baY]`!@b^!%b]G##$#CUab`WXGKQ^!)b__a]!%abA!&#%ObZ3.,!&#-@I!0#&#/aa`b=6TLUQ[a!,b!%a"
  184. DATA "!9ba^]Xa:)RNGF1!*#+AJ>!&#$@Y!+baZbb^=.##%Cbb^][)!4#2T+##9>Q^,3Q`!%b_!EbO*##$$1U\(!+#),3+!*#6Qa_a!&ba_abb`bbU"
  185. DATA "G,Taab``U8!2#/LJK$#-ZO;>T!>babTa!'babbN1'!&#L`=#&!&#')'%&!-#$)L`baa!*b_!%bGa`baabaX-!1#;?KaGJ!@babbabZ\!-bT$"
  186. DATA "!%#;6!&#&#'!4#*FYaa!)b`bQZ!'b[L7,PI%!2#9DZ!Rb[<*!%#'!=#+a!,bYPAU[!&b_@4(2)!2#%N!&b^!'bZMZWbbaW!@b^/5#'&!?#/a"
  187. DATA "!-bYPQVXb_84-!4#)C@PbMEER=[bb`-$(.Sb`(T!*b`!4b\R.(Q;%!@#,a!-baa^`bY9%!6#-!%bA($:2N3aNWJW[KPbbG3!9b]``X)##08!C#"
  188. DATA "N!1ba1!2#$!'#/[aP&*,3.;$B>D!%abbabM-!9b[7?U##)K2!C#)X!0bW&!9#4KJ`bbX!&#+('19!?bU&,Q.HQI$!E#K]!-bD!:#5a!(bQ:$"
  189. DATA "HA/)/M!@b@$%J-$!G#*B^!&b`GJ<8Q/!7#$%(N!+b]!&b`a!&bL`!:bC##%!J#;=_!%bA!J5!7#+Z!2b=!&bW:KV!7bX&#'!L#:0]bb6!&#"
  190. DATA "4BU,!6#I!3bLB!&b]\E(',\!2bU>3%!<#'*!3#Dbb@#-L)79Q4/!4#%a!4b5]!'b])##/V!&b_A?!&b`FL-#%!?#(!3#(H``HYX!%#/)E3,$"
  191. DATA "!/#$##V!4bJ5!&b\2!&#(!%bU(##G!%bV1-##*6!R#';;^ZM8$!(#(!.#*#&_!5b?YbZ=!)#TbP'!%#0<!%bK!%#6;!U#&7\8##$4-$#%!1#"
  192. DATA "a!6bJ3)'&!(#:bC!%#&'.PWbZ!%#)A5!V#5E31[^^QU:!1#2^!5b\[b+!*#ZF!%#$#,A)S-##&+9>!W#(0N!(b>0!0#8]!%bZX!1bJ!)#%#&"
  193. DATA "E&!%#'$G-!    $3Q##$!V#F!*bQ!0#*;/0#&@W!.b[)!)#%%!(#&L?U$%%C_0!?#$!<#1a!+bG!6#J!)b`!%bS*!3#0[_,/Wb_/2*4!1#%!C#"
  194. DATA "(!%#P!-bS4'!3#Q!(baB_bW&!5#=bR0`bK@<'*6F35$#%%!*#$!F#T!0bI+!1#)\!'b^bba-!6#$Da/05-=B%0+<Mb]C$,+!N#A!1bL!2#B!'b"
  195. DATA "Xbba(!8#8EH:!&'$)/,\b\C.#0)!M#X!/ba7!2#3!'b`b^b3!;#&-5-6$(%%&U,?2%#'+!*#%!C#7!/bA!3#8!)bXb?$#;!<#'&U_K#R,##%"
  196. DATA "!&#$!1#$!:#$Ia_!,b/!3#R!+b;)EY!;#1W`bbW4^T!)#.!%#)!,#$!=#1!-b)!3#Qa!(b]3#:bF!;#R!*b.!(#$$##0!I#`!+bJ!4#/a!(b"
  197. DATA "F##@b2#%%!5#,M^!+b`:!?*!L#(!*bJ1$!5#X!(bE##A\!9#L!.bY*!Q#/!)bT!8#K!'bO!&#%!9#J!/bC!Q#=!)b:!8#(_!%ba0!>#/!/b"
  198. DATA "C!Q#@!(bF!:#Hbb^6!@#]bbM=4I!'b^/!Q#R!&b^:!;#*3*$!@#$=0'!&#?[bb`D!)#/&!H#*a!%b]C!g#-NP@)!)#%Q1!G#/_b_K&!j#1:!*#"
  199. DATA "=C##%!E#1^bZ*!k#'1!(#)K>!I#Cbb;!t#8;!J#Wb`3!Q#-!n#G_W##0*!P#$!l#%AO5$!*#'&!~#!H#(!~#!;#$##%!(#%!~#!8#)8;'!W#"
  200. DATA "&!f#+>\O!G#&/EH3&!)#5?@:>[NLA7BD52;ONCDA92/!'#$$!F#$!'#.@>`bM%!5#+,)*+-41-'+8CD1GWa!(b_ZH8BY!9bTNOA8&!B#$6BA"
  201. DATA "30.%#'4E`!%bM!0#.6DX^a!,babb`!,b^_!Cb^W7!0#'/37>DIQZVUPOIB>K!'b`X`!(bL*!,#)IT!@b]`!BbaK2&!%#21!%./7?JHTa!Bb_"
  202. DATA "RG:7?;:GT`!db_;DDC?7!~b!=ba_!Uba!%baa!hbaabaa!%b`^!%bab]a`ba!?b_a!qba\_!~b!Ib"
  203.  
  204. '####################################################################################################################
  205. '####################################################################################################################
  206. '####################################################################################################################
  207.  
  208. SUB init ()
  209. WIDTH , 40
  210. PRINT TAB(27); "Ray Tracer (Beta version)"
  211. PRINT TAB(36); "By Zom-B"
  212.  
  213. scrn& = selectScreenMode&(4, 32)
  214.  
  215. makeTextures
  216. 'texture&(1) = _LOADIMAGE("d:\0synced\software\qb64\wTex.png", 32)
  217. 'texture&(2) = _LOADIMAGE("d:\0synced\software\qb64\wBump.png", 32)
  218. 'texture&(3) = _LOADIMAGE("d:\0synced\software\qb64\fTex.png", 32)
  219. 'texture&(4) = _LOADIMAGE("d:\0synced\software\qb64\fBump.png", 32)
  220.  
  221. makeScene
  222.  
  223. SCREEN scrn&
  224. _DEST scrn&
  225. 'SCREEN _NEWIMAGE(640, 480, 32)
  226.  
  227. sizeX% = _WIDTH
  228. sizeY% = _HEIGHT
  229. maxX% = sizeX% - 1
  230. maxY% = sizeY% - 1
  231. halfX% = sizeX% \ 2
  232. halfY% = sizeY% \ 2
  233.  
  234. cameraPrepare 150, -250, 200, 0, 0, 66, 0, 0, 1, 60, maxX% / maxY%
  235. 'cameraPrepare 0, 0, 400, 0, 0, 132, 0, -1, 0, 45, maxX% / maxY%
  236.  
  237. '####################################################################################################################
  238.  
  239. SUB main ()
  240. 'FOR i% = 0 TO 360 STEP 30
  241. '  x = 100 * COS(i% * _deg2rad)
  242. '  y = 100 * SIN(i% * _deg2rad)
  243. '  cameraPrepare x, y, 400, 0, 0, 200, 0, 0, 1, 60, maxX% / maxY%
  244.  
  245. renderProgressive 256, 4
  246.  
  247. CIRCLE (maxX% \ 2, maxY% \ 2), 3, _RGB32(255, 255, 255), , , 1
  248. 'NEXT
  249.  
  250. '####################################################################################################################
  251. '####################################################################################################################
  252. '####################################################################################################################
  253.  
  254. SUB cameraPrepare (posX, posY, posZ, lookAtX, lookAtY, lookAtZ, upX, upY, upZ, fov, aspect)
  255. camPos.x = posX
  256. camPos.y = posY
  257. camPos.z = posZ
  258.  
  259. camDir.x = lookAtX - posX
  260. camDir.y = lookAtY - posY
  261. camDir.z = lookAtZ - posZ
  262. vectorNormalize camDir
  263. 'PRINT camDir.x, camDir.y, camDir.z
  264.  
  265. camUp.x = upX
  266. camUp.y = upY
  267. camUp.z = upZ
  268. 'vectorNormalize camUp
  269. 'PRINT camUp.x, camUp.y, camUp.z
  270.  
  271. 'Right vec
  272. vectorCross camUp, camDir, camRight
  273. vectorNormalize camRight
  274. 'PRINT camRight.x, camRight.y, camRight.z
  275.  
  276. vectorCross camDir, camRight, camUp
  277. vectorNormalize camUp
  278. 'PRINT camUp.x, camUp.y, camUp.z
  279. 'END
  280.  
  281. scaleY = TAN(fov * (_PI / 360)) * 0.75
  282. scaleX = scaleY * aspect
  283.  
  284. vectorScale camRight, scaleX
  285. vectorScale camUp, scaleY
  286.  
  287. 'PRINT fov, scaleX, scaleY
  288. 'END
  289.  
  290. '####################################################################################################################
  291.  
  292. SUB renderProgressive (startSize%, endSize%)
  293. pixStep% = startSize%
  294.  
  295. pixWidth% = pixStep% - 1
  296. FOR y% = 0 TO maxY% STEP pixStep%
  297.     FOR x% = 0 TO maxX% STEP pixStep%
  298.         tracePoint x%, y%, r!, g!, b!
  299.         LINE (x%, y%)-STEP(pixWidth%, pixWidth%), _RGB(r! * 255, g! * 255, b! * 255), BF
  300.     NEXT
  301.     IF INKEY$ = CHR$(27) THEN SYSTEM
  302.  
  303. WHILE pixStep% > 2
  304.     pixSize% = pixStep% \ 2
  305.     pixWidth% = pixSize% - 1
  306.     FOR y% = 0 TO maxY% STEP pixStep%
  307.         y1% = y% + pixSize%