ASCII scrollable list with mouse
#4
Yep, this is how we all start out. With just a little more work, you can get something like this...

Code: (Select All)
DIM scrn AS my_scrn
DIM page AS my_page
DIM margin AS my_margin
DIM scrb AS my_scrb
DIM cursor AS my_cursor
DIM mb AS my_mb

DIM noe AS INTEGER
DIM row AS INTEGER
DIM scr AS INTEGER

TYPE my_scrn
    w AS INTEGER
    h AS INTEGER
END TYPE

TYPE my_page
    w AS INTEGER
    h AS INTEGER
    c AS INTEGER
END TYPE

TYPE my_margin
    t AS INTEGER
    b AS INTEGER
    l AS INTEGER
    r AS INTEGER
END TYPE

TYPE my_scrb
    t AS INTEGER
    b AS INTEGER
    l AS INTEGER
    x AS INTEGER
    i AS INTEGER
    d AS INTEGER
    h AS INTEGER
    s AS INTEGER
    opt AS INTEGER
    adjust AS INTEGER
END TYPE

TYPE my_cursor
    find AS INTEGER
    scbrrow AS INTEGER ' row + scr
    scbrcol AS INTEGER ' POS(0)
    holdscr AS INTEGER ' Holds scr
    holdrow AS INTEGER ' Holds row
    holdscrbx AS INTEGER ' Holds scrb.x
END TYPE

TYPE my_mb
    l AS INTEGER
    r AS INTEGER
    m AS INTEGER
    drag AS INTEGER
    dragon AS INTEGER
END TYPE

' DEMO -----------------------------------------------------------------
CLS
DIM SHARED debug%
DO: PRINT "Input screen width: 60 - 140, blank for default or -1 for debug mode: ";: INPUT screen_width%
    IF screen_width% = -1 THEN debug% = -1: margin.t = 1: margin.b = 1: margin.l = 127: margin.r = 5: screen_width% = 150: noe = 99: GOTO make_fake_text ' Debug mode.
    IF screen_width% = 0 THEN margin.t = 1: margin.b = 1: margin.l = 10: margin.r = 12: screen_width% = 80: noe = 40: GOTO make_fake_text ' Use defaults for demo.
    IF screen_width% >= 60 AND screen_width% <= 140 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input number of text entries 10 - 99: ";: INPUT noe
    IF noe >= 10 AND noe <= 99 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin top 0 to 10: ";: INPUT margin.t
    IF margin.t >= 0 AND margin.t <= 10 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin bottom 0 to 10: ";: INPUT margin.b
    IF margin.b >= 0 AND margin.b <= 10 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin left 0 to 20: ";: INPUT margin.l
    IF margin.l >= 0 AND margin.l <= 20 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin right 2 to 20: ";: INPUT margin.r
    IF margin.r >= 2 AND margin.r <= 20 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input scrollbar indicator type 1 single 0 Expands per elements: ";: INPUT scrb.opt
    IF scrb.opt >= 0 AND scrb.opt <= 1 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP

make_fake_text:
CLS: REDIM x$(noe)
FOR i% = 1 TO noe
    FOR j% = 1 TO screen_width% - (margin.l + margin.r) - 3 - INT(RND * 7)
        k% = (RND * 24) + 97 + 8
        IF k% > 122 THEN
            IF RIGHT$(x$(i%), 1) <> " " AND LEN(x$(i%)) THEN a$ = " " ELSE a$ = CHR$((RND * 24) + 97)
        ELSE
            a$ = CHR$(k%)
        END IF
        x$(i%) = x$(i%) + a$
    NEXT j%
    x$(i%) = STRING$(2 - LEN(LTRIM$(STR$(i%))), "0") + LTRIM$(STR$(i%)) + " " + x$(i%)
    IF RIGHT$(x$(i%), 1) <> " " THEN x$(i%) = x$(i%) + " " '''else x$(i%) = x$(i%) + "$" ' Trailing space.
NEXT i%

WIDTH screen_width%, 25
IF screen_width% > 90 THEN _SCREENMOVE 0, 0
CLS
' End Demo ------------------------------------------------------------------

GOSUB getvar_setscrn

DO
    IF debug% THEN GOSUB debugger ' Debug only.

    GOSUB displayscrn

    GOSUB makescrb

    GOSUB getkey
LOOP
END

getvar_setscrn:
scrn.w = _WIDTH
scrn.h = _HEIGHT
scrb.x = 0 ' Relative position of the scrollbar cursor from top of scrb.h. 0 Off / 1 to
page.w = scrn.w - (margin.l + margin.r)


dwidth = page.w '*


page.h = scrn.h - (margin.t + margin.b)
scrb.t = margin.t + 1
scrb.b = margin.t + page.h
scrb.l = margin.l + page.w + 2
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.d = scrb.b - scrb.t + 1
scrb.h = scrb.b - scrb.t - 1 ' Max. vertical scroll. Bar minus the top and bottom arrow symbols.
IF scrb.opt = 0 THEN
    scrb.s = (scrb.h + 1) * 2 - noe: IF scrb.s <= 0 THEN scrb.s = 1
ELSE
    scrb.s = 1
END IF

IF row = 0 THEN row = 1
IF page.c = 0 THEN page.c = 7 ' Cursor apearance as underline.
LOCATE margin.t + row, margin.l + 1, 1, 7, page.c
GOSUB getcurrow: cursor.find = -1
RETURN

displayscrn:
yy% = CSRLIN: xx% = POS(0)
LOCATE , , 0: ' Cursor hide.
j% = 0
DO ' page.h determines how mnay rows of text are displayed.
    j% = j% + 1
    LOCATE margin.t + j%, margin.l + 1
    PRINT x$(scr + j%);
    IF j% = page.h OR j% = noe THEN EXIT DO
LOOP
LOCATE yy%, xx%
IF cursor.find THEN
    cursor.find = 0
    IF cursor.scbrrow > scr AND cursor.scbrrow <= scr + page.h THEN
        LOCATE margin.t + cursor.scbrrow - scr, cursor.scbrcol, 1 ' Cursor show.
    END IF
ELSE
    LOCATE , , 1 ' Show cursor.
END IF
RETURN

makescrb:
yy% = CSRLIN: xx% = POS(0)
LOCATE scrb.t, scrb.l
COLOR 0, 7
PRINT CHR$(24);
COLOR 7, 0
FOR i% = 1 TO scrb.h
    LOCATE scrb.t + i%, scrb.l
    PRINT CHR$(177);
NEXT i%
LOCATE scrb.b, scrb.l
COLOR 0, 7
PRINT CHR$(25);
COLOR 7, 0

IF noe > scrb.h + 2 THEN
    FOR i% = 1 TO scrb.s
        LOCATE scrb.t + scrb.x + i%, scrb.l
        COLOR 1, 0
        PRINT CHR$(176); ' Scrollbar index cursor.
    NEXT
    COLOR 7, 0
END IF
LOCATE yy%, xx%
RETURN

getkey:
row = CSRLIN - margin.t
DO
    _LIMIT 60

    IF b$ = "" THEN
        IF migrate% THEN GOSUB hl1: migrate% = 0
        b$ = INKEY$
    ELSE
        b$ = MID$(b$, 3)
    END IF

    IF LEN(b$) THEN


        DEF SEG = 0 '*
        IF PEEK(1047) MOD 16 = 1 AND INSTR("KMOG", MID$(b$, 2, 1)) OR PEEK(1047) MOD 16 = 2 AND INSTR("KMOG", MID$(b$, 2, 1)) THEN
            IF mark% = 0 THEN mark% = (row + scr - 1) * (dwidth + 1) + POS(0) - margin.l
            shift% = -1
        END IF

        a$ = x$(row + scr) '*

        IF INSTR(a$, CHR$(13)) THEN ' Special to paragraph.
            n% = LEN(a$)
        ELSEIF LEN(a$) > dwidth THEN ' Space in right margin.
            n% = dwidth + 1
        ELSE ' All within margin length situations.
            n% = LEN(a$) + 1
        END IF
        n% = n% + margin.l








        SELECT CASE MID$(b$, 1, 2)

            CASE CHR$(0) + "H"
                GOSUB backtocursor '*
                IF row > 1 THEN
                    row = row - 1
                    LOCATE margin.t + row, POS(0)
                    IF LEN(x$(row + scr)) < POS(0) - margin.l THEN
                        '''IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
                        IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
                    ELSE '*
                        GOSUB getcurrow
                    END IF
                ELSEIF scr > 0 THEN
                    scr = scr - 1
                    GOSUB scrollscrn
                END IF
            CASE CHR$(0) + "P"

                GOSUB backtocursor '*
                IF row < page.h AND row + scr < noe OR row + scr = noe AND LEN(a$) > dwidth THEN
                    row = row + 1: IF row + scr > UBOUND(x$) THEN REDIM _PRESERVE x$(row + scr)
                    LOCATE margin.t + row, POS(0)
                    IF LEN(x$(row + scr)) < POS(0) - margin.l THEN
                        '''IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
                        IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
                    END IF
                ELSEIF row + scr < noe THEN
                    scr = scr + 1
                    GOSUB scrollscrn
                    IF LEN(x$(row + scr)) < POS(0) - margin.l THEN
                        '''IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
                        IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
                    ELSE '*
                        GOSUB getcurrow
                    END IF
                END IF


            CASE CHR$(0) + "K"

                IF POS(0) > margin.l + 1 + border.thk THEN
                    LOCATE , POS(0) - 1
                    IF mark% THEN GOSUB hl1
                ELSE
                    IF row = 1 AND scr = 0 THEN
                        ' Do nothing.
                    ELSE
                        b$ = b$ + CHR$(0) + "H" + CHR$(0) + "O"
                        IF mark% THEN migrate% = -1
                    END IF
                END IF
            CASE CHR$(0) + "M"
                IF mark% THEN GOSUB hl1


                IF POS(0) < n% THEN
                    LOCATE , POS(0) + 1
                ELSE
                    IF row + scr < noe OR row + scr = noe AND LEN(a$) > dwidth THEN
                        b$ = b$ + CHR$(0) + "P" + CHR$(0) + "G"
                    END IF
                END IF






            CASE CHR$(0) + "G" ' Cursor home on current line.
                LOCATE , margin.l + 1
            CASE CHR$(0) + "O" ' Cursor end on current line.
                IF kloop% = 0 THEN ' User key press.
                    IF row + scr < noe AND n% <= dwidth THEN
                        LOCATE , n% + 1 ' Allows more text to be added to the line in front of the last character.
                    ELSE ' last line
                        LOCATE , n%
                        '''''IF mark% THEN GOSUB hl1
                    END IF
                ELSE ' Automated cursor advance. For these routines, the curor never goes past last character.
                    LOCATE , n%
                END IF
            CASE CHR$(0) + "w"
                row = 1
                IF scr > 0 THEN scr = 0: GOSUB scrollscrn
                LOCATE margin.t + 1, margin.l + 1
            CASE CHR$(0) + "u"
                IF noe > page.h THEN
                    scr = noe - page.h
                    row = margin.t + page.h
                    LOCATE margin.t + 1, margin.l + 1
                    GOSUB scrollscrn
                    LOCATE margin.t + page.h, margin.l + dwidth
                ELSE
                    row = noe
                    LOCATE margin.t + noe, margin.l + dwidth
                END IF
                b$ = b$ + CHR$(0) + "O"
            CASE CHR$(0) + "I"
                LOCATE , margin.l + 1
                FOR j% = 0 TO page.h
                    b$ = b$ + CHR$(0) + "H"
                NEXT
            CASE CHR$(0) + "Q"
                LOCATE , margin.l + 1
                FOR j% = 0 TO page.h
                    b$ = b$ + CHR$(0) + "P"
                NEXT








            CASE CHR$(0) + "R"
                IF page.c = 7 THEN page.c = 30 ELSE page.c = 7
                LOCATE , , 1, 7, page.c
            CASE CHR$(9)
                RUN
            CASE CHR$(27)
                SYSTEM
        END SELECT

        ' Reverse algorithm. Not needed for this routine. scrb.x = scrb.i / ((noe - scrb.d) / (scrb.h - scrb.s))

        IF row + scr >= INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h THEN
            scrb.x = scrb.x + 1

            GOSUB makescrb

            scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
        ELSEIF row + scr <= scrb.i THEN
            scrb.x = scrb.x - 1

            GOSUB makescrb

            scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
        END IF
    END IF

    IF delay.on! THEN ' Scrollbar delay.
        _DELAY delay.on!
        delay.on! = 0 ' Toggle off.
    END IF

    mb.m = 0
    WHILE _MOUSEINPUT
        mb.l = _MOUSEBUTTON(1)
        mb.m = mb.m + _MOUSEWHEEL
    WEND

    IF mb.l OR mb.m THEN
        mx% = _MOUSEX ' Mouse column.
        my% = _MOUSEY ' Mouse row.

        IF mx% = scrb.l AND scrb.s AND my% >= scrb.t AND my% <= scrb.b OR scrbardrag% AND my% > scrb.t AND my% < scrb.b OR mb.m > 0 AND scrb.x + scrb.s < scrb.h OR mb.m < 0 AND scrb.x <> 0 THEN ' Mouse on scrollbar or doing a bar cursor drag or using the scroll wheel.
            IF my% = scrb.t AND scrb.x > 0 OR my% = scrb.b AND scrb.x + scrb.s < scrb.h OR mb.m THEN ' Mouse on a scrollbar arrow.
                IF my% = scrb.t OR mb.m < 0 THEN scrb.x = scrb.x - 1 ELSE scrb.x = scrb.x + 1 ' Top or bottom arrow.
                IF mb.m = 0 THEN delay.on! = .15
                scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
                scr = scrb.i
                cursor.find = -1
                EXIT DO
            ELSEIF my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 AND scrbardrag% = 0 THEN ' Mouse on scrollbar cursor.
                scrbardrag% = -1: scrb.adjust = (my% - (scrb.t + 1)) - scrb.x
            ELSEIF my% > scrb.t AND my% < scrb.b THEN ' Mouse on scrollbar between scrollbar arrow and cursor.
                IF my% - (scrb.t + 1) - scrb.adjust >= 0 AND my% - (scrb.t + 1) + scrb.s - scrb.adjust <= scrb.h OR scrbardrag% = 0 THEN
                    IF scrbardrag% = 0 THEN ' NO drag, so adjust for cursor length for a click inside the scrollbar above or below the current scrollbar cursor position.
                        IF my% - (scrb.t + 1) > scrb.x THEN
                            scrb.adjust = (my% - (scrb.t + 1)) - scrb.x - 1
                        ELSE
                            scrb.adjust = (my% - (scrb.t + 1)) - scrb.x + 1
                        END IF
                    END IF
                    scrb.x = my% - (scrb.t + 1) - scrb.adjust
                    scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
                    scr = scrb.i
                    cursor.find = -1
                    EXIT DO
                ELSE ' Scrollbar is at top or bottom and mouse cursor is moving vertically along the scrollbar cursor. This allows the variable to readjust.
                    IF mx% = scrb.l THEN scrbardrag% = 0: scrb.adjust = 0
                END IF
            END IF
        ELSEIF my% >= margin.t + 1 AND my% <= margin.t + page.h THEN
            IF mx% >= margin.l + 1 AND mx% <= scrn.w - margin.r THEN
                LOCATE my%, mx%, 1 ' Locate by left mouse click and show cursor.
                GOSUB getcurrow
            END IF
        END IF
    ELSE
        scrbardrag% = 0: scrb.adjust = 0
    END IF
LOOP
RETURN

getcurrow:
row = CSRLIN - margin.t
cursor.scbrrow = row + scr
cursor.scbrcol = POS(0)
cursor.holdscr = scr
cursor.holdrow = row
cursor.holdscrbx = scrb.x
RETURN

backtocursor:
IF cursor.scbrrow > scr AND cursor.scbrrow <= scr + page.h THEN
    ' Display region does not contain cursor. Do nothing.
ELSE ' Display region contains the cursor.
    scr = cursor.holdscr
    row = cursor.holdrow
    scrb.x = cursor.holdscrbx
    scrb.i = scr
    GOSUB makescrb
    GOSUB displayscrn
END IF
RETURN

debugger:
ss% = CSRLIN: tt% = POS(0)
LOCATE 2, 1
PRINT " initiate_scrb% ="; initiate_scrb%
PRINT " scrn.w ="; scrn.w; " scrn.h ="; scrn.h; scrb.s; "     "
PRINT " margin.t ="; margin.t; " margin.b ="; margin.b; " margin.l ="; margin.l; " margin.r ="; margin.r; scrb.s; "     "
PRINT " scrb.t ="; scrb.t; " scrb.b ="; scrb.b; " scrb.l ="; scrb.l; " scrb.d ="; scrb.d; " scrb.x = "; scrb.x; " scrb.i ="; scrb.i; " scrb.h ="; scrb.h; " scrb.s ="; scrb.s; "     "
PRINT " cursor.find ="; cursor.find; " cursor.scbrrow ="; cursor.scbrrow; " cursor.scbrcol = "; cursor.scbrcol; scrb.s; "     "
PRINT " cursor.holdscr ="; cursor.holdscr; " cursor.holdrow ="; cursor.holdrow; " cursor.holdscrbx ="; cursor.holdscrbx
PRINT " page.h% ="; page.h%; " noe = "; noe; " delay_on! ="; delay_on!; " row% = "; row%; " scr% ="; scr%; " mx% ="; mx%; " my% ="; my%; " mb.l ="; mb.l; " mb.dragon ="; mb.dragon; " mb.drag ="; mb.drag; "   "
LOCATE ss%, tt%
_DELAY .05
RETURN
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


scrollscrn: ' Scrolls up or down.
GOSUB wipescrn
yy% = CSRLIN: xx% = POS(0)
LOCATE margin.t + 1, margin.l + 1
j% = 0
DO
    j% = j% + 1
    a1$ = STRING$(dwidth, 42) ' SPACE$(dwidth)
    MID$(a1$, 1, dwidth) = x$(scr + j%)
    '''MID$(a1$, 1, dwidth) = MID$(x$(scr + j%), 1, INSTR(x$(scr + j%), CHR$(10)) - 1) ' Strips off chr$(10)
    h% = INSTR(a1$, "#")
    PRINT a1$;
    IF j% = page.h THEN EXIT DO
    LOCATE margin.t + 1 + j%, margin.l + 1
LOOP
IF row + scr > UBOUND(x$) THEN REDIM _PRESERVE x$(row + scr)
LOCATE yy%, xx%
RETURN

wipescrn:
yy% = CSRLIN: xx% = POS(0)
FOR j% = 1 TO page.h
    LOCATE margin.t + j%, margin.l + 1
    PRINT SPACE$(page.w);
NEXT
LOCATE yy%, xx%
RETURN

'**
hl1:
yy% = CSRLIN: xx% = POS(0)
j% = mark%
k% = (row + scr - 1) * (dwidth + 1) + xx% - margin.l

ss% = CSRLIN: tt% = POS(0)
LOCATE 1, 1
PRINT "k% ="; k%
PRINT "mark% ="; mark%
PRINT "tcol% ="; tcol%
PRINT k% >= tcol%
LOCATE ss%, tt%

IF MID$(b$, 2, 1) = "M" OR MID$(b$, 2, 1) = "K" OR migrate% THEN
    IF k% > tcol% THEN
        IF k% >= mark% THEN COLOR 15, 1: lc% = 15 ELSE COLOR 7, 0: lc% = 7
    ELSEIF k% = tcol% THEN
        IF lc% = 15 THEN COLOR 7, 0: lc% = 7 ELSE COLOR 15, 1: lc% = 15
    ELSE
        IF k% >= mark% THEN COLOR 7, 0: lc% = 7 ELSE COLOR 15, 1: lc% = 15
    END IF

    tcol% = (row + scr - 1) * (dwidth + 1) + xx% - margin.l
    PRINT MID$(x$(scr + row), xx% - margin.l, 1);
ELSE
    BEEP
END IF

COLOR 7, 0
LOCATE yy%, xx%
RETURN

I have another version that highlights. All stuff needed to build WP editors. You are welcome to pull this code apart and use anything you find useful to code your project.

Pete
Reply


Messages In This Thread
RE: ASCII scrollable list with mouse - by bplus - 10-23-2022, 11:50 AM
RE: ASCII scrollable list with mouse - by Pete - 10-23-2022, 02:54 PM



Users browsing this thread: 4 Guest(s)