Author Topic: Scrollable Text Windows for Graphics Screens (Read 4819 times)

bplus · « **on:** May 16, 2019, 02:55:28 pm »

Here is first test demo that I have working as Modal Windows in a graphics screen running a graphics program.
Ctrl + C to view a line numbered array
Ctrl + F to view the contents of the file if you name this code "Array window.bas"

While these windows are showing you can press h for a message box for using scrollWindow SUB demo.

Two ways to exit (at least): press esc or click X in red box in current modal window. This was the tricky part, how to press esc and not to fall through all windows to end program. Just a _KEYCLEAR was not enough.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Array Window: Ctrl + C for sample array, Ctrl + F for this file, then <h>elp for message box, <esc> for exits"
' B+ started 2019-05-15  as test demo for SUB scrollWindow
 
'                          save this file as "Array window.bas"
'              so you can load it and view it in a scrollable window with Ctrl + F
 
 
'Modified from "getArrayItemClicked v4 mbox"
' Main testing and demo of the FUNCTION  getArrayItemNumber%
'started 2018-08-31 B+  developing a general purpose display and select app of a string array
 
'2018-09-04 post v2 bak 9-3_9PM
'2018-09-07 getArrayItem v4 mbox - time to test mbox with help window
' spotted nasty text distortion, Fellippe point me to place to fix.
 
' press h while an Array Window is up and check out my mBox routine!
 
'2019-05-15 modified code to simulate scrollable window
' added  "Beating Cardiod" 'B+ 2019-02-16 for some background program to run
' 2019-05-16 man what a B trying to clear keypresses and clicks!!!
' mainly the escape key to exit one window without
' falling through and exiting the next and the next...
 
'2019-05-17 get rid of _KEYDOWN(27) for exit of sub's
 
CONST nArr = 92 'ubound of array = actual amount of items if LBound = 1
CONST LB = 10 'try different lower bounds not just 0, 1
CONST WW = 1200 'Window Width
CONST WH = 600 'Window Height
 
'center of screen for background Cardiod graphics
CONST CX = WW / 2
CONST CY = WH / 2 - 50
 
SCREEN _NEWIMAGE(WW, WH, 32)
_SCREENMOVE 100, 60
 
'test string array, use indexes in lines for alignment to code for function
REDIM arr(LB TO nArr) AS STRING
DIM i AS INTEGER, loopcount AS INTEGER, magnify AS SINGLE, a AS SINGLE, x AS SINGLE, y AS SINGLE, lastx AS SINGLE, lasty AS SINGLE
DIM kh AS LONG, locRow AS INTEGER, locCol AS INTEGER, boxWidth AS INTEGER, boxHeight AS INTEGER, lnCnt AS INTEGER
FOR i = LB TO nArr
    arr(i) = "This is arr item:" + STR$(i)
NEXT
WHILE 1
 
    'some background graphics program running...
    CLS
    loopcount = (loopcount + 1) MOD 2
    IF loopcount THEN magnify = 10 ELSE magnify = RND * 10 + 12
    FOR a = -_PI TO _PI STEP _PI(1 / 360)
        x = CX + magnify * xCard(a)
        y = CY - magnify * yCard(a)
        IF a <> -_PI THEN
            LINE (x, y)-(lastx, lasty), _RGB(140, 0, 0)
        END IF
        lastx = x: lasty = y
    NEXT
    PAINT (CX, CY), _RGB(180, 0, 0), _RGB(140, 0, 0)
    _DISPLAY
    IF loopcount THEN _DELAY 40 / 60 ELSE _DELAY (30 + RND * 15) / 65
 
    'access to array windows which will act modally
    kh = _KEYHIT
    IF kh = 99 THEN 'ctrl + C
        locRow = 5: locCol = 150 - 25 - 5: boxWidth = 25: boxHeight = 17 '< displays 15 lines of array items
        ''boxHeight is actual screen space in character units, the display uses 2 of the lines for control bars.
        ''boxWidth will include item numbers displayed to left of array string item
        scrollWindow locRow, locCol, boxWidth, boxHeight, arr()
    ELSEIF kh = 102 THEN 'ctrl + F
        REDIM fArr(500) AS STRING
        lnCnt = fLines("Array window.bas", fArr()) '<<<<<<<<<<<<<<<<<<< or whatever name you gave this file AND SAVED!
        LOCATE 25, 1: PRINT "Array window.bas code:"
        scrollWindow 26, 1, 150, 12, fArr()
    ELSEIF kh = 27 THEN 'done
        EXIT WHILE
    END IF
WEND
 
'attempting to create a scrollable view port for displaying an array
' locateRow and locateCol are the same as if using LOCATE row, col  and will get same errors as LOCATE
' boxWidth is in characters 8 pixels wide,
' boxheight uses 2 rows (16 pixels per) to draw Page Up and Page Down Bars, so add 2 more to height than rows of text desired
' arr() is the array we desire to display and scroll
 
'this sub uses a Help sub which in turn uses mBox
SUB scrollWindow (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
    'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
    'boxWidth and boxHeight are in character units, again for locate and print at correct places.
    'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
    DIM wate$
    IF boxHeight < 3 THEN INPUT "boxHeight is too small for call on scrollWindow.", wate$: EXIT SUB
    DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER
    DIM mb AS INTEGER, mx AS INTEGER, my AS INTEGER
    DIM lba AS LONG, uba AS LONG, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG, clrStr AS STRING
    DIM kh AS LONG, lastmx AS INTEGER, lastmy AS INTEGER, row AS INTEGER, index AS LONG
    maxWidth = boxWidth '       number of characters in box
    maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
    lba = LBOUND(arr)
    uba = UBOUND(arr)
    page = 0
    hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
    clrStr = SPACE$(maxWidth) ' clearing a display line
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
 
    GOSUB update '              show the beginning of the array items for selection
 
    WHILE 1 'until get a selection or demand exit
 
        'handle the key stuff
        kh = _KEYHIT
        IF kh THEN
            IF kh > 0 AND kh < 255 THEN
                IF CHR$(kh) = "h" THEN HELP
                IF kh = 27 THEN EXIT WHILE
            ELSE
                SELECT CASE kh 'choosing sections of array to display and highlighted item
                    CASE 20736 'pg dn
                        IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
                    CASE 18688 'pg up
                        IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
                    CASE 18432 'up
                        IF hlite - 1 < 0 THEN
                            IF page > 0 THEN
                                page = page - 1: hlite = maxHeight - 1: GOSUB update
                            END IF
                        ELSE
                            hlite = hlite - 1: GOSUB update
                        END IF
                    CASE 20480 'down
                        IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
                            IF hlite + 1 > maxHeight - 1 THEN
                                page = page + 1: hlite = 0: GOSUB update
                            ELSE
                                hlite = hlite + 1: GOSUB update
                            END IF
                        END IF
                    CASE 18176 'home
                        page = 0: hlite = 0: GOSUB update
                    CASE 20224 ' end
                        page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
                END SELECT
            END IF
        END IF
 
        'handle the mouse stuff
        WHILE _MOUSEINPUT
            IF _MOUSEWHEEL = -1 THEN 'up?
                IF hlite - 1 < 0 THEN
                    IF page > 0 THEN
                        page = page - 1: hlite = maxHeight - 1: GOSUB update
                    END IF
                ELSE
                    hlite = hlite - 1: GOSUB update
                END IF
            ELSEIF _MOUSEWHEEL = 1 THEN 'down?
                IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
                    IF hlite + 1 > maxHeight - 1 THEN
                        page = page + 1: hlite = 0: GOSUB update
                    ELSE
                        hlite = hlite + 1: GOSUB update
                    END IF
                END IF
            END IF
        WEND
        mb = _MOUSEBUTTON(1)
        mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - (locateRow + 1) * 16) / 16) + 2
        IF mb THEN 'click contols or select array item
            '_delay .2 'this sucks but won't clear mouse click
            WHILE mb 'OK!
                IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            WEND
 
            IF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
                IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
                    EXIT WHILE 'escape plan for mouse click top right corner of display box
                ELSE 'PgUp bar clicked
                    IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
                END IF
            ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
                IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
            END IF
        ELSE '   mouse over highlighting, only if mouse has moved!
            IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
                IF mx <> lastmx OR my <> lastmy THEN
                    IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
                        hlite = my - 1
                        lastmx = mx: lastmy = my
                        GOSUB update
                    END IF
                END IF
            END IF
        END IF
        _LIMIT 200
    WEND
 
    'restore previous color settings
    COLOR fg, bg
    'attempt to clear all key presses before exit
    _KEYCLEAR
    EXIT SUB
 
    'display of array sections and controls on screen
    update:
 
    'fix hlite if it has dropped below last array item
    WHILE hlite + page * maxHeight + lba > uba
        hlite = hlite - 1
    WEND
 
    'main display of array items at page * maxHeight (lines high)
    FOR row = 0 TO maxHeight - 1
        IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
        LOCATE locateRow + row + 1, locateColumn: PRINT clrStr$;
        index = row + page * maxHeight + lba
        IF index >= lba AND index <= uba THEN
            LOCATE locateRow + row + 1, locateColumn
            PRINT LEFT$(arr(index), maxWidth);
        END IF
    NEXT
 
    'make page up and down bars to click, print PgUp / PgDn if available
    COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
    LOCATE locateRow, locateColumn: PRINT SPACE$(maxWidth);
    IF page <> 0 THEN LOCATE locateRow, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth);
    LOCATE locateRow + maxHeight + 1, locateColumn: PRINT SPACE$(maxWidth);
    IF page <> INT(uba / maxHeight) THEN
        LOCATE locateRow + maxHeight + 1, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth);
    END IF
    'make exit sign for mouse click
    COLOR _RGB32(255, 255, 255), _RGB32(200, 50, 0)
    LOCATE locateRow, locateColumn + maxWidth - 3
    PRINT " X ";
 
    _DISPLAY
    RETURN
END SUB
 
 
SUB HELP
    DIM n AS STRING, t AS STRING, m AS STRING
    n$ = CHR$(10)
    t$ = "*** Mouse and Key Instructions ***"
    m$ = "Mouse, mouse wheel, and arrow keys should work as expected for navigation."
    m$ = m$ + " Home starts you at lowest array item, End highlights the highest item."
    m$ = m$ + " Use PgUp and PgDn keys or Click Green bars to flip through pages of array items."
    m$ = m$ + " Escape to exit."
    mBox m$, t$
END SUB
 
 
'title$ limit is 57 chars, all lines are 58 chars max
' version bak 2018-09-07_10P
SUB mBox (m AS STRING, title AS STRING)
 
    'first screen dimensions items to restore at exit
    DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
    DIM curScrn AS LONG, backScrn AS LONG, mbx AS LONG 'some handles
    DIM ti AS INTEGER, limit AS INTEGER 'ti = text index for t$(), limit is number of chars per line
    DIM i AS INTEGER, j AS INTEGER, ff AS _BIT, add AS _BYTE 'index, flag and
    DIM bxH AS INTEGER, bxW AS INTEGER 'first as cells then as pixels
    DIM mb AS INTEGER, mx AS INTEGER, my AS INTEGER, mi AS INTEGER, grabx AS INTEGER, graby AS INTEGER
    DIM tlx AS INTEGER, tly AS INTEGER 'top left corner of message box
    DIM lastx AS INTEGER, lasty AS INTEGER, t AS STRING, b AS STRING, c AS STRING, tail AS STRING
    DIM d AS STRING, r AS SINGLE, kh AS LONG
 
    sw = _WIDTH
    sh = _HEIGHT
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    'screen snapshot
    curScrn = _DEST
    backScrn = _NEWIMAGE(sw, sh, 32)
    _PUTIMAGE , curScrn, backScrn
 
    'setup t() to store strings with ti as index, linit 58 chars per line max, b is for build
    REDIM t(0) AS STRING: ti = 0: limit = 58: b = ""
    FOR i = 1 TO LEN(m)
        c = MID$(m, i, 1)
        'are there any new line signals, CR, LF or both? take CRLF or LFCR as one break but dbl LF or CR means blank line
        SELECT CASE c
            CASE CHR$(13) 'load line
                IF MID$(m, i + 1, 1) = CHR$(10) THEN i = i + 1
                t(ti) = b: b = "": ti = ti + 1: REDIM _PRESERVE t(ti) AS STRING
            CASE CHR$(10)
                IF MID$(m, i + 1, 1) = CHR$(13) THEN i = i + 1
                t(ti) = b: b = "": ti = ti + 1: REDIM _PRESERVE t(ti)
            CASE ELSE
                IF c = CHR$(9) THEN c = SPACE$(4): add = 4 ELSE add = 1
                IF LEN(b) + add > limit THEN
                    tail = "": ff = 0
                    FOR j = LEN(b) TO 1 STEP -1 'backup until find a space, save the tail end for next line
                        d = MID$(b, j, 1)
                        IF d = " " THEN
                            t(ti) = MID$(b, 1, j - 1): b = tail + c: ti = ti + 1: REDIM _PRESERVE t(ti)
                            ff = 1 'found space flag
                            EXIT FOR
                        ELSE
                            tail = d + tail 'the tail grows!
                        END IF
                    NEXT
                    IF ff = 0 THEN 'no break? OK
                        t(ti) = b: b = c: ti = ti + 1: REDIM _PRESERVE t(ti)
                    END IF
                ELSE
                    b = b + c 'just keep building the line
                END IF
        END SELECT
    NEXT
    t(ti) = b
    bxH = ti + 3: bxW = limit + 2
 
    'draw message box
    mbx = _NEWIMAGE(60 * 8, (bxH + 1) * 16, 32)
    _DEST mbx
    COLOR _RGB32(60, 40, 25), _RGB32(225, 225, 255)
    LOCATE 1, 1: PRINT LEFT$(SPACE$((bxW - LEN(title) - 3) / 2) + title + SPACE$(bxW), bxW)
    COLOR _RGB32(225, 225, 255), _RGB32(200, 0, 0)
    LOCATE 1, bxW - 2: PRINT " X "
    COLOR _RGB32(60, 40, 25), _RGB32(255, 160, 90)
    LOCATE 2, 1: PRINT SPACE$(bxW);
    FOR r = 0 TO ti
        LOCATE 1 + r + 2, 1: PRINT LEFT$(" " + t(r) + SPACE$(bxW), bxW);
    NEXT
    LOCATE 1 + bxH, 1: PRINT SPACE$(limit + 2);
 
    'now for the action
    _DEST curScrn
 
    'convert to pixels the top left corner of box at moment
    bxW = bxW * 8: bxH = bxH * 16
    tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
    lastx = tlx: lasty = tly
    'now allow user to move it around or just read it
    WHILE 1
        CLS
        _PUTIMAGE , backScrn
        _PUTIMAGE (tlx, tly), mbx, curScrn
        _DISPLAY
        WHILE _MOUSEINPUT: WEND
        mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
        IF mb THEN
            IF mx >= tlx AND mx <= tlx + bxW AND my >= tly AND my <= tly + 16 THEN 'mouse down on title bar
                IF mx >= tlx + bxW - 24 THEN EXIT WHILE
                grabx = mx - tlx: graby = my - tly
                DO WHILE mb 'wait for release
                    mi = _MOUSEINPUT: mb = _MOUSEBUTTON(1)
                    mx = _MOUSEX: my = _MOUSEY
                    IF mx - grabx >= 0 AND mx - grabx <= sw - bxW AND my - graby >= 0 AND my - graby <= sh - bxH THEN
                        'attempt to speed up with less updates
                        IF ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 THEN
                            tlx = mx - grabx: tly = my - graby
                            CLS
                            _PUTIMAGE , backScrn
                            _PUTIMAGE (tlx, tly), mbx, curScrn
                            lastx = tlx: lasty = tly
                            _DISPLAY
                        END IF
                    END IF
                    _LIMIT 400
                LOOP
            END IF
        END IF
        kh = _KEYHIT
        IF kh = 27 OR kh = 13 OR kh = 32 THEN EXIT WHILE
        _LIMIT 400
    WEND
    'put things back
    COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
    _PUTIMAGE , backScrn
    _DISPLAY
    COLOR fg, bg
    _FREEIMAGE backScrn
    _FREEIMAGE mbx
    _AUTODISPLAY
    'clear key presses
    _KEYCLEAR
    'clear mouse clicks
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
END SUB
 
' these subs are used for the background graphics program testing usage of ScrollWindow
'Reference and thanks to:
' http://mathworld.wolfram.com/HeartCurve.html
' find the 6th heart curve equations #7, 8
FUNCTION xCard (t)
    xCard = 16 * SIN(t) ^ 3
END FUNCTION
 
FUNCTION yCard (t)
    yCard = 13 * COS(t) - 5 * COS(2 * t) - 2 * COS(3 * t) - COS(4 * t)
END FUNCTION
 
' this is used to load a file into an array and returns the number of lines in the file
FUNCTION fLines& (fileName$, arr() AS STRING)
    DIM fileCount AS LONG
    IF _FILEEXISTS(fileName$) THEN
        OPEN fileName$ FOR INPUT AS #1
        DO UNTIL EOF(1)
            LINE INPUT #1, arr(fileCount)
            'PRINT filecount%, arr(filecount)
            fileCount = fileCount + 1
        LOOP
        CLOSE #1
        REDIM _PRESERVE arr(fileCount - 1)
    END IF
    fLines& = fileCount 'this file returns the number of lines loaded, 0 means file did not exist
END FUNCTION
 
 

Petr · « **Reply #1 on:** May 17, 2019, 07:12:28 am »

Nice work, Bplus.

Instead of using _keyclear, I use a DO LOOP UNTIL loop that is waiting to release the button. This in turn ensures that one mouse click is not applied to more places than intended. Something like this:

Code: [Select]

SUB Reset_Mouse
    'reset mouseinputs from previous subs
    DO UNTIL _MOUSEBUTTON(1) = 0
        WHILE _MOUSEINPUT: WEND
    LOOP
    '--------------------------------
END SUB

bplus · « **Reply #2 on:** May 17, 2019, 09:48:10 am »

Hi Petr,

Yes, for SUB mBox, I resorted to having to clear both keypresses and clicks with following code and it still didn't work until I added a _LIMIT to slow it down, possibly because the code executes the exit of sub while button or key is still down?

In SUB scrollWindow, I used similar _MOUSEBUTTON(1) clear immediately when click detected, otherwise the Pg Up, Pg Dn bar clicks would keep processing until at start or end of array being displayed.

Code: QB64: [Select]

    'clear key presses
    kh = _KEYHIT
    WHILE _KEYDOWN(27) OR _KEYDOWN(13) OR _KEYDOWN(32) OR kh
        kh = _KEYHIT
        _KEYCLEAR 'ah that got it, nope damn it!
        _LIMIT 10 'try slowing this down
    WEND
    'clear mouse clicks
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        '_delay .2 'this sucks but won't clear mouse click
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
 

Petr · « **Reply #3 on:** May 17, 2019, 10:21:50 am »

This is due to the internal buffer, as show Steve for us here: https://www.qb64.org/forum/index.php?topic=1344.msg105427#msg105427. It is best to wait to clear the contents of the buffer - as it do my program for left mouse button. In the same way it can be done for _KEYDOWN.
It's actually the same as the DO LOOP WHILE _SNDRAWLEN loop that prevents the program from ending before the end of RAW audio playback.

bplus · « **Reply #4 on:** May 17, 2019, 12:31:47 pm »

Oh rats! I am still trying to clear a _KEYDOWN. - Old dog

bplus · « **Reply #5 on:** May 17, 2019, 03:23:50 pm »

First post has been edited to remove all _KEYDOWN(27) used to exit subs or main code loop as well as silly code trying to clear _KEYDOWN values. ecs key presses now working cleanly!

euklides · « **Reply #6 on:** May 18, 2019, 05:22:17 am »

Nice work, of course.

This scrollable text windows would be interesting when used as a selector of something for an other part of a program.

For this, I mean, the heart has no interest.
The selector should show a list. When you double click on an item, the program knows what you want and use it.
In short, a lighter version for a dynamic selector.
But I wrote mine for my use ...

bplus · « **Reply #7 on:** May 18, 2019, 09:33:03 am »

Hi euklides,

A scollable list box for selecting an item from a long array was exactly how this code started. You can still see tell signs eg, the lines being hignlighted.

Just seemed like a good place to start for a "window", specially one that I hope to make act like a console window that is always up and appending new stuff as user interacts with code.

Maybe have 3 Text only games going at once or allow selecting blocks of "output" lines for Clipboard.

News:

Author Topic: Scrollable Text Windows for Graphics Screens (Read 4819 times)

bplus

Scrollable Text Windows for Graphics Screens

Petr

Re: Scrollable Text Windows for Graphics Screens

bplus

Re: Scrollable Text Windows for Graphics Screens

Petr

Re: Scrollable Text Windows for Graphics Screens

bplus

Re: Scrollable Text Windows for Graphics Screens

bplus

Re: Scrollable Text Windows for Graphics Screens

euklides

Re: Scrollable Text Windows for Graphics Screens

bplus

Re: Scrollable Text Windows for Graphics Screens