Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Program Real Line Counter. Anyone want to jump in?
#9
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:
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
It has another line now with my last comment added.
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply


Messages In This Thread
RE: Program Real Line Counter. Anyone want to jump in? - by bplus - 10-22-2022, 10:48 PM

Possibly Related Threads…
Thread Author Replies Views Last Post
  real 2-4 player Pong (requires 2-4 USB mice plugged into your PC) madscijr 1 740 06-26-2024, 01:09 PM
Last Post: madscijr
  RotoLine line drawing James D Jarvis 0 518 10-11-2023, 04:24 PM
Last Post: James D Jarvis

Forum Jump:


Users browsing this thread: 1 Guest(s)