API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Oct 14th, 2019
169
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
QBasic 46.90 KB | None | 0 0
raw download clone embed print report
  1. OPTION BASE 0
  2.  
  3. RANDOMIZE TIMER
  4.  
  5. ' screen related stuff
  6. ' find out current screen resolution
  7. screenhandle = _SCREENIMAGE
  8. userresowidth = _WIDTH(screenhandle)
  9. userresoheight = _HEIGHT(screenhandle)
  10.  
  11. ' make a fullscreen window, or actually don't. make a quarter-screen window.
  12. DIM SHARED screenwidth, screenheight
  13. screenwidth = userresowidth / 2
  14. screenheight = userresoheight / 2
  15. SCREEN _NEWIMAGE(screenwidth, screenheight, 32), , 0, 1
  16. '_FULLSCREEN _STRETCH
  17.  
  18. _MOUSEHIDE
  19.  
  20. ' load the first font from a predetermined list that exists in the windows' font directory
  21. ' if none is found, then use qbasic/qb64 default
  22. windowsdir$ = ENVIRON$("SYSTEMROOT")
  23.  
  24. fontchoices = 2
  25. DIM fontchoice$(fontchoices)
  26.  
  27. fontchoice$(0) = "segoeuib.ttf"
  28. fontchoice$(1) = "ARIALBD.TTF"
  29. fontsize = 12
  30. FOR i = 0 TO fontchoices - 1
  31.     fontpath$ = windowsdir$ + "\Fonts\" + fontchoice$(i)
  32.     IF _FILEEXISTS(fontpath$) THEN
  33.         _FONT _LOADFONT(fontpath$, fontsize)
  34.         EXIT FOR
  35.     END IF
  36. NEXT i
  37. _PRINTMODE _KEEPBACKGROUND
  38.  
  39.  
  40.  
  41. totalcircles = 256
  42.  
  43. maxvx = 0 ' randomize initial velocities in the range -max/2 -> max/2
  44. maxvy = 0
  45. borders = 1
  46. friction = 0.92
  47. bordercoefficient = friction
  48. stictionthreshold = 0.4
  49.  
  50. particlegravity = 0 ' 0, 1
  51. downwardsgravity = 0.0008
  52.  
  53. DIM SHARED scancode(128) AS DOUBLE, oldscancode(128) AS DOUBLE, downscancode(128) AS DOUBLE, keyboardrepeat AS DOUBLE
  54.  
  55. DIM SHARED sqrlookup(32768) AS SINGLE: FOR i = 0 TO 32768: sqrlookup(i) = SQR(i / 32768): NEXT i
  56.  
  57. DIM circleactive(totalcircles), circletouched(totalcircles)
  58. DIM circleposx(totalcircles) AS DOUBLE, circleposy(totalcircles) AS DOUBLE
  59. DIM circlevx(totalcircles) AS DOUBLE, circlevy(totalcircles) AS DOUBLE
  60. DIM circlemass(totalcircles) AS DOUBLE, circlegravity(totalcircles) AS DOUBLE, circlesize(totalcircles) AS DOUBLE
  61. DIM circletolinecontacts(totalcircles) AS _UNSIGNED INTEGER
  62.  
  63. DIM tempcirclevix AS DOUBLE, tempcircleviy AS DOUBLE, tempcirclevjx AS DOUBLE, tempcirclevjy AS DOUBLE
  64. DIM radii AS DOUBLE, radius AS DOUBLE
  65. DIM vx AS DOUBLE, vy AS DOUBLE, newvx AS DOUBLE, newvy AS DOUBLE, newvix AS DOUBLE, newviy AS DOUBLE, newvjx AS DOUBLE, newvjy AS DOUBLE
  66. DIM tempivx AS DOUBLE, tempivy AS DOUBLE, tempjvx AS DOUBLE, tempjvy AS DOUBLE, tempvelocity AS DOUBLE, maxvelocity AS DOUBLE
  67. DIM collisionx AS DOUBLE, collisiony AS DOUBLE
  68. DIM diffxi AS DOUBLE, diffyi AS DOUBLE, diffxj AS DOUBLE, diffyj AS DOUBLE
  69. DIM sqrradi AS DOUBLE, sqrradj AS DOUBLE, sqrdiffi AS DOUBLE, sqrdiffj AS DOUBLE, normi AS DOUBLE, normj AS DOUBLE
  70. DIM distance AS DOUBLE, distx AS DOUBLE, disty AS DOUBLE, distxji AS DOUBLE, distyji AS DOUBLE, distp AS DOUBLE, distv AS DOUBLE
  71. DIM dist AS DOUBLE, distpow AS DOUBLE, unitx AS DOUBLE, unity AS DOUBLE, accx AS DOUBLE, accy AS DOUBLE
  72.  
  73.  
  74.  
  75. DIM particlecolor AS LONG, linecolor AS LONG, pixelcol AS LONG, colred AS LONG, colgre AS LONG, colblu AS LONG, color.black AS LONG
  76. particlecolor = _RGB(240, 240, 240)
  77. linecolor = _RGB(180, 180, 180)
  78. color.black = _RGB(0, 0, 0)
  79. hilightcells = 0
  80. fpslimit = 60
  81. physperframe = 16
  82.  
  83. levselectorfadertimer = TIMER(0.001)
  84. levselectorvisibletime = 4 ' in seconds
  85. levselectorfadetime = 2 ' in seconds
  86.  
  87.  
  88. totalvertices = 10000
  89. DIM linep1x(totalvertices), linep1y(totalvertices), linep2x(totalvertices), linep2y(totalvertices)
  90.  
  91. DIM gridcircle(256, 256, 200) ' why the fuck this needs to be done when i'm gonna redim it later anyway
  92. DIM gridline(256, 256, 1000)
  93.  
  94. DIM listoffiles$(131072)
  95. elmalevdir$ = "" '"E:\Program Files\eol\lev\"
  96. GOSUB getdirectorycontents
  97. GOSUB importelmalevel
  98. GOSUB initcircles
  99. GOSUB initlinegrid
  100.  
  101.  
  102.  
  103. ON TIMER(1) GOSUB updatefps
  104. TIMER ON
  105.  
  106. 'selectedline = 3
  107.  
  108. DO
  109.  
  110.     ' highlight cells that are occupied with circles and lines
  111.     IF hilightcells THEN
  112.         FOR y = 0 TO gridcellsy
  113.             FOR x = 0 TO gridcellsx
  114.                 IF gridcircle(x, y, 0) OR gridline(x, y, 0) THEN
  115.                     x1 = x * gridsizex
  116.                     y1 = y * gridsizey
  117.                     x2 = (x + 1) * gridsizex - 2
  118.                     y2 = (y + 1) * gridsizey - 2
  119.  
  120.                     cc = gridcircle(x, y, 0) * 10
  121.                     cl = gridline(x, y, 0) * 2 + 16
  122.                     IF cl > 160 THEN cl = 160
  123.                     c = cc + cl
  124.                     IF c > 240 THEN c = 240
  125.  
  126.                     LINE (x1, y1)-(x2, y2), _RGB(c, c, c), BF
  127.                 END IF
  128.             NEXT x
  129.         NEXT y
  130.     END IF
  131.  
  132.  
  133.     ' show level selector (or don't)
  134.     IF TIMER(0.001) < (levselectorfadertimer + levselectorvisibletime + levselectorfadetime) THEN
  135.         GOSUB showlevelselector
  136.     END IF
  137.  
  138.  
  139.     ' draw lines
  140.     FOR l = 0 TO totalvertices - 1
  141.         aaLine linep1x(l) + 0.1, linep1y(l) + 0.1, linep2x(l) + 0.1, linep2y(l) + 0.1, linecolor, 0 ' ...wtf
  142.         'LINE (linep1x(l), linep1y(l))-(linep2x(l), linep2y(l)), linecolor
  143.     NEXT l
  144.  
  145.  
  146.     ' check which is the fastest bacircle
  147.     maxvelocity = 0
  148.     FOR i = 0 TO totalcircles - 1
  149.         IF circleactive(i) THEN
  150.             tempvelocity = circlevx(i) * circlevx(i) + circlevy(i) * circlevy(i)
  151.             IF tempvelocity > maxvelocity THEN
  152.                 maxvelocity = tempvelocity
  153.                 maxvelocitybacircle = i
  154.             END IF
  155.         END IF
  156.     NEXT i
  157.  
  158.  
  159.     ' draw circles
  160.     FOR i = 0 TO totalcircles - 1
  161.         IF circleactive(i) THEN
  162.             IF i = maxvelocitybacircle THEN
  163.                 aaFilledCircle circleposx(i), circleposy(i), circlesize(i), _RGB(0, 255, 0)
  164.  
  165.                 'CIRCLE (circleposx(i), circleposy(i)), circlesize(i) - 2, _RGB(0, 255, 0)
  166.                 'PAINT (circleposx(i), circleposy(i)), _RGB(0, 255, 0)
  167.             ELSE
  168.                 'aaFilledCircle circleposx(i), circleposy(i), circlesize(i), particlecolor
  169.                 aaCircle circleposx(i), circleposy(i), circlesize(i), particlecolor, 0
  170.                 'CIRCLE (circleposx(i), circleposy(i)), circlesize(i), particlecolor
  171.                 'PAINT (circleposx(i), circleposy(i)), particlecolor
  172.                 'PSET (circleposx(i) + drawoffsetx, circleposy(i) + drawoffsety), particlecolor
  173.             END IF
  174.         END IF
  175.     NEXT i
  176.  
  177.  
  178.     ' calculate physics
  179.     FOR physicsframe = 1 TO physperframe
  180.  
  181.         GOSUB keyboardroutine ' keep it responsive
  182.  
  183.  
  184.         ' reset circle grid
  185.         FOR y = 0 TO gridcellsy
  186.             FOR x = 0 TO gridcellsx
  187.                 gridcircle(x, y, 0) = 0
  188.             NEXT x
  189.         NEXT y
  190.  
  191.         ' populate circle grid (retarded, make one that is only updated if there's any change (BUT MOOOM IT'S HARDER))
  192.         FOR i = 0 TO totalcircles - 1
  193.             IF circleactive(i) THEN
  194.                 pos1x = (circleposx(i) - circlesize(i)) \ gridsizex
  195.                 pos1y = (circleposy(i) - circlesize(i)) \ gridsizey
  196.                 pos2x = (circleposx(i) + circlesize(i)) \ gridsizex
  197.                 pos2y = (circleposy(i) + circlesize(i)) \ gridsizey
  198.  
  199.                 IF pos1x < 0 THEN pos1x = 0
  200.                 IF pos1y < 0 THEN pos1y = 0
  201.                 IF pos2x < 0 THEN pos2x = 0
  202.                 IF pos2y < 0 THEN pos2y = 0
  203.                 IF pos1x >= gridcellsx THEN pos1x = gridcellsx
  204.                 IF pos1y >= gridcellsy THEN pos1y = gridcellsy
  205.                 IF pos2x >= gridcellsx THEN pos2x = gridcellsx
  206.                 IF pos2y >= gridcellsy THEN pos2y = gridcellsy
  207.  
  208.                 FOR gy = pos1y TO pos2y
  209.                     FOR gx = pos1x TO pos2x
  210.                         gridcircle(gx, gy, 0) = gridcircle(gx, gy, 0) + 1 ' there's now one more circle in the current cell
  211.                         gridcircle(gx, gy, gridcircle(gx, gy, 0)) = i ' add that circle's id to that cell
  212.                     NEXT gx
  213.                 NEXT gy
  214.             END IF
  215.         NEXT i
  216.  
  217.  
  218.         ' loop through circles
  219.         FOR i = 0 TO totalcircles - 1
  220.  
  221.             IF circleactive(i) THEN
  222.  
  223.                 ' move circles
  224.                 circleposx(i) = circleposx(i) + circlevx(i)
  225.                 circleposy(i) = circleposy(i) + circlevy(i)
  226.  
  227.                 ' bounce off screen boundaries
  228.                 IF borders THEN
  229.                     IF circleposx(i) < circlesize(i) AND circlevx(i) < 0 THEN
  230.                         circleposx(i) = circlesize(i)
  231.                         circlevx(i) = -circlevx(i) * bordercoefficient
  232.                         circlevy(i) = circlevy(i) * bordercoefficient
  233.                     ELSEIF circleposx(i) > (screenwidth - circlesize(i) - 1) AND circlevx(i) > 0 THEN
  234.                         circleposx(i) = screenwidth - circlesize(i) - 1
  235.                         circlevx(i) = -circlevx(i) * bordercoefficient
  236.                         circlevy(i) = circlevy(i) * bordercoefficient
  237.                     ELSEIF circleposy(i) < circlesize(i) AND circlevy(i) < 0 THEN
  238.                         circleposy(i) = circlesize(i)
  239.                         circlevx(i) = circlevx(i) * bordercoefficient
  240.                         circlevy(i) = -circlevy(i) * bordercoefficient
  241.                     ELSEIF circleposy(i) > (screenheight - circlesize(i) - 1) AND circlevy(i) > 0 THEN
  242.                         circleposy(i) = screenheight - circlesize(i) - 1
  243.                         circlevx(i) = circlevx(i) * bordercoefficient
  244.                         circlevy(i) = -circlevy(i) * bordercoefficient
  245.  
  246.                         IF circletouched(i) = 0 THEN circleactive(i) = 0
  247.                     END IF
  248.                 END IF
  249.  
  250.  
  251.                 ' gravity between circle-particles
  252.                 IF particlegravity THEN
  253.                     accx = 0
  254.                     accy = 0
  255.                     FOR j = 0 TO totalcircles - 1
  256.  
  257.                         IF circleactive(j) THEN
  258.  
  259.                             IF (i <> j) THEN
  260.                                 dist = SQR((circleposx(i) - circleposx(j)) * (circleposx(i) - circleposx(j)) + (circleposy(i) - circleposy(j)) * (circleposy(i) - circleposy(j))) + 2
  261.                                 unitx = (circleposx(j) - circleposx(i)) / dist
  262.                                 unity = (circleposy(j) - circleposy(i)) / dist
  263.                                 distpow = dist ^ 2
  264.  
  265.                                 accx = accx + 1 / distpow * circlegravity(j) * unitx
  266.                                 accy = accy + 1 / distpow * circlegravity(j) * unity
  267.                             END IF
  268.  
  269.                         END IF
  270.  
  271.                     NEXT j
  272.  
  273.                     circlevx(i) = circlevx(i) + accx
  274.                     circlevy(i) = circlevy(i) + accy
  275.                 END IF
  276.  
  277.  
  278.  
  279.                 ' circle to line collision
  280.  
  281.                 ' get grid cells occupied by the bacircle for checking if any line segment is also in any of the same cells for potential collision
  282.                 circlegridpos1x = (circleposx(i) - circlesize(i)) \ gridsizex
  283.                 circlegridpos1y = (circleposy(i) - circlesize(i)) \ gridsizey
  284.                 circlegridpos2x = (circleposx(i) + circlesize(i)) \ gridsizex
  285.                 circlegridpos2y = (circleposy(i) + circlesize(i)) \ gridsizey
  286.  
  287.                 IF circlegridpos1x < 0 THEN circlegridpos1x = 0
  288.                 IF circlegridpos1y < 0 THEN circlegridpos1y = 0
  289.                 IF circlegridpos2x < 0 THEN circlegridpos2x = 0
  290.                 IF circlegridpos2y < 0 THEN circlegridpos2y = 0
  291.                 IF circlegridpos1x >= gridcellsx THEN circlegridpos1x = gridcellsx
  292.                 IF circlegridpos1y >= gridcellsy THEN circlegridpos1y = gridcellsy
  293.                 IF circlegridpos2x >= gridcellsx THEN circlegridpos2x = gridcellsx
  294.                 IF circlegridpos2y >= gridcellsy THEN circlegridpos2y = gridcellsy
  295.  
  296.                 collision = 0 ' we shall assumeth teh initial wanderance
  297.                 circletolinecontacts(i) = 0 ' also reset the counter
  298.  
  299.                 FOR gy = circlegridpos1y TO circlegridpos2y
  300.                     FOR gx = circlegridpos1x TO circlegridpos2x
  301.                         FOR gridlineid = 1 TO gridline(gx, gy, 0)
  302.  
  303.                             l = gridline(gx, gy, gridlineid)
  304.  
  305.                             ' make a bounding box of the line
  306.                             bound1x = linep1x(l)
  307.                             bound2x = linep2x(l)
  308.                             IF bound2x < bound1x THEN SWAP bound1x, bound2x
  309.                             bound1y = linep1y(l)
  310.                             bound2y = linep2y(l)
  311.                             IF bound2y < bound1y THEN SWAP bound1y, bound2y
  312.  
  313.                             ' check if circle is inside line's bounding box + its radius
  314.                             IF circleposx(i) > bound1x - circlesize(i) AND circleposx(i) < bound2x + circlesize(i) AND circleposy(i) > bound1y - circlesize(i) AND circleposy(i) < bound2y + circlesize(i) THEN
  315.  
  316.                                 ' i guess, then calculate some local coordinates
  317.                                 circleradiuspov = circlesize(i) * circlesize(i)
  318.  
  319.                                 localp1x = linep1x(l) - circleposx(i)
  320.                                 localp1y = linep1y(l) - circleposy(i)
  321.                                 localp2x = linep2x(l) - circleposx(i)
  322.                                 localp2y = linep2y(l) - circleposy(i)
  323.                                 p2minusp1x = localp2x - localp1x
  324.                                 p2minusp1y = localp2y - localp1y
  325.  
  326.                                 a = (p2minusp1x) * (p2minusp1x) + (p2minusp1y) * (p2minusp1y)
  327.                                 b = 2 * ((p2minusp1x * localp1x) + (p2minusp1y * localp1y))
  328.                                 c = (localp1x * localp1x) + (localp1y * localp1y) - (circleradiuspov)
  329.                                 delta = b * b - (4 * a * c)
  330.  
  331.                                 ' is a circle intersecting the infinite line?
  332.                                 IF (delta >= 0) THEN
  333.  
  334.                                     collision = 1 ' could actually collide with the segment ?!?!?
  335.  
  336.                                     u = -b / (2 * a)
  337.                                     intersectx = linep1x(l) + (u * p2minusp1x)
  338.                                     intersecty = linep1y(l) + (u * p2minusp1y)
  339.  
  340.                                     ' debug
  341.                                     'kakkax = intersectx
  342.                                     'kakkay = intersecty
  343.                                     'fauxradius = 3
  344.                                     'pyllymakkara = 0 ' show debug gfx
  345.                                     'kaurakeksi = 0
  346.  
  347.                                     ' is a circle outside of the axxual line segment?
  348.                                     IF (intersectx < bound1x OR intersectx > bound2x) AND (intersecty < bound1y OR intersecty > bound2y) THEN
  349.  
  350.                                         tempax = ABS(intersectx - linep1x(l))
  351.                                         tempbx = ABS(intersectx - linep2x(l))
  352.                                         tempay = ABS(intersecty - linep1y(l))
  353.                                         tempby = ABS(intersecty - linep2y(l))
  354.                                         endpointx = linep1x(l)
  355.                                         endpointy = linep1y(l)
  356.                                         IF tempbx < tempax THEN endpointx = linep2x(l)
  357.                                         IF tempby < tempay THEN endpointy = linep2y(l)
  358.  
  359.                                         ' check if we are close enough to hit an endpoint
  360.                                         distx = endpointx - circleposx(i)
  361.                                         disty = endpointy - circleposy(i)
  362.                                         distance = (distx * distx) + (disty * disty)
  363.  
  364.                                         IF (distance > circleradiuspov) THEN
  365.  
  366.                                             ' nope, too far.
  367.                                             collision = 0
  368.  
  369.                                         ELSE
  370.  
  371.                                             ' yeap, close enough.
  372.                                             intersectx = endpointx
  373.                                             intersecty = endpointy
  374.  
  375.                                         END IF
  376.  
  377.  
  378.                                     END IF
  379.  
  380.                                     IF collision THEN
  381.  
  382.                                         circletolinecontacts(i) = circletolinecontacts(i) + 1
  383.  
  384.                                         ' does teh bacircle move towards teh line?
  385.                                         distx = intersectx - circleposx(i)
  386.                                         disty = intersecty - circleposy(i)
  387.                                         distp = distx * circlevx(i) + disty * circlevy(i)
  388.                                         IF (distp >= 0) THEN
  389.  
  390.                                             distv = (distx * distx) + (disty * disty)
  391.  
  392.                                             ' move circle tangent to the line, prevents bacircles slowly flowing through a line
  393.                                             ' also prevents bacircles from hitting line endpoints while rolling along a line, maybe.
  394.                                             ' getting stuck between 2 almost parallel lines: how to fix poppage?
  395.                                             norm = circleradiuspov / distv
  396.                                             circleposx(i) = intersectx - distx * norm
  397.                                             circleposy(i) = intersecty - disty * norm
  398.  
  399.                                             ' yes, let's calculate the new velocity vector
  400.                                             newvx = distp / distv * distx
  401.                                             newvy = distp / distv * disty
  402.                                             circlevx(i) = circlevx(i) + 2 * -newvx * friction
  403.                                             circlevy(i) = circlevy(i) + 2 * -newvy * friction
  404.                                             circletouched(i) = 1
  405.  
  406.                                         END IF
  407.                                     END IF
  408.                                 END IF
  409.                             END IF
  410.                         NEXT gridlineid
  411.                     NEXT gx
  412.                 NEXT gy
  413.  
  414.  
  415.  
  416.                 ' downwards gravity
  417.                 'IF NOT collision THEN
  418.                 circlevy(i) = circlevy(i) + downwardsgravity
  419.                 'END IF
  420.  
  421.  
  422.  
  423.                 ' circle to circle collision detection
  424.  
  425.                 ' get grid cells occupied by the bacircle again, since its position might have changed (line tangent)
  426.                 circlegridpos1x = (circleposx(i) - circlesize(i)) \ gridsizex
  427.                 circlegridpos1y = (circleposy(i) - circlesize(i)) \ gridsizey
  428.                 circlegridpos2x = (circleposx(i) + circlesize(i)) \ gridsizex
  429.                 circlegridpos2y = (circleposy(i) + circlesize(i)) \ gridsizey
  430.  
  431.                 IF circlegridpos1x < 0 THEN circlegridpos1x = 0
  432.                 IF circlegridpos1y < 0 THEN circlegridpos1y = 0
  433.                 IF circlegridpos2x < 0 THEN circlegridpos2x = 0
  434.                 IF circlegridpos2y < 0 THEN circlegridpos2y = 0
  435.                 IF circlegridpos1x >= gridcellsx THEN circlegridpos1x = gridcellsx
  436.                 IF circlegridpos1y >= gridcellsy THEN circlegridpos1y = gridcellsy
  437.                 IF circlegridpos2x >= gridcellsx THEN circlegridpos2x = gridcellsx
  438.                 IF circlegridpos2y >= gridcellsy THEN circlegridpos2y = gridcellsy
  439.  
  440.                 FOR gy = circlegridpos1y TO circlegridpos2y
  441.                     FOR gx = circlegridpos1x TO circlegridpos2x
  442.                         FOR gridcircleid = 1 TO gridcircle(gx, gy, 0)
  443.                             j = gridcircle(gx, gy, gridcircleid)
  444.  
  445.                             'FOR j = i + 1 TO totalcircles - 1 ' old slow loop
  446.  
  447.                             IF circleactive(j) THEN
  448.  
  449.                                 IF i <> j THEN
  450.  
  451.                                     ' check for bounding box
  452.                                     IF (circleposx(i) + circlesize(i) + circlesize(j) > circleposx(j) AND circleposx(i) < circleposx(j) + circlesize(i) + circlesize(j) AND circleposy(i) + circlesize(i) + circlesize(j) > circleposy(j) AND circleposy(i) < circleposy(j) + circlesize(i) + circlesize(j)) THEN
  453.  
  454.                                         ' check if circles axxualli collide
  455.                                         distx = circleposx(j) - circleposx(i)
  456.                                         disty = circleposy(j) - circleposy(i)
  457.                                         distance = (distx * distx) + (disty * disty)
  458.                                         radii = circlesize(i) + circlesize(j)
  459.  
  460.                                         IF (distance <= radii * radii) THEN
  461.  
  462.                                             ' yes. but do they move towards each other?
  463.                                             vx = circlevx(i) - circlevx(j)
  464.                                             vy = circlevy(i) - circlevy(j)
  465.                                             IF (distx * vx + disty * vy > 0) THEN
  466.  
  467.                                                 IF 1 THEN
  468.                                                     ' if circles have enough combined velocity, move them iteratively (vitun hidas) closer to the actual collision
  469.                                                     IF totalvelocity#(circlevx(i), circlevy(i), circlevx(j), circlevy(j)) > 1 THEN
  470.  
  471.                                                         ' copy velocities
  472.                                                         tempcirclevix = circlevx(i)
  473.                                                         tempcircleviy = circlevy(i)
  474.                                                         tempcirclevjx = circlevx(j)
  475.                                                         tempcirclevjy = circlevy(j)
  476.  
  477.                                                         ' move balls back and forth to an appropriate degree of precision
  478.                                                         velocityfactor = -0.5
  479.                                                         collision = 1
  480.                                                         oldcollision = 0
  481.                                                         move = 0
  482.                                                         DO
  483.                                                             move = move + 1
  484.  
  485.                                                             ' check if collision status has changed
  486.                                                             distx = circleposx(j) - circleposx(i)
  487.                                                             disty = circleposy(j) - circleposy(i)
  488.                                                             distance = (distx * distx) + (disty * disty)
  489.                                                             radii = circlesize(i) + circlesize(j)
  490.  
  491.                                                             IF collision = 0 THEN
  492.                                                                 IF (distance <= radii * radii) THEN
  493.                                                                     collision = 1
  494.                                                                 END IF
  495.                                                             ELSEIF collision = 1 THEN
  496.                                                                 IF (distance > radii * radii) THEN
  497.                                                                     collision = 0
  498.                                                                 END IF
  499.                                                             END IF
  500.  
  501.                                                             IF collision <> oldcollision THEN
  502.                                                                 tempcirclevix = tempcirclevix * velocityfactor
  503.                                                                 tempcircleviy = tempcircleviy * velocityfactor
  504.                                                                 tempcirclevjx = tempcirclevjx * velocityfactor
  505.                                                                 tempcirclevjy = tempcirclevjy * velocityfactor
  506.                                                             END IF
  507.  
  508.                                                             oldcollision = collision
  509.  
  510.                                                             circleposx(i) = circleposx(i) + tempcirclevix
  511.                                                             circleposy(i) = circleposy(i) + tempcircleviy
  512.                                                             circleposx(j) = circleposx(j) + tempcirclevjx
  513.                                                             circleposy(j) = circleposy(j) + tempcirclevjy
  514.  
  515.                                                             ' debug gfx
  516.                                                             IF 0 THEN
  517.                                                                 CLS
  518.  
  519.                                                                 PSET (circleposx(i), circleposy(i)), _RGB(255, 255, 0)
  520.                                                                 PSET (circleposx(j), circleposy(j)), _RGB(0, 255, 0)
  521.                                                                 CIRCLE (circleposx(i), circleposy(i)), circlesize(i), _RGB(200, 200, 200)
  522.                                                                 CIRCLE (circleposx(j), circleposy(j)), circlesize(j), _RGB(200, 200, 200)
  523.                                                                 PRINT move; ":"; totalvelocity#(tempcirclevix, tempcircleviy, tempcirclevjx, tempcirclevjy)
  524.                                                                 PCOPY 0, 1
  525.                                                                 _DELAY 0.03
  526.                                                                 'x$ = INPUT$(1)
  527.                                                             END IF
  528.  
  529.                                                         LOOP UNTIL totalvelocity#(tempcirclevix, tempcircleviy, tempcirclevjx, tempcirclevjy) < 0.5
  530.  
  531.                                                     END IF
  532.                                                 END IF
  533.  
  534.                                                 ' compare distance differences and calculate the correct factor of the new velocity vector for the first timestep after collision
  535.                                                 ' todo. =(
  536.  
  537.                                                 ' new velocities
  538.                                                 distxji = circleposx(j) - circleposx(i)
  539.                                                 distyji = circleposy(j) - circleposy(i)
  540.                                                 distance = (distxji * distxji) + (distyji * distyji)
  541.  
  542.                                                 newvix = (circlevx(i) * distxji + circlevy(i) * distyji) / distance * distxji
  543.                                                 newviy = (circlevx(i) * distxji + circlevy(i) * distyji) / distance * distyji
  544.                                                 newvjx = (circlevx(j) * -(distxji) + circlevy(j) * -(distyji)) / distance * -(distxji)
  545.                                                 newvjy = (circlevx(j) * -(distxji) + circlevy(j) * -(distyji)) / distance * -(distyji)
  546.  
  547.                                                 tempivx = circlevx(i) + ((2 * circlemass(j)) / (circlemass(i) + circlemass(j))) * (newvjx - newvix)
  548.                                                 tempivy = circlevy(i) + ((2 * circlemass(j)) / (circlemass(i) + circlemass(j))) * (newvjy - newviy)
  549.                                                 tempjvx = circlevx(j) + ((2 * circlemass(i)) / (circlemass(j) + circlemass(i))) * (newvix - newvjx)
  550.                                                 tempjvy = circlevy(j) + ((2 * circlemass(i)) / (circlemass(j) + circlemass(i))) * (newviy - newvjy)
  551.  
  552.                                                 ' if the combined velocity of the bacircles is too low, don't apply friction
  553.                                                 velocitycoefficient = friction
  554.                                                 IF totalvelocity(tempivx, tempivy, tempjvx, tempjvy) < stictionthreshold THEN velocitycoefficient = 1
  555.  
  556.                                                 'IF circletolinecontacts(i) < 1 THEN
  557.                                                 circlevx(i) = tempivx * velocitycoefficient
  558.                                                 circlevy(i) = tempivy * velocitycoefficient
  559.                                                 'END IF
  560.                                                 circlevx(j) = tempjvx * velocitycoefficient
  561.                                                 circlevy(j) = tempjvy * velocitycoefficient
  562.  
  563.                                                 ' make sure the bacircles aren't overlapping
  564.                                                 collisionx = ((circleposx(i) * circlesize(j)) + (circleposx(j) * circlesize(i))) / radii
  565.                                                 collisiony = ((circleposy(i) * circlesize(j)) + (circleposy(j) * circlesize(i))) / radii
  566.  
  567.                                                 diffxi = collisionx - circleposx(i)
  568.                                                 diffyi = collisiony - circleposy(i)
  569.                                                 diffxj = collisionx - circleposx(j)
  570.                                                 diffyj = collisiony - circleposy(j)
  571.  
  572.                                                 sqrdiffi = SQR(diffxi * diffxi + diffyi * diffyi)
  573.                                                 sqrdiffj = SQR(diffxj * diffxj + diffyj * diffyj)
  574.                                                 normi = circlesize(i) / sqrdiffi
  575.                                                 normj = circlesize(j) / sqrdiffj
  576.  
  577.                                                 ' don't fix the position of the first bacircle if it's in contact with at least one line
  578.                                                 ' might need balancing for the second bacircle mutta hyp„t„„n nyt ensin
  579.                                                 IF circletolinecontacts(i) < 1 THEN
  580.                                                     circleposx(i) = collisionx - diffxi * normi
  581.                                                     circleposy(i) = collisiony - diffyi * normi
  582.                                                 END IF
  583.                                                 circleposx(j) = collisionx - diffxj * normj
  584.                                                 circleposy(j) = collisiony - diffyj * normj
  585.  
  586.                                             END IF
  587.                                         END IF
  588.                                     END IF
  589.                                 END IF
  590.                             END IF
  591.  
  592.                         NEXT gridcircleid
  593.                     NEXT gx
  594.                 NEXT gy
  595.  
  596.             END IF
  597.         NEXT i
  598.  
  599.         physcalcframe = physcalcframe + 1
  600.  
  601.     NEXT physicsframe
  602.  
  603.     frame = frame + 1
  604.  
  605.  
  606.     GOSUB keyboardroutine ' in case we don't calculate physics at all
  607.  
  608.  
  609.     ' debug gfx for shared endpoint collision
  610.     IF pyllymakkara = 1 THEN
  611.         kaurakeksi = kaurakeksi + 1
  612.         IF kaurakeksi = 100 THEN
  613.             kaurakeksi = 0
  614.             pyllymakkara = 0
  615.         END IF
  616.         CIRCLE (kakkax, kakkay), fauxradius
  617.     END IF
  618.  
  619.  
  620.  
  621.     intphys = INT(physperframe)
  622.     fpsstring1$ = fps$ + " fps"
  623.     fpsstring2$ = "x" + trim$(STR$(intphys)) + " (" + pfps$ + ")"
  624.     fpsstringoffset1 = _PRINTWIDTH(fpsstring1$)
  625.     fpsstringoffset2 = _PRINTWIDTH(fpsstring2$)
  626.     COLOR _RGB(255, 255, 255)
  627.     _PRINTSTRING (screenwidth - fpsstringoffset1 - 1, screenheight - 26), fpsstring1$
  628.     _PRINTSTRING (screenwidth - fpsstringoffset2 - 1, screenheight - 14), fpsstring2$
  629.  
  630.     ' show inp(96) output
  631.     'FOR k = 0 TO 127
  632.     '    IF scancode(k) THEN PRINT k; scancode(k)
  633.     'NEXT k
  634.  
  635.     PCOPY 0, 1
  636.     LINE (0, 0)-(screenwidth - 1, screenheight - 1), color.black, BF
  637.  
  638.     _LIMIT fpslimit
  639.  
  640. LOOP
  641.  
  642. 'SYSTEM
  643.  
  644.  
  645.  
  646.  
  647. showlevelselector:
  648. fadefactor = 1
  649. IF TIMER(0.001) > (levselectorfadertimer + levselectorvisibletime) THEN
  650.     fadefactor = (levselectorfadetime - (TIMER(0.001) - (levselectorfadertimer + levselectorvisibletime))) / levselectorfadetime
  651. END IF
  652.  
  653. FOR i = -levelrange TO levelrange
  654.     colorfactor = (levelrange - ABS(i) + 3) / (levelrange * 2 + 3)
  655.     IF i = 0 THEN colorfactor = 1
  656.     c = 255 * (colorfactor * fadefactor)
  657.     COLOR _RGB(c, c, c)
  658.  
  659.     IF listoffiles$(leveldiroffset + i + levelrange) = currentlevel$ THEN
  660.         vertices$ = "  (" + trim$(STR$(totalvertices)) + ")"
  661.     ELSE
  662.         vertices$ = ""
  663.     END IF
  664.     IF leveldiroffset + i >= 0 THEN _PRINTSTRING (2, textyoffset + (i + levelrange) * fontsize), listoffiles$(leveldiroffset + i + levelrange) + vertices$
  665. NEXT i
  666.  
  667. 'colorfactor = 0.9
  668. 'c = 255 * (colorfactor * fadefactor)
  669. 'COLOR _RGB(c, c, c)
  670. '_PRINTSTRING (2, textyoffset - 2 * fontsize), "vertices: " + trim$(STR$(totalvertices))
  671.  
  672. RETURN
  673.  
  674.  
  675.  
  676. keyboardroutine:
  677. tempscancode = 0
  678.  
  679. dummy$ = INKEY$
  680. keyboard = INP(96)
  681. IF keyboard < 128 THEN
  682.     scancode(keyboard) = TIMER(0.001)
  683.     IF downscancode(keyboard) = 0 THEN downscancode(keyboard) = TIMER(0.001)
  684. ELSE
  685.     scancode(keyboard - 128) = 0
  686.     downscancode(keyboard - 128) = 0
  687. END IF
  688.  
  689. FOR i = 1 TO 127
  690.     IF scancode(i) > 0 AND oldscancode(i) = 0 THEN tempscancode = i
  691. NEXT i
  692. IF tempscancode > 0 THEN scancode(tempscancode) = TIMER(0.001)
  693.  
  694.  
  695.  
  696. ' randomize circles
  697. IF oncekeypress(19) THEN ' r
  698.     GOSUB initcircles
  699.     GOSUB initlinegrid ' grid size might have changed because the cell size is calculated according to the average bacircle radius
  700. END IF
  701.  
  702. ' toggle cell highlighting
  703. IF oncekeypress(35) THEN ' h
  704.     hilightcells = hilightcells + 1
  705.     IF hilightcells = 2 THEN hilightcells = 0
  706. END IF
  707.  
  708.  
  709. ' change number of physics calculations per frame
  710. IF oncekeypress(12) THEN IF INT(physperframe) > 0 THEN physperframe = physperframe / 2
  711. IF oncekeypress(13) THEN physperframe = physperframe * 2
  712.  
  713. IF oncekeypress(30) THEN selectedline = selectedline + 1
  714. IF oncekeypress(31) THEN selectedline = selectedline - 1
  715. IF selectedline = totalvertices THEN selectedline = 0
  716. IF selectedline < 0 THEN selectedline = totalvertices - 1
  717.  
  718. levselectornavigation = 0
  719. ' select new level
  720. IF oncekeypress(28) THEN
  721.     GOSUB importelmalevel
  722.     GOSUB initcircles
  723.     GOSUB initlinegrid
  724.  
  725.     levselectornavigation = 1
  726. END IF
  727.  
  728. ' change level selector offset
  729. levlistscroll = 1
  730. IF keypress(42) OR keypress(54) THEN levlistscroll = 8
  731. IF repeatedkeypress(72) THEN ' arrow up
  732.     leveldiroffset = leveldiroffset - levlistscroll
  733.     IF leveldiroffset < 0 THEN leveldiroffset = 0
  734.  
  735.     levselectornavigation = 1
  736. END IF
  737. IF repeatedkeypress(80) THEN ' arrow down
  738.     leveldiroffset = leveldiroffset + levlistscroll
  739.     IF leveldiroffset > numberoflevels - levelrange - 1 THEN leveldiroffset = numberoflevels - levelrange - 1
  740.  
  741.     levselectornavigation = 1
  742. END IF
  743. IF repeatedkeypress(73) THEN ' page up
  744.     leveldiroffset = leveldiroffset - numberoflevelsshown * levlistscroll
  745.     IF leveldiroffset < 0 THEN leveldiroffset = 0
  746.  
  747.     levselectornavigation = 1
  748. END IF
  749. IF repeatedkeypress(81) THEN ' page down
  750.     leveldiroffset = leveldiroffset + numberoflevelsshown * levlistscroll
  751.     IF leveldiroffset > numberoflevels - levelrange - 1 THEN leveldiroffset = numberoflevels - levelrange - 1
  752.  
  753.     levselectornavigation = 1
  754. END IF
  755.  
  756. IF levselectornavigation = 1 THEN levselectorfadertimer = TIMER(0.001)
  757.  
  758.  
  759. IF keypress(1) THEN SYSTEM
  760.  
  761.  
  762. FOR i = 0 TO 127
  763.     oldscancode(i) = scancode(i)
  764. NEXT i
  765. RETURN
  766.  
  767.  
  768.  
  769.  
  770. updatefps:
  771. fps = INT(physcalcframe / physperframe * 10) / 10 'frame
  772. fps$ = trim$(STR$(fps))
  773. IF fps = INT(fps) THEN fps$ = fps$ + ".0"
  774. IF fps < 1 THEN fps$ = "0" + fps$
  775. IF fps < 0.1 THEN fps$ = "0.0"
  776.  
  777. pfps = physcalcframe
  778. pfps$ = trim$(STR$(pfps))
  779.  
  780. frame = 0
  781. physcalcframe = 0
  782.  
  783. 'IF levselectornavigation = 0 THEN
  784. '    levselectorfade = levselectorfade + 1
  785. 'END IF
  786. RETURN
  787.  
  788.  
  789.  
  790.  
  791. getdirectorycontents:
  792. SHELL _HIDE "dir " + CHR$(34) + elmalevdir$ + "*.lev" + CHR$(34) + " /b /on > bacirclineshelloutput.tmp"
  793. OPEN "bacirclineshelloutput.tmp" FOR INPUT AS #1
  794.  
  795. numberoflevels = 0
  796. WHILE NOT EOF(1)
  797.     INPUT #1, listoffiles$(numberoflevels)
  798.     numberoflevels = numberoflevels + 1
  799. WEND
  800. CLOSE #1
  801. KILL "bacirclineshelloutput.tmp"
  802.  
  803. IF numberoflevels = 0 THEN
  804.     _PRINTSTRING (4, 4), "wateh no levels found =( put me in lev folder pls"
  805.     PCOPY 0, 1
  806.     x$ = INPUT$(1)
  807.     SYSTEM
  808. END IF
  809.  
  810. levelrange = 5 ' how many previous and next levels shown
  811. IF numberoflevels < (levelrange * 2 + 1) THEN levelrange = 0
  812. numberoflevelsshown = levelrange * 2 + 1 ' and the one currently selected
  813. textyoffset = screenheight - (fontsize * numberoflevelsshown) - 4
  814.  
  815. leveldiroffset = INT(numberoflevels * RND) ' start at nth file
  816.  
  817. RETURN
  818.  
  819.  
  820.  
  821.  
  822. importelmalevel:
  823. ' open elma .lev
  824. REDIM numberofpolys AS DOUBLE
  825.  
  826. filename$ = elmalevdir$ + listoffiles$(leveldiroffset + levelrange)
  827. OPEN filename$ FOR BINARY AS #1
  828.  
  829. GET #1, 131, numberofpolys
  830. numberofpolys = INT(numberofpolys)
  831. REDIM numberofvertices(numberofpolys) AS LONG
  832. REDIM vertexx(numberofpolys, 8000) AS DOUBLE, vertexy(numberofpolys, 8000) AS DOUBLE, grassflag(numberofpolys) AS LONG
  833.  
  834. minvertexx = 1000000
  835. minvertexy = 1000000
  836. maxvertexx = -1000000
  837. maxvertexy = -1000000
  838. v = 0
  839. FOR poly = 0 TO numberofpolys - 1
  840.     GET #1, , grassflag(poly)
  841.     GET #1, , numberofvertices(poly)
  842.     FOR vert = 0 TO numberofvertices(poly) - 1
  843.         GET #1, , vertexx(poly, vert)
  844.         GET #1, , vertexy(poly, vert)
  845.         IF vertexx(poly, vert) < minvertexx THEN minvertexx = vertexx(poly, vert)
  846.         IF vertexy(poly, vert) < minvertexy THEN minvertexy = vertexy(poly, vert)
  847.         IF vertexx(poly, vert) > maxvertexx THEN maxvertexx = vertexx(poly, vert)
  848.         IF vertexy(poly, vert) > maxvertexy THEN maxvertexy = vertexy(poly, vert)
  849.         v = v + 1
  850.     NEXT vert
  851. NEXT poly
  852.  
  853. CLOSE #1
  854.  
  855. ' scale level to fit screen
  856. factorvertexx = (screenwidth - 1) / (maxvertexx - minvertexx)
  857. factorvertexy = (screenheight - 1) / (maxvertexy - minvertexy)
  858. scalefactor = factorvertexx
  859. xoffset = 0
  860. IF factorvertexy < scalefactor THEN
  861.     scalefactor = factorvertexy
  862.     xoffset = (screenwidth - scalefactor * (maxvertexx - minvertexx)) / 2
  863. END IF
  864.  
  865. FOR poly = 0 TO numberofpolys - 1
  866.     IF grassflag(poly) = 0 THEN
  867.         FOR vert = 0 TO numberofvertices(poly) - 1
  868.             vertexx(poly, vert) = (vertexx(poly, vert) - minvertexx) * scalefactor + xoffset
  869.             vertexy(poly, vert) = (vertexy(poly, vert) - minvertexy) * scalefactor
  870.         NEXT vert
  871.     END IF
  872. NEXT poly
  873.  
  874. l = 0
  875. FOR poly = 0 TO numberofpolys - 1
  876.     IF grassflag(poly) = 0 THEN
  877.         FOR vert = 0 TO numberofvertices(poly) - 1
  878.             nextvert = vert + 1
  879.             IF nextvert = numberofvertices(poly) THEN nextvert = 0
  880.  
  881.             linep1x(l) = vertexx(poly, vert)
  882.             linep1y(l) = vertexy(poly, vert)
  883.             linep2x(l) = vertexx(poly, nextvert)
  884.             linep2y(l) = vertexy(poly, nextvert)
  885.             IF ABS(linep2x(l) - linep1x(l)) < 0.01 THEN linep2x(l) = linep2x(l) + 0.001 ' to prevent zero-sized
  886.             IF ABS(linep2y(l) - linep1y(l)) < 0.01 THEN linep2y(l) = linep2y(l) + 0.001 ' bounding box
  887.  
  888.             l = l + 1
  889.             ' LINE (vertexx(poly, vert), vertexy(poly, vert))-(vertexx(poly, nextvert), vertexy(poly, nextvert))
  890.         NEXT vert
  891.     END IF
  892. NEXT poly
  893. totalvertices = l
  894.  
  895. RETURN
  896.  
  897.  
  898. initlinegrid:
  899. ' reset the line grid
  900. FOR y = 0 TO gridcellsy
  901.     FOR x = 0 TO gridcellsx
  902.         FOR i = 1 TO gridline(x, y, 0)
  903.             gridline(x, y, i) = 0
  904.         NEXT i
  905.         gridline(x, y, 0) = 0
  906.     NEXT x
  907. NEXT y
  908.  
  909. ' populate the line grid
  910. FOR l = 0 TO totalvertices - 1
  911.     length = INT(SQR((linep2x(l) - linep1x(l)) * (linep2x(l) - linep1x(l)) + (linep2y(l) - linep1y(l)) * (linep2y(l) - linep1y(l))))
  912.     lengthdiv = length
  913.     IF lengthdiv = 0 THEN lengthdiv = 1
  914.  
  915.     FOR c = 0 TO length
  916.         cellx = (linep1x(l) + (linep2x(l) - linep1x(l)) * (c / lengthdiv)) \ gridsizex
  917.         celly = (linep1y(l) + (linep2y(l) - linep1y(l)) * (c / lengthdiv)) \ gridsizey
  918.  
  919.         IF gridline(cellx, celly, gridline(cellx, celly, 0)) <> l OR gridline(cellx, celly, 0) = 0 THEN
  920.             gridline(cellx, celly, 0) = gridline(cellx, celly, 0) + 1 ' the cell has one more line in it
  921.             gridline(cellx, celly, gridline(cellx, celly, 0)) = l ' add that line's id to that cell
  922.         END IF
  923.     NEXT c
  924. NEXT l
  925. RETURN
  926.  
  927.  
  928.  
  929. initcircles:
  930. circlecolumns = 128
  931. FOR i = 0 TO totalcircles - 1
  932.     circlemass(i) = 4 * RND + 4
  933.     circleposx(i) = ((i MOD circlecolumns) + 2) * (screenwidth / (circlecolumns + 3))
  934.     circleposy(i) = (i \ circlecolumns) * 20 + 120
  935.  
  936.     circlevx(i) = maxvx * RND - maxvx / 2
  937.     circlevy(i) = maxvy * RND - maxvy / 2
  938.  
  939.     IF filename$ <> currentlevel$ THEN
  940.         circleactive(i) = 1
  941.         circletouched(i) = 0
  942.     END IF
  943. NEXT i
  944. drawoffsetx = 0
  945. drawoffsety = 0
  946.  
  947. IF 0 THEN
  948.     circleposx(0) = 320
  949.     circleposy(0) = 200
  950.     circlemass(0) = 3000
  951.     circlevx(0) = 0.5
  952.     circlevy(0) = 0.8
  953.  
  954. END IF
  955.  
  956. FOR i = 0 TO totalcircles - 1
  957.     circlegravity(i) = circlemass(i) / 1280
  958.     circlesize(i) = SQR(circlemass(i))
  959. NEXT i
  960.  
  961. currentlevel$ = filename$
  962.  
  963. avgcirclesize = 0
  964. FOR i = 0 TO totalcircles - 1: avgcirclesize = avgcirclesize + circlesize(i): NEXT i
  965. avgcirclesize = avgcirclesize / totalcircles
  966. IF avgcirclesize < 4 THEN avgcirclesize = 4
  967. gridsizex = FIX(avgcirclesize * 4)
  968. gridsizey = FIX(avgcirclesize * 4)
  969. gridcellsx = FIX(screenwidth / gridsizex)
  970. gridcellsy = FIX(screenheight / gridsizey)
  971.  
  972. REDIM gridcircle(gridcellsx, gridcellsy, totalcircles) AS INTEGER ' work, bitch
  973.  
  974. RETURN
  975.  
  976.  
  977.  
  978. ' obsolete
  979. initlines:
  980. FOR l = 1 TO numberoflines - 1
  981.     'linep1x(l) = linep2x(l - 1)
  982.     'linep1y(l) = linep2y(l - 1)
  983.     'linep2x(l) = linep1x(l) + 200 * RND - 100
  984.     'linep2y(l) = linep1y(l) + 200 * RND - 100
  985.  
  986.     linep1x(l) = screenwidth * RND
  987.     linep1y(l) = screenheight * RND
  988.     linep2x(l) = linep1x(l) + 400 * RND - 200
  989.     linep2y(l) = linep1y(l) + 400 * RND - 200
  990.  
  991. NEXT l
  992.  
  993. IF 0 THEN
  994.     linep1x(0) = 290
  995.     linep1y(0) = 170
  996.     linep2x(0) = 340
  997.     linep2y(0) = 220
  998.  
  999.     linep1x(1) = 290
  1000.     linep1y(1) = 170
  1001.     linep2x(1) = 340
  1002.     linep2y(1) = 223
  1003. END IF
  1004.  
  1005. IF 1 THEN
  1006.     linep1x(0) = 20
  1007.     linep1y(0) = 310
  1008.     linep2x(0) = 150
  1009.     linep2y(0) = 305
  1010.  
  1011.     linep1x(1) = 150
  1012.     linep1y(1) = 305
  1013.     linep2x(1) = 200
  1014.     linep2y(1) = 309
  1015.  
  1016.     linep1x(2) = 200
  1017.     linep1y(2) = 309
  1018.     linep2x(2) = 400
  1019.     linep2y(2) = 300 '291.1
  1020.  
  1021.     linep1x(3) = 430
  1022.     linep1y(3) = 260
  1023.     linep2x(3) = 430.1
  1024.     linep2y(3) = 260.1
  1025.  
  1026.     linep1x(4) = 450
  1027.     linep1y(4) = 320
  1028.     linep2x(4) = 600
  1029.     linep2y(4) = 305
  1030.  
  1031.     linep1x(5) = 600
  1032.     linep1y(5) = 305
  1033.     linep2x(5) = 640
  1034.     linep2y(5) = 293
  1035.  
  1036.     linep1x(6) = 450 '0
  1037.     linep1y(6) = 320 '311
  1038.     linep2x(6) = 400 '50
  1039.     linep2y(6) = 300 '290
  1040. END IF
  1041. RETURN
  1042.  
  1043.  
  1044.  
  1045.  
  1046.  
  1047. SUB aaLine (x0, y0, x1, y1, rgbcol AS LONG, settype)
  1048.  
  1049. ox0 = x0
  1050. oy0 = y0
  1051. ox1 = x1
  1052. oy1 = y1
  1053.  
  1054. steep = 0
  1055. IF ABS(y1 - y0) > ABS(x1 - x0) THEN steep = 1
  1056.  
  1057. IF steep THEN
  1058.     SWAP x0, y0
  1059.     SWAP x1, y1
  1060. END IF
  1061. IF x0 > x1 THEN
  1062.     SWAP x0, x1
  1063.     SWAP y0, y1
  1064. END IF
  1065.  
  1066. dx = x1 - x0
  1067. dy = y1 - y0
  1068. gradient = dy / dx
  1069.  
  1070. ' koodirosmo's comment: these endpoints seem to be performing subpar-ly
  1071. ' handle first endpoint
  1072. xend = CINT(x0) ' this and CINT(x1) sometimes crashes if a circle drops from high enough onto a line (?)
  1073. yend = y0 + gradient * (xend - x0)
  1074. xgap = rfpart(x0 + 0.5)
  1075. xpxl1 = xend ' this will be used in the main loop
  1076. ypxl1 = FIX(yend)
  1077. IF steep THEN
  1078.     plot ypxl1, xpxl1, rfpart(yend) * xgap, rgbcol, settype
  1079.     plot ypxl1 + 1, xpxl1, fpart(yend) * xgap, rgbcol, settype
  1080. ELSE
  1081.     plot xpxl1, ypxl1, rfpart(yend) * xgap, rgbcol, settype
  1082.     plot xpxl1, ypxl1 + 1, fpart(yend) * xgap, rgbcol, settype
  1083. END IF
  1084. intery = yend + gradient ' first y-intersection for the main loop
  1085.  
  1086. ' handle second endpoint
  1087. xend = CINT(x1)
  1088. yend = y1 + gradient * (xend - x1)
  1089. xgap = fpart(x1 + 0.5)
  1090. xpxl2 = xend ' this will be used in the main loop
  1091. ypxl2 = FIX(yend)
  1092. IF steep THEN
  1093.     plot ypxl2, xpxl2, rfpart(yend) * xgap, rgbcol, settype
  1094.     plot ypxl2 + 1, xpxl2, fpart(yend) * xgap, rbgcol, settype
  1095. ELSE
  1096.     plot xpxl2, ypxl2, rfpart(yend) * xgap, rgbcol, settype
  1097.     plot xpxl2, ypxl2 + 1, fpart(yend) * xgap, rgbcol, settype
  1098. END IF
  1099.  
  1100. ' main loop
  1101. FOR x = xpxl1 + 1 TO xpxl2 - 1
  1102.     IF steep THEN
  1103.         plot FIX(intery), x, rfpart(intery), rgbcol, settype
  1104.         plot FIX(intery) + 1, x, fpart(intery), rgbcol, settype
  1105.     ELSE
  1106.         plot x, FIX(intery), rfpart(intery), rgbcol, settype
  1107.         plot x, FIX(intery) + 1, fpart(intery), rgbcol, settype
  1108.     END IF
  1109.     intery = intery + gradient
  1110. NEXT x
  1111.  
  1112. ' kr”hh”m.
  1113. plot ox0, oy0, 1, rgbcol, 0
  1114. plot ox1, oy1, 1, rgbcol, 0
  1115.  
  1116. END SUB
  1117.  
  1118.  
  1119.  
  1120. SUB plot (x, y, c, rgbcol AS LONG, settype)
  1121. ' draw antialiased pixel
  1122. ' settype: 0 = draw if any of the color channels is brighter than in the current pixel
  1123. '          1 = add to the pixel color channels
  1124.  
  1125. DIM p AS LONG
  1126.  
  1127. 'PRINT c;
  1128. 'PCOPY 0, 1
  1129. IF c > 1 THEN c = 1
  1130. IF c > 0 THEN c = sqrlookup(c * 32768) ' SQR(c)
  1131. r = _RED(rgbcol) * c
  1132. g = _GREEN(rgbcol) * c
  1133. b = _BLUE(rgbcol) * c
  1134.  
  1135. p = POINT(x, y)
  1136. pr = _RED(p)
  1137. pg = _GREEN(p)
  1138. pb = _BLUE(p)
  1139.  
  1140. IF settype = 0 THEN
  1141.     IF pr < r OR pg < g OR pb < b THEN PSET (x, y), _RGB(r, g, b)
  1142. ELSEIF settype = 1 THEN
  1143.     PSET (x, y), _RGB(r + pr, g + pg, b + pb)
  1144. END IF
  1145. END SUB
  1146.  
  1147.  
  1148.  
  1149. ' fractional part of x
  1150. FUNCTION fpart (x)
  1151. IF x < 0 THEN fpart = 1 - (x - FIX(x))
  1152. fpart = x - FIX(x)
  1153. END FUNCTION
  1154.  
  1155. FUNCTION rfpart (x)
  1156. rfpart = 1 - fpart(x)
  1157. END FUNCTION
  1158.  
  1159.  
  1160.  
  1161.  
  1162. SUB aaCircle (x, y, radius, rgbcol AS LONG, settype)
  1163. 'CIRCLE (x, y), radius, rgbcol
  1164. 'PAINT (x, y), rgbcol
  1165.  
  1166. ci = radius * 2
  1167. FOR i = 0 TO ci
  1168.     a0 = i * _PI / radius
  1169.     a1 = (i + 1) * _PI / radius
  1170.     x0 = x + COS(a0) * radius
  1171.     y0 = y + SIN(a0) * radius
  1172.     x1 = x + COS(a1) * radius
  1173.     y1 = y + SIN(a1) * radius
  1174.     aaLine x0, y0, x1, y1, rgbcol, settype
  1175. NEXT i
  1176.  
  1177. END SUB
  1178.  
  1179.  
  1180. SUB aaFilledCircle (x, y, radius, rgbcol AS LONG)
  1181. ' this is fuging idiotic
  1182. aaCircle x, y, radius, rgbcol, 0
  1183. aaCircle x, y, radius - 0.5, rgbcol, 0
  1184. FOR c = 1 TO radius - 1 STEP 0.5
  1185.     aaCircle x, y, c, rgbcol, 1
  1186. NEXT c
  1187. END SUB
  1188.  
  1189.  
  1190.  
  1191.  
  1192. FUNCTION acos (x AS DOUBLE) ' inverse cosine, not used anywhere
  1193. IF x < 1 THEN
  1194.     acos = (2 * ATN(1)) - ATN(x / SQR(1 - x * x))
  1195. END IF
  1196. END FUNCTION
  1197.  
  1198.  
  1199. ' combined velocities of two bacircles
  1200. FUNCTION totalvelocity# (vix AS DOUBLE, viy AS DOUBLE, vjx AS DOUBLE, vjy AS DOUBLE)
  1201. totalvelocity# = SQR(vix * vix + viy * viy) + SQR(vjx * vjx + vjy * vjy)
  1202. END FUNCTION
  1203.  
  1204.  
  1205. ' true if key is held down
  1206. FUNCTION keypress (code)
  1207. IF scancode(code) > 0 THEN keypress = scancode(code)
  1208. END FUNCTION
  1209.  
  1210. ' true only once when key was first pressed down
  1211. FUNCTION oncekeypress (code)
  1212. IF scancode(code) > 0 AND oldscancode(code) = 0 THEN oncekeypress = scancode(code)
  1213. END FUNCTION
  1214.  
  1215. ' mimics key repeat
  1216. FUNCTION repeatedkeypress (code)
  1217. pressed = oncekeypress(code)
  1218. IF pressed OR scancode(code) > (downscancode(code) + 0.3) THEN
  1219.     IF (TIMER(0.001) > keyboardrepeat + 0.03) THEN
  1220.         repeatedkeypress = scancode(code)
  1221.         keyboardrepeat = TIMER(0.001)
  1222.     END IF
  1223. END IF
  1224. END FUNCTION
  1225.  
  1226.  
  1227. FUNCTION trim$ (s$)
  1228. trim$ = LTRIM$(RTRIM$(s$))
  1229. END FUNCTION
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!