Program Real Line Counter. Anyone want to jump in?

Code: (Select All)

WIDTH 100, 25

_SCREENMOVE _MIDDLE

DIM i AS _INTEGER64



z$ = _CLIPBOARD$

x$ = UCASE$(_CLIPBOARD$)

IF RIGHT$(x$, 2) <> CHR$(13) + CHR$(10) THEN x$ = x$ + CHR$(13) + CHR$(10) ' Compensates for 1-line no return Notepad copy.



PRINT "Line count analysis...": PRINT



DO

    LINE INPUT "Count statements beginning with REM or ' as a line? [Y] / [N]: "; rem_ans$: PRINT

    rem_ans$ = UCASE$(rem_ans$)

    IF INSTR("YN", rem_ans$) THEN EXIT DO

LOOP



PRINT "Press [1] to parse all colons. [2] to exclude colons in one-line IF/THEN statements.": PRINT



DO

    _LIMIT 30

    b$ = INKEY$

    IF LEN(b$) THEN

        SELECT CASE b$

            CASE CHR$(27): SYSTEM

            CASE "1": PRINT "Parsing all significant colons...": EXIT DO

            CASE "2": myopt = -1: PRINT "Parsing all significant colons not used in IF/THEN one line statements.": EXIT DO

        END SELECT

    END IF

LOOP

PRINT

_KEYCLEAR



FOR i = 1 TO LEN(x$)

    a$ = MID$(x$, i, 1)

    IF a$ = CHR$(13) OR a$ = CHR$(10) THEN

        IF a$ = CHR$(10) THEN

            IF label_check THEN

                tmp$ = _TRIM$(MID$(s$, INSTR(s$, ":") + 1))

                IF MID$(tmp$, 1, 3) = "REM" OR LEFT$(tmp$, 1) = "'" OR tmp$ = CHR$(10) + CHR$(13) OR tmp$ = "" THEN ELSE MID$(z$, label_check, 1) = CHR$(0): c_cnt = c_cnt + 1

            END IF

            if_block$ = "": then_marker = 0

            c$ = "": parse1$ = "": parse2$ = "": parse3$ = "": label_check = 0: ide_line_cnt = ide_line_cnt + 1

            IF parse4$ = "off" THEN rem_lines = rem_lines + 1

            IF LEN(s$) = 0 THEN blank_line_cnt = blank_line_cnt + 1

            s$ = ""

        ELSE

            IF if_block$ = "on" THEN

                MID$(z$, i, 1) = CHR$(255): MID$(z$, then_marker, 1) = CHR$(0): c_cnt = c_cnt + 1 ' Add one line for the END IF

                if_block$ = "": then_marker = 0

            END IF

        END IF

    ELSE

        s$ = s$ + a$

        c$ = c$ + a$

        IF myopt THEN IF c$ = "THEN " THEN IF parse1$ = "" AND parse2$ = "" AND parse4$ = "" THEN parse3$ = "off"

        IF myopt = 0 THEN IF c$ = "THEN " THEN then_marker = i

        IF s$ = "$IF  THEN" THEN parse4$ = "off": parse1$ = "": parse2$ = "": parse3$ = ""

        IF a$ = "'" OR c$ = "REM " THEN

            IF parse1$ = "" AND parse2$ = "" AND parse3$ = "" AND parse4$ = "" THEN parse1$ = "off"

            IF _TRIM$(s$) = _TRIM$(c$) THEN rem_lines = rem_lines + 1

        END IF

        IF parse4$ = "off" THEN IF s$ = "$END IF " THEN parse4$ = ""

        IF a$ = " " THEN c$ = ""

        IF parse1$ <> "off" THEN

            IF a$ = CHR$(34) THEN IF parse1$ = "" AND parse3$ = "" THEN IF parse2$ = "off" THEN parse2$ = "" ELSE parse2$ = "off"

            IF parse2$ <> "off" THEN

                IF parse3$ <> "off" THEN

                    IF parse4$ <> "off" THEN

                        IF myopt = 0 AND then_marker THEN IF a$ = ":" THEN IF if_block$ = "" THEN if_block$ = "on"

                        IF col$ = "on" THEN IF a$ <> " " AND a$ <> ":" THEN col$ = ""

                        IF a$ = ":" THEN ' Test for label.

                            IF INSTR(MID$(LTRIM$(s$), 1, INSTR(LTRIM$(s$), ":")), " ") = 0 THEN

                                label_check = i + 1

                            ELSE

                                IF col$ = "" THEN col$ = "on": c_cnt = c_cnt + 1: MID$(z$, i, 1) = CHR$(0)

                            END IF

                        END IF

                    END IF

                END IF

            END IF

        END IF

    END IF

    IF a$ = "_" THEN IF MID$(x$, i + 1, 1) = CHR$(13) THEN IF parse1$ = "" AND parse2$ = "" AND parse3$ = "" THEN cont_lines = cont_lines + 1

NEXT

IF rem_ans$ = "Y" THEN

    PRINT "IDE Lines ="; ide_line_cnt; "  Statement Lines ="; ide_line_cnt - blank_line_cnt - cont_lines; "  Real Lines ="; ide_line_cnt - blank_line_cnt - cont_lines + c_cnt

ELSE

    PRINT "IDE Lines ="; ide_line_cnt; "  Statement Lines Without Remark Lines ="; ide_line_cnt - blank_line_cnt - cont_lines - rem_lines; "  Real Lines ="; ide_line_cnt - blank_line_cnt - cont_lines - rem_lines + c_cnt

END IF



_CLIPBOARD$ = ""

FOR i = 1 TO LEN(z$)

    a$ = MID$(z$, i, 1)

    IF a$ = CHR$(0) THEN

        concat$ = concat$ + CHR$(13) + CHR$(10)

    ELSEIF a$ = CHR$(255) THEN

        concat$ = concat$ + CHR$(13) + "END IF"

    ELSE

        concat$ = concat$ + a$

    END IF

NEXT



_CLIPBOARD$ = concat$



PRINT: PRINT "Program line rewrite was added to your clipboard."

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