while I'm selecting between the half-finished programs, I'll post the interesting ones here
from "the big chase" (flying on the neverend perlin field WASD+mouse)
from "the big chase" (flying on the neverend perlin field WASD+mouse)
Code: (Select All)
CONST pip180 = 3.141592 / 180
CONST perlin_pers = 7 'amplitudo
CONST perlin_level = 5 'level of resolution wave
CONST perlin_multiplier = 0.006
CONST perlin_smooth_noise_interpolation_type = 0 '0-none '1-standard
CONST perlin_flat_soil_limit = .8
DIM SHARED rotating(2), cosrotz, sinrotz, cosrotx, sinrotx, map_zoom_xy, map_zoom_distance, rotx_bevel, see_point
monx = _DESKTOPWIDTH * .7: mony = monx / 16 * 9 'screen size
shadow_ratio = 1
text_deep = INT(40 * shadow_ratio)
map_shadow = 15 / shadow_ratio
text_height_scale = 15
position_speed = .9
map_resolution = 70
map_dimxy = 1200 * .8
map_dimz = 250 * .8
map_zoom_xy = 6
map_zoom_distance = 15
mouse_sens_xy = 1
mouse_sens_z = 1
cam(4) = pip180 * 270
me(0) = 2000: me(1) = 2000
DIM clmn(1999, 5): ration_column = 0.0003
'create pseudo random buffer
DIM SHARED noise_rand_c: noise_rand_c = 10000: DIM SHARED noise_rand(noise_rand_c - 1): FOR t = 0 TO noise_rand_c - 1: noise_rand(t) = RND(1): NEXT t
'create texture
DIM color_temp AS _INTEGER64: DIM SHARED mapz_min, mapz_max: text_size = 8: text_size_marg = 8: DIM texture(text_height_scale - 1, text_deep - 1)
FOR t = 0 TO text_deep - 1: FOR t2 = 0 TO text_height_scale - 1: dark = 1 - (1 / (text_deep - 1) * t)
color_temp = _RGBA32((255 * dark), (100 * dark), ((255 / text_height_scale * t2)) * dark, 255 * dark)
temp = _NEWIMAGE(text_size, text_size, 32): _DEST temp: CLS: marg = text_size * text_size_marg / 100
LINE (marg, marg)-(text_size - marg, text_size - marg), color_temp, BF: texture(t2, t) = _COPYIMAGE(temp, 33): _FREEIMAGE temp: NEXT t2, t
'find min/max Z
mapz_min = 9999999: mapz_max = -mapz_min: FOR t = 0 TO 1999: c = Perlin2D(1000 * RND(1), 1000 * RND(1))
IF mapz_min > c THEN mapz_min = c
IF mapz_max < c THEN mapz_max = c
NEXT t: temp_a = 1 / (mapz_max - mapz_min)
'fill map-buffer
DIM map(map_resolution - 1, map_resolution - 1, 9): perl_setx = INT(me(0)): perl_sety = INT(me(1))
FOR map_x = 0 TO map_resolution - 1: FOR map_y = 0 TO map_resolution - 1: map_z = Perlin2D(perl_setx + map_x, perl_sety + map_y)
map((map_x + perl_setx) MOD map_resolution, (map_y + perl_sety) MOD map_resolution, 0) = 1 / (mapz_max - mapz_min) * (map_z - mapz_min)
map((map_x + perl_setx) MOD map_resolution, (map_y + perl_sety) MOD map_resolution, 6) = noise(map_x, map_y) < ration_column: NEXT map_y, map_x
'MAP array
'0-perlin Z-data
'1-maptriangle calculate X
'2-maptriangle calculate Y
'3-maptriangle calculate Z
'4-distance from me (color)
'5-texture height scale
'6-is there a column ?
'7-is the point visible?
'ME array
'0-me X location
'1-me Y location
'2-me Z location
'3-vector_x
'4-vector_y
mon = _NEWIMAGE(monx, mony, 32): SCREEN mon: _FULLSCREEN: _MOUSEHIDE
DO: _LIMIT 40
IF INKEY$ = CHR$(27) THEN END
'control flight
kw = _KEYDOWN(119): ks = _KEYDOWN(115): mousex = 0: mousey = 0: WHILE _MOUSEINPUT: mousex = mousex + _MOUSEMOVEMENTX: mousey = mousey + _MOUSEMOVEMENTY: WEND
rotx = (rotx + mousex * mouse_sens_xy * .005) * .95: max_incli = 65: IF ABS(rotx) > (max_incli * pip180) THEN rotx = max_incli * pip180 * SGN(rotx)
actual_speed = 1 / position_speed * SQR(me(3) * me(3) + me(4) * me(4)): rotx_bevel2 = rotx * actual_speed * ABS(kw)
rotx_bevel = rotx_bevel + (rotx_bevel2 - rotx_bevel) * .05: cam(3) = cam(3) + rotx / 20
cam(4) = cam(4) + mousey * mouse_sens_z / 100: szog_z = -cam(4): me(2) = me(2) + COS(szog_z) * actual_speed * 5 * ABS(kw) 'calculating Z
position_accel = .02: ww = .9999: szog_xy = cam(3) + rotx 'calculating XY
new_vec_x = -SIN(szog_xy) * position_accel * ABS(kw)
new_vec_y = -COS(szog_xy) * position_accel * ABS(kw)
vec_x = (me(3) * ww + new_vec_x)
vec_y = (me(4) * ww + new_vec_y)
vec_sum = SQR(vec_x * vec_x + vec_y * vec_y): IF vec_sum > position_speed THEN vec_sum = position_speed / vec_sum ELSE vec_sum = 1
me(3) = vec_x * vec_sum: me(4) = vec_y * vec_sum: me(0) = me(0) + me(3): me(1) = (me(1) + me(4))
deacc = .97
IF ks THEN me(3) = me(3) * deacc: me(4) = me(4) * deacc
IF ks = 0 AND kw = 0 THEN me(3) = me(3) * .99: me(4) = me(4) * .99
'replace the missing row in the buffer line Y
DO WHILE INT(INT(me(0))) <> perl_setx: dir = -SGN(INT(me(0)) - perl_setx): perl_setx = perl_setx - dir
temp = perl_setx + ABS(dir = -1) * (map_resolution - 1): temp_m = INT(temp MOD map_resolution)
FOR map_y = 0 TO map_resolution - 1: map_z = Perlin2D(temp, perl_sety + map_y)
map(temp_m, (map_y + perl_sety) MOD map_resolution, 0) = temp_a * (map_z - mapz_min)
map(temp_m, INT((map_y + perl_sety) MOD map_resolution), 6) = noise(temp, perl_sety + map_y) < ration_column: NEXT map_y: LOOP
'replace the missing row in the buffer line X
DO WHILE INT(INT(me(1))) <> perl_sety: dir = -SGN(INT(me(1)) - perl_sety): perl_sety = perl_sety - dir
temp = perl_sety + ABS(dir = -1) * (map_resolution - 1): temp_m = INT(temp MOD map_resolution)
FOR map_x = 0 TO map_resolution - 1: map_z = Perlin2D(perl_setx + map_x, temp)
map(INT((map_x + perl_setx) MOD map_resolution), temp_m, 0) = temp_a * (map_z - mapz_min)
map((map_x + perl_setx) MOD map_resolution, temp_m, 6) = noise(perl_setx + map_x, temp) < ration_column: NEXT map_x: LOOP
cosrotz = COS(cam(3)): sinrotz = SIN(cam(3)): cosrotx = COS(cam(4)): sinrotx = SIN(cam(4)) 'to rotating angles
'calculating position and textures
clmn(0, 0) = 0 'reset column counter
FOR map_x = 0 TO map_resolution - 1: px = -map_dimxy / 2 + map_dimxy / map_resolution * (map_x - (me(0) - INT(me(0))))
FOR map_y = 0 TO map_resolution - 1: py = -map_dimxy / 2 + map_dimxy / map_resolution * (map_y - (me(1) - INT(me(1))))
read_mapx = INT((map_x + perl_setx) MOD map_resolution): read_mapy = INT((map_y + perl_sety) MOD map_resolution)
map_z = map(read_mapx, read_mapy, 0): IF map_z > perlin_flat_soil_limit THEN map_z = perlin_flat_soil_limit
pz2 = map_dimz * map_z - me(2): rotate px, py, pz2, 1: IF see_point THEN map(map_x, map_y, 7) = 1 ELSE map(map_x, map_y, 7) = 0: _CONTINUE
map(map_x, map_y, 1) = rotating(0): map(map_x, map_y, 2) = rotating(1): map(map_x, map_y, 3) = rotating(2)
map(map_x, map_y, 4) = INT(SQR(px * px + py * py) / map_shadow): IF map(map_x, map_y, 4) > text_deep - 1 THEN map(map_x, map_y, 4) = text_deep - 1
map(map_x, map_y, 5) = INT(text_height_scale * map_z): IF map(map_x, map_y, 5) > text_height_scale - 1 THEN map(map_x, map_y, 5) = text_height_scale - 1
IF map(map_x, map_y, 5) < 0 THEN map(map_x, map_y, 5) = 0
IF map(read_mapx, read_mapy, 6) THEN clmn(clmn(0, 0) + 1, 2) = map(map_x, map_y, 4): clmn(clmn(0, 0) + 1, 0) = px: clmn(clmn(0, 0) + 1, 1) = py: clmn(0, 0) = clmn(0, 0) + 1
NEXT map_y, map_x
'do maptriangle from squares !
FOR map_x = 0 TO map_resolution - 2: FOR map_y = 0 TO map_resolution - 2:
IF (map(map_x, map_y, 7) AND map(map_x + 1, map_y, 7) AND map(map_x, map_y + 1, 7) AND map(map_x + 1, map_y + 1, 7)) = 0 THEN _CONTINUE
m0x = map(map_x, map_y, 1): m0y = map(map_x, map_y, 2): m0z = map(map_x, map_y, 3)
m1x = map(map_x + 1, map_y, 1): m1y = map(map_x + 1, map_y, 2): m1z = map(map_x + 1, map_y, 3)
m2x = map(map_x, map_y + 1, 1): m2y = map(map_x, map_y + 1, 2): m2z = map(map_x, map_y + 1, 3)
m3x = map(map_x + 1, map_y + 1, 1): m3y = map(map_x + 1, map_y + 1, 2): m3z = map(map_x + 1, map_y + 1, 3)
atexture = texture(map(map_x, map_y, 5), map(map_x, map_y, 4))
_MAPTRIANGLE (0, 0)-(text_size - 1, 0)-(0, text_size - 1), atexture TO(m0x, m0y, m0z)-(m1x, m1y, m1z)-(m2x, m2y, m2z)
_MAPTRIANGLE (0, 0)-(text_size - 1, 0)-(0, text_size - 1), atexture TO(m3x, m3y, m3z)-(m1x, m1y, m1z)-(m2x, m2y, m2z)
NEXT map_y, map_x
'draw columns
ac_ang = 5: ac_rad = 20: column_height = 800: column_rot = column_rot + 1
FOR ac = 0 TO clmn(0, 0) - 1: FOR t = 0 TO ac_ang - 1: temp = (360 / ac_ang * t + column_rot) * pip180
px = clmn(ac + 1, 0) + SIN(temp) * ac_rad: py = clmn(ac + 1, 1) + COS(temp) * ac_rad
pz2 = 400: rotate px, py, pz2, 0: ac(t, 0, 0) = rotating(0): ac(t, 1, 0) = rotating(1): ac(t, 2, 0) = rotating(2)
pz2 = -300: rotate px, py, pz2, 0: ac(t, 0, 1) = rotating(0): ac(t, 1, 1) = rotating(1): ac(t, 2, 1) = rotating(2)
NEXT t
FOR t = 0 TO ac_ang - 1: t2 = (t + 1) MOD ac_ang
m0x = ac(t, 0, 0): m0y = ac(t, 1, 0): m0z = ac(t, 2, 0): m1x = ac(t2, 0, 0): m1y = ac(t2, 1, 0): m1z = ac(t2, 2, 0)
m2x = ac(t, 0, 1): m2y = ac(t, 1, 1): m2z = ac(t, 2, 1): m3x = ac(t2, 0, 1): m3y = ac(t2, 1, 1): m3z = ac(t2, 2, 1)
atexture = texture(0, clmn(ac + 1, 2))
_MAPTRIANGLE (0, 0)-(text_size - 1, 0)-(0, text_size - 1), atexture TO(m0x, m0y, m0z)-(m1x, m1y, m1z)-(m2x, m2y, m2z)
_MAPTRIANGLE (0, 0)-(text_size - 1, 0)-(0, text_size - 1), atexture TO(m3x, m3y, m3z)-(m1x, m1y, m1z)-(m2x, m2y, m2z)
NEXT t, ac
_DISPLAY: CLS
LOOP
FUNCTION noise (x, y) 'reading pseudo random buffer
x2 = INT(x): y2 = INT(y): a = INT(ABS(x2) + ABS(y2)) MOD noise_rand_c: b = ABS(x2) MOD noise_rand_c: c = noise_rand(a) + noise_rand(b): noise = c - INT(c)
END FUNCTION
FUNCTION SmoothNoise (x, y)
SELECT CASE perlin_smooth_noise_interpolation_type
CASE 0: SmoothNoise = noise(x, y)
CASE 1: corners = (noise(x - 1, y - 1) + noise(x + 1, y - 1) + noise(x - 1, y + 1) + noise(x + 1, y + 1)) / 16
sides = (noise(x - 1, y) + noise(x + 1, y) + noise(x, y - 1) + noise(x, y + 1)) / 8: center = noise(x, y) / 4: SmoothNoise = corners + sides + center
END SELECT: END FUNCTION
FUNCTION Perlin2D (x, y): total = 0: FOR t = 0 TO perlin_level - 1: frequency = 2 ^ t * perlin_multiplier: amplitude = perlin_pers ^ t
total = total + InterpolatedNoise(x * frequency, y * frequency) * amplitude: NEXT t: Perlin2D = total: END FUNCTION
FUNCTION InterpolatedNoise (x, y): integer_X = INT(x): fractional_X = x - integer_X: integer_y = INT(y): fractional_Y = y - integer_y
v1 = SmoothNoise(integer_X, integer_y): v2 = SmoothNoise(integer_X + 1, integer_y)
v3 = SmoothNoise(integer_X, integer_y + 1): v4 = SmoothNoise(integer_X + 1, integer_y + 1)
i1 = Interpolate(v1, v2, fractional_X): i2 = Interpolate(v3, v4, fractional_X): InterpolatedNoise = Interpolate(i1, i2, fractional_Y): END FUNCTION
FUNCTION Interpolate (a, b, x): Interpolate = a * (1 - x) + b * x: END FUNCTION
SUB rotate (px, py, pz2, see_analysis)
px3 = px * cosrotz - py * sinrotz: py2 = px * sinrotz + py * cosrotz: py3 = py2 * cosrotx - pz2 * sinrotx: pz3 = -(py2 * sinrotx + pz2 * cosrotx)
see_point = pz3 < 100: IF see_point = 0 AND see_analysis THEN EXIT SUB
px4 = (px3 * COS(rotx_bevel)) - (py3 * SIN(rotx_bevel)): py4 = (px3 * SIN(rotx_bevel)) + (py3 * COS(rotx_bevel))
rotating(0) = -px4 * map_zoom_xy: rotating(1) = -py4 * map_zoom_xy: rotating(2) = pz3 * map_zoom_distance: END SUB