Program Real Line Counter. Anyone want to jump in?

[bplus]

This one does keep the blank lines, it just ignores them in the count. It could be easily modified to strip the blank lines out.  I'm considering that for a proof of real line numbers. For instance, if you run MG's app through the program with "Y" and "1" options, you get a paste of 175 IDE lines, so 20 of those are blank lines for spacing.

Pete

That's just about it! I see only one missed colon after Do but all the colons enclosed in Print " : "  preserved.

I ran the revised program and according to screen shot is working fine.

Rewrite MasterGy's Shadowing:

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
End If

'window
monx = 800
mony = Int(monx / _DesktopWidth * _DesktopHeight)
monm = monx * .008
mon = _NewImage(monx, mony, 32)
Screen mon
_FullScreen
_DisplayOrder _Hardware , _Software

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
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
        PSet (t, t2), _RGBA32(0, 0, 0, Int(255 / (cube_deep - 1) * t2) - 3)
Next t2, t
cube_text = _CopyImage(temp, 33)
_FreeImage temp

'mask distance behind texture
Dim shdw_m(15000)
For t = 0 To 15000
    shdw_m(t) = Interpolate(.999, .97, 1 / 15000 * t)
Next t


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

For t = 0 To 2
    obj(obj_c - 1, 3 + t) = mapdim / 2
    obj(obj_c - 1, t) = mapdim / 2
Next t
For t = 0 To 2
    me(t) = mapdim / 2
Next t
light = .2
me(4) = -.2
ut_me4 = -.2
ylook_limit = 80 'radian

_Dest mon
Locate 1, 1
Print "moving:WASD       looking:mouse        light adjust : mousewheel"
Dim p(3, 2), p2(3, 2), pc(7, 9)
Do:
    _Limit 30
    'control
    mouse_sens_xy = .01
    mouse_sens_z = .01
    mousex = 0
    mousey = 0
    mousew = 0
    While _MouseInput
        mousex = mousex + _MouseMovementX
        mousey = mousey + _MouseMovementY
        mousew = mousew + _MouseWheel
    Wend
    me(3) = me(3) + mousex * mouse_sens_xy
    me(4) = me(4) + mousey * mouse_sens_z

    ylook_deg = ((me(4) / pip180) + 90)
    If Abs(ylook_deg) > ylook_limit Then me(4) = ut_me4 Else ut_me4 = me(4)
    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
    Locate 2, 1
    Print "light:"; Int(light * 100); "%   "
    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
    deg_XY = -90 * Abs(ka) + 90 * Abs(kd)
    szog_xy = me(3) + deg_XY * pip180
    szog_z = me(4)
    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

    'draw cubes
    px1 = cube_res / 2
    px2 = cube_res - 2
    dl = cube_deep - 3
    c_dis = Interpolate(50, 2500, light)
    temp = cube_deep / c_dis
    For a_obj = 0 To obj_c - 1
        For t = 0 To 7
            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
            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
        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

            '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
            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
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
    px4 = px3 * cosrot_cs - py3 * sinrot_cs
    py4 = px3 * sinrot_cs + py3 * cosrot_cs
    px = -px4
    py = -py4
    pz2 = -pz3
End Sub

This one is a keeper for me! (Well, they both are!) Thanks