+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: MasterGy (https://staging.qb64phoenix.com/forumdisplay.php?fid=45)
+---- Thread: Curiosities (/showthread.php?tid=836)
Pages:
1
2
Curiosities - MasterGy - 09-01-2022
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)
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 SUBRE: Curiosities - Coolman - 09-02-2022
hello. it's amazing what you can do with qb64. impressive. that said, you should always have a standard way to exit a program. usually it's by using the escape key.
RE: Curiosities - MasterGy - 09-02-2022
Thanks Coolman ! I'll add the exit. And here I tried out the control and dynamics of the car. I still see mistakes in the dynamics, but it is interesting that it has remained.
Does not use external files
Code: (Select All)
CONST pip180 = 3.141592 / 180
CONST perlin_pers = 8 '7 'amplitudo
CONST perlin_level = 4 '5 'level of resolution wave
CONST perlin_multiplier = 0.012
CONST perlin_smooth_noise_interpolation_type = 0 '0-none '1-standard
CONST perlin_flat_soil_limit_low = .6 'high value is low area (negate)
CONST perlin_flat_soil_limit_high = .1
CONST flight_array_size = 20: DIM flight_save(flight_array_size - 1)
DIM SHARED rotating(2), cosrotz, sinrotz, cosrotx, sinrotx, map_zoom_xy, map_zoom_distance, see_point, flight(19, flight_array_size), me(19), rotx_bevel
DIM SHARED mouse_sens_xy, mouse_sens_z, position_speed, clmn_rad
DIM SHARED map_x, map_y, perl_setx, perl_sety, map_resolution, map_z, map_dimz, map_dimxy, flight_high_max
monx = 1366 * .8: mony = monx / 16 * 9 'screen size
RANDOMIZE TIMER
win_marg = monx / 25
flight_high_max = -70
auto_precalc = 22
auto_mouse_scale = 120
auto_try_resolution = 22
'DIM flight_auto(auto_try_resolution - 1, flight_array_size - 1): DIM auto_efficiency(auto_try_resolution - 1, 5) '0- 1 if crash '1- target-flight distance
pr_temp = 0 'temp pr
text_deep = 30 'make deep shadow pictures
map_center = 100000 'start of perlin-map
text_height_scale = 15
amap_c = 2
'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
position_speed = .3
map_resolution = 50 'see map resolution
DIM SHARED map_resper2: map_resper2 = INT(map_resolution / 2)
DIM SHARED max_incli: max_incli = 65 'flight max rotation
map_dimxy = 1200 * .8
map_dimz = 250 * .8
DIM SHARED ee: ee = map_dimxy / map_resolution
map_zoom_xy = 6 * .2
map_zoom_distance = 15 * .2
mouse_sens_xy = 1.6
mouse_sens_z = 1
me(6) = pip180 * 270
me(0) = map_center: me(1) = map_center
control_type$(0) = "walking": control_type$(1) = "flying": control_type$(2) = "flying/autopilot"
DIM color_temp(9) AS _INTEGER64
targ_text = _LOADIMAGE("need\target.jpg", 33)
DIM clmn(1999, 5): clmn_rad = 30: ration_column = 0.0003
ration_column = 0.0003
'PREPARATION ---------------------------------------------------------------------------------------------------------------------------------------------------
'create wheel texture
whe_ts = 30: whe_marg = whe_ts / 7: temp = _NEWIMAGE(whe_ts, whe_ts, 32): _DEST temp: CLS , 0: marg = whe_ts * text_size_marg / 100
PAINT (0, 0), _RGBA32(10, 10, 10, 255)
LINE (whe_marg, whe_marg)-(whe_ts - whe_marg, whe_ts - whe_marg), _RGBA32(100, 100, 100, 255), BF
texture_noiser temp, 50: whe_text = _COPYIMAGE(temp, 33): _FREEIMAGE temp
'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
'vehicle frame texture
noi = 20: vhfr_ts = 30: marg = 5: temp = _NEWIMAGE(vhfr_ts, vhfr_ts, 32): _DEST temp: PAINT (0, 0), _RGBA32(46, 88, 100, 255)
LINE (marg, marg)-(vhfr_ts - marg, vhfr_ts - marg), _RGBA32(255, 166, 50, 255), BF: texture_noiser temp, noi: vhfr_text(0) = _COPYIMAGE(temp, 33): _FREEIMAGE temp
temp = _NEWIMAGE(vhfr_ts, vhfr_ts, 32): _DEST temp: PAINT (0, 0), _RGBA32(255 / 2, 166 / 2, 50 / 2, 255): texture_noiser temp, noi: vhfr_text(1) = _COPYIMAGE(temp, 33): _FREEIMAGE temp
temp = _NEWIMAGE(vhfr_ts, vhfr_ts, 32): _DEST temp: PAINT (0, 0), _RGBA32(150, 150, 255, 50): vhfr_text(2) = _COPYIMAGE(temp, 33): _FREEIMAGE temp
temp = _NEWIMAGE(vhfr_ts, vhfr_ts, 32): _DEST temp: PAINT (0, 0), _RGBA32(233, 94, 61, 255)
marg = 5: LINE (marg, marg)-(vhfr_ts - marg, vhfr_ts - marg), _RGB32(255, 0, 0), BF: _SETALPHA 0, _RGB32(255, 0, 0) TO _RGB32(255, 0, 0)
texture_noiser temp, noi: vhfr_text(3) = _COPYIMAGE(temp, 33): _FREEIMAGE temp
vp$ = "-01010-03010-01020-03020-00031-04031-01052-03052-01072-03072-00081-04081-00101-04101-00090-04090" 'points X(2),Y(2),Z(1)
vl$ = "-0001-0002-0103-0203-0004-0105-0204-0305-0406-0507-0607-0410-0511-0608-0709-0809-0810-0911-1011-1012-1113-1213-1412-1513-1415-0405-0214-0315" '3d lines
sq$ = "-0123-4567-0246-2367-3175-1054" 'cubes points make square
vt$ = "-000102031-000104051-141512131-101112131-040012141-050113151-080910111-141502031" 'bodywork textures
vt$ = vt$ + "-040610082-040509112-040506072-060708092" 'vehicle windows
vp$ = vp$ + "-01081-01101-01092-01102-03081-03101-03092-03102-00092-04092-00102-04102": vt$ = vt$ + "-161718193-202122233-242526270" 'extension air deflector
DIM temp_color(0) AS _INTEGER64 'create texture to map
'find min/max Z
DIM SHARED mapz_multiplier: mapz_min = 9999999: mapz_max = -mapz_min: FOR t = 0 TO 2999: c = Perlin2D_original(5000 * RND(1), 5000 * RND(1))
mapz_min = c * ABS(mapz_min > c) + mapz_min * (ABS(mapz_min > c) XOR 1): mapz_max = c * ABS(mapz_max < c) + mapz_max * (ABS(mapz_max < c) XOR 1)
NEXT t: mapz_multiplier = 1 / (mapz_max - mapz_min)
'fill map-buffer
DIM SHARED map(map_resolution - 1, map_resolution - 1, 19): 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: zact = perlin2d(perl_setx + map_x, perl_sety + map_y)
temp_m = INT((map_x + perl_setx) MOD map_resolution): temp_m2 = INT((map_y + perl_sety) MOD map_resolution)
map(temp_m, temp_m2, 0) = zact
map(temp_m, temp_m2, 6) = noise(map_x, map_y) < ration_column
map(temp_m, temp_m2, 11) = ABS(zact > .55)
NEXT map_y, map_x
'calculating shadows
FOR map_x = 0 TO map_resolution - 1: FOR map_y = 0 TO map_resolution - 1
dis = INT((text_deep - 1) / map_resper2 * SQR((map_x - map_resper2) ^ 2 + (map_y - map_resper2) ^ 2)): IF dis < 0 OR dis > text_deep - 1 THEN _CONTINUE
map(map_x, map_y, 9) = 1: map(map_x, map_y, 8) = dis: 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?
'8-shadow-table
'9-not used area signal
'11-texture
'ME array
'0-me X location
'1-me Y location
'2-me Z location
'3-vector_x
'4-vector_y
'5-me XY angle CAM3
'6-me XY CAM4
'7-me kanyarodas merteke
'FLIGHT array
'0-active
'1-rotx - kanyarodas merteke
'2-rotx_bevel
'3-location X
'4-location Y
'5-location Z
'6-vector X
'7-vector Y
'8-W gas
'9-S brake
'10-mouseX
'11-mouseZ
'12 cam4 /me6
'13 cam3 /me5
'15 actual speed
'16 column (XY) crash /last step
'17 land (Z) crash /last step
'PREPARATION END ------------------------------------------------------------------------------------------------------------------------------------------
GOSUB new_target
mon = _NEWIMAGE(monx, mony, 32): SCREEN mon: _FULLSCREEN _SQUAREPIXELS , _SMOOTH: _MOUSEHIDE: _DISPLAYORDER _HARDWARE , _SOFTWARE
CLS , 0
control_type = 0
IF pr_temp THEN _PRINTSTRING (0, 0), "moving:mouse+WASD jump:space walking/fly: F"
DIM wang(20, 2, 1, 1)
veh_posx = map_center
veh_posy = map_center
DIM veh(19, 49)
old_camera_type = -1
camera_type = 0
gravity = .3
veh_gra = gravity
'-------------------------------------------------------- BOSS CYCLE -----------------------------------------------------------------------------------
DO: _LIMIT 40
'keyboard/mouse inputs
IF _KEYDOWN(27) THEN SYSTEM
kf = _KEYDOWN(102): k_space = _KEYDOWN(32)
kw = _KEYDOWN(119): ks = _KEYDOWN(115): mousex = 0: mousey = 0: mw = 0: WHILE _MOUSEINPUT: mousex = mousex + _MOUSEMOVEMENTX: mousey = mousey + _MOUSEMOVEMENTY
mw = mw + _MOUSEWHEEL
WEND
kw = _KEYDOWN(119): ks = _KEYDOWN(115): ka = _KEYDOWN(97): kd = _KEYDOWN(100)
k_space = _KEYDOWN(32)
k_left = _KEYDOWN(19200): k_right = _KEYDOWN(19712): k_up = _KEYDOWN(18432): k_down = _KEYDOWN(20480): veh_wheel_sens = 8
IF ut_kf = 0 AND kf THEN control_type = (control_type + 1) MOD 3
ut_kf = kf
me2_comp = me2_comp + mw * .1
IF _KEYDOWN(45) THEN me2_comp = me2_comp - .1
IF _KEYDOWN(43) THEN me2_comp = me2_comp + .1
IF _KEYDOWN(47) THEN dis_comp = dis_comp + 3
IF _KEYDOWN(42) THEN dis_comp = dis_comp - 3
IF _KEYDOWN(52) THEN veh_rotate2 = veh_rotate2 - .1
IF _KEYDOWN(54) THEN veh_rotate2 = veh_rotate2 + .1
IF _KEYDOWN(56) THEN veh_rotate3 = veh_rotate3 - .1
IF _KEYDOWN(50) THEN veh_rotate3 = veh_rotate3 + .1
'contol
IF pr_temp THEN _PRINTSTRING (500, 0), "control type : " + control_type$(control_type) + " "
control_type = 0
SELECT CASE control_type '(0-walking 1-flying)
CASE 0
walk_speed = .18
me(3) = 0: me(4) = 0: me(7) = 0: flight(0, 1) = 0
me(5) = me(5) + mousex * mouse_sens_xy / 200: me(6) = me(6) + mousey * mouse_sens_xy / 200
go = ABS(ka OR kd OR kw OR ks): direction = (-90 * ABS(ka) + 90 * ABS(kd) + 180 * ABS(ks)) * go * pip180
go_x = -(SIN(direction + me(5)) * walk_speed) * go: go_y = -(COS(direction + me(5)) * walk_speed) * go
me(0) = me(0) + go_x: me(1) = me(1) + go_y
' me(2) = (map_deep(me(0), me(1)) - .18 + mapzd) * map_dimz
'IF k_space AND free_jump THEN jump_cf = 15
'rotx_bevel = rotx_bevel * .95
me(2) = me(2) - jump_cf / 4: jump_cf = jump_cf - 1: IF jump_cf < 0 THEN jump_cf = 0
END SELECT
'camera control
IF INKEY$ = "c" THEN camera_type = (camera_type + 1) MOD 4
IF camera_type <> old_camera_type THEN
me2_comp = 0: dis_comp = 0
LOCATE 1, 1: PRINT "VEHICLE CONTROL: arrow keys ,space-handbrake"
q$ = "camera height :mousewheel or *,- button , camera distance /,* button"
c$(0) = "typical view -" + q$
c$(1) = "interior view and mouse look around"
c$(2) = "'camera follows the car - " + q$
c$(3) = "free walking - WASD + mouse arrow " + q$
LOCATE 2, 1: PRINT "camera type :"; camera_type; "(change C button); "
LOCATE 3, 1: PRINT c$(camera_type) + SPACE$(120 - LEN(c$(camera_type)))
END IF
old_camera_type = camera_type
SELECT CASE camera_type
CASE 0
dis = (45 + dis_comp) / ee
me(0) = SIN(veh_rotate1) * dis + veh_posx
me(1) = COS(veh_rotate1) * dis + veh_posy
me(2) = map_deep(me(0), me(1)) * map_dimz - (2 + me2_comp) * ee
me(5) = (degree(veh_posx - me(0), veh_posy - me(1)) + 180) * pip180
me(6) = (degree(-(me(2) - veh_posz), dis * ee) - 90) * pip180
CASE 1
me(5) = me(5) + (veh_rotate1 - me(5)) / 10
dis = 5 - 5.4 ' dis_comp = -5.2: me2_comp = 0.6
me(0) = SIN(veh_rotate1) * dis + veh_posx
me(1) = COS(veh_rotate1) * dis + veh_posy
me(2) = veh_posz - 12
me(6) = -(veh_rotate3 + pip180 * -90) - pip180 * 180 + veh_rotate3_mass
CASE 2
medismax = 3: medismin = 5: follow = .01
DO WHILE SQR((me(0) - veh_posx) ^ 2 + (me(1) - veh_posy) ^ 2) > medismax
me(0) = me(0) + SGN(veh_posx - me(0)) * follow: me(1) = me(1) + SGN(veh_posy - me(1)) * follow: LOOP
DO WHILE SQR((me(0) - veh_posx) ^ 2 + (me(1) - veh_posy) ^ 2) < medismin
me(0) = me(0) - SGN(veh_posx - me(0)) * follow: me(1) = me(1) - SGN(veh_posy - me(1)) * follow: LOOP
me(5) = (degree(veh_posx - me(0), veh_posy - me(1)) + 180) * pip180
me(2) = map_deep(me(0), me(1)) * map_dimz - (.5 + me2_comp) * ee
dis = SQR((me(0) - veh_posx) ^ 2 + (me(1) - veh_posy) ^ 2)
me(6) = (degree(-(me(2) - veh_posz), dis * ee) - 90) * pip180
CASE 3
medis = 25: follow = .01
IF me(0) <> veh_posx THEN DO WHILE ABS(me(0) - veh_posx) > medis: me(0) = me(0) + SGN(veh_posx - me(0)) * follow: LOOP
IF me(1) <> veh_posy THEN DO WHILE ABS(me(1) - veh_posy) > medis: me(1) = me(1) + SGN(veh_posy - me(1)) * follow: LOOP
me(2) = map_deep(me(0), me(1)) * map_dimz - (1 + me2_comp) * ee
dis = SQR((me(0) - veh_posx) ^ 2 + (me(1) - veh_posy) ^ 2)
me(6) = (degree(-(me(2) - veh_posz), dis * ee) - 90) * pip180
END SELECT
' LOCATE 3, 1: PRINT rotx_bevel
IF camera_type = 1 THEN
cosrotz = COS(me(5))
sinrotz = SIN(me(5))
cosrotx = COS(me(6) - veh_rotate3)
sinrotx = SIN(me(6) - veh_rotate3)
' rotx_bevel = veh_rotate2
' rotx_bevel = TIMER / 20 '* RND(1)
ELSE
cosrotz = COS(me(5)): sinrotz = SIN(me(5)): cosrotx = COS(me(6)): sinrotx = SIN(me(6)) 'to rotating angles
END IF
'------------------------------------------ TERRAIN DRAW --------------------------------------------------------------------------------------------------
'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 = INT(perl_setx + ABS(dir = -1) * (map_resolution - 1)): temp_m = INT(temp MOD map_resolution)
FOR map_y = 0 TO map_resolution - 1: zact = perlin2d(temp, perl_sety + map_y): temp_m2 = INT(map_y + perl_sety) MOD map_resolution
map(temp_m, temp_m2, 0) = zact: map(temp_m, temp_m2, 6) = noise(temp, perl_sety + map_y) < ration_column
map(temp_m, temp_m2, 11) = ABS(zact > .55): 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: zact = perlin2d(perl_setx + map_x, temp): temp_m2 = INT((map_x + perl_setx) MOD map_resolution)
map(temp_m2, temp_m, 0) = zact: map(temp_m2, temp_m, 6) = noise(perl_setx + map_x, temp) < ration_column
map(temp_m2, temp_m, 11) = ABS(zact > .55): NEXT map_x: LOOP
'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: IF map(map_x, map_y, 9) = 0 THEN _CONTINUE
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)
map(map_x, map_y, 7) = 0: pz2 = map_dimz * map_z - me(2): rotate px, py, pz2, 1: IF see_point = 0 THEN _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, 7) = 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, 8): 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)
shdw = ABS(INT(m2z * 0.015))
' atexture = texture(map(map_x, map_y, 5), map(map_x, map_y, 4))
atexture = texture(map(map_x, map_y, 5), shdw)
_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
'TERRAIN DRAW END --------------------------------------------------------------------------------------------------------------------------------------------
'VEHICLE DRAW -------------------------------------------------------------------------------------------------------
v_ratio = .4 'car relativ size
veh_tengelytav = 4 * v_ratio: veh_kerektav = 4 * v_ratio: veh_kerekrad = 1 * v_ratio: veh_kerekszeles = .9 * v_ratio: veh_shockab_scale = .3
body_cx = .6 * v_ratio: body_cy = .6 * v_ratio: body_cz = .7 * v_ratio: frs = .08 * v_ratio: frs_dis_c = 1.1: body_yadd = -5.5 'frame size (ratio to vp$)
'draw wheel
wh_r(0) = veh_kerekrad: wh_r(1) = veh_kerekrad * .4: wh_div = 12 'wheel parameters
FOR a_wheel = 0 TO 3: wh_posy = (SGN(a_wheel AND 1) * 2 - 1) * veh_tengelytav / 2: wh_posx = (SGN(a_wheel AND 2) * 2 - 1) * veh_kerektav / 2
wheel_ang = (90 + ABS(a_wheel AND 1) * veh_wheel) * pip180
FOR awh = 0 TO wh_div - 1: ang = (-wheel(a_wheel, 0) + 360 / wh_div * awh) * pip180: x = SIN(ang): y = COS(ang)
FOR sz = 0 TO 1: wh_z = (sz * 2 - 1) * veh_kerekszeles / 2: FOR whr = 0 TO 1: r1 = x * wh_r(whr): r2 = wh_z: r3 = y * wh_r(whr)
rotate_2d r2, r1, wheel_ang: r1 = r1 + wh_posx: r2 = r2 + wh_posy: r3 = r3 + veh_shockab_scale * shockab(a_wheel)
rotate_vehicle r1, r2, r3, veh_rotate1, veh_rotate2, veh_rotate3: r1 = r1 + veh_posx: r2 = r2 + veh_posy: r3 = r3 * ee + veh_posz
rotate (r1 - me(0)) * ee, (r2 - me(1)) * ee, r3 - me(2), 0: FOR t = 0 TO 2: wang(awh, t, whr, sz) = rotating(t): NEXT t, whr, sz, awh
FOR t1 = 0 TO wh_div - 1: t2 = (t1 + 1) MOD wh_div: FOR t3 = 0 TO 1: FOR t4 = 0 TO 1
p00 = t1: p01 = t4: p02 = t4: p10 = t2: p11 = t4: p12 = t4: p20 = t1: p21 = t3: p22 = t3 XOR 1: p30 = t2: p31 = t3: p32 = t3 XOR 1
_MAPTRIANGLE (0, 0)-(whe_ts - 1, 0)-(0, whe_ts - 1), whe_text TO(wang(p00, 0, p01, p02), wang(p00, 1, p01, p02), wang(p00, 2, p01, p02))-(wang(p10, 0, p11, p12), wang(p10, 1, p11, p12), wang(p10, 2, p11, p12))-(wang(p20, 0, p21, p22), wang(p20, 1, p21, p22), wang(p20, 2, p21, p22))
_MAPTRIANGLE (whe_ts - 1, whe_ts - 1)-(whe_ts - 1, 0)-(0, whe_ts - 1), whe_text TO(wang(p30, 0, p31, p32), wang(p30, 1, p31, p32), wang(p30, 2, p31, p32))-(wang(p10, 0, p11, p12), wang(p10, 1, p11, p12), wang(p10, 2, p11, p12))-(wang(p20, 0, p21, p22), wang(p20, 1, p21, p22), wang(p20, 2, p21, p22))
NEXT t4, t3, t1, a_wheel
'draw vehicle frame
FOR t1 = 0 TO LEN(vl$) / 5 - 1: p1 = VAL(MID$(vl$, t1 * 5 + 2, 2)): p2 = VAL(MID$(vl$, t1 * 5 + 4, 2))
x1 = (VAL(MID$(vp$, p1 * 6 + 2, 2)) - 2) * body_cx: y1 = -(VAL(MID$(vp$, p1 * 6 + 4, 2)) + body_yadd) * body_cy: z1 = -(VAL(MID$(vp$, p1 * 6 + 6, 1))) * body_cz
x2 = (VAL(MID$(vp$, p2 * 6 + 2, 2)) - 2) * body_cx: y2 = -(VAL(MID$(vp$, p2 * 6 + 4, 2)) + body_yadd) * body_cy: z2 = -(VAL(MID$(vp$, p2 * 6 + 6, 1))) * body_cz
xc = (x1 + x2) / 2: yc = (y1 + y2) / 2: zc = (z1 + z2) / 2: dis = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2 + (z1 - z2) ^ 2) / 2 * frs_dis_c
angle1 = (-degree(x2 - x1, y2 - y1)) * pip180: angle2 = (degree(y2 - y1, z2 - z1) - 90) * pip180
FOR t2 = 0 TO 7: p(t2, 0) = (SGN(ABS(t2 AND 1)) * 2 - 1) * frs: p(t2, 1) = (SGN(ABS(t2 AND 2)) * 2 - 1) * dis: p(t2, 2) = (SGN(ABS(t2 AND 4)) * 2 - 1) * frs
rotate_2d p(t2, 0), p(t2, 1), angle1: rotate_2d p(t2, 1), p(t2, 2), -angle2: p(t2, 0) = p(t2, 0) + xc: p(t2, 1) = p(t2, 1) + yc: p(t2, 2) = p(t2, 2) + zc
rotate_vehicle p(t2, 0), p(t2, 1), p(t2, 2), veh_rotate1, veh_rotate2 + veh_rotate2_mass, veh_rotate3 + veh_rotate3_mass
r1 = p(t2, 0) + veh_posx: r2 = p(t2, 1) + veh_posy
r3 = (veh_posz + p(t2, 2) * ee) - me(2): rotate (r1 - me(0)) * ee, (r2 - me(1)) * ee, r3, 0: FOR t = 0 TO 2: p(t2, t) = rotating(t): NEXT t, t2
FOR t2 = 0 TO 5: FOR t3 = 0 TO 3: sqv(t3) = VAL(MID$(sq$, 2 + t2 * 5 + t3, 1)): NEXT t3
_MAPTRIANGLE (0, 0)-(vhfr_ts - 1, 0)-(0, vhfr_ts - 1), vhfr_text(0) TO(p(sqv(0), 0), p(sqv(0), 1), p(sqv(0), 2))-(p(sqv(1), 0), p(sqv(1), 1), p(sqv(1), 2))-(p(sqv(2), 0), p(sqv(2), 1), p(sqv(2), 2))
_MAPTRIANGLE (vhfr_ts - 1, vhfr_ts - 1)-(vhfr_ts - 1, 0)-(0, vhfr_ts - 1), vhfr_text(0) TO(p(sqv(3), 0), p(sqv(3), 1), p(sqv(3), 2))-(p(sqv(1), 0), p(sqv(1), 1), p(sqv(1), 2))-(p(sqv(2), 0), p(sqv(2), 1), p(sqv(2), 2))
NEXT t2, t1
'draw vehicle bodywork textures
FOR t1 = 0 TO LEN(vt$) / 10 - 1: FOR t = 0 TO 3: vtx(t) = VAL(MID$(vt$, t1 * 10 + (t + 1) * 2, 2)): NEXT t
FOR t2 = 0 TO 3: vt(t2, 0) = (VAL(MID$(vp$, vtx(t2) * 6 + 2, 2)) - 2) * body_cx: vt(t2, 1) = -(VAL(MID$(vp$, vtx(t2) * 6 + 4, 2)) + body_yadd) * body_cy
vt(t2, 2) = -(VAL(MID$(vp$, vtx(t2) * 6 + 6, 1))) * body_cz:
rotate_vehicle vt(t2, 0), vt(t2, 1), vt(t2, 2), veh_rotate1, veh_rotate2 + veh_rotate2_mass, veh_rotate3 + veh_rotate3_mass
r1 = vt(t2, 0) + veh_posx: r2 = vt(t2, 1) + veh_posy: r3 = (veh_posz + vt(t2, 2) * ee) - me(2)
rotate (r1 - me(0)) * ee, (r2 - me(1)) * ee, r3, 0: FOR t = 0 TO 2: vt(t2, t) = rotating(t): NEXT t, t2: atexture = vhfr_text(VAL(MID$(vt$, t1 * 10 + 10, 1)))
_MAPTRIANGLE (0, 0)-(vhfr_ts - 1, 0)-(0, vhfr_ts - 1), atexture TO(vt(0, 0), vt(0, 1), vt(0, 2))-(vt(1, 0), vt(1, 1), vt(1, 2))-(vt(2, 0), vt(2, 1), vt(2, 2))
_MAPTRIANGLE (vhfr_ts - 1, vhfr_ts - 1)-(vhfr_ts - 1, 0)-(0, vhfr_ts - 1), atexture TO(vt(3, 0), vt(3, 1), vt(3, 2))-(vt(1, 0), vt(1, 1), vt(1, 2))-(vt(2, 0), vt(2, 1), vt(2, 2))
NEXT t1
'VEHICLE DRAW END ----------------------------------------------------------------------------------------------------------
'vehicle shockabs control
wheel_gc = 0: min_wh = 999999
FOR a_wheel = 0 TO 3
r2 = (SGN(a_wheel AND 1) * 2 - 1) * veh_tengelytav * .3: r1 = (SGN(a_wheel AND 2) * 2 - 1) * veh_kerektav * .3: r3 = veh_shockab_scale * shockab(a_wheel)
rotate_vehicle r1, r2, r3, veh_rotate1, veh_rotate2, veh_rotate3: r1 = r1 + veh_posx: r2 = r2 + veh_posy: r3 = r3 * ee + veh_posz
dis_wheel(a_wheel, 0) = map_deep(r1, r2) * map_dimz 'a kerekek alatti talaj magassaga
dis_wheel(a_wheel, 1) = r3 'a kerek helyzete Z
dis_wheel(a_wheel, 2) = (dis_wheel(a_wheel, 0) - dis_wheel(a_wheel, 1) - 10) ' shockab(2) = .5 '0-bal hatso '1-bal elso '2-jobb hatso '3-jobb elso
wheel_gc = wheel_gc + ABS(dis_wheel(a_wheel, 2) < 0): qw = -0.2
IF dis_wheel(a_wheel, 2) < -1 THEN dis_wheel(a_wheel, 3) = qw / 2 ELSE dis_wheel(a_wheel, 3) = 0
IF dis_wheel(a_wheel, 2) < 1 THEN shockab(a_wheel) = shockab(a_wheel) - ABS(dis_wheel(a_wheel, 2)) * .02 ELSE shockab(a_wheel) = shockab(a_wheel) + .05
shockab(a_wheel) = shockab(a_wheel) * 1.01
IF shockab(a_wheel) > 1 THEN shockab(a_wheel) = 1
IF shockab(a_wheel) < 0 THEN shockab(a_wheel) = 0
IF dis_wheel(a_wheel, 2) < min_wh THEN min_wh = dis_wheel(a_wheel, 2): w_rot_neg = a_wheel
NEXT a_wheel
zact = map_deep(veh_posx, veh_posy) * map_dimz - veh_kerekrad * ee
IF zact < veh_posz THEN veh_posz = veh_posz + (zact - veh_posz) * .7: veh_vecz = 0 ELSE veh_vecz = veh_vecz + .06: veh_posz = veh_posz + .22
vfly = ABS(wheel_gc < 2 AND ABS(veh_speed) > .02): turn_rot = 1
'vehicle Z-contol
ana_rad = 3 * v_ratio: ang = (veh_rotate1): x1 = veh_posx + SIN(ang) * ana_rad: y1 = veh_posy + COS(ang) * ana_rad: m1 = map_deep(x1, y1) * map_dimz / ee
x2 = veh_posx - SIN(ang) * ana_rad: y2 = veh_posy - COS(ang) * ana_rad: m2 = map_deep(x2, y2) * map_dimz / ee
nofly_veh_rotate3 = (-degree(m2 - m1, ana_rad * 2)) * pip180: veh_doles_power = SIN(nofly_veh_rotate3)
ang = (veh_rotate1) + 90 * pip180: x1 = veh_posx + SIN(ang) * ana_rad: y1 = veh_posy + COS(ang) * ana_rad: m1 = map_deep(x1, y1) * map_dimz / ee
x2 = veh_posx - SIN(ang) * ana_rad: y2 = veh_posy - COS(ang) * ana_rad: m2 = map_deep(x2, y2) * map_dimz / ee
nofly_veh_rotate2 = (degree(m2 - m1, ana_rad * 2)) * pip180
qq_c = .022: fly_veh_rotate2 = SGN(veh_rotate2_v) * qq_c: fly_veh_rotate3 = SGN(veh_rotate3_v) * qq_c: fly_veh_rotate1 = SGN(veh_rotate1 - veh_rotate1_last) / 40
IF vfly THEN
IF wheel_gc > 0 THEN ell = 1 ELSE ell = 1
new_rotate3 = veh_rotate3 + fly_veh_rotate3 * ell: new_rotate2 = veh_rotate2 + fly_veh_rotate2 * ell: veh_rotate1 = veh_rotate1 + fly_veh_rotate1
ELSE
veh_rotate2_v = dif_ang(veh_rotate2, veh_rotate2_last, _PI) / pip180 '* turn_rot
veh_rotate3_v = dif_ang(veh_rotate3, veh_rotate3_last, _PI) / pip180 '* turn_rot
veh_rotate3_last = veh_rotate3: veh_rotate2_last = veh_rotate2: veh_rotate1_last = veh_rotate1
new_rotate3 = nofly_veh_rotate3: new_rotate2 = nofly_veh_rotate2
END IF
veh_rotate2 = veh_rotate2 + dif_ang(new_rotate2, veh_rotate2, _PI) / pip180 * .009
veh_rotate3 = veh_rotate3 + dif_ang(new_rotate3, veh_rotate3, _PI) / pip180 * .009
'vehicle direction control
veh_speed_max = .6: veh_speed_min = .3
veh_wheel = veh_wheel + (k_left - k_right) * veh_wheel_sens
veh_wheel_max = 70: IF ABS(veh_wheel) > veh_wheel_max THEN veh_wheel = SGN(veh_wheel) * veh_wheel_max
veh_speed = SQR(veh_vecx ^ 2 + veh_vecy ^ 2) * veh_speed_max: IF k_space AND ABS(vfly = 0) THEN gg = 3 ELSE gg = 1
veh_wheel = veh_wheel * (.85 - veh_speed / gg)
wheel_speed_meas = -dif_ang(degree(vec_y, -vec_x), veh_rotate1 / pip180, 360)
'an idiot stupid solution to keep the government from changing
lim = 80: kat4 = ABS(180 - wheel_speed_meas) < lim OR ABS(-180 - wheel_speed_meas) < lim OR ABS(0 - wheel_speed_meas) < lim
k_side = (k_left OR k_right) OR k_down OR k_up OR k_space
IF k_side <> k_sidel THEN kat4 = 1
k_sidel = k_side
IF veh_speed < .01 AND k_space = 0 AND ((k_left OR k_right) = 0) THEN kat4 = 0
IF veh_speed > veh_speed_l THEN kat4 = 0
veh_speed_l = veh_speed
IF kat4 THEN act_wheel = wsml ELSE wsml = wheel_speed_meas: act_wheel = wsml
IF vfly = 0 THEN
veh_rotate1_v_new = (veh_speed_max * veh_speed * veh_wheel) / 30 * SGN(act_wheel)
korm_bef = (1 - veh_speed / veh_speed_max): IF korm_bef < .05 THEN korm_bef = .05
veh_rotate1_v = veh_rotate1_v + (veh_rotate1_v_new - veh_rotate1_v) * korm_bef / 6
veh_rotate1_v = veh_rotate1_v * .99
IF veh_speed < 0.005 THEN veh_speed = 0
elf = (1 - (veh_speed / veh_speed_max)) * SGN(veh_speed) * 1.2
IF elf > .95 THEN elf = .95
veh_rotate1 = veh_rotate1 + veh_rotate1_v * elf
field_resistant = veh_doles_power * .005 * ABS(vfly = 0)
position_accel = .007 * (k_up - k_down * .6) * ABS(k_space = 0) + field_resistant
ww = .98
new_vec_x = SIN(veh_rotate1) * position_accel
new_vec_y = COS(veh_rotate1) * position_accel
vec_x = (veh_vecx * ww + new_vec_x)
vec_y = (veh_vecy * ww + new_vec_y)
vec_sum = SQR(vec_x * vec_x + vec_y * vec_y)
IF vec_sum > 1 THEN vec_sum = 1 / vec_sum ELSE vec_sum = 1
veh_vecx = vec_x * vec_sum: veh_vecy = vec_y * vec_sum
veh_speed = SQR(veh_vecx ^ 2 + veh_vecy ^ 2)
IF ((k_down = 0 AND k_up = 0) OR k_space) AND veh_speed < .0002 THEN veh_vecx = 0: veh_vecy = 0: veh_speed = 0
deacc = 1 - .02 * ABS(k_space)
veh_vecx = veh_vecx * deacc: veh_vecy = veh_vecy * deacc
END IF
veh_posx = veh_posx + veh_vecx: veh_posy = veh_posy + veh_vecy: veh_posz = veh_posz + veh_vecz
'mass center
ang = degree(veh_vecx, veh_vecy) * pip180 - veh_rotate1: dis = SQR(veh_vecx ^ 2 + veh_vecy ^ 2)
veh_rotate2_mass = -SIN(ang) * dis * .6: veh_rotate3_mass_need = (dis - dis_l) * 30 * SGN(wheel_speed_meas) + -4.5 * pip180
veh_rotate3_mass = veh_rotate3_mass + (veh_rotate3_mass_need - veh_rotate3_mass) * .1: dis_l = dis
'wheels rotation
FOR a_wheel = 0 TO 3: wh_posy = (SGN(a_wheel AND 1) * 2 - 1) * veh_tengelytav / 2: wh_posx = (SGN(a_wheel AND 2) * 2 - 1) * veh_kerektav / 2
rotate_2d wh_posy, wh_posx, veh_rotate1: wheel_ang = (90 + ABS(a_wheel AND 1) * veh_wheel) * pip180: add = veh_speed: IF add > .2 THEN add = .2
IF k_space AND ((a_wheel AND 1) = 0) THEN add = 0
wheel(a_wheel, 0) = wheel(a_wheel, 0) + add * 50 * SGN(wheel_speed_meas): NEXT a_wheel
_DISPLAY: IF pr_temp THEN _PRINTSTRING (0, 20), SPACE$(160)
LOOP
'--------------------------------------------------------------------------- BOSS CYCLE END -------------------------------------------------
rotating_draw:
rd = .3
_MAPTRIANGLE (0, 0)-(whe_ts - 1, 0)-(0, whe_ts - 1), whe_text TO(rotating(0), rotating(1), rotating(2))-(rotating(0) + rd, rotating(1), rotating(2))-(rotating(0), rotating(1) + rd, rotating(2))
RETURN
new_target: l = 300: targ(0) = map_center + l / 2 + l * RND(1): targ(1) = map_center + l / 2 + l * RND(1): targ(2) = (map_deep(targ(0), targ(1)) - .1 - targ_size / 2)
new_target_signal = 160: RETURN
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_original (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_original = total
END FUNCTION
FUNCTION perlin2d (x, y): perlin2dx = mapz_multiplier * (Perlin2D_original(x, y) - mapz_min)
' perlin2d = 0: EXIT FUNCTION
IF perlin2dx > perlin_flat_soil_limit_low THEN perlin2dx = perlin_flat_soil_limit_low
IF perlin2dx < perlin_flat_soil_limit_high THEN perlin2dx = perlin_flat_soil_limit_high
perlin2d = perlin2dx
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 < 200: IF see_point = 0 AND see_analysis THEN EXIT SUB
rotate_2d px3, py2, rotx_bevel: rotating(0) = px3 * map_zoom_xy: rotating(1) = -py3 * map_zoom_xy: rotating(2) = pz3 * map_zoom_distance: END SUB
SUB rotate_2d (x, y, ang): x1 = -(x * COS(ang) - y * SIN(ang)): y1 = -(x * SIN(ang) + y * COS(ang)): x = x1: y = y1: END SUB
FUNCTION map_deep (x, y)
read_mapx1 = INT(x + map_resper2) MOD map_resolution: read_mapx2 = INT(x + map_resper2 + 1) MOD map_resolution
read_mapy1 = INT(y + map_resper2) MOD map_resolution: read_mapy2 = INT(y + map_resper2 + 1) MOD map_resolution
mapx1 = Interpolate(map(read_mapx1, read_mapy1, 0), map(read_mapx2, read_mapy1, 0), x - INT(x))
mapx2 = Interpolate(map(read_mapx1, read_mapy2, 0), map(read_mapx2, read_mapy2, 0), x - INT(x))
map_deep = Interpolate(mapx1, mapx2, y - INT(y))
' map_deep = (SIN(x10 / 500) + 1) / 2
END FUNCTION
FUNCTION degree (a, b): degreex = ATN((a + .00001) / (b + .00001)) / pip180: degreex = degreex - 180 * ABS(0 > b): degreex = degreex - 360 * (degreex < 0)
degree = degreex: END FUNCTION
SUB rotate_vehicle (p0, p1, p2, a1, a2, a3): rotate_2d p2, p1, a3 + 180 * pip180: rotate_2d p0, p2, a2 + 180 * pip180: rotate_2d p0, p1, -a1: END SUB
FUNCTION dif_ang (a, b, unit): a2 = a: b2 = b
DO WHILE ABS(a2 - b2) > ABS((a2 - unit) - b2): a2 = a2 - unit: LOOP: DO WHILE ABS(a2 - b2) > ABS((a2 + unit) - b2): a2 = a2 + unit: LOOP: dif_ang = a2 - b2
END FUNCTION
SUB texture_noiser (a, b): REDIM tc AS _INTEGER64: _DEST a: _SOURCE a: FOR tx = 0 TO _WIDTH(a) - 1: FOR ty = 0 TO _HEIGHT(a) - 1
tc = POINT(tx, ty): rc = b * RND(1) - b / 2: IF _RED32(tc) = 10 AND _GREEN32(tc) = 10 THEN rc = 0
c_red = _RED32(tc) + rc: c_green = _GREEN32(tc) + rc: c_blue = _BLUE32(tc) + rc: c_alpha = _ALPHA32(tc)
PSET (tx, ty), _RGBA32(c_red, c_green, c_blue, c_alpha): NEXT ty, tx
END SUBRE: Curiosities - Coolman - 09-02-2022
nice job. really impressive.
RE: Curiosities - bplus - 09-02-2022
+1 and doesn't look like a terrible amount of code, awesome!
RE: Curiosities - mnrvovrfc - 09-02-2022
@MasterGy you have a profound understanding of three-dimensional graphics programming and don't even need to do it in a payware programming system! It makes me even more ashamed I invested in Purebasic...
Thank you for this great example, and keep up the good work.
RE: Curiosities - James D Jarvis - 09-04-2022
That is some impressive stuff. Dying to see collision detection with obstacles.
RE: Curiosities - james2464 - 09-04-2022
I'd love to see this code broken down and explained - it's all machine language to me! Haha. Really great to see what can be done with QB64. Thanks for posting, glad to see this.
RE: Curiosities - James D Jarvis - 09-04-2022
Dug in and fiddled with some of the variables to see what would happen and I am impressed even more. Cranked up the gravity and spread out the curves (to create difference in driving space) and decreased the vehicle power and the physics respond really well.
RE: Curiosities - MasterGy - 09-04-2022
I am very glad that you will try it! I'm even more happy if you confirm the values. I calibrated it for a long time to make it enjoyable. You may have a better setup. If you can do better, I'd be happy to see it.
My original goal was for the car to actually move. Unfortunately, this has not yet been achieved. This uses the laws of rigid-body physics only slightly. For example, the car cannot roll over. Or if we go up a hill at high speed, it doesn't fly as it should. Small mistakes. If I have time, I would really like a realistic simulation where the car rolls over like it does in real life.
If I have time, I would like a simple description of the 3D view and, if you are interested, also of this program, what it does.