« previous next »
Pages: [1]   Go Down

Author Topic: Psychedelic Star Swirl  (Read 7360 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Psychedelic Star Swirl
« on: March 04, 2018, 08:30:45 pm »
One Year Anniversary Edition:
Code: QB64: [Select]
  1. _TITLE "Psychedelic Star Swirl bplus 2018-03-04"
  2. ' translated from
  3. ' Psychedelic Star Swirl.bas SmallBASIC 0.12.8 [B+=MGA] 2017-03-03
  4. ' Spiral Pearl Swirl 4 SB.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-01
  5. ' from Spiral Pearl Swirl.bas for FreeBASIC [B+=MGA] 2017-02-28
  6. ' from SdlBasic 3d version 2017-02-28
  7. ' inspired by spiral Bang
  8. CONST xmax = 1280
  9. CONST ymax = 760
  10. SCREEN _NEWIMAGE(xmax, ymax, 32)
  12.  
  13. DIM SHARED r, g, b, clr
  14. 'whatever screen size your device here is middle
  15. cx = xmax / 2: cy = ymax / 2: r = RND: g = RND: b = RND: k$ = " "
  17.     size = 1
  18.     radius = .06
  19.     angle = sangle
  20.     CLS
  21.     WHILE radius < 800
  22.         x = COS(angle) * radius
  23.         y = SIN(angle) * radius
  24.         r2 = (x ^ 2 + y ^ 2) ^ .5
  25.         size = 4 * r2 ^ .25
  26.         FOR r = size TO 1 STEP -4
  27.             'cc = 160 + 95 * radius/400 - r/size*120
  28.             chColor
  29.             star cx + x, cy + y, r / 3, r * 1.6, 5, RND * 360
  30.         NEXT
  31.         angle = angle - .4
  32.         radius = radius + 1
  33.     WEND
  34.     _DISPLAY ' update screen with new image
  35.     _LIMIT 5 '<<<<<<<<<<<<<<<<<<<<<<<<<< adjust to higher speeds if you dare
  36.     sangle = sangle + _PI(1 / 18)
  38.  
  39. SUB star (x, y, rInner, rOuter, nPoints, angleOffset)
  40.     ' x, y are same as for circle,
  41.     ' rInner is center circle radius
  42.     ' rOuter is the outer most point of star
  43.     ' nPoints is the number of points,
  44.     ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
  45.     ' this is to allow us to spin the polygon of n sides
  46.     pAngle = RAD(360 / nPoints): radAngleOffset = RAD(angleOffset)
  47.     x1 = x + rInner * COS(radAngleOffset)
  48.     y1 = y + rInner * SIN(radAngleOffset)
  49.     FOR i = 0 TO nPoints - 1
  50.         x2 = x + rOuter * COS(i * pAngle + radAngleOffset + .5 * pAngle)
  51.         y2 = y + rOuter * SIN(i * pAngle + radAngleOffset + .5 * pAngle)
  52.         x3 = x + rInner * COS((i + 1) * pAngle + radAngleOffset)
  53.         y3 = y + rInner * SIN((i + 1) * pAngle + radAngleOffset)
  54.         LINE (x1, y1)-(x2, y2)
  55.         LINE (x2, y2)-(x3, y3)
  56.         x1 = x3: y1 = y3
  57.     NEXT
  59.  
  60. SUB chColor ()
  61.     clr = clr + 1
  62.     COLOR _RGB32(127 + 127 * SIN(r * clr), 127 + 127 * SIN(g * clr), 127 + 127 * SIN(b * clr))
  63.     IF clr > 40000 THEN r = RND: g = RND: b = RND: clr = 0
  65. FUNCTION RAD (dA)
  66.     RAD = _PI(dA / 180)
  68.  
  69.  

Logged

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Psychedelic Star Swirl
« Reply #1 on: March 05, 2018, 04:20:11 am »
This looks pretty good! :D
Logged
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

FellippeHeitor

  • Guest
Re: Psychedelic Star Swirl
« Reply #2 on: March 05, 2018, 09:08:22 am »
Crazy stars, bplus!
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Psychedelic Star Swirl
« Reply #3 on: March 05, 2018, 09:20:09 am »
So how do your eyes feel after you've seen a dozen or so color patterns?
Logged

FellippeHeitor

  • Guest
Re: Psychedelic Star Swirl
« Reply #4 on: March 05, 2018, 10:07:35 am »
I don't like the slow frame rate so I increased it but then the stars were too fast. Maybe if you had more frames in between you could speed frame rate and make it smoother. The overall effect is great anyway.
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Psychedelic Star Swirl
« Reply #5 on: March 05, 2018, 10:14:22 am »
More orderly stars, smoother transitions faster color pattern changes:

Code: QB64: [Select]
  1. _TITLE "Psychedelic Star Swirl bplus 2018-03-05 mod 04"
  2. ' translated from
  3. ' Psychedelic Star Swirl.bas SmallBASIC 0.12.8 [B+=MGA] 2017-03-03
  4. ' Spiral Pearl Swirl 4 SB.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-03-01
  5. ' from Spiral Pearl Swirl.bas for FreeBASIC [B+=MGA] 2017-02-28
  6. ' from SdlBasic 3d version 2017-02-28
  7. ' inspired by spiral Bang
  8. CONST xmax = 1280
  9. CONST ymax = 760
  10. SCREEN _NEWIMAGE(xmax, ymax, 32)
  12.  
  13. DIM SHARED r, g, b, clr
  14. 'whatever screen size your device here is middle
  15. cx = xmax / 2: cy = ymax / 2: r = RND: g = RND: b = RND: k$ = " "
  17.     size = 1
  18.     radius = .06
  19.     angle = sangle
  20.     CLS
  21.     WHILE radius < 800
  22.         x = COS(angle) * radius
  23.         y = SIN(angle) * radius
  24.         r2 = (x ^ 2 + y ^ 2) ^ .5
  25.         size = 4 * r2 ^ .25
  26.         FOR r = size TO 1 STEP -7
  27.             'cc = 160 + 95 * radius/400 - r/size*120
  28.             chColor
  29.             star cx + x, cy + y, r / 3, r * 1.6, 5, angle
  30.         NEXT
  31.         angle = angle - .4
  32.         radius = radius + 1
  33.     WEND
  34.     _DISPLAY ' update screen with new image
  35.     _LIMIT 20 '<<<<<<<<<<<<<<<<<<<<<<<<<< adjust to higher speeds if you dare
  36.     sangle = sangle + _PI(1 / 360)
  38.  
  39. SUB star (x, y, rInner, rOuter, nPoints, angleOffset)
  40.     ' x, y are same as for circle,
  41.     ' rInner is center circle radius
  42.     ' rOuter is the outer most point of star
  43.     ' nPoints is the number of points,
  44.     ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
  45.     ' this is to allow us to spin the polygon of n sides
  46.     pAngle = RAD(360 / nPoints): radAngleOffset = RAD(angleOffset)
  47.     x1 = x + rInner * COS(radAngleOffset)
  48.     y1 = y + rInner * SIN(radAngleOffset)
  49.     FOR i = 0 TO nPoints - 1
  50.         x2 = x + rOuter * COS(i * pAngle + radAngleOffset + .5 * pAngle)
  51.         y2 = y + rOuter * SIN(i * pAngle + radAngleOffset + .5 * pAngle)
  52.         x3 = x + rInner * COS((i + 1) * pAngle + radAngleOffset)
  53.         y3 = y + rInner * SIN((i + 1) * pAngle + radAngleOffset)
  54.         LINE (x1, y1)-(x2, y2)
  55.         LINE (x2, y2)-(x3, y3)
  56.         x1 = x3: y1 = y3
  57.     NEXT
  59.  
  60. SUB chColor ()
  61.     clr = clr + 1
  62.     COLOR _RGB32(127 + 127 * SIN(r * clr), 127 + 127 * SIN(g * clr), 127 + 127 * SIN(b * clr))
  63.     IF clr > 40000 THEN r = RND: g = RND: b = RND: clr = 0
  65. FUNCTION RAD (dA)
  66.     RAD = _PI(dA / 180)
  68.  
  69.  

OMG too early in morning for this!!! bplus getting seasick
« Last Edit: March 05, 2018, 10:21:23 am by bplus »
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Psychedelic Star Swirl
« Reply #6 on: March 05, 2018, 12:20:03 pm »
The effect was totally lost on me. I'll go into it in more depth later, but right now I have to go outside and cluck like a chicken.

Well, maybe not hypnotic, but when I coded the program, the IDE was tilting! No kidding, it took my eyes about 30-seconds to re-adjust. You should market this to law enforcement for DUI marijuana detection. I figure anyone who is stoned would fall flat on his face when the program closed. Eitehr that, or deny that anything was moving while the program was running. Either way, lock 'em up!

Pete :D

PS That's a lot of bang for such little buck (code).
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Re: Psychedelic Star Swirl
« Reply #7 on: March 05, 2018, 07:17:46 pm »
No OpenGL here. Just old-fashioned number crunching. Only things i did were to eliminate CLS and comment call to findcentroid(), and set the fps limit to 128. It will go higher depending on your computing horsepower. Eliminated unused SUBS because code and comments would not fit.

Code: QB64: [Select]
  2. DEFINT A-Z
  3. CONST MaxPolys = 191
  4. CONST asteroid = 0
  5. CONST laserbomb = 1
  6. CONST ismyship = 2
  7. DIM SHARED CenterScreenX, CenterScreenY
  8.  
  9. '*************** Zom-B's famous (at least on [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]) screen mode selector!
  10. DIM SHARED maxscreenx, maxscreeny, maxscreenz
  12. WIDTH , 36
  13. maxscreenx = _DESKTOPWIDTH
  14. maxscreeny = _DESKTOPHEIGHT
  15. ncolors = 32
  16. SCREEN _NEWIMAGE(maxscreenx, maxscreeny, ncolors)
  17. CenterScreenX = _WIDTH / 2
  18. CenterScreenY = _HEIGHT / 2
  19. _TITLE "Rotating Polys Using Gradient Triangle And Lines From Center of screen to object centroid * rendered in real-time no get or put. press mouse button or space bar for cool effect, esc to exit"
  20.  
  21. DIM SHARED minX%(0 TO _HEIGHT - 1)
  22. DIM SHARED maxX%(0 TO _HEIGHT - 1)
  23. DIM SHARED minR!(0 TO _HEIGHT - 1)
  24. DIM SHARED maxR!(0 TO _HEIGHT - 1)
  25. DIM SHARED minG!(0 TO _HEIGHT - 1)
  26. DIM SHARED maxG!(0 TO _HEIGHT - 1)
  27. DIM SHARED minB!(0 TO _HEIGHT - 1)
  28. DIM SHARED maxB!(0 TO _HEIGHT - 1)
  29.  
  30. '************************ for experimental collision detection algo
  31. DIM SHARED DivSecX, DivSecY, DivSecZ, NumXSegs, NumYSegs, NumZSegs, MinObjectRotateXYZ%, MaxObjectRotateRateXYZ%, MaxR
  32. DIM SHARED currentplayerx, currentplayery, currentplayerz
  33. NumYSegs = 16
  34. NumXSegs = 16
  35. NumZSegs = 16
  36. maxscreenz = 1024
  37. DivSecY = _HEIGHT / NumYSegs
  38. DivSecX = _WIDTH / NumXSegs
  39. DivSecZ = maxscreenz / NumZSegs
  40.  
  41. '* this is just an arbitrary formula i came up with that keeps counts() and polysinregion() from having array bounds errors
  42. '* there is probably a better one available, but this involves a lot of probability theory
  43. ProbableMax = 2 * MaxPolys / ((NumXSegs + 1) ^ (1 / 8))
  44.  
  45. DIM SHARED Counts(NumXSegs, NumYSegs, NumZSegs), PolysInRegion(NumXSegs, NumYSegs, NumZSegs, ProbableMax)
  46.  
  47. '*************************
  48. TYPE PolyRec
  49.     px AS INTEGER
  50.     py AS INTEGER
  51.     pz AS INTEGER
  52.     radius AS INTEGER
  53.     nsides AS INTEGER
  54.     incx AS INTEGER
  55.     incy AS INTEGER
  56.     incz AS INTEGER
  57.     rotateangle AS INTEGER
  58.     incrotate AS INTEGER
  59.     vertical AS INTEGER
  60.     horizontal AS INTEGER
  61.     verticalinc AS INTEGER
  62.     horizontalinc AS INTEGER
  63.     fill AS INTEGER
  64.     fillstep AS INTEGER
  65.     dosectorlines AS INTEGER
  66.     cr AS SINGLE
  67.     cg AS SINGLE
  68.     cb AS SINGLE
  69.     crs AS SINGLE
  70.     cgs AS SINGLE
  71.     cbs AS SINGLE
  72.     mass AS INTEGER
  73.     alreadychecked AS INTEGER
  74.     style AS INTEGER
  75.     kind AS INTEGER
  76.     active AS INTEGER
  78. k! = 2520
  79. '2^3 * 3^2 * 5 * 7 = 2520, a number dividable by all numbers between 1 and 10.
  80. DIM SHARED SinTable!(0 TO k! - 1), CosTable!(0 TO k! - 1), UpBoundTrigTables%, mybulletmin, mybulletmax, myship, points&
  81.  
  82. UpBoundTrigTables% = UBOUND(SinTable!)
  83. MaxObjectRotateRateXYZ% = (UpBoundTrigTables% + 1) / 8
  84. MinObJectRotateRateXYZ% = (UpBoundTrigTables% + 1) / 15
  85. '* use precalculated trig tables for speed, especially doing rotations!
  86. '* this program does a ton of them
  87. FOR i = 0 TO UpBoundTrigTables%
  88.     a! = i * 3.141592653589793 / ((UpBoundTrigTables% + 1) / 2)
  89.     SinTable!(i) = SIN(a!)
  90.     CosTable!(i) = COS(a!)
  92. keystepx = maxscreenx / 10
  93. keystepy = maxscreeny / 10
  94. keystepz = maxscreenz / 10
  95. DIM Polys(MaxPolys) AS PolyRec
  96.  
  97. IF DivSecX < DivSecY THEN
  98.     MaxR = DivSecX
  100.     MaxR = DivSecY
  102. IF DivSecZ < MaxR THEN
  103.     MaxR = DivSecZ
  105.  
  106. '* user-controlled poly -- still a bit jumpy to say the least, even with loop-unrolled (formerly the for/next with index i on polygons)
  107. '* program a faster way to handle this and add some shooting/effects, you got yourself a game!
  108. myship = 0
  109. numbullets = 32
  110. mybulletmin = myship + 1
  111. mybulletmax = mybulletmin + numbullets
  112. '* set default values for stuff flying around on-screen
  113. '* must pass i as this determines the classification of the polygon
  114. '* far easier to do this than creating individual polygon records for the ship, its weapons (laserbombs) and each asteroid (polyoid)
  115. FOR i = 0 TO MaxPolys
  116.     setPolyParams Polys(), i
  118. nframes% = 0
  119. frames& = 0
  120. tstart# = TIMER
  121. Bytes% = (DivSecX * DivSecY * (32 / 8) + 4) / 2
  122. DIM RestoreScreen%(DivSecX, DivSecY, 1 TO Bytes%)
  123. oldpx = -1
  124. oldpy = -1
  125. asteroidhit = 0
  127.  
  128. '* change this to 0 for making into game
  129. testing = -1
  130. IF testing THEN
  131.     up$ = CHR$(0) + CHR$(72) '* up arrow
  132.     down$ = CHR$(0) + CHR$(80) '* down arrow
  133.     lft$ = CHR$(0) + CHR$(75) '* left arrow
  134.     rght$ = CHR$(0) + CHR$(77) '* right arrow
  135.     back$ = CHR$(0) + CHR$(141) '* ctrl-up
  136.     forward$ = CHR$(0) + CHR$(145) '*ctrl-down
  137.     fire$ = " "
  138.     fdx$ = "X"
  139.     fdy$ = "Y"
  140.     fdz$ = "Z"
  141.     fdxn$ = "^X"
  142.     fdyn$ = "^Y"
  143.     fdzn$ = "^Z"
  144.     cutthatcrapout$ = CHR$(27)
  146.     GetKey "Up", up$
  147.     GetKey "Down", down$
  148.     GetKey "Left", lft$
  149.     GetKey "Right", rght$
  150.     GetKey "forward", forward$
  151.     GetKey "Back", back$
  152.     GetKey "Fire", fire$
  153.     GetKey "Stop this infernal madness", cutthatcrapout$
  154.     GetKey "Fire Direction X+", fdx$
  155.     GetKey "Fire Direction Y+", fdy$
  156.     GetKey "Fire Direction Z+", fdz$
  157.     GetKey "Fire Direction X-", fdxn$
  158.     GetKey "Fire Direction Y-", fdyn$
  159.     GetKey "Fire Direction Z-", fdzn$
  161.  
  162. '_FULLSCREEN
  163. points& = 0
  164. asteroidhit = 0
  165. asteroidhitmax = 256
  166. i = MaxPolys + 1
  167. missilesactive% = 0
  168. nframes% = 0
  170.     frames& = frames& + 1
  171.     DO
  172.  
  173.         DO
  174.             lb% = _MOUSEBUTTON(1)
  175.             IF lb% THEN
  176.                 k$ = fire$
  177.             END IF
  178.             rb% = _MOUSEBUTTON(2)
  179.             IF rb% THEN '* function not yet implemented
  180.             END IF
  181.             currentplayerx = _MOUSEX
  182.             currentplayery = _MOUSEY
  183.             M% = _MOUSEINPUT
  184.         LOOP UNTIL NOT M%
  185.         k$ = INKEY$
  186.         SELECT CASE k$
  187.             CASE CHR$(1) TO CHR$(26)
  188.                 k$ = "^" + CHR$(ASC("A") - 1 + ASC(k$))
  189.         END SELECT
  190.         SELECT CASE k$ '* keyboard
  191.             CASE lft$
  192.                 currentplayerx = SetToMinMax(currentplayerx - keystepx, Polys(myship).radius, maxscreenx - Polys(myship).radius)
  193.             CASE rght$
  194.                 currentplayerx = SetToMinMax(currentplayerx + keystepx, Polys(myship).radius, maxscreenx - Polys(myship).radius)
  195.             CASE up$
  196.                 currentplayery = SetToMinMax(currentplayery - keystepy, Polys(myship).radius, maxscreeny - Polys(myship).radius)
  197.             CASE down$
  198.                 currentplayery = SetToMinMax(currentplayery + keystepy, Polys(myship).radius, maxscreeny - Polys(myship).radius)
  199.             CASE forward$ '* into the screen -- increasing z values move away from player
  200.                 currentplayerz = SetToMinMax(currentplayerz + keystepz, Polys(myship).radius, maxscreenz - Polys(myship).radius)
  201.             CASE back$
  202.                 currentplayerz = SetToMinMax(currentplayerz - keystepz, Polys(myship).radius, maxscreenz - Polys(myship).radius)
  203.             CASE fire$
  204.                 '* the laserbombs start in a cluster and spread out fairly evenly along x,y and z planes
  205.                 '* don't fire off too many at once or my collision-checking program might scream
  206.                 '* i have fired off 64 at once without failure. for a cool effect, hold down the spacebar
  207.                 '* or whatever key you select for your fire button and then release it.
  208.                 missilesactive% = -1
  209.                 nframes% = 0
  210.                 count% = 0
  211.                 FOR h = mybulletmin TO mybulletmax
  212.                     Polys(h).active = -1
  213.                     Polys(h).px = currentplayerx + Polys(myship).radius
  214.                     Polys(h).py = currentplayery + Polys(myship).radius
  215.                     Polys(h).pz = currentplayerz + Polys(myship).radius
  216.                     Polys(h).incx = (CINT(RND) * 2 - 1) * (INT(RND * (_HEIGHT \ 32)) + 1)
  217.                     Polys(h).incy = (CINT(RND) * 2 - 1) * (INT(RND * (_HEIGHT \ 32)) + 1)
  218.                     Polys(h).incz = (CINT(RND) * 2 - 1) * (INT(RND * (maxscreenz \ 32)) + 1)
  219.                     'Polys(h).incx = 7 + INT(RND * 9)
  220.                     'Polys(h).incy = 7 + INT(RND * 9)
  221.                     'Polys(h).incz = 7 + INT(RND * 9)
  222.                 NEXT
  223.                 IF fdx < 1 THEN
  224.                     fdx = 1
  225.                 END IF
  226.                 IF fdy < 1 THEN
  227.                     fdy = 1
  228.                 END IF
  229.                 IF fdz < 1 THEN
  230.                     fdz = 1
  231.                 END IF
  232.                 EXIT DO
  233.             CASE fdx$
  234.                 fdx = fdx + 1
  235.             CASE fdy$
  236.                 fdy = fdy + 1
  237.             CASE fdz$
  238.                 fdz = fdz + 1
  239.             CASE fdxn$ '* "^X"
  240.                 fdx = fdx - 1
  241.             CASE fdyn$ '* "^Y"
  242.                 fdy = fdy - 1
  243.             CASE fdzn$ '* "^Z"
  244.                 fdz = fdz - 1
  245.             CASE cutthatcrapout$
  246.                 SYSTEM
  247.             CASE ELSE
  248.                 mk = 0
  249.                 LOCATE 2, 1
  250.                 DO
  251.                     IF mk < LEN(k$) THEN
  252.                         mk = mk + 1
  253.                         PRINT USING "###:"; ASC(k$, mk);
  254.                     ELSE
  255.                         EXIT DO
  256.                     END IF
  257.                 LOOP
  258.         END SELECT
  259.     LOOP UNTIL k$ = ""
  260.     DO
  261.         IF oldpx <> currentplayerx OR oldpy <> currentplayery OR currentplayerz <> oldpz THEN
  262.             'drawpolySimple PlayerRect, _RGB32(PlayerRect.cr, playerrrect.cg, PlayerRect.cb)
  263.             oldpy = currentplayery
  264.             oldpx = currentplayerx
  265.             oldpz = currentplayerz
  266.             'PlayerRect.px = CurrentPlayerx
  267.             'PlayerRect.py = CurrentPlayerY
  268.             'PlayerRect.pz = CurrentPlayerZ
  269.         END IF
  270.         IF i > MaxPolys THEN
  271.             _DISPLAY
  272.             PrintLocate 3, 1, MID$(STR$(points&), 2), 1, 0, 0, dummy$
  273.             oldpx = currentplayerx - 1
  274.             oldpy = currentplayery - 1
  275.             i = 0
  276.             FOR X = 0 TO NumXSegs
  277.                 FOR y = 0 TO NumYSegs
  278.                     FOR z = 0 TO NumZSegs
  279.                         FOR a = 0 TO Counts(X, y, z) - 1
  280.                             Polys(PolysInRegion(X, y, z, a)).alreadychecked = 0
  281.                         NEXT
  282.                         Counts(X, y, z) = 0
  283.                     NEXT
  284.                 NEXT
  285.             NEXT
  286.             EXIT DO
  287.         ELSE
  288.             'drawpoly Polys(i), 0
  289.             SELECT CASE Polys(i).kind
  290.                 CASE ismyship
  291.                     Polys(i).px = currentplayerx
  292.                     Polys(i).py = currentplayery
  293.                     Polys(i).pz = currentplayerz
  294.                 CASE ELSE
  295.                     IF Polys(i).px > maxscreenx - Polys(i).incx - Polys(i).radius THEN
  296.                         Polys(i).incx = -Polys(i).incx
  297.                         Polys(i).incrotate = -SGN(Polys(i).incy) * RandRange%(MinObJectRotateRateXYZ%, MaxObjectRotateRateXYZ%)
  298.                     ELSEIF Polys(i).px < Polys(i).radius - Polys(i).incx THEN
  299.                         Polys(i).incx = -Polys(i).incx
  300.                         Polys(i).incrotate = SGN(Polys(i).incy) * RandRange%(MinObJectRotateRateXYZ%, MaxObjectRotateRateXYZ%)
  301.                     END IF
  302.  
  303.                     IF Polys(i).py > maxscreeny - Polys(i).incy - Polys(i).radius THEN
  304.                         Polys(i).incy = -Polys(i).incy
  305.                         Polys(i).incrotate = SGN(Polys(i).incx) * RandRange%(MinObJectRotateRateXYZ%, MaxObjectRotateRateXYZ%)
  306.                     ELSEIF Polys(i).py < Polys(i).radius - Polys(i).incy THEN
  307.                         Polys(i).incy = -Polys(i).incy
  308.                         Polys(i).incrotate = -SGN(Polys(i).incx) * RandRange%(MinObJectRotateRateXYZ%, MaxObjectRotateRateXYZ%)
  309.                     END IF
  310.  
  311.                     IF Polys(i).pz > maxscreenz - Polys(i).incz - Polys(i).radius THEN
  312.                         Polys(i).incz = -Polys(i).incz
  313.                         Polys(i).incrotate = SGN(Polys(i).incx) * RandRange%(MinObJectRotateRateXYZ%, MaxObjectRotateRateXYZ%)
  314.                     ELSEIF Polys(i).pz < Polys(i).radius - Polys(i).incz THEN
  315.                         Polys(i).incz = -Polys(i).incz
  316.                         Polys(i).incrotate = -SGN(Polys(i).incz) * RandRange%(MinObJectRotateRateXYZ%, MaxObjectRotateRateXYZ%)
  317.                     END IF
  318.             END SELECT
  319.             '* SetIncrementers Polys(i).px, Polys(i).incx, Polys(i).radius, Maxscreenx - Polys(i).radius
  320.             '* SetIncrementers Polys(i).py, Polys(i).incy, Polys(i).radius, Maxscreeny - Polys(i).radius
  321.             '* SetIncrementers Polys(i).pz, Polys(i).incz, Polys(i).radius, MaxScreenZ - Polys(i).radius
  322.  
  323.             SetIncrementers Polys(i).cr, Polys(i).crs, 0, 255
  324.             SetIncrementers Polys(i).cg, Polys(i).cgs, 0, 255
  325.             SetIncrementers Polys(i).cb, Polys(i).cbs, 0, 255
  326.  
  327.             Polys(i).horizontal = MapToTrigTables%(Polys(i).horizontal + Polys(i).horizontalinc)
  328.             Polys(i).vertical = MapToTrigTables%(Polys(i).vertical + Polys(i).verticalinc)
  329.             Polys(i).rotateangle = MapToTrigTables%(Polys(i).rotateangle + Polys(i).incrotate)
  330.  
  331.             Polys(i).px = Polys(i).px + Polys(i).incx
  332.             Polys(i).py = Polys(i).py + Polys(i).incy
  333.             Polys(i).pz = Polys(i).pz + Polys(i).incz
  334.  
  335.             Polys(i).cr = Polys(i).cr + Polys(i).crs
  336.             Polys(i).cg = Polys(i).cg + Polys(i).cgs
  337.             Polys(i).cb = Polys(i).cb + Polys(i).cbs
  338.             IF Polys(i).active THEN
  339.                 drawpoly Polys(i), 1
  340.  
  341.                 getsegminmax Polys(i).px, StartX, EndX, Polys(i).radius, IndexX, DivSecX, NumXSegs
  342.                 getsegminmax Polys(i).py, StartY, EndY, Polys(i).radius, IndexY, DivSecY, NumYSegs
  343.                 getsegminmax Polys(i).pz, StartZ, EndZ, Polys(i).radius, IndexZ, DivSecZ, NumZSegs
  344.  
  345.                 PolysInRegion(IndexX, IndexY, IndexZ, Counts(IndexX, IndexY, IndexZ)) = i
  346.                 Polys(PolysInRegion(IndexX, IndexY, IndexZ, i)).alreadychecked = -1
  347.                 FOR sx = StartX TO EndX
  348.                     FOR sy = StartY TO EndY
  349.                         FOR sz = StartZ TO EndZ
  350.                             FOR z = 0 TO Counts(sx, sy, sz) - 1
  351.                                 GOSUB MainCollider
  352.                             NEXT
  353.                         NEXT
  354.                     NEXT
  355.                 NEXT
  356.                 Counts(IndexX, IndexY, IndexZ) = Counts(IndexX, IndexY, IndexZ) + 1
  357.                 'PutRegion Polys(i), IndexX, IndexY, RestoreScreen%()
  358.             ELSE
  359.                 'drawpoly Polys(i), 0
  360.             END IF
  361.             i = i + 1
  362.             IF missilesasctive% THEN
  363.                 IF count% > MaxPolys% THEN
  364.                     IF nfames% < 64 THEN
  365.                         nframes% = nframes% + 1
  366.                     ELSE
  367.                         IF testing THEN
  368.                         ELSE
  369.                             '* LOCATE 2, 1
  370.                             '* PRINT "Ha! You missed us, James T Kirk -- you suck!";
  371.                         END IF
  372.                         FOR h = mybulletmin TO mybulletmax
  373.                             '* drawpoly Polys(h), 0
  374.                             Polys(h).active = 0
  375.                         NEXT
  376.                         count% = 0
  377.                         nframes% = 0
  378.                         missilesactive% = 0
  379.                     END IF
  380.                 ELSE
  381.                     count% = count% + 1
  382.                 END IF
  383.             END IF
  384.         END IF
  385.     LOOP
  386.     '_LIMIT 60
  387.     _DISPLAY
  388.     IF k$ = CHR$(27) THEN
  389.         EXIT DO
  390.     ELSE
  391.         'CLS
  392.         IF frames& MOD 1000 = 0 THEN
  393.             '_TITLE STR$(frames& / 1000) + STR$(frames& / (TIMER - tstart#))
  394.         END IF
  395.         'saveimage _DEST, "ScreenShot" + STR$(frame& / 1000)
  396.         'SYSTEM
  397.     END IF
  398.     _LIMIT 128
  400. tend# = TIMER
  401. PRINT frames& / (tend# - tstart#)
  404.  
  405. MainCollider:
  406. IF PolysInRegion(sx, sy, sz, i) <> PolysInRegion(sx, sy, sz, z) THEN
  407.     collide Polys(), PolysInRegion(sx, sy, sz, i), PolysInRegion(sx, sy, sz, z)
  408.     IF Distance(Polys(PolysInRegion(sx, sy, sz, i)), Polys(PolysInRegion(sx, sy, sz, z))) <= 0 THEN
  409.         SELECT CASE Polys(PolysInRegion(sx, sy, sz, i)).kind
  410.             CASE asteroid
  411.                 IF Polys(PolysInRegion(sx, sy, sz, z)).kind = laserbomb THEN
  412.                     '* asteroid smacked bomb
  413.                     Polys(PolysInRegion(sx, sy, sz, z)).active = 0
  414.                     Polys(PolysInRegion(sx, sy, sz, i)).active = 0
  415.                     points& = points& + 1
  416.                 END IF
  417.             CASE laserbomb
  418.                 IF Polys(PolysInRegion(sx, sy, sz, z)).kind = asteroid THEN
  419.                     '* bomb smacked asteroid
  420.                     Polys(PolysInRegion(sx, sy, sz, z)).active = 0
  421.                     Polys(PolysInRegion(sx, sy, sz, i)).active = 0
  422.                     IF testing THEN
  423.                     ELSE
  424.                         points& = points& + 1
  425.                         IF testing THEN
  426.                         ELSE
  427.                         END IF
  428.                     END IF
  429.                 END IF
  430.             CASE ismyship
  431.                 IF Polys(PolysInRegion(sx, sy, sz, z)).kind = asteroid THEN
  432.                     '* asteroid smacked my ship
  433.                     IF asteroidhit < asteroidhitmax THEN
  434.                         asteroidhit = asteroidhit + 1
  435.                     ELSE
  436.                         points& = points& - 1
  437.                         asteroidhit = 0
  438.                     END IF
  439.                 END IF
  440.         END SELECT
  441.     END IF
  444.  
  445. SUB setPolyParams (p() AS PolyRec, i)
  446.     p(i).radius = INT(((MaxR - 2) / 1.28) * RND) + 2
  447.     p(i).px = INT(RND * (maxscreenx - 2 * p(i).radius)) + p(i).radius
  448.     p(i).py = INT(RND * (maxscreeny - 2 * p(i).radius)) + p(i).radius
  449.     p(i).pz = INT(RND * (maxscreenz - 2 * p(i).radius)) + p(i).radius
  450.     p(i).nsides = INT(RND * 7) + 2
  451.     IF p(i).nsides = 2 THEN p(i).nsides = 40 'approximate circle
  452.     p(i).incx = (CINT(RND) * 2 - 1) * (INT(RND * (_HEIGHT \ 32)) + 1)
  453.     p(i).incy = (CINT(RND) * 2 - 1) * (INT(RND * (_HEIGHT \ 32)) + 1)
  454.     p(i).incz = (CINT(RND) * 2 - 1) * (INT(RND * (maxscreenz \ 32)) + 1)
  455.     p(i).rotateangle = RangeNum%(MinObjectRotateXYZ%, MaxObjectRotateRateXYZ%)
  456.     p(i).incrotate = (CINT(RND) * 2 - 1) * RandRange%(MinObJectRotateRateXYZ%, MaxObjectRotateRateXYZ%)
  457.  
  458.     '* these are used by drawpolySimple
  459.     p(i).fill = CINT(RND) * 2 - 1
  460.     p(i).fillstep = INT(RND * MaxR) + 1
  461.     p(i).style = INT(RND * 3)
  462.     p(i).dosectorlines = INT(1 - RND * 2)
  463.     p(i).vertical = (CINT(RND) * 2 - 1) * RangeNum%(MinObjectRotateXYZ%, MaxObjectRotateRateXYZ%)
  464.     p(i).horizontal = (CINT(RND) * 2 - 1) * RangeNum%(MinObjectRotateXYZ%, MaxObjectRotateRateXYZ%)
  465.     p(i).verticalinc = (CINT(RND) * 2 - 1) * RangeNum%(MinObjectRotateXYZ%, MaxObjectRotateRateXYZ%)
  466.     p(i).horizontalinc = (CINT(RND) * 2 - 1) * RangeNum%(MinObjectRotateXYZ%, MaxObjectRotateRateXYZ%)
  467.     'Color cycling
  468.     p(i).cr = RND * 256
  469.     p(i).cg = RND * 256
  470.     p(i).cb = RND * 256
  471.     p(i).crs = (CINT(RND) * 2 - 1) * (RND * 4 + 2)
  472.     p(i).cgs = (CINT(RND) * 2 - 1) * (RND * 4 + 2)
  473.     p(i).cbs = (CINT(RND) * 2 - 1) * (RND * 4 + 2)
  474.  
  475.     '* these are used by collision checker
  476.     p(i).mass = 1 '(Polys(i).radius ^ 3) / 4
  477.     p(i).alreadychecked = 0
  478.     p(i).active = -1
  479.     SELECT CASE i
  480.         CASE myship
  481.             p(i).kind = ismyship
  482.             p(i).incx = 0
  483.             p(i).incy = 0
  484.             p(i).incz = 0
  485.             p(i).radius = MaxR
  486.             IF _MOUSEINPUT THEN
  487.                 currentplayerx = _MOUSEX
  488.                 currentplayery = _MOUSEY
  489.             END IF
  490.             p(i).pz = currentplayerx
  491.             p(i).py = currentplayery
  492.             p(i).px = currentplayerz
  493.             p(i).incrotate = (UpBoundTrigTables% + 1) / (p(i).nsides + 1)
  494.         CASE mybulletmin TO mybulletmax
  495.             p(i).kind = laserbomb
  496.             p(i).active = 0
  497.             p(i).nsides = INT(RND * 7) + 3
  498.         CASE ELSE
  499.             p(i).kind = asteroid
  500.     END SELECT
  502. SUB GetKey (p$, r$)
  503.     PRINT "Press the key to go "; p$
  504.     DO
  505.         r$ = INKEY$
  506.     LOOP UNTIL r$ > ""
  508.  
  509. SUB getsegminmax (ptcheck, sxy, exy, radius, Index, divider, NumSegs)
  510.     Index = SetToMinMax(ptcheck \ divider, 0, NumSegs)
  511.     IF Index > 0 THEN
  512.         sxy = (ptcheck - radius) \ divider
  513.     ELSE
  514.         sxy = Index
  515.     END IF
  516.     IF (ptcheck + radius) \ divider > NumSegs THEN
  517.         exy = NumSegs
  518.     ELSE
  519.         exy = (ptcheck + radius) \ divider
  520.     END IF
  522.  
  523. FUNCTION SetToMinMax (calcvalue, minval, maxval)
  524.     '* used to calculate rotating values, namely color variations used for shading/coloring polygons and increments used for moving asteroids/laserbombs
  525.     '* whose values are not mouse/user input dependent
  526.     IF calcvalue < minval THEN
  527.         SetToMinMax = minval
  528.     ELSE
  529.         IF calcvalue > maxval THEN
  530.             SetToMinMax = maxval
  531.         ELSE
  532.             SetToMinMax = calcvalue
  533.         END IF
  534.     END IF
  536.  
  537. SUB SetIncrementers (a, addv, min, max)
  538.     a = SetToMinMax(a + addv, min, max)
  539.     IF a < min - addv THEN
  540.         addv = -addv
  541.     ELSEIF a > max - addv THEN
  542.         addv = -addv
  543.     END IF
  545.  
  546. SUB collide (p() AS PolyRec, x, y)
  547.     calcmethod = 1
  548.     SELECT CASE calcmethod
  549.         CASE 1
  550.             IF Distance(p(x), p(y)) > 0 THEN
  551.                 EXIT SUB
  552.             ELSE
  553.                 CalcVelocities p(), x, y
  554.                 p(x).alreadychecked = -1
  555.                 p(y).alreadychecked = -1
  556.             END IF
  557.         CASE ELSE
  558.             IF (NOT p(x).alreadychecked) OR (NOT p(y).alreadychecked) THEN
  559.                 IF ABS(p(x).pz - p(y).pz) < p(x).radius + p(y).radius THEN
  560.                     d = ((p(x).px - p(y).px) ^ 2 + (p(x).py - p(y).py) ^ 2)
  561.                     IF d <= (p(x).radius + p(y).radius) ^ 2 THEN
  562.                         CalcVelocities p(), x, y
  563.                         p(x).alreadychecked = -1
  564.                         p(y).alreadychecked = -1
  565.                     END IF
  566.                 END IF
  567.             END IF
  568.     END SELECT
  570.  
  571. FUNCTION Distance (p AS PolyRec, q AS PolyRec)
  572.     '* calculates distance using pythagorean formula for (x1,y1), (x2,y2) and relative distance betweenz Z
  573.     dx! = (p.px - q.px) ^ 2
  574.     dy! = (p.py - q.py) ^ 2
  575.     hyp! = SQR(dx! + dy!)
  576.     IF hyp! > p.radius + q.radius THEN
  577.         s! = hyp! - (p.radius + q.radius)
  578.     ELSE
  579.         IF ABS(p.pz - q.pz) > p.radius + q.radius THEN
  580.             s! = ABS(p.pz - q.pz)
  581.         ELSE
  582.             s! = hyp! - (p.radius + q.radius)
  583.         END IF
  584.     END IF
  585.     Distance = s!
  587.  
  588. FUNCTION RangeNum% (min%, max%)
  589.     '* generates random number from min% to max% inclusive
  590.     RangeNum% = min% + INT(RND * (max% - min% + 1))
  592.  
  593. FUNCTION GetPx (p AS PolyRec, m$)
  594.     SELECT CASE m$
  595.         CASE "x"
  596.             GetPx = p.px
  597.         CASE "y"
  598.             GetPx = p.py
  599.         CASE "z"
  600.             GetPx = p.pz
  601.         CASE ELSE
  602.             GetPx = 0
  603.     END SELECT
  605.  
  606. SUB CalcVelocities (b() AS PolyRec, i&, j&)
  607.     temp1 = b(i&).incx
  608.     temp2 = b(j&).incx
  609.     totalMass = (b(i&).mass + b(j&).mass)
  610.     b(i&).incx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  611.     b(j&).incx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
  612.     temp1 = b(i&).incy
  613.     temp2 = b(j&).incy
  614.     b(i&).incy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  615.     b(j&).incy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
  616.     temp1 = b(i&).incz
  617.     temp2 = b(j&).incz
  618.     b(i&).incz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
  619.     b(j&).incz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
  621.  
  622. SUB drawpoly (p AS PolyRec, intensity)
  623.     REDIM x(p.nsides), y(p.nsides)
  624.     cr0 = 255 * intensity
  625.     cg0 = 255 * intensity
  626.     cb0 = 255 * intensity
  627.     cr1 = p.cr * intensity
  628.     cg1 = p.cg * intensity
  629.     cb1 = p.cb * intensity
  630.  
  631.     x = p.px
  632.     y = p.py
  633.     z = p.pz
  634.     r = p.radius
  635.  
  636.     a! = p.rotateangle - INT(p.rotateangle / (UpBoundTrigTables% + 1)) * (UpBoundTrigTables% + 1)
  637.     sa! = (UpBoundTrigTables% + 1) / p.nsides
  638.     b = INT(a!)
  639.     x1! = CosTable!(b) * CosTable!(p.horizontal)
  640.     y1! = SinTable!(b) * SinTable!(p.vertical)
  641.     zscale! = (z / maxscreenz)
  642.     rzscale! = r * zscale!
  643.     IF x < _WIDTH / 2 THEN
  644.         fx = x + rzscale! / 3
  645.     ELSE
  646.         fx = x - rzscale! / 3
  647.     END IF
  648.  
  649.     IF y > _HEIGHT / 2 THEN
  650.         fy = y - rzscale! / 3
  651.     ELSE
  652.         fy = y + rzscale! / 3
  653.     END IF
  654.  
  655.     FOR a = p.nsides - 1 TO 0 STEP -1
  656.         a! = a! + sa!
  657.         a! = a! + (UpBoundTrigTables% + 1) * (a! >= (UpBoundTrigTables% + 1))
  658.         b = INT(a!)
  659.         x2! = CosTable!(b) * CosTable!(p.horizontal): x(a) = x2!
  660.         y2! = SinTable!(b) * SinTable!(p.vertical): y(a) = y2!
  661.         IF zscale! = 1 THEN
  662.             SELECT CASE p.style
  663.                 CASE 1
  664.                     gTriangle fx, fy, x + (x1! * rzscale!), y + (y1! * rzscale!), x + (x2! * rzscale!), y + (y2! * rzscale!), _RGB32(cr0, cg0, cb0), _RGB32(cr1, cg1, cb1), RGBToNum(cr1, cg1, cb1)
  665.                 CASE 2
  666.                     gTriangle fx, fy, x + (x1! * r), y + (y1! * r), x + (x2! * r), y + (y2! * r), _RGB32(cr0, cg0, cb0), _RGB32(cr1, cg1, cb1), _RGB32(cr1, cg1, cb1)
  667.                 CASE ELSE
  668.                     drawpolySimple p, _RGB32(cr0, cg0, cb0)
  669.             END SELECT
  670.         ELSEIF zscale! <> 0 THEN
  671.             SELECT CASE p.style
  672.                 CASE 1
  673.                     gTriangle fx, fy, x + (x1! * rzscale!), y + (y1! * rzscale!), x + (x2! * rzscale!), y + (y2! * rzscale!), _RGB32(cr0, cg0, cb0), _RGB32(cr1, cg1, cb1), RGBToNum(cr1, cg1, cb1)
  674.                 CASE 2
  675.                     gTriangle fx, fy, x + (x1! * r), y + (y1! * r), x + (x2! * r), y + (y2! * r), _RGB32(cr0, cg0, cb0), _RGB32(cr1, cg1, cb1), _RGB32(cr1, cg1, cb1)
  676.                 CASE ELSE
  677.                     drawpolySimple p, _RGB32(cr0, cg0, cb0)
  678.             END SELECT
  679.         END IF
  680.         x1! = x2!
  681.         y1! = y2!
  682.     NEXT
  684.  
  685. FUNCTION RGBToNum& (cr, cg, cb)
  686.     RGBToNum& = cr * 65536 + cg * 256 + cb
  688.  
  689. SUB NewPolyDraw (p AS PolyRec)
  690.     ang = 0
  691.     stp = 360 / p.nsides
  692.     deg = ATN(1) / 45
  693.     r = p.radius
  694.     x = p.px
  695.     y = p.py
  696.     DO
  697.         x1 = y + COS(ang * deg) * r
  698.         y1 = y + SIN(ang * deg) * r
  699.         x2 = y + COS((ang + 5) * deg) * r
  700.         y2 = y + SIN((ang + 5) * deg) * r
  701.         gTriangle x, y, x1, y1, x2, y2, c1&, c2&, c2&
  702.         ang = ang + stp
  703.     LOOP UNTIL ang > 360 - stp
  705.  
  706. SUB drawpolySimple (p AS PolyRec, c)
  707.     IF p.nsides > 0 THEN
  708.         IF c = 0 THEN
  709.             fc& = 0
  710.         ELSE
  711.             fc& = _RGB32(p.cr, p.cg, p.cb)
  712.         END IF
  713.         Zfactor! = p.pz / maxscreenz
  714.         yx = (UpBoundTrigTables% + 1) / p.nsides
  715.         angle2 = MapToTrigTables%(p.rotateangle)
  716.         FOR i = 0 TO (UpBoundTrigTables% + 1) STEP yx
  717.             angle = angle2
  718.             angle2 = MapToTrigTables%(angle + yx)
  719.             IF p.fill THEN
  720.                 FOR cr = 1 TO p.radius STEP p.fillstep
  721.                     x1 = p.px + Zfactor! * (cr * CosTable!(angle)) * CosTable!(MapToTrigTables%(p.horizontal))
  722.                     y1 = p.py + Zfactor! * (cr * SinTable!((angle))) * SinTable!(MapToTrigTables%(p.vertical))
  723.                     x2 = p.px + Zfactor! * (cr * CosTable!(((angle2)))) * CosTable!(MapToTrigTables%(p.horizontal))
  724.                     y2 = p.py + Zfactor! * (cr * SinTable!(((angle2)))) * SinTable!(MapToTrigTables%(p.vertical))
  725.                     LINE (x1, y1)-(x2, y2), fc&
  726.                     IF p.dosectorlines THEN
  727.                         LINE (p.px, p.py)-(x1, y1), fc&
  728.                     END IF
  729.                 NEXT
  730.             ELSE
  731.                 x1 = p.px + Zfactor! * (p.radius * CosTable!((angle)))
  732.                 y1 = p.py + Zfactor! * (p.radius * SinTable!((angle)))
  733.                 x2 = p.px + Zfactor! * (p.radius * CosTable!(((angle2))))
  734.                 y2 = p.py + Zfactor! * (p.radius * SinTable!(((angle2))))
  735.                 LINE (x1, y1)-(x2, y2), fc&
  736.                 IF p.dosectorlines THEN
  737.                     LINE (p.px, p.py)-(x1, y1), fc&
  738.                 END IF
  739.             END IF
  740.         NEXT
  741.     ELSE
  742.         PSET (p.px, p.py), c
  743.     END IF
  745.  
  746. FUNCTION MapToTrigTables% (angle)
  747.     a = angle MOD (UpBoundTrigTables% + 1)
  748.     IF a < 0 THEN
  749.         a = a + (UpBoundTrigTables% + 1)
  750.     END IF
  751.     MapToTrigTables% = a
  753.  
  754. FUNCTION CosToSinMap (angle)
  755.     '* not used
  756.     CosToSinMap = MapToTrigTables%(angle - (UpBoundTrigTables% + 1) / 4)
  758.  
  759. FUNCTION RandRange% (min%, max%)
  760.     RandRange% = min% + INT(RND * (max% - min% + 1))
  762.  
  763. '=== Make a linear gradient along the vertical axis of an edge ===
  764. SUB gTriangle (x1%, y1%, x2%, y2%, x3%, y3%, c1&, c2&, c3&)
  765.     cr1 = _RED32(c1&): cg1 = _GREEN32(c1&): cb1 = _BLUE32(c1&)
  766.     cr2 = _RED32(c2&): cg2 = _GREEN32(c2&): cb2 = _BLUE32(c2&)
  767.     cr3 = _RED32(c3&): cg3 = _GREEN32(c3&): cb3 = _BLUE32(c3&)
  768.  
  769.     minY% = y1%
  770.     maxY% = y1%
  771.     IF minY% > y2% THEN minY% = y2%
  772.     IF maxY% < y2% THEN maxY% = y2%
  773.     IF minY% > y3% THEN minY% = y3%
  774.     IF maxY% < y3% THEN maxY% = y3%
  775.  
  776.     IF minY% < 0 THEN minY% = 0
  777.     IF maxY% > _HEIGHT - 1 THEN maxY% = _HEIGHT - 1
  778.  
  779.     ' Create a vertical gradient along each side of the triangle
  780.     FOR y% = minY% TO maxY%
  781.         minX%(y%) = _WIDTH
  782.         maxX%(y%) = -1
  783.     NEXT
  784.  
  785.     gMark x1%, y1%, x2%, y2%, cr1%, cg1%, cb1%, cr2%, cg2%, cb2%
  786.     gMark x2%, y2%, x3%, y3%, cr2%, cg2%, cb2%, cr3%, cg3%, cb3%
  787.     gMark x3%, y3%, x1%, y1%, cr3%, cg3%, cb3%, cr1%, cg1%, cb1%
  788.  
  789.     FOR y% = minY% TO maxY%
  790.         x% = minX%(y%)
  791.         maxX% = maxX%(y%)
  792.         cr! = minR!(y%)
  793.         cg! = minG!(y%)
  794.         cb! = minB!(y%)
  795.  
  796.         D% = maxX% - x%
  797.         crs! = (maxR!(y%) - cr!) / D%
  798.         cgs! = (maxG!(y%) - cg!) / D%
  799.         cbs! = (maxB!(y%) - cb!) / D%
  800.  
  801.         IF maxX% >= _WIDTH THEN maxX% = _WIDTH - 1
  802.  
  803.         IF x% < 0 THEN
  804.             cr! = cr! - crs! * x%
  805.             cg! = cg! - cgs! * x%
  806.             cb! = cb! - cbs! * x%
  807.             x% = 0
  808.         END IF
  809.  
  810.         WHILE x% <= maxX%
  811.             PSET (x%, y%), _RGB(CINT(cr!) AND &HFF, CINT(cg!) AND &HFF, CINT(cb!) AND &HFF)
  812.             x% = x% + 1
  813.             cr! = cr! + crs!
  814.             cg! = cg! + cgs!
  815.             cb! = cb! + cbs!
  816.         WEND
  817.     NEXT
  819.  
  820. '=== Make a linear gradient along the vertical axis of an edge ===
  821. SUB gMark (x1%, y1%, x2%, y2%, cr1%, cg1%, cb1%, cr2%, cg2%, cb2%)
  822.     D% = y2% - y1%
  823.     IF y1% < y2% THEN
  824.         x! = x1%
  825.         y% = y1%
  826.         cr! = cr1%
  827.         cg! = cg1%
  828.         cb! = cb1%
  829.         maxY% = y2%
  830.     ELSE
  831.         x! = x2%
  832.         y% = y2%
  833.         cr! = cr2%
  834.         cg! = cg2%
  835.         cb! = cb2%
  836.         maxY% = y1%
  837.     END IF
  838.  
  839.     sx! = (x2% - x1%) / D%
  840.     crs! = (cr2% - cr1%) / D%
  841.     cgs! = (cg2% - cg1%) / D%
  842.     cbs! = (cb2% - cb1%) / D%
  843.  
  844.     IF maxY% >= _HEIGHT THEN maxY% = _HEIGHT - 1
  845.  
  846.     IF y% < 0 THEN
  847.         x! = x! - sx! * y%
  848.         cr! = cr! - crs! * y%
  849.         cg! = cg! - cgs! * y%
  850.         cb! = cb! - cbs! * y%
  851.         y% = 0
  852.     END IF
  853.  
  854.     WHILE y% <= maxY%
  855.         x% = CINT(x!)
  856.         IF minX%(y%) > x% THEN
  857.             minX%(y%) = x%
  858.             minR!(y%) = cr!
  859.             minG!(y%) = cg!
  860.             minB!(y%) = cb!
  861.         END IF
  862.         IF maxX%(y%) < x% THEN
  863.             maxX%(y%) = x%
  864.             maxR!(y%) = cr!
  865.             maxG!(y%) = cg!
  866.             maxB!(y%) = cb!
  867.         END IF
  868.         y% = y% + 1
  869.         x! = x! + sx!
  870.         cr! = cr! + crs!
  871.         cg! = cg! + cgs!
  872.         cb! = cb! + cbs!
  873.     WEND
  875.  
  876. SUB GetRegion (p AS PolyRec, ix, iy, pic%())
  877.     '* my failed attempt at capturing a screen region so only regions of screen have to be redrawn
  878.     x1 = SetToMinMax(p.px - p.radius, p.radius, _WIDTH - p.radius)
  879.     y1 = SetToMinMax(p.py - p.radius, p.radius, _HEIGHT - p.radius)
  880.     x2 = SetToMinMax(p.px + p.radius, x1 + p.radius, _WIDTH - p.radius)
  881.     y2 = SetToMinMax(p.py + p.radius, y1 + p.radius, _HEIGHT - p.radius)
  882.     GET (x, y)-(x + p.radius, y + p.radius), pic%(ix, iy, 1)
  883.     'GET (x, y)-STEP(2 * p.radius, 2 * p.radius), pic%(ix,iy,1)
  885.  
  886. SUB PutRegion (p AS PolyRec, ix, iy, pic%())
  887.     '* my failed attempt at redrawing a screen region so only regions of screen have to be redrawn
  888.     x1 = SetToMinMax(p.px - p.radius, p.radius, _WIDTH - p.radius)
  889.     y1 = SetToMinMax(p.py - p.radius, p.radius, _HEIGHT - p.radius)
  890.     x2 = SetToMinMax(p.px + p.radius, x1 + p.radius, _WIDTH - p.radius)
  891.     y2 = SetToMinMax(p.py + p.radius, y1 + p.radius, _HEIGHT - p.radius)
  892.     PUT (x1, y1), pic%(ix, iy, 1), PSET
  894.  
  895. SUB PrintLocate (row, col, what$, whatcolor, gotonextline, doinput, ret$)
  896.     LOCATE row, col
  897.     COLOR whatcolor
  898.     PRINT what$;
  899.     IF doinput THEN
  900.         LINE INPUT ret$
  901.     END IF
  902.     IF gotonextline THEN PRINT
  904.  
« Last Edit: March 05, 2018, 07:45:29 pm by codeguy »
Logged

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Re: Psychedelic Star Swirl
« Reply #8 on: March 05, 2018, 07:53:19 pm »
cool spinning spiral stars :). Indeed, psychedelic.
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Psychedelic Star Swirl
« Reply #9 on: March 06, 2018, 12:15:16 am »
Hi codeguy,

I looked at your 800 line plus beautiful monster in post above...

maybe you don't need any more psychedelic?   ;-))
Logged

Offline codeguy

  • Forum Regular
  • Posts: 174
    • View Profile
Re: Psychedelic Star Swirl
« Reply #10 on: March 06, 2018, 12:33:38 am »
Quote
Posted by: bplus
« on: Today at 02:15:16 AM »

Hi codeguy,

I looked at your 800 line plus beautiful monster in post above...

maybe you don't need any more psychedelic?   ;-))

LMBO. No psychedelics for me except on-screen. I like my brain unaltered.
:) :) :) :^)
« Last Edit: March 06, 2018, 12:36:36 am by codeguy »
Logged
Pages: [1]   Go Up
« previous next »