'3D OpenWorld Terrain Demo
'Using Perlin Noise
'By Ashish Kushwaha
'$CONSOLE
'noise function related variables
mapW = 800: mapH = 800 'control the size of the map or world
'Terrain Map related variables
'terrainData(mapW,mapH) contain elevation data and moistureMap(mapW,mapH) contain moisture data
DIM SHARED terrainMap
(mapW
, mapH
), moistureMap
(mapW
, mapH
), terrainData
(mapW
, mapH
) AS vec3
'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
DIM SHARED mountVert
(mapW
* mapH
* 6) AS SINGLE, mountColor
(mapW
* mapH
* 6), mountNormal
(mapW
* mapH
* 6)
'MODs
'map
DIM SHARED worldMap&
, myLocation&
'stored the 2D Map worldMap&
= _NEWIMAGE(mapW
+ 300, mapH
+ 300, 32)
'surprise
'sky
DIM SHARED worldTextures&
(1), worldTextureHandle&
(0) ' worldTextures&(0) = _NEWIMAGE(600, 600, 32)
' FOR i = 1 TO 5: worldTextures&(i) = _NEWIMAGE(200, 200, 32): NEXT
worldTextures&
(1) = _NEWIMAGE(32, 32, 32) '3 32's_PUTIMAGE (0, 32)-(32, 0), tmp&
, worldTextures&
(1)
'The reason of commenting down below code is given on line number - 279
'_DEST skyTextures&(0)
'CLS , _RGB(109, 164, 255)
'FOR y = 0 TO _HEIGHT - 1
' FOR x = 0 TO _WIDTH - 1
' noiseDetail 5, 0.5
' k! = (ABS(noise(x * 0.04, y * 0.04, x / y * 0.01)) * 1.3) ^ 3
' PSET (x, y), _RGBA(255, 255, 255, k! * 255)
'NEXT x, y
'skyW = _WIDTH(skyTextures&(0))
'skyH = _HEIGHT(skyTextures&(0))
'_PUTIMAGE (0, 0), 0, skyTextures&(1), (skyW / 3, 0)-STEP(skyW / 3, skyH / 3) 'back or rear
'_PUTIMAGE (0, 0), 0, skyTextures&(2), (0, skyH / 3)-STEP(skyW / 3, skyH / 3) 'left
'_PUTIMAGE (0, 0), 0, skyTextures&(3), (skyW / 3, skyH / 3)-STEP(skyW / 3, skyH / 3) 'up
'_PUTIMAGE (0, 0), 0, skyTextures&(4), (2 * (skyW / 3), skyH / 3)-STEP(skyW / 3, skyH / 3) 'right
'_PUTIMAGE (0, 0), 0, skyTextures&(5), (skyW / 3, 2 * (skyH / 3))-STEP(skyW / 3, skyH / 3) 'front
'_DEST 0
'camera
_DEST myLocation&
'Generating the blip icon 'image data of blip icon
blipicon:
DATA 0,0,0,0,0,1,0,0,0,0,0 DATA 0,0,0,0,0,1,0,0,0,0,0 DATA 0,0,0,0,1,1,1,0,0,0,0 DATA 0,0,0,1,1,1,1,1,0,0,0 DATA 0,0,0,1,1,1,1,1,0,0,0 DATA 0,0,1,1,1,1,1,1,1,0,0 DATA 0,1,1,1,1,1,1,1,1,1,0 DATA 0,1,1,1,1,1,1,1,1,1,0 DATA 1,1,1,1,0,0,0,1,1,1,1 DATA 1,1,0,0,0,0,0,0,0,1,1 DATA 1,0,0,0,0,0,0,0,0,0,1 DATA 0,0,0,0,0,0,0,0,0,0,0
'Map elevations and mositure calculation done here with the help of perlin noise
freq = 1
nx = x * 0.01
ny = y * 0.01
noiseDetail 2, 0.4
v!
= ABS(noise
(nx
* freq
, ny
* freq
, 0)) * 1.5 + ABS(noise
(nx
* freq
* 4, ny
* freq
* 4, 0)) * .25 v! = v! ^ (3.9)
elev = v! * 255
noiseDetail 2, 0.4
m!
= ABS(noise
(nx
* 2, ny
* 2, 0)) m! = m! ^ 1.4
' PSET (x + mapW, y), _RGB(0, 0, m! * 255)
moistureMap(x, y) = m!
' PSET (x, y), _RGB(elev, elev, elev)
terrainMap(x, y) = (elev / 255) * mountHeightMax
terrainData(x, y).x = map(x, 0, mapW, -mapW * 0.04, mapW * 0.04)
terrainData(x, y).y = terrainMap(x, y)
terrainData(x, y).z = map(y, 0, mapH, -mapH * 0.04, mapH * 0.04)
setMountColor x, y, 0, (elev / 255) * mountHeightMax, mountHeightMax
clr~&
= _RGB(mountColor
(0) * 255, mountColor
(1) * 255, mountColor
(2) * 255) PSET (x
+ 150, y
+ 150), clr~&
IF terrainMap
(x
, y
) <= 0.3 * mountHeightMax
AND RND > 0.99993 AND Surprise.set
= 0 THEN Surprise.
pos = terrainData
(x
, y
) ' line(x-2,y-2)-step(4,4),_rgb(255,0,0),bf
Surprise.set = 1
sx = x: sy = y
'CLS
'PRINT "Generating World..."
'need to show a catchy progress bar
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
' _TITLE "3D OpenWorld Mountails [Hit SPACE to switch between MODs]"
LINE (sx
- 3 + 150, sy
- 3 + 150)-STEP(6, 6), _RGB(255, 0, 0), BF
generateTerrainData
PRINT "Hit Enter To Step In The World." PRINT "Map size : ";
(mapH
* mapW
* 24) / 1024;
" kB"
glAllow = -1
IF Cam.mpos.z
> mapH
- 2 THEN Cam.mpos.z
= mapH
- 2 'prevent reaching out of the world map IF Cam.mpos.x
> mapW
- 2 THEN Cam.mpos.x
= mapW
- 2 ' IF Cam.mpos.z
< 2 THEN Cam.mpos.z
= 2 ' IF Cam.mpos.x
< 2 THEN Cam.mpos.x
= 2 '
Cam.mpos.z
= Cam.mpos.z
+ SIN(theta
) * 0.45: Cam.mpos.x
= Cam.mpos.x
+ COS(theta
) * 0.45 Cam.mpos.z
= Cam.mpos.z
- SIN(theta
) * 0.45: Cam.mpos.x
= Cam.mpos.x
- COS(theta
) * 0.45 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 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
IF worldMOD
= 2 OR worldMOD
= 3 THEN worldMOD
= 0 ELSE worldMOD
= worldMOD
+ 1
CLS , 1 'clear the screen and make it transparent so that GL context not get hidden.
'rotation of world causes rotation of map too. calculation of the source points of map is done below
sx1
= COS(_PI(.75) + theta
) * 150 * sqrt2
+ Cam.mpos.x
+ 150: sy1
= SIN(_PI(.75) + theta
) * 150 * sqrt2
+ Cam.mpos.z
+ 150 sx2
= COS(_PI(1.25) + theta
) * 150 * sqrt2
+ Cam.mpos.x
+ 150: sy2
= SIN(_PI(1.25) + theta
) * 150 * sqrt2
+ Cam.mpos.z
+ 150 sx3
= COS(_PI(1.75) + theta
) * 150 * sqrt2
+ Cam.mpos.x
+ 150: sy3
= SIN(_PI(1.75) + theta
) * 150 * sqrt2
+ Cam.mpos.z
+ 150 sx4
= COS(_PI(2.25) + theta
) * 150 * sqrt2
+ Cam.mpos.x
+ 150: sy4
= SIN(_PI(2.25) + theta
) * 150 * sqrt2
+ Cam.mpos.z
+ 150 'displaying the minimap
'showing your location
'drawing red border along the map make it attractive
setMountColor 0, 0, i - 1, mountVert(i), mountHeightMax
snowMount = 2
glSetup = -1
rad = 1 'distance of camera from origin (0,0,0)
farPoint = 1.0 'far point of camera target
'initialize camera
Cam.mpos.x = mapW / 2
Cam.mpos.z = mapH / 2
Cam.mpos.y = 8
'initialize textures for sky
_glTexImage2D _GL_TEXTURE_2D
, 0, _GL_RGB
, _WIDTH(worldTextures&
(i
)), _HEIGHT(worldTextures&
(i
)), 0, _GL_BGRA_EXT
, _GL_UNSIGNED_BYTE
, m.OFFSET
IF worldMOD
= 0 THEN _glClearColor 0.7, 0.8, 1.0, 1.0 'this makes the background look sky blue. v~&
= hsb~&
(clock#
MOD 255, 255, 128, 255)
_glEnable _GL_DEPTH_TEST
'Of course, we are going to do 3D
_glEnable _GL_TEXTURE_2D
'so that we can use texture for our sky. :)
_glEnable _GL_LIGHTING
'Without light, everything dull.
'night MOD
_glLightfv _GL_LIGHT0
, _GL_AMBIENT
, glVec4
(0.05, 0.05, 0.33, 0) _glLightfv _GL_LIGHT0
, _GL_DIFFUSE
, glVec4
(0.55, 0.55, 0.78, 0) _glLightfv _GL_LIGHT0
, _GL_SPECULAR
, glVec4
(0.75, 0.75, 0.98, 0) _glLightfv _GL_LIGHT0
, _GL_AMBIENT
, glVec4
(0.35, 0.35, 0.33, 0) 'gives a bit yellowing color to the light _glLightfv _GL_LIGHT0
, _GL_DIFFUSE
, glVec4
(0.75, 0.75, 0.60, 0) 'so it will feel like sun is in the sky _glLightfv _GL_LIGHT0
, _GL_SPECULAR
, glVec4
(0.95, 0.95, 0.80, 0) _glLightfv _GL_LIGHT0
, _GL_AMBIENT
, glVec4
(kR
/ 2, kG
/ 2, kB
/ 2, 0) _glLightfv _GL_LIGHT0
, _GL_DIFFUSE
, glVec4
(kR
* 0.9, kG
* 0.9, kB
* 0.9, 0) _glLightfv _GL_LIGHT0
, _GL_SPECULAR
, glVec4
(kR
, kG
, kB
, 0)
' IF Cam.mpos.y > (terrainMap(Cam.mpos.x, Cam.mpos.z)) THEN Cam.mpos.y = Cam.mpos.y - 0.03 ELSE
Cam.mpos.y = meanAreaHeight(1, Cam.mpos.x, Cam.mpos.z) 'if you are in air then you must fall.
'calculation of camera eye, its target, etc...
Cam.
pos.x
= map
(Cam.mpos.x
, 0, mapW
, -mapW
* 0.04, mapW
* 0.04) Cam.
pos.z
= map
(Cam.mpos.z
, 0, mapH
, -mapH
* 0.04, mapH
* 0.04) Cam.
pos.y
= Cam.mpos.y
+ 0.3
Cam.target.y
= Cam.
pos.y
* COS(phi
) Cam.target.x
= Cam.
pos.x
+ COS(theta
) * farPoint
Cam.target.z
= Cam.
pos.z
+ SIN(theta
) * farPoint
gluLookAt Cam.
pos.x
, Cam.
pos.y
, Cam.
pos.z
, Cam.target.x
, Cam.target.y
, Cam.target.z
, 0, 1, 0
'use of this skybox was avoided by me because I believe that it makes the scene a bit unrealistic.
' skybox 5.0
' draw the world
IF worldMOD
<> 3 AND snowMount
<> 2 THEN showSurprise
0.4, Cam.
pos
clock# = clock# + .5
FOR i
= y%
- n%
TO y%
+ n%
FOR j
= x%
- n%
TO x%
+ n%
h# = h# + terrainMap(j, i)
g% = g% + 1
meanAreaHeight# = (h# / g%)
SUB showSurprise
(s
, a
AS vec3
) worldMOD = 3
_TITLE "You finally came to know that its QB64 Island!!" snowMount = 1
_TITLE "Welcome to this new world..." Cam.mpos.y = 6
'draws a beautiful sky
SUB setMountColor
(xi
, yi
, i
, h
, h_max
) 'assign color on the basis of height map and moisture map. IF h
> 0.8 * h_max
THEN mountColor
(i
) = 0.439: mountColor
(i
+ 1) = 0.988: mountColor
(i
+ 2) = 0.988:
EXIT SUB mountColor(i) = 1: mountColor(i + 1) = 1: mountColor(i + 2) = 1
IF moistureMap
(xi
, yi
) < 0.1 THEN mountColor
(i
) = 0.333: mountColor
(i
+ 1) = 0.333: mountColor
(i
+ 2) = 0.333:
EXIT SUB 'scorched IF moistureMap
(xi
, yi
) < 0.2 THEN mountColor
(i
) = 0.533: mountColor
(i
+ 1) = 0.533: mountColor
(i
+ 2) = 0.533:
EXIT SUB 'bare IF moistureMap
(xi
, yi
) < 0.5 THEN mountColor
(i
) = 0.737: mountColor
(i
+ 1) = 0.737: mountColor
(i
+ 2) = 0.6705:
EXIT SUB 'tundra mountColor
(i
) = 0.8705: mountColor
(i
+ 1) = 0.8705: mountColor
(i
+ 2) = 0.898:
EXIT SUB 'snow 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 IF moistureMap
(xi
, yi
) < 0.66 THEN mountColor
(i
) = 0.533: mountColor
(i
+ 1) = 0.600: mountColor
(i
+ 2) = 0.466:
EXIT SUB 'shrubland mountColor
(i
) = 0.6: mountColor
(i
+ 1) = 0.6705: mountColor
(i
+ 2) = 0.466:
EXIT SUB 'taiga 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 IF moistureMap
(xi
, yi
) < 0.50 THEN mountColor
(i
) = 0.533: mountColor
(i
+ 1) = 0.6705: mountColor
(i
+ 2) = 0.333:
EXIT SUB 'grassland 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 mountColor
(i
) = 0.262: mountColor
(i
+ 1) = 0.533: mountColor
(i
+ 2) = 0.233:
EXIT SUB 'temperate rain forest IF h
< 0.01 * h_max
THEN mountColor
(i
) = 0.262: mountColor
(i
+ 1) = 0.262: mountColor
(i
+ 2) = 0.478:
EXIT SUB 'ocean IF h
< 0.07 * h_max
THEN mountColor
(i
) = 0.627: mountColor
(i
+ 1) = 0.568: mountColor
(i
+ 2) = 0.466:
EXIT SUB 'beach 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 IF moistureMap
(xi
, yi
) < 0.33 THEN mountColor
(i
) = 0.533: mountColor
(i
+ 1) = 0.6705: mountColor
(i
+ 2) = 0.333:
EXIT SUB 'grassland 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 mountColor
(i
) = 0.2: mountColor
(i
+ 1) = 0.466: mountColor
(i
+ 2) = 0.333:
EXIT SUB 'tropical rain forest
SUB generateTerrainData
() index = 0
'##################################################################################################
'# Note : The below method consumes more memory. It uses 3x more vertex array than the next one. #
'# So, use of this method was avoided by me. #
'##################################################################################################
' _dest _console
' FOR z = 0 TO mapH - 1
' FOR x = 0 TO mapW - 1
' A = terrainData(x, z)
' B = terrainData(x, z + 1)
' C = terrainData(x + 1, z)
' D = terrainData(x+1,z+1)
' ' ?index
' ' OBJ_CalculateNormal A, B, C, R
' ' mountNormal(index) = R.x : mountNormal(index+1) = R.y : mountNormal(index+2) = R.z
' ' mountNormal(index+3) = R.x : mountNormal(index+4) = R.y : mountNormal(index+5) = R.z
' ' mountNormal(index+6) = R.x : mountNormal(index+7) = R.y : mountNormal(index+8) = R.z
' mountVert(index) = A.x : mountVert(index+1) = A.y : mountVert(index+2) = A.z : setMountColor x,z,index, A.y, mountHeightMax
' mountVert(index+3) = B.x : mountVert(index+4) = B.y : mountVert(index+5) = B.z : setMountColor x,z+1,index+3, B.y, mountHeightMax
' mountVert(index+6) = C.x : mountVert(index+7) = C.y : mountVert(index+8) = C.z: setMountColor x+1,z,index+6, C.y, mountHeightMax
' ' OBJ_CalculateNormal C,B,D, R
' ' mountNormal(index+9) = R.x : mountNormal(index+10) = R.y : mountNormal(index+11) = R.z
' ' mountNormal(index+12) = R.x : mountNormal(index+13) = R.y : mountNormal(index+14) = R.z
' ' mountNormal(index+15) = R.x : mountNormal(index+16) = R.y : mountNormal(index+17) = R.z
' mountVert(index+9) = C.x : mountVert(index+10) = C.y : mountVert(index+11) = C.z: setMountColor x+1,z, index+9, C.y, mountHeightMax
' mountVert(index+12) = B.x : mountVert(index+13) = B.y : mountVert(index+14) = B.z: setMountColor x,z+1,index+12, B.y, mountHeightMax
' 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
' index = index+18
' NEXT x,z
'this method is efficient than the above one.
A = terrainData(x, z) 'get out coordinates from our stored data
B = terrainData(x, z + 1)
C = terrainData(x + 1, z)
OBJ_CalculateNormal A, B, C, R 'calculates the normal of a triangle
'store color, coordinate & normal data in an array
mountNormal(index) = R.x: mountNormal(index + 1) = R.y: mountNormal(index + 2) = R.z
mountVert(index) = A.x: mountVert(index + 1) = A.y: mountVert(index + 2) = A.z: setMountColor x, z, index, A.y, mountHeightMax
mountNormal(index + 3) = R.x: mountNormal(index + 4) = R.y: mountNormal(index + 5) = R.z
mountVert(index + 3) = B.x: mountVert(index + 4) = B.y: mountVert(index + 5) = B.z: setMountColor x, z + 1, index + 3, B.y, mountHeightMax
index = index + 6
dd$ = d$
IF foundpoint
= 1 THEN k
= k
+ 1 IF cA$
= "." THEN foundpoint
= 1
p5random!
= RND * (mx!
- mn!
) + mn!
FUNCTION map!
(value!
, minRange!
, maxRange!
, newMinRange!
, newMaxRange!
) map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
'coded in QB64 by Fellipe Heitor
'Can be found in p5js.bas library
'http://bit.ly/p5jsbas
p5NoiseSetup = 1
PERLIN_YWRAPB = 4
PERLIN_YWRAP
= INT(1 * (2 ^ PERLIN_YWRAPB
)) PERLIN_ZWRAPB = 8
PERLIN_ZWRAP
= INT(1 * (2 ^ PERLIN_ZWRAPB
)) PERLIN_SIZE = 4095
perlin_octaves = 4
perlin_amp_falloff = 0.5
FOR i
= 0 TO PERLIN_SIZE
+ 1
xf = x - xi
yf = y - yi
zf = z - zi
r = 0
ampl = .5
FOR o
= 1 TO perlin_octaves
of
= xi
+ INT(yi
* (2 ^ PERLIN_YWRAPB
)) + INT(zi
* (2 ^ PERLIN_ZWRAPB
))
rxf
= 0.5 * (1.0 - COS(xf
* _PI)) ryf
= 0.5 * (1.0 - COS(yf
* _PI))
n1
= perlin
(of
AND PERLIN_SIZE
) n1
= n1
+ rxf
* (perlin
((of
+ 1) AND PERLIN_SIZE
) - n1
) n2
= perlin
((of
+ PERLIN_YWRAP
) AND PERLIN_SIZE
) n2
= n2
+ rxf
* (perlin
((of
+ PERLIN_YWRAP
+ 1) AND PERLIN_SIZE
) - n2
) n1 = n1 + ryf * (n2 - n1)
of = of + PERLIN_ZWRAP
n2
= perlin
(of
AND PERLIN_SIZE
) n2
= n2
+ rxf
* (perlin
((of
+ 1) AND PERLIN_SIZE
) - n2
) n3
= perlin
((of
+ PERLIN_YWRAP
) AND PERLIN_SIZE
) n3
= n3
+ rxf
* (perlin
((of
+ PERLIN_YWRAP
+ 1) AND PERLIN_SIZE
) - n3
) n2 = n2 + ryf * (n3 - n2)
n1
= n1
+ (0.5 * (1.0 - COS(zf
* _PI))) * (n2
- n1
)
r = r + n1 * ampl
ampl = ampl * perlin_amp_falloff
xf = xf * 2
yf = yf * 2
zf = zf * 2
IF xf
>= 1.0 THEN xi
= xi
+ 1: xf
= xf
- 1 IF yf
>= 1.0 THEN yi
= yi
+ 1: yf
= yf
- 1 IF zf
>= 1.0 THEN zi
= zi
+ 1: zf
= zf
- 1 noise! = r
SUB noiseDetail
(lod!
, falloff!
) IF lod!
> 0 THEN perlin_octaves
= lod!
IF falloff!
> 0 THEN perlin_amp_falloff
= falloff!
'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
H = map(__H, 0, 255, 0, 360)
S = map(__S, 0, 255, 0, 1)
B = map(__B, 0, 255, 0, 1)
hsb~&
= _RGBA32(B
* 255, B
* 255, B
* 255, A
)
fmx = B - (B * S) + S
fmn = B + (B * S) - S
fmx = B + (B * S)
fmn = B - (B * S)
H = H - 360
H = H / 60
H
= H
- (2 * INT(((iSextant
+ 1) MOD 6) / 2))
fmd = (H * (fmx - fmn)) + fmn
fmd = fmn - (H * (fmx - fmn))
SUB OBJ_CalculateNormal
(p1
AS vec3
, p2
AS vec3
, p3
AS vec3
, N
AS vec3
)
U.x = p2.x - p1.x
U.y = p2.y - p1.y
U.z = p2.z - p1.z
V.x = p3.x - p1.x
V.y = p3.y - p1.y
V.z = p3.z - p1.z
N.x = (U.y * V.z) - (U.z * V.y)
N.y = (U.z * V.x) - (U.x * V.z)
N.z = (U.x * V.y) - (U.y * V.x)
OBJ_Normalize N
SUB OBJ_Normalize
(V
AS vec3
) mag!
= SQR(V.x
* V.x
+ V.y
* V.y
+ V.z
* V.z
) V.x = V.x / mag!
V.y = V.y / mag!
V.z = V.z / mag!
internal_vec4(0) = x
internal_vec4(1) = y
internal_vec4(2) = z
internal_vec4(3) = w
glVec4%&
= _OFFSET(internal_vec4
())
'============================================================
'=== This file was created with MakeDATA.bas by RhoSigma, ===
'=== you must $INCLUDE this at the end of your program. ===
'============================================================
'=====================================================================
'Function to write the embedded DATAs back to disk. Call this FUNCTION
'once, before you will access the represented file for the first time.
'After the call always use the returned realFile$ ONLY to access the
'written file, as the filename was maybe altered in order to avoid the
'overwriting of an existing file of the same name in the given location.
'---------------------------------------------------------------------
'SYNTAX: realFile$ = WriteqbiconData$ (wantFile$)
'
'INPUTS: wantFile$ --> The filename you would like to write the DATAs
' to, can contain a full or relative path.
'
'RESULT: realFile$ --> On success the path and filename finally used
' after applied checks, use ONLY this returned
' name to access the file.
' -> On failure this FUNCTION will panic with the
' appropriate ERROR code, you may handle this as
' needed with your own ON ERROR GOTO... handler.
'=====================================================================
'--- separate filename body & extension ---
body$
= LEFT$(file$
, po%
- 1) body$ = file$
ext$ = ""
'--- avoid overwriting of existing files ---
num% = 1
file$
= body$
+ "(" + LTRIM$(STR$(num%
)) + ")" + ext$
num% = num% + 1
'--- write DATAs ---
'--- set result ---
WriteqbiconData$ = file$
'--- DATAs representing the contents of file qbicon32.png
'---------------------------------------------------------------------
qbicon:
DATA &H474E5089,&H0A1A0A0D,&H0D000000,&H52444849,&H20000000,&H20000000,&H00000608,&H7A7A7300 DATA &H000000F4,&H4D416704,&HB1000041,&H61FC0B8F,&H00000005,&H59487009,&H0E000073,&H0E0000C1 DATA &H91B801C1,&H0000ED6B,&H45741A00,&H6F537458,&H61777466,&H50006572,&H746E6961,&H54454E2E DATA &H2E337620,&H30312E35,&HA172F430,&HC0010000,&H54414449,&H97C54758,&H20C371E1,&HA519850C DATA &H064430A3,&HDB3124E8,&H823B3FB4,&H5D14C887,&H04A84D21,&H8C096308,&H87F6E2E0,&HD67E02F2 DATA &HBE7C5F13,&H6EE6318B,&H32F9F98D,&H4A6A13E6,&H66A141DF,&H060DE3F4,&H283CCDC8,&HA0AEB0D4 DATA &H869AC350,&HE1E5F0A0,&H42FAF78D,&H35621C7F,&HE71AB1F6,&H3CFE85F5,&H0F502444,&HA81115E9 DATA &H922AF485,&HE6F00828,&H8C2746EE,&H0F4B7EBA,&HEDCDE011,&H15184E93,&H25D3DCD7,&H0A938650 DATA &H1940834F,&H3D3C2A4E,&H551C3C02,&H6CBEC278,&H8E04EFFE,&H24E64F6A,&H92554702,&HBD808D39 DATA &HCD712195,&H2812A73D,&HA78549C3,&HF73DC047,&H9EE6B8E1,&H7F365D78,&HB54D0109,&H104A6808 DATA &H27157A98,&H62AF5302,&HDDC4A04E,&H11F35222,&H082D39E6,&HC89CE6F0,&HBCAE6276,&H020688E9 DATA &HB732A1F0,&H569436B4,&H8301F0E1,&HBCA6AC3A,&H00E288E9,&H5CB2C091,&H2EAD0057,&HD87DE3F4 DATA &HEF57B16C,&H5050FC1D,&H2616BDF8,&H237F613D,&HAA390B50,&H40244038,&H3878A98D,&H0230F4AA DATA &H0BB9C03C,&HADA7B09D,&H9E953BE6,&H2FD8010E,&HD5B48E43,&H73D2A77C,&HFDB70122,&HCD7141C6 DATA &H39FAE93D,&HD2A680CF,&H9A026D70,&H24F0FBC2,&H2DAE13E5,&H6FEE0FBC,&H9F2E7013,&HB9AE2830 DATA &H66A75D27,&H52F6754D,&H0043A019,&HA93873F6,&HA90244F4,&H01CAA1D9,&H10DFFEC2,&H84039540 DATA &H033CD7FD,&H72A6AC3C,&H11BFB080,&HEB157B98,&HD75E3409,&H02184099,&H688E9A94,&H0854190E DATA &H2FF0040F,&H46621E72,&H1B3509A1,&H05FDBBD5,&HF13FDC1C,&H6A6E33B4,&H00000000,&H444E4549