Author Topic: 3D OpenWorld Mountains by Ashish  (Read 7791 times)

0 Members and 1 Guest are viewing this topic.

Offline Qwerkey

  • Forum Resident
  • Posts: 755
    • View Profile
3D OpenWorld Mountains by Ashish
« on: February 29, 2020, 11:44:32 am »
 
3D OpenWorld Screenshot.png


3D OpenWorld Mountains

Author: @Ashish
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1139.msg103744#msg103744
Version: March 23, 2019
Tags: [3D], [Graphics], [OpenGL]

Description:
A 3D OpenWorld Terrain/Mountain demo, where a lot of effort has been made to make it realistic.

Controls:
    Use W,S,A,D for forward, backward, left and right movement respectively.
    Use mouse movement for rotation.
    Hit space bar key to switch between MODs. There are three MODs in the given program (sunny day, night and lines).
    A small map is also displayed on the left bottom of the screen, where you can see your current location in the world.


Source Code:
Code: QB64: [Select]
  1. '3D OpenWorld Terrain Demo
  2. 'Using Perlin Noise
  3. 'By Ashish Kushwaha
  4.  
  5.  
  6. '$CONSOLE
  7.  
  8. _TITLE "3D OpenWorld Terrain"
  9. SCREEN _NEWIMAGE(800, 600, 32)
  10.  
  11.  
  12.  
  13. CONST sqrt2 = 2 ^ 0.5
  14. CONST mountHeightMax = 4
  15.  
  16. TYPE vec3
  17.     x AS SINGLE
  18.     y AS SINGLE
  19.     z AS SINGLE
  20.  
  21. TYPE vec2
  22.     x AS SINGLE
  23.     y AS SINGLE
  24.  
  25. TYPE tree
  26.     h AS SINGLE
  27.     POS AS vec3
  28.     mpos AS vec2
  29.  
  30. TYPE camera
  31.     POS AS vec3
  32.     mpos AS vec3
  33.     target AS vec3
  34.  
  35. TYPE blowMIND
  36.     POS AS vec3
  37.     set AS _BYTE
  38.  
  39. DECLARE LIBRARY 'camera control function
  40.     SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
  41.  
  42.  
  43. 'noise function related variables
  44. DIM SHARED perlin_octaves AS SINGLE, perlin_amp_falloff AS SINGLE
  45.  
  46. DIM SHARED mapW, mapH
  47. mapW = 800: mapH = 800 'control the size of the map or world
  48.  
  49. 'Terrain Map related variables
  50. 'terrainData(mapW,mapH) contain elevation data and moistureMap(mapW,mapH) contain moisture data
  51. DIM SHARED terrainMap(mapW, mapH), moistureMap(mapW, mapH), terrainData(mapW, mapH) AS vec3
  52. 'these stored the 3 Dimensional coordinates of the objects. Used as a array buffer with glDrawArrays(). glDrawArrays() is faster than normal glBegin() ... glEnd() for rendering
  53. DIM SHARED mountVert(mapW * mapH * 6) AS SINGLE, mountColor(mapW * mapH * 6), mountNormal(mapW * mapH * 6)
  54.  
  55. 'MODs
  56. DIM SHARED worldMOD
  57.  
  58. 'map
  59. DIM SHARED worldMap&, myLocation& 'stored the 2D Map
  60. worldMap& = _NEWIMAGE(mapW + 300, mapH + 300, 32)
  61. myLocation& = _NEWIMAGE(10, 10, 32)
  62.  
  63. 'surprise
  64. DIM SHARED Surprise AS blowMIND, snowMount
  65.  
  66. 'sky
  67. DIM SHARED worldTextures&(3), worldTextureHandle&(2)
  68.  
  69. tmp& = _LOADIMAGE(WriteqbiconData$("qb.png"))
  70. KILL "qb.png"
  71. worldTextures&(1) = _NEWIMAGE(32, 32, 32) '3 32's
  72. _PUTIMAGE (0, 32)-(32, 0), tmp&, worldTextures&(1)
  73.  
  74. _DEST worldMap&
  75. CLS , _RGB(0, 0, 255)
  76.  
  77. 'day sky containing some clouds
  78. worldTextures&(2) = _NEWIMAGE(400, 400, 32)
  79.  
  80. _DEST worldTextures&(2)
  81. CLS , _RGB(109, 164, 255)
  82. FOR y = 0 TO _HEIGHT - 1
  83.     FOR x = 0 TO _WIDTH - 1
  84.         j1# = map(ABS((_WIDTH / 2) - x), _WIDTH / 2, 70, 0, 1)
  85.         j2# = map(ABS((_HEIGHT / 2) - y), _HEIGHT / 2, 70, 0, 1)
  86.         noiseDetail 5, 0.46789
  87.         k! = (ABS(noise(x * 0.04, y * 0.04, x / y * 0.01)) * 1.3) ^ 3 * j1# * j2#
  88.         PSET (x, y), _RGBA(255, 255, 255, k! * 255)
  89. NEXT x, y
  90. 'starry night sky texture
  91. worldTextures&(3) = _NEWIMAGE(_WIDTH * 3, _HEIGHT * 3, 32)
  92. _DEST worldTextures&(3)
  93. CLS , _RGB(7, 0, 102)
  94. FOR i = 0 TO 300
  95.     cx = p5random(10, _WIDTH - 10): cy = p5random(10, _HEIGHT - 10)
  96.     CircleFill cx, cy, p5random(0, 2), _RGBA(255, 255, 255, p5random(0, 255))
  97. DIM SHARED Cam AS camera, theta, phi
  98.  
  99.  
  100. DIM SHARED glAllow AS _BYTE
  101. RESTORE blipicon
  102. _DEST myLocation& 'Generating the blip icon
  103. FOR i = 0 TO 10
  104.     FOR j = 0 TO 10
  105.         READ cx
  106.         IF cx = 1 THEN PSET (j, i), _RGB(255, 0, 200)
  107. NEXT j, i
  108. 'image data of blip icon
  109. blipicon:
  110. DATA 0,0,0,0,0,1,0,0,0,0,0
  111. DATA 0,0,0,0,0,1,0,0,0,0,0
  112. DATA 0,0,0,0,1,1,1,0,0,0,0
  113. DATA 0,0,0,1,1,1,1,1,0,0,0
  114. DATA 0,0,0,1,1,1,1,1,0,0,0
  115. DATA 0,0,1,1,1,1,1,1,1,0,0
  116. DATA 0,1,1,1,1,1,1,1,1,1,0
  117. DATA 0,1,1,1,1,1,1,1,1,1,0
  118. DATA 1,1,1,1,0,0,0,1,1,1,1
  119. DATA 1,1,0,0,0,0,0,0,0,1,1
  120. DATA 1,0,0,0,0,0,0,0,0,0,1
  121. DATA 0,0,0,0,0,0,0,0,0,0,0
  122.  
  123.  
  124. 'Map elevations and mositure calculation done here with the help of perlin noise
  125. freq = 1
  126. FOR y = 0 TO mapH
  127.     FOR x = 0 TO mapW
  128.         nx = x * 0.01
  129.         ny = y * 0.01
  130.         noiseDetail 2, 0.4
  131.         v! = ABS(noise(nx * freq, ny * freq, 0)) * 1.5 + ABS(noise(nx * freq * 4, ny * freq * 4, 0)) * .25
  132.         v! = v! ^ (3.9)
  133.         elev = v! * 255
  134.         noiseDetail 2, 0.4
  135.         m! = ABS(noise(nx * 2, ny * 2, 0))
  136.         m! = m! ^ 1.4
  137.  
  138.         ' PSET (x + mapW, y), _RGB(0, 0, m! * 255)
  139.         moistureMap(x, y) = m!
  140.  
  141.         ' PSET (x, y), _RGB(elev, elev, elev)
  142.         terrainMap(x, y) = (elev / 255) * mountHeightMax
  143.         terrainData(x, y).x = map(x, 0, mapW, -mapW * 0.04, mapW * 0.04)
  144.         terrainData(x, y).y = terrainMap(x, y)
  145.         terrainData(x, y).z = map(y, 0, mapH, -mapH * 0.04, mapH * 0.04)
  146.  
  147.         setMountColor x, y, 0, (elev / 255) * mountHeightMax, mountHeightMax
  148.         clr~& = _RGB(mountColor(0) * 255, mountColor(1) * 255, mountColor(2) * 255)
  149.         PSET (x, y), clr~&
  150.         _DEST worldMap&
  151.         PSET (x + 150, y + 150), clr~&
  152.         _DEST 0
  153.  
  154.         IF terrainMap(x, y) <= 0.3 * mountHeightMax AND RND > 0.99993 AND Surprise.set = 0 THEN
  155.             Surprise.POS = terrainData(x, y)
  156.             ' line(x-2,y-2)-step(4,4),_rgb(255,0,0),bf
  157.             Surprise.set = 1
  158.             sx = x: sy = y
  159.         END IF
  160.  
  161.     NEXT x
  162.  
  163.     'CLS
  164.     'PRINT "Generating World..."
  165.     'need to show a catchy progress bar
  166.     FOR j = 0 TO map(y, 0, mapH - 1, 0, _WIDTH - 1): LINE (j, _HEIGHT - 6)-(j, _HEIGHT - 1), hsb~&(map(j, 0, _WIDTH - 1, 0, 255), 255, 128, 255): NEXT j
  167.     _DISPLAY
  168. ' _TITLE "3D OpenWorld Mountails [Hit SPACE to switch between MODs]"
  169. _DEST worldMap&
  170. LINE (sx - 3 + 150, sy - 3 + 150)-STEP(6, 6), _RGB(255, 0, 0), BF
  171. generateTerrainData
  172. PRINT "Hit Enter To Step In The World."
  173. PRINT "Map size : "; (mapH * mapW * 24) / 1024; " kB"
  174.  
  175. glAllow = -1
  176.     theta = (_MOUSEX / _WIDTH) * _PI(2.5) 'controls x-axis rotation
  177.     phi = map(_MOUSEY, 0, _HEIGHT, -_PI(0), _PI(0.5)) 'controls y-axis rotation
  178.  
  179.     IF Cam.mpos.z > mapH - 2 THEN Cam.mpos.z = mapH - 2 'prevent reaching out of the world map
  180.     IF Cam.mpos.x > mapW - 2 THEN Cam.mpos.x = mapW - 2 '
  181.     IF Cam.mpos.z < 2 THEN Cam.mpos.z = 2 '
  182.     IF Cam.mpos.x < 2 THEN Cam.mpos.x = 2 '
  183.  
  184.     IF _KEYDOWN(ASC("w")) OR _KEYDOWN(ASC("W")) THEN 'forward movement based on y-axis rotation
  185.         Cam.mpos.z = Cam.mpos.z + SIN(theta) * 0.45: Cam.mpos.x = Cam.mpos.x + COS(theta) * 0.45
  186.     END IF
  187.     IF _KEYDOWN(ASC("s")) OR _KEYDOWN(ASC("S")) THEN ' backward movement based on y-axis rotation
  188.         Cam.mpos.z = Cam.mpos.z - SIN(theta) * 0.45: Cam.mpos.x = Cam.mpos.x - COS(theta) * 0.45
  189.     END IF
  190.     IF _KEYDOWN(ASC("a")) OR _KEYDOWN(ASC("A")) THEN 'left movement based on y-axis rotation
  191.         Cam.mpos.z = Cam.mpos.z + SIN(theta - _PI(0.5)) * 0.45: Cam.mpos.x = Cam.mpos.x + COS(theta - _PI(0.5)) * 0.45
  192.     END IF
  193.     IF _KEYDOWN(ASC("d")) OR _KEYDOWN(ASC("D")) THEN 'right movement based on y-axis rotation
  194.         Cam.mpos.z = Cam.mpos.z + SIN(theta + _PI(0.5)) * 0.45: Cam.mpos.x = Cam.mpos.x + COS(theta + _PI(0.5)) * 0.45
  195.     END IF
  196.  
  197.     IF _KEYHIT = ASC(" ") THEN 'switching between MODs
  198.         IF worldMOD = 2 OR worldMOD = 3 THEN worldMOD = 0 ELSE worldMOD = worldMOD + 1
  199.     END IF
  200.  
  201.     CLS , 1 'clear the screen and make it transparent so that GL context not get hidden.
  202.     _LIMIT 60
  203.  
  204.     'rotation of world causes rotation of map too. calculation of the source points of map is done below
  205.     sx1 = COS(_PI(.75) + theta) * 150 * sqrt2 + Cam.mpos.x + 150: sy1 = SIN(_PI(.75) + theta) * 150 * sqrt2 + Cam.mpos.z + 150
  206.     sx2 = COS(_PI(1.25) + theta) * 150 * sqrt2 + Cam.mpos.x + 150: sy2 = SIN(_PI(1.25) + theta) * 150 * sqrt2 + Cam.mpos.z + 150
  207.     sx3 = COS(_PI(1.75) + theta) * 150 * sqrt2 + Cam.mpos.x + 150: sy3 = SIN(_PI(1.75) + theta) * 150 * sqrt2 + Cam.mpos.z + 150
  208.     sx4 = COS(_PI(2.25) + theta) * 150 * sqrt2 + Cam.mpos.x + 150: sy4 = SIN(_PI(2.25) + theta) * 150 * sqrt2 + Cam.mpos.z + 150
  209.     'displaying the minimap
  210.     _MAPTRIANGLE (sx3, sy3)-(sx4, sy4)-(sx2, sy2), worldMap& TO(0, _HEIGHT - 150 * sqrt2)-(150 * sqrt2, _HEIGHT - 150 * sqrt2)-(0, _HEIGHT - 1)
  211.     _MAPTRIANGLE (sx2, sy2)-(sx4, sy4)-(sx1, sy1), worldMap& TO(0, _HEIGHT - 1)-(150 * sqrt2, _HEIGHT - 150 * sqrt2)-(150 * sqrt2, _HEIGHT - 1)
  212.     'showing your location
  213.     _PUTIMAGE (75 * sqrt2, _HEIGHT - 75 * sqrt2)-STEP(10, 10), myLocation&
  214.     'drawing red border along the map make it attractive
  215.     LINE (1, _HEIGHT - 150 * sqrt2)-STEP(150 * sqrt2, 150 * sqrt2), _RGB(255, 0, 0), B
  216.     _DISPLAY
  217.    
  218.     IF snowMount = 1 THEN
  219.         FOR i = 1 TO UBOUND(mountVert) STEP 3
  220.             setMountColor 0, 0, i - 1, mountVert(i), mountHeightMax
  221.         NEXT
  222.         snowMount = 2
  223.     END IF
  224.  
  225.  
  226. SUB _GL () STATIC
  227.  
  228.     IF glAllow = 0 THEN EXIT SUB 'we are not ready yet
  229.  
  230.     IF NOT glSetup THEN
  231.         glSetup = -1
  232.         _GLVIEWPORT 0, 0, _WIDTH, _HEIGHT 'define our rendering area
  233.  
  234.         aspect# = _WIDTH / _HEIGHT 'used to create perspective view
  235.  
  236.         rad = 1 'distance of camera from origin (0,0,0)
  237.         farPoint = 1.0 'far point of camera target
  238.  
  239.         'initialize camera
  240.         Cam.mpos.x = mapW / 2
  241.         Cam.mpos.z = mapH / 2
  242.         Cam.mpos.y = 8
  243.         'initialize textures for sky
  244.         FOR i = 1 TO UBOUND(worldTextures&)
  245.             _GLGENTEXTURES 1, _OFFSET(worldTextureHandle&(i - 1))
  246.  
  247.             DIM m AS _MEM
  248.             m = _MEMIMAGE(worldTextures&(i))
  249.  
  250.             _GLBINDTEXTURE _GL_TEXTURE_2D, worldTextureHandle&(i - 1)
  251.             _GLTEXIMAGE2D _GL_TEXTURE_2D, 0, _GL_RGB, _WIDTH(worldTextures&(i)), _HEIGHT(worldTextures&(i)), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
  252.  
  253.             _MEMFREE m
  254.  
  255.             _GLTEXPARAMETERI _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR
  256.             _GLTEXPARAMETERI _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST
  257.             _FREEIMAGE worldTextures&(i)
  258.         NEXT
  259.     END IF
  260.  
  261.     IF worldMOD = 0 THEN _GLCLEARCOLOR 0.7, 0.8, 1.0, 1.0 'this makes the background look sky blue.
  262.     IF worldMOD = 1 THEN _GLCLEARCOLOR 0.031, 0.0, 0.307, 1.0 'night sky
  263.     IF worldMOD = 2 THEN _GLCLEARCOLOR 0.0, 0.0, 0.0, 1.0
  264.     IF worldMOD = 3 THEN
  265.         v~& = hsb~&(clock# MOD 255, 255, 128, 255)
  266.         kR = _RED(v~&) / 255: kG = _GREEN(v~&) / 255: kB = _BLUE(v~&) / 255
  267.         _GLCLEARCOLOR kR, kG, kB, 1
  268.     END IF
  269.     '_glClear _GL_COLOR_BUFFER_BIT OR _GL_DEPTH_BUFFER_BIT
  270.  
  271.     _GLENABLE _GL_DEPTH_TEST 'Of course, we are going to do 3D
  272.     _GLDEPTHMASK _GL_TRUE
  273.  
  274.  
  275.     _GLENABLE _GL_TEXTURE_2D 'so that we can use texture for our sky. :)
  276.  
  277.     IF worldMOD <> 2 THEN
  278.         _GLENABLE _GL_LIGHTING 'Without light, everything dull.
  279.         _GLENABLE _GL_LIGHT0
  280.     END IF
  281.  
  282.     IF worldMOD = 1 THEN
  283.         'night MOD
  284.         _GLLIGHTFV _GL_LIGHT0, _GL_AMBIENT, glVec4(0.05, 0.05, 0.33, 0)
  285.         _GLLIGHTFV _GL_LIGHT0, _GL_DIFFUSE, glVec4(0.55, 0.55, 0.78, 0)
  286.         _GLLIGHTFV _GL_LIGHT0, _GL_SPECULAR, glVec4(0.75, 0.75, 0.98, 0)
  287.     ELSEIF worldMOD = 0 THEN
  288.         _GLLIGHTFV _GL_LIGHT0, _GL_AMBIENT, glVec4(0.35, 0.35, 0.33, 0) 'gives a bit yellowing color to the light
  289.         _GLLIGHTFV _GL_LIGHT0, _GL_DIFFUSE, glVec4(0.75, 0.75, 0.60, 0) 'so it will feel like sun is in the sky
  290.         _GLLIGHTFV _GL_LIGHT0, _GL_SPECULAR, glVec4(0.95, 0.95, 0.80, 0)
  291.     ELSEIF worldMOD = 3 THEN 'disco light
  292.         _GLLIGHTFV _GL_LIGHT0, _GL_AMBIENT, glVec4(kR / 2, kG / 2, kB / 2, 0)
  293.         _GLLIGHTFV _GL_LIGHT0, _GL_DIFFUSE, glVec4(kR * 0.9, kG * 0.9, kB * 0.9, 0)
  294.         _GLLIGHTFV _GL_LIGHT0, _GL_SPECULAR, glVec4(kR, kG, kB, 0)
  295.     END IF
  296.     _GLSHADEMODEL _GL_SMOOTH 'to make the rendering smooth
  297.  
  298.     _GLMATRIXMODE _GL_PROJECTION
  299.     _GLUPERSPECTIVE 70, aspect#, 0.01, 15.0 'set up out perpective
  300.  
  301.     _GLMATRIXMODE _GL_MODELVIEW
  302.  
  303.     ' IF Cam.mpos.y > (terrainMap(Cam.mpos.x, Cam.mpos.z)) THEN Cam.mpos.y = Cam.mpos.y - 0.03 ELSE
  304.     Cam.mpos.y = meanAreaHeight(1, Cam.mpos.x, Cam.mpos.z) 'if you are in air then you must fall.
  305.  
  306.     'calculation of camera eye, its target, etc...
  307.     Cam.POS.x = map(Cam.mpos.x, 0, mapW, -mapW * 0.04, mapW * 0.04)
  308.     Cam.POS.z = map(Cam.mpos.z, 0, mapH, -mapH * 0.04, mapH * 0.04)
  309.     Cam.POS.y = Cam.mpos.y + 0.3
  310.  
  311.     Cam.target.y = Cam.POS.y * COS(phi)
  312.     Cam.target.x = Cam.POS.x + COS(theta) * farPoint
  313.     Cam.target.z = Cam.POS.z + SIN(theta) * farPoint
  314.  
  315.     gluLookAt Cam.POS.x, Cam.POS.y, Cam.POS.z, Cam.target.x, Cam.target.y, Cam.target.z, 0, 1, 0
  316.  
  317.  
  318.  
  319.     ' draw the world
  320.     _GLENABLE _GL_COLOR_MATERIAL
  321.     _GLCOLORMATERIAL _GL_FRONT, _GL_AMBIENT_AND_DIFFUSE
  322.  
  323.     _GLENABLECLIENTSTATE _GL_VERTEX_ARRAY
  324.     _GLVERTEXPOINTER 3, _GL_FLOAT, 0, _OFFSET(mountVert())
  325.     _GLENABLECLIENTSTATE _GL_COLOR_ARRAY
  326.     _GLCOLORPOINTER 3, _GL_FLOAT, 0, _OFFSET(mountColor())
  327.     _GLENABLECLIENTSTATE _GL_NORMAL_ARRAY
  328.     _GLNORMALPOINTER _GL_FLOAT, 0, _OFFSET(mountNormal())
  329.  
  330.     IF worldMOD = 2 THEN _GLDRAWARRAYS _GL_LINE_STRIP, 1, (UBOUND(mountvert) / 3) - 1 ELSE _GLDRAWARRAYS _GL_TRIANGLE_STRIP, 1, (UBOUND(mountVert) / 3) - 1
  331.     _GLDISABLECLIENTSTATE _GL_VERTEX_ARRAY
  332.     _GLDISABLECLIENTSTATE _GL_COLOR_ARRAY
  333.     _GLDISABLECLIENTSTATE _GL_NORMAL_ARRAY
  334.     _GLDISABLE _GL_COLOR_MATERIAL
  335.  
  336.  
  337.     _GLDISABLE _GL_LIGHTING
  338.     IF worldMOD <> 3 AND snowMount <> 2 THEN showSurprise 0.4, Cam.POS
  339.  
  340.     _GLMATRIXMODE _GL_PROJECTION
  341.     _GLUPERSPECTIVE 70, aspect#, 0.01, 100
  342.  
  343.     _GLMATRIXMODE _GL_MODELVIEW
  344.  
  345.     skybox 32.0 'sky
  346.  
  347.     _GLFLUSH
  348.  
  349.     clock# = clock# + .5
  350.  
  351. FUNCTION meanAreaHeight# (n%, x%, y%)
  352.     FOR i = y% - n% TO y% + n%
  353.         FOR j = x% - n% TO x% + n%
  354.             h# = h# + terrainMap(j, i)
  355.             g% = g% + 1
  356.     NEXT j, i
  357.     meanAreaHeight# = (h# / g%)
  358.  
  359. SUB showSurprise (s, a AS vec3)
  360.     IF a.x > Surprise.POS.x - s AND a.x < Surprise.POS.x + s AND a.z > Surprise.POS.z - s AND a.z < Surprise.POS.z + s THEN
  361.         IF RND > 0.5 THEN
  362.             worldMOD = 3
  363.             _TITLE "You finally came to know that its QB64 Island!!"
  364.         ELSE
  365.             snowMount = 1
  366.             _TITLE "Welcome to this new world..."
  367.             Cam.mpos.y = 6
  368.         END IF
  369.     END IF
  370.  
  371.     _GLBINDTEXTURE _GL_TEXTURE_2D, worldTextureHandle&(0)
  372.  
  373.     _GLBEGIN _GL_QUADS
  374.     _GLTEXCOORD2F 0, 1
  375.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y + 2 * s, Surprise.POS.z - s 'front
  376.     _GLTEXCOORD2F 0, 0
  377.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y, Surprise.POS.z - s
  378.     _GLTEXCOORD2F 1, 0
  379.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y, Surprise.POS.z - s
  380.     _GLTEXCOORD2F 1, 1
  381.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y + 2 * s, Surprise.POS.z - s
  382.     _GLEND
  383.  
  384.     _GLBEGIN _GL_QUADS
  385.     _GLTEXCOORD2F 0, 1
  386.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y + 2 * s, Surprise.POS.z + s 'rear
  387.     _GLTEXCOORD2F 0, 0
  388.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y, Surprise.POS.z + s
  389.     _GLTEXCOORD2F 1, 0
  390.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y, Surprise.POS.z + s
  391.     _GLTEXCOORD2F 1, 1
  392.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y + 2 * s, Surprise.POS.z + s
  393.     _GLEND
  394.  
  395.     _GLBEGIN _GL_QUADS
  396.     _GLTEXCOORD2F 1, 0
  397.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y + 2 * s, Surprise.POS.z + s 'left
  398.     _GLTEXCOORD2F 0, 0
  399.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y, Surprise.POS.z + s
  400.     _GLTEXCOORD2F 0, 1
  401.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y, Surprise.POS.z - s
  402.     _GLTEXCOORD2F 1, 1
  403.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y + 2 * s, Surprise.POS.z - s
  404.     _GLEND
  405.  
  406.     _GLBEGIN _GL_QUADS
  407.     _GLTEXCOORD2F 1, 0
  408.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y + 2 * s, Surprise.POS.z + s 'right
  409.     _GLTEXCOORD2F 0, 0
  410.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y, Surprise.POS.z + s
  411.     _GLTEXCOORD2F 0, 1
  412.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y, Surprise.POS.z - s
  413.     _GLTEXCOORD2F 1, 1
  414.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y + 2 * s, Surprise.POS.z - s
  415.     _GLEND
  416.  
  417.     _GLBEGIN _GL_QUADS 'up
  418.     _GLTEXCOORD2F 0, 1
  419.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y + 2 * s, Surprise.POS.z - s 'up
  420.     _GLTEXCOORD2F 0, 0
  421.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y + 2 * s, Surprise.POS.z + s
  422.     _GLTEXCOORD2F 1, 0
  423.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y + 2 * s, Surprise.POS.z + s
  424.     _GLTEXCOORD2F 1, 1
  425.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y + 2 * s, Surprise.POS.z - s
  426.     _GLEND
  427.  
  428.     _GLBEGIN _GL_QUADS 'down
  429.     _GLTEXCOORD2F 0, 1
  430.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y, Surprise.POS.z - s 'up
  431.     _GLTEXCOORD2F 0, 0
  432.     _GLVERTEX3F Surprise.POS.x - s, Surprise.POS.y, Surprise.POS.z + s
  433.     _GLTEXCOORD2F 1, 0
  434.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y, Surprise.POS.z + s
  435.     _GLTEXCOORD2F 1, 1
  436.     _GLVERTEX3F Surprise.POS.x + s, Surprise.POS.y, Surprise.POS.z - s
  437.     _GLEND
  438.  
  439.  
  440. 'draws a beautiful sky
  441. SUB skybox (s)
  442.     IF worldMOD > 1 THEN EXIT SUB
  443.  
  444.     _GLDEPTHMASK _GL_FALSE
  445.  
  446.     IF worldMOD = 0 THEN _GLBINDTEXTURE _GL_TEXTURE_2D, worldTextureHandle&(1) ELSE _GLBINDTEXTURE _GL_TEXTURE_2D, worldTextureHandle&(2)
  447.  
  448.     _GLBEGIN _GL_QUADS
  449.     _GLTEXCOORD2F 0, 1
  450.     _GLVERTEX3F -s, s, -s 'front
  451.     _GLTEXCOORD2F 0, 0
  452.     _GLVERTEX3F -s, -s, -s
  453.     _GLTEXCOORD2F 1, 0
  454.     _GLVERTEX3F s, -s, -s
  455.     _GLTEXCOORD2F 1, 1
  456.     _GLVERTEX3F s, s, -s
  457.     _GLEND
  458.  
  459.     '_glBindTexture _GL_TEXTURE_2D, skyTextureHandle&(0)
  460.     _GLBEGIN _GL_QUADS
  461.     _GLTEXCOORD2F 0, 1
  462.     _GLVERTEX3F -s, s, s 'rear
  463.     _GLTEXCOORD2F 0, 0
  464.     _GLVERTEX3F -s, -s, s
  465.     _GLTEXCOORD2F 1, 0
  466.     _GLVERTEX3F s, -s, s
  467.     _GLTEXCOORD2F 1, 1
  468.     _GLVERTEX3F s, s, s
  469.     _GLEND
  470.  
  471.     '_glBindTexture _GL_TEXTURE_2D, skyTextureHandle&(1)
  472.     _GLBEGIN _GL_QUADS
  473.     _GLTEXCOORD2F 1, 0
  474.     _GLVERTEX3F -s, s, s 'left
  475.     _GLTEXCOORD2F 0, 0
  476.     _GLVERTEX3F -s, -s, s
  477.     _GLTEXCOORD2F 0, 1
  478.     _GLVERTEX3F -s, -s, -s
  479.     _GLTEXCOORD2F 1, 1
  480.     _GLVERTEX3F -s, s, -s
  481.     _GLEND
  482.  
  483.     '_glBindTexture _GL_TEXTURE_2D, skyTextureHandle&(3)
  484.     _GLBEGIN _GL_QUADS
  485.     _GLTEXCOORD2F 1, 0
  486.     _GLVERTEX3F s, s, s 'right
  487.     _GLTEXCOORD2F 0, 0
  488.     _GLVERTEX3F s, -s, s
  489.     _GLTEXCOORD2F 0, 1
  490.     _GLVERTEX3F s, -s, -s
  491.     _GLTEXCOORD2F 1, 1
  492.     _GLVERTEX3F s, s, -s
  493.     _GLEND
  494.  
  495.     '_glBindTexture _GL_TEXTURE_2D, skyTextureHandle&(2)
  496.     _GLBEGIN _GL_QUADS
  497.     _GLTEXCOORD2F 0, 1
  498.     _GLVERTEX3F -s, s, -s 'up
  499.     _GLTEXCOORD2F 0, 0
  500.     _GLVERTEX3F -s, s, s
  501.     _GLTEXCOORD2F 1, 0
  502.     _GLVERTEX3F s, s, s
  503.     _GLTEXCOORD2F 1, 1
  504.     _GLVERTEX3F s, s, -s
  505.     _GLEND
  506.  
  507.     _GLDEPTHMASK _GL_TRUE
  508.  
  509. SUB setMountColor (xi, yi, i, h, h_max) 'assign color on the basis of height map and moisture map.
  510.     IF snowMount = 1 THEN
  511.         IF h > 0.8 * h_max THEN mountColor(i) = 0.439: mountColor(i + 1) = 0.988: mountColor(i + 2) = 0.988: EXIT SUB
  512.         mountColor(i) = 1: mountColor(i + 1) = 1: mountColor(i + 2) = 1
  513.         EXIT SUB
  514.     END IF
  515.     IF h > 0.8 * h_max THEN
  516.         IF moistureMap(xi, yi) < 0.1 THEN mountColor(i) = 0.333: mountColor(i + 1) = 0.333: mountColor(i + 2) = 0.333: EXIT SUB 'scorched
  517.         IF moistureMap(xi, yi) < 0.2 THEN mountColor(i) = 0.533: mountColor(i + 1) = 0.533: mountColor(i + 2) = 0.533: EXIT SUB 'bare
  518.         IF moistureMap(xi, yi) < 0.5 THEN mountColor(i) = 0.737: mountColor(i + 1) = 0.737: mountColor(i + 2) = 0.6705: EXIT SUB 'tundra
  519.         mountColor(i) = 0.8705: mountColor(i + 1) = 0.8705: mountColor(i + 2) = 0.898: EXIT SUB 'snow
  520.     END IF
  521.     IF h > 0.6 * h_max THEN
  522.         IF moistureMap(xi, yi) < 0.33 THEN mountColor(i) = 0.788: mountColor(i + 1) = 0.823: mountColor(i + 2) = 0.607: EXIT SUB 'temperate desert
  523.         IF moistureMap(xi, yi) < 0.66 THEN mountColor(i) = 0.533: mountColor(i + 1) = 0.600: mountColor(i + 2) = 0.466: EXIT SUB 'shrubland
  524.         mountColor(i) = 0.6: mountColor(i + 1) = 0.6705: mountColor(i + 2) = 0.466: EXIT SUB 'taiga
  525.     END IF
  526.     IF h > 0.3 * h_max THEN
  527.         IF moistureMap(xi, yi) < 0.16 THEN mountColor(i) = 0.788: mountColor(i + 1) = 0.823: mountColor(i + 2) = 0.607: EXIT SUB 'temperate desert
  528.         IF moistureMap(xi, yi) < 0.50 THEN mountColor(i) = 0.533: mountColor(i + 1) = 0.6705: mountColor(i + 2) = 0.333: EXIT SUB 'grassland
  529.         IF moistureMap(xi, yi) < 0.83 THEN mountColor(i) = 0.403: mountColor(i + 1) = 0.576: mountColor(i + 2) = 0.349: EXIT SUB 'temperate deciduous forest
  530.         mountColor(i) = 0.262: mountColor(i + 1) = 0.533: mountColor(i + 2) = 0.233: EXIT SUB 'temperate rain forest
  531.     END IF
  532.     IF h < 0.01 * h_max THEN mountColor(i) = 0.262: mountColor(i + 1) = 0.262: mountColor(i + 2) = 0.478: EXIT SUB 'ocean
  533.     IF h < 0.07 * h_max THEN mountColor(i) = 0.627: mountColor(i + 1) = 0.568: mountColor(i + 2) = 0.466: EXIT SUB 'beach
  534.     IF h <= 0.3 * h_max THEN
  535.         IF moistureMap(xi, yi) < 0.16 THEN mountColor(i) = 0.823: mountColor(i + 1) = 0.725: mountColor(i + 2) = 0.545: EXIT SUB 'subtropical desert
  536.         IF moistureMap(xi, yi) < 0.33 THEN mountColor(i) = 0.533: mountColor(i + 1) = 0.6705: mountColor(i + 2) = 0.333: EXIT SUB 'grassland
  537.         IF moistureMap(xi, yi) < 0.66 THEN mountColor(i) = 0.337: mountColor(i + 1) = 0.600: mountColor(i + 2) = 0.266: EXIT SUB 'tropical seasonal forest
  538.         mountColor(i) = 0.2: mountColor(i + 1) = 0.466: mountColor(i + 2) = 0.333: EXIT SUB 'tropical rain forest
  539.     END IF
  540.  
  541. SUB generateTerrainData ()
  542.     DIM A AS vec3, B AS vec3, C AS vec3, R AS vec3
  543.     index = 0
  544.  
  545.     '##################################################################################################
  546.     '# Note : The below method consumes more memory. It uses 3x more vertex array than the next one.  #
  547.     '# So, use of this method was avoided by me.                                                      #
  548.     '##################################################################################################
  549.  
  550.     ' _dest _console
  551.     ' FOR z = 0 TO mapH - 1
  552.     ' FOR x = 0 TO mapW - 1
  553.     ' A = terrainData(x, z)
  554.     ' B = terrainData(x, z + 1)
  555.     ' C = terrainData(x + 1, z)
  556.     ' D = terrainData(x+1,z+1)
  557.  
  558.     ' ' ?index
  559.     ' ' OBJ_CalculateNormal A, B, C, R
  560.  
  561.     ' ' mountNormal(index) = R.x : mountNormal(index+1) = R.y : mountNormal(index+2) = R.z
  562.     ' ' mountNormal(index+3) = R.x : mountNormal(index+4) = R.y : mountNormal(index+5) = R.z
  563.     ' ' mountNormal(index+6) = R.x : mountNormal(index+7) = R.y : mountNormal(index+8) = R.z
  564.  
  565.     ' mountVert(index) = A.x : mountVert(index+1) = A.y : mountVert(index+2) = A.z : setMountColor x,z,index, A.y, mountHeightMax
  566.     ' mountVert(index+3) = B.x : mountVert(index+4) = B.y : mountVert(index+5) = B.z :  setMountColor x,z+1,index+3, B.y, mountHeightMax
  567.     ' mountVert(index+6) = C.x : mountVert(index+7) = C.y : mountVert(index+8) = C.z: setMountColor x+1,z,index+6, C.y, mountHeightMax
  568.  
  569.     ' ' OBJ_CalculateNormal C,B,D, R
  570.  
  571.     ' ' mountNormal(index+9) = R.x : mountNormal(index+10) = R.y : mountNormal(index+11) = R.z
  572.     ' ' mountNormal(index+12) = R.x : mountNormal(index+13) = R.y : mountNormal(index+14) = R.z
  573.     ' ' mountNormal(index+15) = R.x : mountNormal(index+16) = R.y : mountNormal(index+17) = R.z
  574.  
  575.     ' mountVert(index+9) = C.x : mountVert(index+10) = C.y : mountVert(index+11) = C.z: setMountColor x+1,z, index+9, C.y, mountHeightMax
  576.     ' mountVert(index+12) = B.x : mountVert(index+13) = B.y : mountVert(index+14) = B.z: setMountColor x,z+1,index+12, B.y, mountHeightMax
  577.     ' mountVert(index+15) = D.x : mountVert(index+16) = D.y : mountVert(index+17) = D.z: setMountColor x+1,z+1,index+15, D.y, mountHeightMax
  578.     ' index = index+18
  579.     ' NEXT x,z
  580.  
  581.     'this method is efficient than the above one.
  582.     DO
  583.         IF z MOD 2 = 0 THEN x = x + 1 ELSE x = x - 1
  584.  
  585.         A = terrainData(x, z) 'get out coordinates from our stored data
  586.         B = terrainData(x, z + 1)
  587.         C = terrainData(x + 1, z)
  588.  
  589.         OBJ_CalculateNormal A, B, C, R 'calculates the normal of a triangle
  590.  
  591.         'store color, coordinate & normal data in an array
  592.         mountNormal(index) = R.x: mountNormal(index + 1) = R.y: mountNormal(index + 2) = R.z
  593.         mountVert(index) = A.x: mountVert(index + 1) = A.y: mountVert(index + 2) = A.z: setMountColor x, z, index, A.y, mountHeightMax
  594.  
  595.         mountNormal(index + 3) = R.x: mountNormal(index + 4) = R.y: mountNormal(index + 5) = R.z
  596.         mountVert(index + 3) = B.x: mountVert(index + 4) = B.y: mountVert(index + 5) = B.z: setMountColor x, z + 1, index + 3, B.y, mountHeightMax
  597.  
  598.         index = index + 6
  599.  
  600.         IF x = mapW - 1 THEN
  601.             IF z MOD 2 = 0 THEN x = x + 1: z = z + 1
  602.         END IF
  603.         IF x = 1 THEN
  604.             IF z MOD 2 = 1 THEN x = x - 1: z = z + 1
  605.         END IF
  606.         IF z = mapH - 1 THEN EXIT DO
  607.     LOOP
  608.     _DEST 0
  609.  
  610. FUNCTION trimDecimal# (num, n%)
  611.     d$ = RTRIM$(STR$(num))
  612.     dd$ = d$
  613.     FOR i = 1 TO LEN(d$)
  614.         cA$ = MID$(d$, i, 1)
  615.         IF foundpoint = 1 THEN k = k + 1
  616.         IF cA$ = "." THEN foundpoint = 1
  617.         IF k = n% THEN dd$ = LEFT$(dd$, i)
  618.     NEXT i
  619.     trimDecimal# = VAL(dd$)
  620.  
  621.  
  622. FUNCTION p5random! (mn!, mx!)
  623.     IF mn! > mx! THEN
  624.         SWAP mn!, mx!
  625.     END IF
  626.     p5random! = RND * (mx! - mn!) + mn!
  627.  
  628.  
  629. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  630.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  631.  
  632. SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
  633.     'This sub from here: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1848.msg17254#msg17254
  634.     DIM Radius AS LONG
  635.     DIM RadiusError AS LONG
  636.     DIM X AS LONG
  637.     DIM Y AS LONG
  638.  
  639.     Radius = ABS(R)
  640.     RadiusError = -Radius
  641.     X = Radius
  642.     Y = 0
  643.  
  644.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  645.  
  646.     ' Draw the middle span here so we don't draw it twice in the main loop,
  647.     ' which would be a problem with blending turned on.
  648.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  649.  
  650.     WHILE X > Y
  651.  
  652.         RadiusError = RadiusError + Y * 2 + 1
  653.  
  654.         IF RadiusError >= 0 THEN
  655.  
  656.             IF X <> Y + 1 THEN
  657.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  658.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  659.             END IF
  660.  
  661.             X = X - 1
  662.             RadiusError = RadiusError - X * 2
  663.  
  664.         END IF
  665.  
  666.         Y = Y + 1
  667.  
  668.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  669.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  670.  
  671.     WEND
  672.  
  673.  
  674.  
  675. 'coded in QB64 by Fellipe Heitor
  676. 'Can be found in p5js.bas library
  677. 'http://bit.ly/p5jsbas
  678. FUNCTION noise! (x AS SINGLE, y AS SINGLE, z AS SINGLE)
  679.     STATIC p5NoiseSetup AS _BYTE
  680.     STATIC perlin() AS SINGLE
  681.     STATIC PERLIN_YWRAPB AS SINGLE, PERLIN_YWRAP AS SINGLE
  682.     STATIC PERLIN_ZWRAPB AS SINGLE, PERLIN_ZWRAP AS SINGLE
  683.     STATIC PERLIN_SIZE AS SINGLE
  684.  
  685.     IF p5NoiseSetup = 0 THEN
  686.         p5NoiseSetup = 1
  687.  
  688.         PERLIN_YWRAPB = 4
  689.         PERLIN_YWRAP = INT(1 * (2 ^ PERLIN_YWRAPB))
  690.         PERLIN_ZWRAPB = 8
  691.         PERLIN_ZWRAP = INT(1 * (2 ^ PERLIN_ZWRAPB))
  692.         PERLIN_SIZE = 4095
  693.  
  694.         perlin_octaves = 4
  695.         perlin_amp_falloff = 0.5
  696.  
  697.         REDIM perlin(PERLIN_SIZE + 1) AS SINGLE
  698.         DIM i AS SINGLE
  699.         FOR i = 0 TO PERLIN_SIZE + 1
  700.             perlin(i) = RND
  701.         NEXT
  702.     END IF
  703.  
  704.     x = ABS(x)
  705.     y = ABS(y)
  706.     z = ABS(z)
  707.  
  708.     DIM xi AS SINGLE, yi AS SINGLE, zi AS SINGLE
  709.     xi = INT(x)
  710.     yi = INT(y)
  711.     zi = INT(z)
  712.  
  713.     DIM xf AS SINGLE, yf AS SINGLE, zf AS SINGLE
  714.     xf = x - xi
  715.     yf = y - yi
  716.     zf = z - zi
  717.  
  718.     DIM r AS SINGLE, ampl AS SINGLE, o AS SINGLE
  719.     r = 0
  720.     ampl = .5
  721.  
  722.     FOR o = 1 TO perlin_octaves
  723.         DIM of AS SINGLE, rxf AS SINGLE
  724.         DIM ryf AS SINGLE, n1 AS SINGLE, n2 AS SINGLE, n3 AS SINGLE
  725.         of = xi + INT(yi * (2 ^ PERLIN_YWRAPB)) + INT(zi * (2 ^ PERLIN_ZWRAPB))
  726.  
  727.         rxf = 0.5 * (1.0 - COS(xf * _PI))
  728.         ryf = 0.5 * (1.0 - COS(yf * _PI))
  729.  
  730.         n1 = perlin(of AND PERLIN_SIZE)
  731.         n1 = n1 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n1)
  732.         n2 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
  733.         n2 = n2 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n2)
  734.         n1 = n1 + ryf * (n2 - n1)
  735.  
  736.         of = of + PERLIN_ZWRAP
  737.         n2 = perlin(of AND PERLIN_SIZE)
  738.         n2 = n2 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n2)
  739.         n3 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
  740.         n3 = n3 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n3)
  741.         n2 = n2 + ryf * (n3 - n2)
  742.  
  743.         n1 = n1 + (0.5 * (1.0 - COS(zf * _PI))) * (n2 - n1)
  744.  
  745.         r = r + n1 * ampl
  746.         ampl = ampl * perlin_amp_falloff
  747.         xi = INT(xi * (2 ^ 1))
  748.         xf = xf * 2
  749.         yi = INT(yi * (2 ^ 1))
  750.         yf = yf * 2
  751.         zi = INT(zi * (2 ^ 1))
  752.         zf = zf * 2
  753.  
  754.         IF xf >= 1.0 THEN xi = xi + 1: xf = xf - 1
  755.         IF yf >= 1.0 THEN yi = yi + 1: yf = yf - 1
  756.         IF zf >= 1.0 THEN zi = zi + 1: zf = zf - 1
  757.     NEXT
  758.     noise! = r
  759.  
  760. SUB noiseDetail (lod!, falloff!)
  761.     IF lod! > 0 THEN perlin_octaves = lod!
  762.     IF falloff! > 0 THEN perlin_amp_falloff = falloff!
  763.  
  764. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
  765. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
  766.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
  767.  
  768.     H = map(__H, 0, 255, 0, 360)
  769.     S = map(__S, 0, 255, 0, 1)
  770.     B = map(__B, 0, 255, 0, 1)
  771.  
  772.     IF S = 0 THEN
  773.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  774.         EXIT FUNCTION
  775.     END IF
  776.  
  777.     DIM fmx AS _FLOAT, fmn AS _FLOAT
  778.     DIM fmd AS _FLOAT, iSextant AS INTEGER
  779.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
  780.  
  781.     IF B > .5 THEN
  782.         fmx = B - (B * S) + S
  783.         fmn = B + (B * S) - S
  784.     ELSE
  785.         fmx = B + (B * S)
  786.         fmn = B - (B * S)
  787.     END IF
  788.  
  789.     iSextant = INT(H / 60)
  790.  
  791.     IF H >= 300 THEN
  792.         H = H - 360
  793.     END IF
  794.  
  795.     H = H / 60
  796.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
  797.  
  798.     IF iSextant MOD 2 = 0 THEN
  799.         fmd = (H * (fmx - fmn)) + fmn
  800.     ELSE
  801.         fmd = fmn - (H * (fmx - fmn))
  802.     END IF
  803.  
  804.     imx = _ROUND(fmx * 255)
  805.     imd = _ROUND(fmd * 255)
  806.     imn = _ROUND(fmn * 255)
  807.  
  808.     SELECT CASE INT(iSextant)
  809.         CASE 1
  810.             hsb~& = _RGBA32(imd, imx, imn, A)
  811.         CASE 2
  812.             hsb~& = _RGBA32(imn, imx, imd, A)
  813.         CASE 3
  814.             hsb~& = _RGBA32(imn, imd, imx, A)
  815.         CASE 4
  816.             hsb~& = _RGBA32(imd, imn, imx, A)
  817.         CASE 5
  818.             hsb~& = _RGBA32(imx, imn, imd, A)
  819.         CASE ELSE
  820.             hsb~& = _RGBA32(imx, imd, imn, A)
  821.     END SELECT
  822.  
  823.  
  824.  
  825. SUB OBJ_CalculateNormal (p1 AS vec3, p2 AS vec3, p3 AS vec3, N AS vec3)
  826.     DIM U AS vec3, V AS vec3
  827.  
  828.     U.x = p2.x - p1.x
  829.     U.y = p2.y - p1.y
  830.     U.z = p2.z - p1.z
  831.  
  832.     V.x = p3.x - p1.x
  833.     V.y = p3.y - p1.y
  834.     V.z = p3.z - p1.z
  835.  
  836.     N.x = (U.y * V.z) - (U.z * V.y)
  837.     N.y = (U.z * V.x) - (U.x * V.z)
  838.     N.z = (U.x * V.y) - (U.y * V.x)
  839.     OBJ_Normalize N
  840.  
  841. SUB OBJ_Normalize (V AS vec3)
  842.     mag! = SQR(V.x * V.x + V.y * V.y + V.z * V.z)
  843.     V.x = V.x / mag!
  844.     V.y = V.y / mag!
  845.     V.z = V.z / mag!
  846.  
  847. FUNCTION glVec4%& (x, y, z, w)
  848.     STATIC internal_vec4(3)
  849.     internal_vec4(0) = x
  850.     internal_vec4(1) = y
  851.     internal_vec4(2) = z
  852.     internal_vec4(3) = w
  853.     glVec4%& = _OFFSET(internal_vec4())
  854.  
  855. '============================================================
  856. '=== This file was created with MakeDATA.bas by RhoSigma, ===
  857. '=== you must $INCLUDE this at the end of your program.   ===
  858. '============================================================
  859.  
  860. '=====================================================================
  861. 'Function to write the embedded DATAs back to disk. Call this FUNCTION
  862. 'once, before you will access the represented file for the first time.
  863. 'After the call always use the returned realFile$ ONLY to access the
  864. 'written file, as the filename was maybe altered in order to avoid the
  865. 'overwriting of an existing file of the same name in the given location.
  866. '---------------------------------------------------------------------
  867. 'SYNTAX: realFile$ = WriteqbiconData$ (wantFile$)
  868. '
  869. 'INPUTS: wantFile$ --> The filename you would like to write the DATAs
  870. '                      to, can contain a full or relative path.
  871. '
  872. 'RESULT: realFile$ --> On success the path and filename finally used
  873. '                      after applied checks, use ONLY this returned
  874. '                      name to access the file.
  875. '                   -> On failure this FUNCTION will panic with the
  876. '                      appropriate ERROR code, you may handle this as
  877. '                      needed with your own ON ERROR GOTO... handler.
  878. '=====================================================================
  879. FUNCTION WriteqbiconData$ (file$)
  880.     '--- separate filename body & extension ---
  881.     FOR po% = LEN(file$) TO 1 STEP -1
  882.         IF MID$(file$, po%, 1) = "." THEN
  883.             body$ = LEFT$(file$, po% - 1)
  884.             ext$ = MID$(file$, po%)
  885.             EXIT FOR
  886.         ELSEIF MID$(file$, po%, 1) = "\" OR MID$(file$, po%, 1) = "/" OR po% = 1 THEN
  887.             body$ = file$
  888.             ext$ = ""
  889.             EXIT FOR
  890.         END IF
  891.     NEXT po%
  892.     '--- avoid overwriting of existing files ---
  893.     num% = 1
  894.     WHILE _FILEEXISTS(file$)
  895.         file$ = body$ + "(" + LTRIM$(STR$(num%)) + ")" + ext$
  896.         num% = num% + 1
  897.     WEND
  898.     '--- write DATAs ---
  899.     ff% = FREEFILE
  900.     OPEN file$ FOR OUTPUT AS ff%
  901.     RESTORE qbicon
  902.     READ numL&, numB&
  903.     FOR i& = 1 TO numL&
  904.         READ dat&
  905.         PRINT #ff%, MKL$(dat&);
  906.     NEXT i&
  907.     IF numB& > 0 THEN
  908.         FOR i& = 1 TO numB&
  909.             READ dat&
  910.             PRINT #ff%, CHR$(dat&);
  911.         NEXT i&
  912.     END IF
  913.     CLOSE ff%
  914.     '--- set result ---
  915.     WriteqbiconData$ = file$
  916.  
  917.     '--- DATAs representing the contents of file qbicon32.png
  918.     '---------------------------------------------------------------------
  919.     qbicon:
  920.     DATA 144,4
  921.     DATA &H474E5089,&H0A1A0A0D,&H0D000000,&H52444849,&H20000000,&H20000000,&H00000608,&H7A7A7300
  922.     DATA &H000000F4,&H4D416704,&HB1000041,&H61FC0B8F,&H00000005,&H59487009,&H0E000073,&H0E0000C1
  923.     DATA &H91B801C1,&H0000ED6B,&H45741A00,&H6F537458,&H61777466,&H50006572,&H746E6961,&H54454E2E
  924.     DATA &H2E337620,&H30312E35,&HA172F430,&HC0010000,&H54414449,&H97C54758,&H20C371E1,&HA519850C
  925.     DATA &H064430A3,&HDB3124E8,&H823B3FB4,&H5D14C887,&H04A84D21,&H8C096308,&H87F6E2E0,&HD67E02F2
  926.     DATA &HBE7C5F13,&H6EE6318B,&H32F9F98D,&H4A6A13E6,&H66A141DF,&H060DE3F4,&H283CCDC8,&HA0AEB0D4
  927.     DATA &H869AC350,&HE1E5F0A0,&H42FAF78D,&H35621C7F,&HE71AB1F6,&H3CFE85F5,&H0F502444,&HA81115E9
  928.     DATA &H922AF485,&HE6F00828,&H8C2746EE,&H0F4B7EBA,&HEDCDE011,&H15184E93,&H25D3DCD7,&H0A938650
  929.     DATA &H1940834F,&H3D3C2A4E,&H551C3C02,&H6CBEC278,&H8E04EFFE,&H24E64F6A,&H92554702,&HBD808D39
  930.     DATA &HCD712195,&H2812A73D,&HA78549C3,&HF73DC047,&H9EE6B8E1,&H7F365D78,&HB54D0109,&H104A6808
  931.     DATA &H27157A98,&H62AF5302,&HDDC4A04E,&H11F35222,&H082D39E6,&HC89CE6F0,&HBCAE6276,&H020688E9
  932.     DATA &HB732A1F0,&H569436B4,&H8301F0E1,&HBCA6AC3A,&H00E288E9,&H5CB2C091,&H2EAD0057,&HD87DE3F4
  933.     DATA &HEF57B16C,&H5050FC1D,&H2616BDF8,&H237F613D,&HAA390B50,&H40244038,&H3878A98D,&H0230F4AA
  934.     DATA &H0BB9C03C,&HADA7B09D,&H9E953BE6,&H2FD8010E,&HD5B48E43,&H73D2A77C,&HFDB70122,&HCD7141C6
  935.     DATA &H39FAE93D,&HD2A680CF,&H9A026D70,&H24F0FBC2,&H2DAE13E5,&H6FEE0FBC,&H9F2E7013,&HB9AE2830
  936.     DATA &H66A75D27,&H52F6754D,&H0043A019,&HA93873F6,&HA90244F4,&H01CAA1D9,&H10DFFEC2,&H84039540
  937.     DATA &H033CD7FD,&H72A6AC3C,&H11BFB080,&HEB157B98,&HD75E3409,&H02184099,&H688E9A94,&H0854190E
  938.     DATA &H2FF0040F,&H46621E72,&H1B3509A1,&H05FDBBD5,&HF13FDC1C,&H6A6E33B4,&H00000000,&H444E4549
  939.     DATA &HAE,&H42,&H60,&H82
« Last Edit: March 07, 2020, 05:51:51 am by Qwerkey »