10-22-2022, 10:48 PM
Meanwhile at another loacation MasterGy's Shaddowing program hand counted at 89 Ide - 20 blank + 85 = 154 LOC
Petes colon code got 155 and I wouldn't be surprised if I missed a colon:
It has another line now with my last comment added.
Petes colon code got 155 and I wouldn't be surprised if I missed a colon:
Code: (Select All)
picture$ = "" '<-------- enter an image or leave the field blank
'texture
If _FileExists(picture$) Then
text = _LoadImage(picture$, 33)
Else
temp = _NewImage(1, 1, 32): _Dest temp: Cls , _RGB32(255, 255, 255): text = _CopyImage(temp, 33): _FreeImage temp ' 4
End If
'window
monx = 800: mony = Int(monx / _DesktopWidth * _DesktopHeight): monm = monx * .008: mon = _NewImage(monx, mony, 32): Screen mon: _FullScreen: _DisplayOrder _Hardware , _Software '10
Const pip180 = 3.141592 / 180
Dim Shared me(9), cosrotz, sinrotz, cosrotx, sinrotx, sinrot_cs, cosrot_cs
'cube locations, sizes
Randomize Timer
cube_res = 1000: cube_deep = 1000 '11
temp = _NewImage(cube_res - 1, cube_deep - 1, 32): _Dest temp: For t = 0 To cube_res - 1: For t2 = 0 To cube_deep - 1 ' 14
PSet (t, t2), _RGBA32(0, 0, 0, Int(255 / (cube_deep - 1) * t2) - 3)
Next t2, t: cube_text = _CopyImage(temp, 33): _FreeImage temp ' 16
'mask distance behind texture
Dim shdw_m(15000): For t = 0 To 15000: shdw_m(t) = Interpolate(.999, .97, 1 / 15000 * t): Next t ' 19
mapdim = 1000
'make cubes
obj_c = 200
Dim obj(obj_c - 1, 9): _Source deep_text: For t = 0 To obj_c - 2: For t2 = 0 To 2: obj(t, t2) = mapdim * Rnd: obj(t, t2 + 3) = 10 + 40 * Rnd: Next t2, t ' 25
For t = 0 To 2: obj(obj_c - 1, 3 + t) = mapdim / 2: obj(obj_c - 1, t) = mapdim / 2: Next t ' 28
For t = 0 To 2: me(t) = mapdim / 2: Next t: light = .2: me(4) = -.2: ut_me4 = -.2: ylook_limit = 80 'radian ' 34
_Dest mon
Locate 1, 1: Print "moving:WASD looking:mouse light adjust : mousewheel" ' 35
Dim p(3, 2), p2(3, 2), pc(7, 9)
Do: _Limit 30
'control
mouse_sens_xy = .01: mouse_sens_z = .01 ' 36
mousex = 0: mousey = 0: mousew = 0: While _MouseInput: mousex = mousex + _MouseMovementX: mousey = mousey + _MouseMovementY: mousew = mousew + _MouseWheel: Wend ' 43
me(3) = me(3) + mousex * mouse_sens_xy: me(4) = me(4) + mousey * mouse_sens_z ' 44
ylook_deg = ((me(4) / pip180) + 90): If Abs(ylook_deg) > ylook_limit Then me(4) = ut_me4 Else ut_me4 = me(4) ' 45
rot_cs = (rot_cs + mousex * .001 * Abs(Sin(me(4)))) * .9
light = light - mousew * 0.005: If light < 0 Then light = 0 Else If light > 1 Then light = 1 ' 46
Locate 2, 1: Print "light:"; Int(light * 100); "% " ' 47
position_speed = 5
kw = _KeyDown(119): ks = _KeyDown(115): ka = _KeyDown(97): kd = _KeyDown(100): new_direction = (Abs(ka Or kd Or kw) Or -Abs(ks)) * position_speed ' 51
deg_XY = -90 * Abs(ka) + 90 * Abs(kd): szog_xy = me(3) + deg_XY * pip180: szog_z = me(4) ' 53
me(0) = me(0) - Sin(szog_xy) * (1 - Cos(szog_z)) * new_direction
me(1) = me(1) - Cos(szog_xy) * (1 - Cos(szog_z)) * new_direction
me(2) = me(2) - Cos(szog_z + _Pi) * new_direction
cosrotz = Cos(me(3)): sinrotz = Sin(me(3)): cosrotx = Cos(me(4)): sinrotx = Sin(me(4)): cosrot_cs = Cos(rot_cs): sinrot_cs = Sin(rot_cs) 'to rotating angles ' 58
'draw cubes
px1 = cube_res / 2: px2 = cube_res - 2 ' 59
dl = cube_deep - 3: c_dis = Interpolate(50, 2500, light): temp = cube_deep / c_dis ' 61
For a_obj = 0 To obj_c - 1: For t = 0 To 7 ' 62
For t2 = 0 To 2: pc(t, t2) = (obj(a_obj, 3 + t2) * (Sgn(t And 2 ^ t2) * 2 - 1) + (obj(a_obj, t2) - me(t2))): Next t2 ' 64
rotate pc(t, 0), pc(t, 1), pc(t, 2)
pc(t, 3) = Sqr(pc(t, 0) * pc(t, 0) + pc(t, 1) * pc(t, 1) + pc(t, 2) * pc(t, 2))
sm = shdw_m(Abs(Int(pc(t, 2))))
For t2 = 0 To 2: pc(t, 4 + t2) = pc(t, t2) * sm: Next t2 ' 66
Next t
For t = 0 To 5: For t2 = 0 To 3: side(t2) = Val(Mid$("024623673175105445670123", 1 + t * 4 + t2, 1)): For t3 = 0 To 2: p(t2, t3) = pc(side(t2), t3): p2(t2, t3) = pc(side(t2), t3 + 4): Next t3, t2 ' 72
'texture
_MapTriangle (0, 0)-(_Width(text) - 1, 0)-(0, _Height(text)), text To(p(0, 0), p(0, 1), p(0, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth
_MapTriangle (_Width(text), _Height(text))-(_Width(text) - 1, 0)-(0, _Height(text)), text To(p(3, 0), p(3, 1), p(3, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth
'shadow mask
For t2 = 0 To 3: py(t2) = Int(temp * pc(side(t2), 3)): If py(t2) > dl Then py(t2) = dl ' 74
Next t2
_MapTriangle (1, py(0))-(px1, py(1))-(px2, py(2)), cube_text To(p2(0, 0), p2(0, 1), p2(0, 2))-(p2(1, 0), p2(1, 1), p2(1, 2))-(p2(2, 0), p2(2, 1), p2(2, 2)), , _Smooth
_MapTriangle (1, py(3))-(px1, py(1))-(px2, py(2)), cube_text To(p2(3, 0), p2(3, 1), p2(3, 2))-(p2(1, 0), p2(1, 1), p2(1, 2))-(p2(2, 0), p2(2, 1), p2(2, 2)), , _Smooth
Next t, a_obj
_Display
Loop
Function Interpolate (a, b, x): Interpolate = a + (b - a) * x: End Function ' 76
Sub rotate (px, py, pz2): px3 = px * cosrotz - py * sinrotz: py2 = px * sinrotz + py * cosrotz: py3 = py2 * cosrotx - pz2 * sinrotx: pz3 = py2 * sinrotx + pz2 * cosrotx '80
px4 = px3 * cosrot_cs - py3 * sinrot_cs: py4 = px3 * sinrot_cs + py3 * cosrot_cs: px = -px4: py = -py4: pz2 = -pz3: End Sub ' 85
' hand cound 89 Ide - 20 blank + 85 colons = 154 lines
b = b + ...