Author Topic: Lists Linking Demo (Read 13439 times)

SMcNeill · « **Reply #30 on:** January 19, 2019, 04:00:43 pm »

Quote from: STxAxTIC on January 19, 2019, 03:40:44 pm

Okay so let's recap.

You started this thread not knowing how to identify a linked list, and changed your mind on what to call this thread after several of us dropped hints.

Instead of conceding anything, you instead doubled down that you were right in the first place.

Then I throw down how it finally works, something a Wikidive could have told you.

You pretend not to read my explanation, and magically divine "aha, I can refer to an example of this that someone else made! (still not a real example)"

I'm not sure where your work enters this discussion.

I was right in the first place.

It’s just a shame that you can’t comprehend the idea that a name can be associated with different things. You want to object to this being called a “linked list”, yet you can offer no insight as to what you think it should be called. It’s a “linking table”, though since it deals primarily with a single column of data, I prefer the term “list” over “table” — and you’ve given no reason why “table/list” shouldn’t be interchangeable.

It’s also a shame that you don’t even know how an $INCLUDE file works, and can’t comprehend that idet$ *is* a linked list — it’s simply an optimized linked list, forced to be kept in order for some odd reason only known by Galleon. Obviously you have no idea of the very “Linked Lists” you rant so heavily over— you can’t recognize one in its simplest form — nor do you have any comprehension of Linking Tables, yet you like to pretend to be all-knowing on the subject...

Do some research and learn a bit about the subjects you’re arguing over. As it is, you just come across as a belligerent idiot to me.

Pete · « **Reply #31 on:** January 19, 2019, 04:11:07 pm »

From Bill's post, now a ways back because I took a nap...

Quote

Proponents of linked lists say "no".

But the problem here is that Ancient Alien Theorists say, "yes."

--------------------------

Yeah the word processing was a good example. I had an idea way back to do something like this...

Say we have 3 records...

1 Pete
2 Steve
3 Rick

Now we missed Bill, and want to insert him into space 1. Yes, with arrays, that would mean we'd have to reassign Pete to 2, Steve to 3 and Rick to 4. However, if we had a tracking string that increased each a record was added, we could just leave these arrays as... a$(1) = "Pete" a$(2) = "Steve" a$(3) = "Rick" and a$(4) = "Bill" So how do we get the order with that tracking string? Like so... tracking$ = "4|1|2|3" it's very easy to manipulate a tracking string with INSTR() and MID$(). So when we need to repront the screen, we consult the tracking string, parse it out and it reprints the order as 4,1,2,3. It also identifies the correct record by the line you are on. If you cursor to line 3...

1 Bill
2 Pete
--> 3 Steve
4 Rick

it looks at the third number in the tracking string, which is 2. This is the array "Steve" was assigned to.

Good stuff guys. Let's see if we can keep it up but without biting each other's heads off. You know we really need Clippy for that.

Pete

_vince · « **Reply #32 on:** January 20, 2019, 05:07:24 am »

I, too, have a qb64 linked lists example. These are the proper "doubly linked lists" with the classic textbox/editor example along with storing a whole string per node.

@Steve, the term "linked list" is very specific and well known term in the programming/CS community, like the terms "binary tree", "pointer", "data type", "stack space", "variable", and so on, as it is a specific technique for a particular problem with shuffling items in a list as described by stx. It is not interchangeable with "linking table" as I've jokingly pointed out, so it's pretty misleading to use the it for something else, that is all. It would be like calling badminton "basketball" because the ball is basket shaped, logical only if "basketball" wasn't the already established term that it is.

Code: QB64: [Select]

defint a-z
 
type nodeType
        str as _mem
        strLen as integer
 
'you can add more data to store per node here
 
        n as _mem
        p as _mem
end type
 
type listType
        head as _mem
        tail as _mem
end type
 
screen 0
 
dim new as listType
dim cur as _mem
dim temp as _mem
 
newList new
 
'insert garbage
addNodeNext temp, "test1", new.head
addNodeNext temp, "test2", temp
addNodeNext temp, "test3", temp
addNodeNext temp, "test4", temp
addNodePrev temp, "testa", new.tail
addNodePrev temp, "estb", temp
addNodePrev temp, "", temp
addNodePrev temp, "td", temp
 
printList new
 
nextNode cur, new.head
 
cx = 1
cy = 1
 
do
        cls
        locate 1,1
        printList new
 
        locate cy,cx
        color 0,7
        print chr$(screen(cy,cx))
        color 7,0
 
        do 
                k$ = inkey$
        loop until len(k$)>0
 
        select case k$
        case chr$(13) 'enter
                if cy = 1 and cx = 1 then
                        addNodePrev cur, "", cur
                elseif -1 then
                        s$ = readNode$(cur)
                        ss$ = right$(s$, len(s$)-cx+1)
                        s$ = left$(s$, cx-1)
                        writeNode cur, s$
                        addNodeNext cur, ss$, cur
                        cy = cy + 1
                        cx = 1
                end if
 
        case chr$(8) 'backspace
                if cx = 1 then
                        if cy > 1 then
                                s$ = readNode$(cur)
                                temp = cur
                                prevNode cur, cur
                                ss$ = readNode$(cur)
                                cx = len(ss$) + 1
                                writeNode cur, ss$ + s$
                                cy = cy-1
                                rmNode temp
                        end if
                elseif cx > 1 then
                        cx = cx - 1
                        s$ = readNode$(cur)
                        ss$ = left$(s$, cx-1) + right$(s$, len(s$)-cx)
                        writeNode cur, ss$
                end if
 
        case chr$(0)+"K" 'left
                if cx > 1 then cx = cx - 1
 
        case chr$(0)+"M" 'right
                s$ = readNode$(cur)
                if cx <= len(s$) then cx = cx + 1
 
        case chr$(0)+"H" 'up
                s$ = readNode$(cur)
                if cy > 1 then
                        prevNode cur, cur
                        s$ = readNode$(cur)
                        if cx > len(s$) then cx = len(s$) + 1
                        cy = cy - 1
                end if
 
        case chr$(0)+"P" 'down
                nextNode temp, cur
                if temp.offset <> new.tail.offset then
                        cur = temp
                        s$ = readNode$(cur)
                        if cx > len(s$) then cx = len(s$) + 1
                        cy = cy + 1
                end if
 
        case chr$(32) to chr$(128)
                s$ = readNode$(cur)
                s$ = mid$(s$,1,cx-1) + k$ + right$(s$, len(s$)-cx+1)
                writeNode cur, s$
                cx = cx + 1
        end select
 
loop until k$ = chr$(27)
system
 
sub addNodeNext (new as _mem, s$, cur as _mem)
        dim node as nodeType
        dim temp as _mem
        dim n as _mem
 
        temp = _memnew(len(node))
 
        nextNode n, cur
 
        node.strLen = len(s$)
        if node.strLen > 0 then 
                node.str = _memnew(len(s$))
                _memput node.str, node.str.offset, s$
        end if
        node.n = n
        node.p = cur
        _memput temp, temp.offset, node
 
        node = _memget(cur, cur.offset, nodeType)
        node.n = temp
        _memput cur, cur.offset, node
 
        node = _memget(n, n.offset, nodeType)
        node.p = temp
        _memput n, n.offset, node
 
        new = temp
end sub
 
sub addNodePrev (new as _mem, s$, cur as _mem)
        dim node as nodeType
        dim temp as _mem
        dim p as _mem
 
        temp = _memnew(len(node))
 
        prevNode p, cur
 
        node.strLen = len(s$)
        if node.strLen > 0 then 
                node.str = _memnew(len(s$))
                _memput node.str, node.str.offset, s$
        end if
 
        node.n = cur
        node.p = p
        _memput temp, temp.offset, node
 
        node = _memget(cur, cur.offset, nodeType)
        node.p = temp
        _memput cur, cur.offset, node
 
        node = _memget(p, p.offset, nodeType)
        node.n = temp
        _memput p, p.offset, node
 
        new = temp
end sub
 
sub rmNode (cur as _mem)
        dim node as nodeType
        dim n as _mem
        dim p as _mem
 
        'remove the string first
        node = _memget(cur, cur.offset, nodeType)
        if node.strLen > 0 then
                _memfree node.str
        end if
 
        nextNode n, cur
        prevNode p, cur
 
        node = _memget(p, p.offset, nodeType)
        node.n = n
        _memput p, p.offset, node
 
        node = _memget(n, n.offset, nodeType)
        node.p = p
        _memput n, n.offset, node
 
        _memfree cur
end sub
 
sub nextNode (new as _mem, old as _mem)
        dim node as nodeType
 
        node = _memget(old, old.offset, nodeType)
        new = node.n
end sub
 
sub prevNode (new as _mem, old as _mem)
        dim node as nodeType
 
        node = _memget(old, old.offset, nodeType)
        new = node.p
end sub
 
function readNode$ (cur as _mem)
        dim node as nodeType
 
        node = _memget(cur, cur.offset, nodeType)
        if node.strLen = 0 then
                readNode$ = ""
                exit function
        end if
        s$ = string$(node.strLen, 0)
        _memget node.str, node.str.offset, s$
 
        readNode$ = s$
end sub
 
sub writeNode (cur as _mem, s$)
        dim node as nodeType
 
        'remove old string, freeing memory
        node = _memget(cur, cur.offset, nodeType)
        if node.strLen > 0 then _memfree node.str
 
        'add new string
        node.strLen = len(s$)
        if node.strLen > 0 then
                node.str = _memnew(len(s$))
                _memput node.str, node.str.offset, s$
        end if
        _memput cur, cur.offset, node
end sub
 
sub newList (new as listType)
        dim node as nodeType
 
        new.head = _memnew(len(node))
        new.tail = _memnew(len(node))
 
        s$ = "head"
        node.strLen = len(s$)
        node.str = _memnew(len(s$))
        node.n = new.tail
        node.p = new.tail
        _memput node.str, node.str.offset, s$
        _memput new.head, new.head.offset, node
 
        s$ = "tail"
        node.strLen = len(s$)
        node.str = _memnew(len(s$))
        node.n = new.head
        node.p = new.head
        _memput node.str, node.str.offset, s$
        _memput new.tail, new.tail.offset, node
end sub
 
sub printList (cur as listType)
        dim temp as _mem
 
        nextNode temp, cur.head
        do 
                if temp.offset = cur.tail.offset then exit do
 
                print readNode$ (temp)
                nextNode temp, temp
        loop
end sub
 
sub rmList (cur as listType)
        dim temp as _mem
        dim temp2 as _mem
 
        nextNode temp, cur.head
        do 
                if temp.offset = cur.tail.offset then exit do
 
                temp2 = temp
                nextNode temp, temp2
                rmNode temp2
        loop
 
        rmNode cur.head
        rmNode cur.tail
end sub
 
 

Pete · « **Reply #33 on:** January 20, 2019, 11:01:44 am »

Thanks for "pointing" out the C connection, V.

I read about that too, but I know next to nothing about the language, so I didn't want to chime in like I was some kind of authority. What I should have posted is from my limited reading, it appeared to me that the C language uses pointers and coined that phrase, "linked list" in association with putting data in nodes, which I assume are user determined memory locations. I would suspect people in that community would be more sensitive to how that term is defined when using other languages, especially ones like BASIC, which are not associated with using pointers. So the phrase, "What's in a name?" Well, maybe it is all up to who feels they have the most ownership of it. Something similar to this happened to me this morning when I was looking through Bing news and clicked on a headline about PGA Awards. I was expecting a golf article, but instead got some crap about "Producers Guild Awards."

Anyway, QB64 has the C _MEM keywords that bridge the gap into linked lists. I've haven't used those QB64 keywords yet, so thanks V, for posting a node example. It will take me awhile to get to it but hopefully not to long to absorb it. I have always had to rely on the technique I described in the last post or the rather elaborate use of arrays, which I believe that article I read stated was the next best way to link data in a non-pointer language.

Pete

SMcNeill · « **Reply #34 on:** January 20, 2019, 11:32:47 am »

Quote

It would be like calling badminton "basketball" because the ball is basket shaped, logical only if "basketball" wasn't the already established term that it is.

Maybe it’s just a regional thing; as I know us hillbillies have our own lingo, but the term I’m using is perfectly suitable around here, just as some places seem to call “soccer” as “football”, even though it’s obviously something different. I’ve never said a Linked List wasn’t used as you illustrate; I’ve just said it’s also had a different meaning as I’ve known it. Sometimes “football” is an oval shaped ball you throw in the air, sometimes it’s a circular ball hit with your head — yet, people are generally tolerant enough not to say, “Gee, you’re using that term wrong.”, or at least they’re willing to accept when told, “Well, that’s what we call the game here.”

Like I’ve mentioned, I’m more than willing to call the demo here by another name, if someone can suggest something better to describe what it’s doing. My biggest problem with folks complaining over the name is simply nobody has actually offered a suggestion of what it should be called.

I’m thinking of renaming it the “FIN GUT.BM LIBRARY — Fuck It, Nobody Gets to Use This, But Me LIBRARY.” If somebody ever wants to do something similar, let them do it themselves and call it whatever the hell they want.

Pete · « **Reply #35 on:** January 20, 2019, 12:48:14 pm »

I tried your new name but I got a "Duplicate Definition" error when I tried to run it.

Pete :D

TempodiBasic · « **Reply #36 on:** January 20, 2019, 05:39:31 pm »

Pete
What name do you search, in specific?
:-)

following your explanation about linked lists

Quote

Say we have 3 records...

1 Pete
2 Steve
3 Rick

now if we add the forth record "Bill"
in the original list we add at the end the new record...
Original List Desired List
1 Pete 1 Bill
2 Steve 2 Pete
3 Rick 3 Steve
4 Bill 4 Rick

stored in new variable tracking$ = "4|1|2|3" --> that is the index of Desired List
now we can order in increasing alphabetical AlphaIncrease$ = "4|1|3|2"
and we can order in decreasing alphabetical AlphaDecrese$ = "2|3|1|4"
and we can extract names including "i" NameI$ = "4|3"
and we can extract names including two "e" NameE$="1|2"
the thing becomes interesting....

Pete · « **Reply #37 on:** January 20, 2019, 09:24:09 pm »

Since you showed some interest in this method, I'll post some working code. It's pretty limited, but it will demonstrate how a tracking string would work...

T$ is the tracking string.
r is the record number in sequential order of entry.

Code: QB64: [Select]

separator$ = "|"
LOCATE , , 1, 7, 7
DO
    _LIMIT 30
    b$ = INKEY$
    IF b$ <> "" THEN
        yy% = CSRLIN
        SELECT CASE b$
            CASE CHR$(0) + "H"
                IF CSRLIN > 1 THEN LOCATE CSRLIN - 1
            CASE CHR$(0) + "P"
                IF CSRLIN < 4 THEN LOCATE CSRLIN + 1
            CASE "A" TO "z", "0" TO "9"
                IF a$(yy%) = "" AND r < 4 THEN
                    PRINT b$;
                    GOSUB text
                ELSE
                    BEEP ' For this demo, overwrite is not allowed. Only insert.
                END IF
            CASE CHR$(0) + "R" ' Insert Key
                IF r < 8 THEN ' Allow up to 8 lines with insert, 4 with just enter.
                    ' Move all entries one line down the screen.
                    PRINT SPACE$(80)
                    GOSUB getseed
                    DO
                        x$ = MID$(t$, seed%, INSTR(seed%, t$, separator$) - seed% + 1) ' Include separator to insure names are unique when concatenated.
                        PRINT SPACE$(80);
                        LOCATE , 1
                        PRINT a$(VAL(x$))
                        seed% = seed% + LEN(x$)
                    LOOP UNTIL seed% > LEN(t$)
                    LOCATE yy%, 1
                    b$ = ""
                    GOSUB text
                ELSE
                    BEEP ' Only allow 5 entries for this demo
                END IF
            CASE CHR$(9)
                CLS
                seed% = 1
                FOR i = 1 TO r
                    _DELAY .25
                    x$ = MID$(t$, seed%, INSTR(seed%, t$, separator$) - seed% + 1)
                    PRINT a$(VAL(x$))
                    seed% = seed% + LEN(x$)
                NEXT
                yy% = CSRLIN
                LOCATE 20, 1: PRINT t$
                LOCATE yy%
            CASE CHR$(27)
                SYSTEM
        END SELECT
    END IF
LOOP
 
getseed:
k% = 1: seed% = 1
FOR i% = 1 TO LEN(t$)
    IF k% = yy% THEN EXIT FOR
    IF MID$(t$, i%, 1) = separator$ THEN k% = k% + 1
NEXT
seed% = i%
RETURN
 
text:
LINE INPUT x$
LOCATE yy%, 1
r = r + 1
a$(r) = b$ + x$
GOSUB getseed
insert$ = separator$
t$ = MID$(insert$ + t$, 1, INSTR(seed%, insert$ + t$, separator$)) + LTRIM$(STR$(r)) + separator$ + MID$(insert$ + t$, INSTR(seed%, insert$ + t$, separator$) + 1)
IF insert$ <> "" THEN t$ = MID$(t$, 2): insert$ = ""
LOCATE 20, 1: PRINT "Tracking String = "; t$
LOCATE yy% + 1, 1 ' Move next line down
RETURN

Keys are type something and press ENTER. Works with Line Input function.
Insert something with INSERT key then type as usual. Stuff on screen under insert line will move down.
Use the TAB key to clear the screen and it wil print the order correctly, using the tracking string to decide the proper order.

Pete

_vince · « **Reply #38 on:** January 21, 2019, 09:27:43 am »

Quote from: Pete on January 20, 2019, 11:01:44 am

Thanks for "pointing" out the C connection, V.

I read about that too, but I know next to nothing about the language, so I didn't want to chime in like I was some kind of authority. What I should have posted is from my limited reading, it appeared to me that the C language uses pointers and coined that phrase, "linked list" in association with putting data in nodes, which I assume are user determined memory locations. I would suspect people in that community would be more sensitive to how that term is defined when using other languages, especially ones like BASIC, which are not associated with using pointers. So the phrase, "What's in a name?" Well, maybe it is all up to who feels they have the most ownership of it. Something similar to this happened to me this morning when I was looking through Bing news and clicked on a headline about PGA Awards. I was expecting a golf article, but instead got some crap about "Producers Guild Awards."

Anyway, QB64 has the C _MEM keywords that bridge the gap into linked lists. I've haven't used those QB64 keywords yet, so thanks V, for posting a node example. It will take me awhile to get to it but hopefully not to long to absorb it. I have always had to rely on the technique I described in the last post or the rather elaborate use of arrays, which I believe that article I read stated was the next best way to link data in a non-pointer language.

Pete

Nothing to do with C specifically, I have not mentioned C, these are general concepts applicable to all languages. _MEM is not a C keyword but a QB64 keyword.

QBasic/QB45 has pointers as well, they exist within the realm controlled by statements such as PEEK, POKE, VARPTR (variable pointer), VARSEG (variable segment), SADD (string address), VARPTR$, DEF SEG, and so on.

I am going to add a few entries related to _MEM to my QB64/FB dictionary.

STxAxTIC · « **Reply #39 on:** January 22, 2019, 08:08:07 am »

Looks like we institutionally forgot that I made a full-blown doubly linked list text editor in QB64 a few months ago - the qXed project. I halted the effort to make it a cheap emacs clone because the quality of my internet connection forbids me to test certain online features... however that's irrelevant for this. Like Vince said, a "real" one would use one entire string per node. This one uses one character per node for... certain reasons I can explain. Literally too much to talk about with this program, so I've stripped a few things down to show the basics here.

So HERE is a working example of a doubly-linked list in action. It's a fully-working text editor, but the learning curve is a little steep, and I haven't explained a damn thing so you will think it's full of bugs unless you discover simple stuff.

Code: QB64: [Select]

'$EXEICON:'qXedlogo.ico'
'$RESIZE:ON
 
'REM $Include: 'sxmath.bi'
'REM $Include: 'sxript.bi'
 
scrHand& = _NEWIMAGE(90, 30, 0)
SCREEN scrHand&
'_FREEIMAGE scrHand&
 
' Define fundamental structures.
TYPE Vector
    X AS INTEGER
    Y AS INTEGER
END TYPE
 
TYPE Cell
    Identity AS LONG
    Pointer AS LONG
    Lagger AS LONG
    Content AS STRING * 1
END TYPE
 
DIM SHARED ChainLimit AS LONG
DIM SHARED BOC AS LONG ' Beginning of chain.
DIM SHARED EOC AS LONG ' End of chain.
ChainLimit = 128000
BOC = -1
EOC = ChainLimit
 
' Define text window properties.
DIM SHARED WindowHeight
DIM SHARED WindowWidth
DIM SHARED VisibleLines
DIM SHARED TopIndent
DIM SHARED LeftIndent
DIM SHARED TextHeight
DIM SHARED TextWidth
DIM SHARED HScroll
DIM SHARED TextWrapping
DIM SHARED TextFormatting
DIM SHARED InsertKey
TopIndent = 1
LeftIndent = 1
WindowWidth = _WIDTH '
WindowHeight = _HEIGHT '- 2
TextHeight = WindowHeight - 2 * TopIndent
TextWidth = WindowWidth - 2 * LeftIndent
HScroll = 1
TextWrapping = 0
TextFormatting = -1
InsertKey = -1
 
' Initiate text inside window.
DIM SHARED StartIndex
DIM SHARED LineAsMapped(TextHeight) AS STRING
DIM SHARED Cursor1 AS Vector
DIM SHARED Cursor2 AS Vector
DIM SHARED ID1
DIM SHARED ID2
 
' Auxiliary 2D text grid.
DIM SHARED GOLSwitch
DIM SHARED AuxGrid(TextWidth, TextHeight, 2) AS STRING
GOLSwitch = -1
 
' Load text file into memory if applicable, use example string if not.
DIM SHARED FileName$
c$ = COMMAND$
IF (c$ <> "") THEN
    q$ = ""
    OPEN c$ FOR INPUT AS #1
    DO WHILE NOT EOF(1)
        LINE INPUT #1, r$
        q$ = q$ + r$ + CHR$(13)
    LOOP
    CLOSE #1
    i = INSTR(c$, ".")
    IF (i <> 0) THEN j = i - 1 ELSE j = LEN(c$)
    FileName$ = LEFT$(c$, j) + "-" + LTRIM$(RTRIM$(STR$(INT(TIMER)))) + ".txt"
    _TITLE FileName$
ELSE
    FileName$ = "Newfile" + "-" + DATE$ + "-" + LTRIM$(RTRIM$(STR$(INT(TIMER)))) + ".txt"
    q$ = "I sank to the floor. I [experienced] this hallucination of tumbling forward into these fractal geometric spaces made of light and then I found myself in the equivalent of the Pope's private chapel and there were insect elf machines proffering strange little tablets with strange writing on them, and I was aghast, completely appalled, because [in] a matter of seconds . . . my entire expectation of the nature of the world was just being shredded in front of me. I've never actually gotten over it. These self-transforming machine elf creatures were speaking in a colored language which condensed into rotating machines that were like Faberge eggs but crafted out of luminescent superconducting ceramics and liquid crystal gels. All this stuff was just so weird and so alien and so un-English-able that it was a complete shock - I mean, the literal turning inside out of [my] intellectual universe!" + CHR$(13) + CHR$(13) + "This went on for two or three minutes, this situation of [discontinuous] orthogonal dimensions to reality just engulfing me. As I came out of it and the room reassembled itself, I said, " + CHR$(34) + "I can't believe it, it's impossible." + CHR$(34) + " To call that a drug is ridiculous; that just means that you just don't have a word for it and so you putter around and you come upon this sloppy concept [that] something goes into your body and there's a change. It's not like that; it's like being struck by noetic lightning. [Note: " + CHR$(34) + "Noetic" + CHR$(34) + " derives from the theologian Pierre Teilhard de Chardin's " + CHR$(34) + "noosphere" + CHR$(34) + " - the collective consciousness of humankind conceived of as a sort of philosophical virtuality.]" + CHR$(13) + CHR$(13) + "[What] astonished me was [that] . . . in the carpets of Central Asia, in the myths of the Maya, in the visions of an Arcimboldi or a Fra Angelico or a Bosch, there is not a hint, not a clue, not an atom of the presence of this thing, This was more [multiplex] than the universe that we share with each other. It was the victory of Neo-Platonic metaphysics; everything [was] made out of a fourth-dimensional mosaic of energy. I was knocked off my feet, and set myself the goal of understanding this. There was really no choice, you see."
    'q$ = " "
END IF
 
_TITLE "qXed"
 
' Create memory space for string.                                      a
DIM SHARED TheChain(ChainLimit) AS Cell
 
' Create character list.
CALL Assimilate(q$)
 
' Prime main loop.
CALL MapText
CALL CalibrateCursor(ID1)
CALL CalibrateCursor(ID2)
CALL PrintEverything
 
DIM SHARED DEBUG$
 
' Main loop.
DO
    IF (StateChange = 1) THEN
        CALL PrintEverything
    END IF
 
    IF (GOLSwitch = 1) THEN
        CALL ConvertToGrid
        CALL GOL
        CALL ConvertFromGrid
        CALL MapText
        CALL PrintEverything
    END IF
 
    'IF _RESIZE = -1 THEN
    '    _DELAY .1
    '    oldimage& = scrHand&
    '    scrHand& = _NEWIMAGE(_RESIZEWIDTH / 8, _RESIZEHEIGHT / 16, 0)
    '    SCREEN scrHand&
    '    _FREEIMAGE oldimage&
    '    WindowWidth = INT(_RESIZEWIDTH / 8)
    '    WindowHeight = INT(_RESIZEHEIGHT / 16)
    '    TextHeight = WindowHeight - 2 * TopIndent
    '    TextWidth = WindowWidth - 2 * LeftIndent
    '    REDIM LineAsMapped(TextHeight)
    '    REDIM AuxGrid(TextWidth, TextHeight, 2)
    '    CALL MapText
    '    CALL CalibrateCursor(ID1)
    '    CALL CalibrateCursor(ID2)
    '    CALL PrintEverything
    'END IF
 
    _DISPLAY
    _LIMIT 120
LOOP
SYSTEM
 
SUB PrintEverything
    CLS
 
    c$ = "qXed" + " " + DEBUG$
    CALL DisplayText(1, 1, 11, 0, c$)
 
    ' Main text
    FOR i = 1 TO VisibleLines
        c$ = LineAsMapped(i)
        IF ((TextFormatting = 1) AND (TextWrapping <> 2)) THEN
            FOR j = 1 TO TextWidth - LEN(c$)
                c$ = c$ + "_"
            NEXT
        END IF
        d$ = MID$(c$, HScroll, TextWidth)
        CALL DisplayText(LeftIndent + 1, TopIndent + i, 7, 1, d$)
    NEXT
 
    ' Cursor2
    IF ((Cursor2.X > 0 AND Cursor2.X < WindowWidth) AND ((Cursor2.Y > 0) AND (Cursor2.Y < WindowHeight))) THEN
        p1 = LinearCount(StartIndex, ID1)
        p2 = LinearCount(StartIndex, ID2)
        pe = LinearCount(StartIndex, EOC)
        IF ((p2 > p1) AND (p2 < pe)) THEN
            c$ = TheChain(ID2).Content
            IF (c$ = " ") THEN c$ = "_"
            IF (c$ = CHR$(13)) THEN c$ = "~"
            CALL DisplayText(Cursor2.X, Cursor2.Y, 0, 6, c$)
        END IF
    END IF
 
    ' Cursor1
    IF ((Cursor1.X > 0 AND Cursor1.X < WindowWidth) AND ((Cursor1.Y > 0) AND (Cursor1.Y < WindowHeight))) THEN
        c$ = TheChain(ID1).Content
        IF (c$ = " ") THEN c$ = "_"
        IF (c$ = CHR$(13)) THEN c$ = "~"
        IF ((Cursor1.X = Cursor2.X) AND (Cursor1.Y = Cursor2.Y)) THEN
            a = 16: b = 5
        ELSE
            a = 16: b = 3
        END IF
        CALL DisplayText(Cursor1.X, Cursor1.Y, a, b, c$)
    END IF
 
    ' Cursor status
    d$ = TheChain(ID1).Content
    e$ = TheChain(ID2).Content
    IF ((ASC(d$) = 10) OR (ASC(d$) = 13)) THEN d$ = "~"
    IF ((ASC(e$) = 10) OR (ASC(e$) = 13)) THEN e$ = "~"
    IF (ASC(d$) = 32) THEN d$ = "_"
    IF (ASC(e$) = 32) THEN e$ = "_"
    c$ = "(" + LTRIM$(RTRIM$(STR$(Cursor1.X - LeftIndent))) + "," + LTRIM$(RTRIM$(STR$(Cursor1.Y - TopIndent))) + ":" + " " + LTRIM$(RTRIM$(d$)) + " " + LTRIM$(RTRIM$(STR$(ID1))) + ")"
    a = 0: b = 3
    IF ((Cursor1.X = Cursor2.X) AND (Cursor1.Y = Cursor2.Y)) THEN
        a = 15: b = 5
    END IF
    CALL DisplayText(2, WindowHeight, a, b, c$)
    g$ = "(" + LTRIM$(RTRIM$(STR$(Cursor2.X - LeftIndent))) + "," + LTRIM$(RTRIM$(STR$(Cursor2.Y - TopIndent))) + ":" + " " + LTRIM$(RTRIM$(e$)) + " " + LTRIM$(RTRIM$(STR$(ID2))) + ")"
    a = 6: b = 0
    IF (LinearCount(StartIndex, ID2) > LinearCount(StartIndex, ID1)) THEN
        a = 0: b = 6
    END IF
    CALL DisplayText(3 + LEN(c$), WindowHeight, a, b, g$)
    ' Horizontal scrollbar
    p = LinearCount(NthP(StartIndex, FindID(LeftIndent + 1, Cursor1.Y)), ID1)
    q = LEN(LineAsMapped(Cursor1.Y - TopIndent))
    r = p / q
    IF r > 1 THEN r = 1
    IF r < 0 THEN r = 0
    i = 2 + INT(r * (WindowWidth - 2))
    IF i < 1 THEN i = 1
    IF i > WindowWidth THEN i = WindowWidth
    CALL DisplayText(i, WindowHeight - 1, 8, 7, "^")
 
    ' Vertical scrollbar
    p = LinearCount(ID1, NthP(ID1, ChainLimit + 1))
    q = LinearCount(NthL(ID1, ChainLimit + 1), NthP(ID1, ChainLimit + 1))
    IF (q = 0) THEN r = 1 ELSE r = 1 - p / q
    CALL DisplayText(WindowWidth, 1 + INT(r * (WindowHeight - 1)), 8, 7, "<")
 
    ' Help
    SELECT CASE TextWrapping
        CASE 0: d$ = "Square"
        CASE 1: d$ = "Fluid"
        CASE 2: d$ = "None"
    END SELECT
    c$ = "[F6=Save] [F11=Format] [F12=Wrap: " + d$ + "]"
    IF (TextWrapping = 2) THEN c$ = "[F1/2=HScroll] " + c$
    c$ = c$ + STR$(INT(100 * r)) + "%"
    IF (LEN(c$) >= TextWidth) THEN c$ = LEFT$(c$, TextWidth)
    CALL DisplayText(WindowWidth - LEN(c$), 1, 15, 0, c$)
    c$ = "[Esc=Sync] [Mouse2=Copy] [Mouse3=Paste]"
    IF (InsertKey = 1) THEN c$ = "[Ins] " + c$
    IF (LEN(c$) >= TextWidth) THEN c$ = LEFT$(c$, TextWidth)
    CALL DisplayText(WindowWidth - LEN(c$), WindowHeight, 15, 0, c$)
 
    ' Pointer
    IF ((_MOUSEX >= 1) AND (_MOUSEX <= WindowWidth) AND (_MOUSEY >= 1) AND (_MOUSEY <= WindowHeight)) THEN
        a$ = CHR$(SCREEN(_MOUSEY, _MOUSEX))
        CALL DisplayText(_MOUSEX, _MOUSEY, 0, 15, a$)
    END IF
 
    COLOR 15, 0
 
END SUB
 
SUB Assimilate (a AS STRING)
    ' Load a string to initialize chain.
    FOR k = 1 TO ChainLimit
        TheChain(k).Identity = 0
    NEXT
    StartIndex = 1
    PreviousIdentity = BOC
    NextIdentity = NextOpenIdentity(StartIndex)
    FOR k = 1 TO LEN(a)
        j = NextIdentity
        TheChain(j).Identity = j
        TheChain(j).Content = ReFormat$(MID$(a, k, 1))
        TheChain(j).Lagger = PreviousIdentity
        PreviousIdentity = j
        IF (k < LEN(a)) THEN
            NextIdentity = NextOpenIdentity(j)
            TheChain(j).Pointer = NextIdentity
        ELSE
            TheChain(j).Pointer = EOC
        END IF
        PRINT TheChain(j).Content
    NEXT
    ID1 = StartIndex
    ID2 = NthP(ID1, ChainLimit + 1)
END SUB
 
FUNCTION ReFormat$ (a AS STRING)
    c$ = a
    IF c$ = CHR$(10) THEN c$ = CHR$(13)
    IF c$ = CHR$(9) THEN c$ = "    "
    ReFormat = c$
END FUNCTION
 
FUNCTION NthP (a AS LONG, b AS LONG)
    ' Returns the address that is b jumps ahead of address a.
    i = a
    IF (i <> EOC) THEN
        k = 0
        j = 0
        DO WHILE (k < b)
            k = k + 1
            j = TheChain(i).Identity
            i = TheChain(j).Pointer
            IF (i = EOC) THEN EXIT DO
        LOOP
    END IF
    NthP = j
END FUNCTION
 
FUNCTION NthPC (a AS LONG, b AS STRING)
    ' Returns the address holding b first enLinearCountered from a.
    i = a
    DO
        j = TheChain(i).Identity
        i = TheChain(j).Pointer
        IF (TheChain(j).Content = b) THEN EXIT DO
        IF (i = EOC) THEN
            j = BOC
            EXIT DO
        END IF
    LOOP
    NthPC = j
END FUNCTION
 
FUNCTION NthL (a AS LONG, b AS LONG)
    ' Returns the address that is b jumps behind address a.
    i = a
    k = 0
    DO WHILE k < b
        k = k + 1
        j = TheChain(i).Identity
        i = TheChain(j).Lagger
        IF (i = BOC) THEN EXIT DO
    LOOP
    NthL = j
END FUNCTION
 
FUNCTION NextOpenIdentity (a AS LONG)
    ' Returns first nonzero identity.
    FOR j = a TO ChainLimit
        IF (TheChain(j).Identity = 0) THEN EXIT FOR
    NEXT
    IF (j > ChainLimit) THEN
        PRINT "Out of memory: "; ChainLimit
        SLEEP
        SYSTEM
    END IF
    NextOpenIdentity = j
END FUNCTION
 
FUNCTION BackBreak (a AS LONG)
    ' Function for scrolling up.
    j = a
    lastbreak = 0
    c$ = ""
    DO
        IF (j = BOC) THEN EXIT DO
        k = TheChain(j).Lagger
        IF (k = BOC) THEN
            lastbreak = j
            EXIT DO
        END IF
        j = k
        d$ = TheChain(j).Content
        IF ((TextWrapping = 1) AND (d$ = " ")) THEN lastbreak = j
        c$ = d$ + c$
        IF (TextWrapping <> 2) AND (LEN(c$) = TextWidth) THEN EXIT DO
        IF (d$ = CHR$(13)) THEN EXIT DO
    LOOP
    IF (lastbreak <> 0) THEN j = TheChain(lastbreak).Identity
    BackBreak = j
END FUNCTION
 
SUB InsertBefore (a AS LONG, b AS STRING)
    ' Inserts a single cell before address a in the chain.
    j = NextOpenIdentity(a)
    al = TheChain(a).Lagger
    TheChain(j).Identity = j
    TheChain(j).Pointer = a
    TheChain(j).Lagger = al
    TheChain(j).Content = ReFormat$(b)
    TheChain(a).Lagger = j
    IF (al = BOC) THEN StartIndex = j ELSE TheChain(al).Pointer = j
END SUB
 
SUB InsertAfter (a AS LONG, b AS STRING)
    ' Inserts a single cell after address a in the chain.
    j = NextOpenIdentity(a)
    ap = TheChain(a).Pointer
    TheChain(j).Identity = j
    TheChain(j).Pointer = ap
    TheChain(j).Lagger = a
    TheChain(j).Content = ReFormat$(b)
    TheChain(a).Pointer = j
    IF (ap <> EOC) THEN TheChain(ap).Lagger = j
END SUB
 
SUB InsertRange (a AS LONG, b AS STRING)
    ' Inserts a sub-chain anywhere.
    FOR k = 1 TO LEN(b)
        c$ = MID$(b, k, 1)
        CALL InsertBefore(a, c$)
    NEXT
END SUB
 
SUB UnlinkCell (a AS LONG)
    ' Remove single cell from chain and clear identity.
    ap = TheChain(a).Pointer
    al = TheChain(a).Lagger
    IF ((ap = EOC) AND (al = BOC)) THEN
        TheChain(a).Content = " "
        'ID1 = a
        'ID2 = ID1
    ELSE
        TheChain(a).Identity = 0
        IF ((ap <> EOC) AND (al <> BOC)) THEN
            TheChain(al).Pointer = ap
            TheChain(ap).Lagger = al
        END IF
        IF (ap = EOC) THEN TheChain(al).Pointer = EOC
        IF (al = BOC) THEN
            StartIndex = ap
            TheChain(ap).Lagger = BOC
        END IF
    END IF
END SUB
 
SUB UnlinkRange (a AS LONG, b AS LONG)
    ' Remove sub-chain and clear identity of each cell.
    bp = TheChain(b).Pointer
    al = TheChain(a).Lagger
    IF ((al = BOC) AND (bp = EOC)) THEN
        CALL UnlinkRange(NthP(a, 2), b)
        TheChain(a).Content = " "
        TheChain(a).Pointer = bp
    ELSE
        k = a
        DO WHILE ((k <> b) AND (k <> EOC))
            TheChain(k).Identity = 0
            k = TheChain(k).Pointer
        LOOP
        TheChain(b).Identity = 0
        TheChain(bp).Lagger = al
        IF (al = BOC) THEN StartIndex = bp ELSE TheChain(al).Pointer = bp
    END IF
END SUB
 
FUNCTION LinearCount (a AS LONG, b AS LONG)
    ' Returns number of links between two addresses.
    i = a
    k = 0
    DO WHILE (i <> b)
        k = k + 1
        j = TheChain(i).Identity
        i = TheChain(j).Pointer
        IF (i = EOC) THEN EXIT DO
    LOOP
    LinearCount = k
END FUNCTION
 
FUNCTION LinearCount2 (a AS LONG, b AS LONG, c AS LONG)
    ' Returns number of links between two addresses, with exit condition.
    i = a
    k = 0
    DO WHILE (i <> b)
        k = k + 1
        j = TheChain(i).Identity
        i = TheChain(j).Pointer
        IF (i = EOC) THEN EXIT DO
        IF (k = c) THEN EXIT DO
    LOOP
    LinearCount2 = k
END FUNCTION
 
FUNCTION Projection$ (a AS LONG, b AS LONG)
    ' Returns the linear content for all address between a and b, inclusive.
    DIM TheReturn AS STRING
    TheReturn = ""
    IF (a = b) THEN
        TheReturn = TheChain(a).Content
    ELSE
        j = a
        DO
            c$ = TheChain(j).Content
            TheReturn = TheReturn + c$
            k = TheChain(j).Pointer
            IF (j = b) THEN EXIT DO
            IF (k = EOC) THEN EXIT DO
            j = k
        LOOP
    END IF
    Projection$ = TheReturn
END SUB
 
SUB MapText
    IF (TextFormatting = 1) THEN br$ = "~" ELSE br$ = " "
    j = StartIndex
    i = 1
    q$ = ""
    d$ = ""
    DO ' Begin with any left-over text from previous iteration.
        q$ = d$
        d$ = ""
        r = TextWidth - LEN(q$)
        IF (TextWrapping <> 2) THEN k1 = NthP(j, r) ELSE k1 = EOC
        k2 = NthPC(j, CHR$(13))
        IF (TextWrapping <> 2) THEN c1 = LinearCount(j, k1) ELSE c1 = LinearCount2(j, k1, TextWidth * TextHeight)
        c2 = LinearCount(j, k2)
        IF (c2 = 0) THEN ' Line is blank-returned.
            k = k2
            q$ = q$ + br$
            j = NthP(k, 2)
        ELSE
            IF (c1 = c2) THEN ' Possible end of chain.
                k = TheChain(k1).Lagger
                q$ = q$ + Projection$(j, k)
                j = NthP(k, 2)
            END IF
            IF (c1 < c2) THEN ' Width limit case (not always maximum).
                k = k1
                q$ = q$ + Projection$(j, k)
                j = NthP(k, 2)
            END IF
            IF (c1 > c2) THEN ' Break return somewhere in line (not first).
                k = k2
                q$ = q$ + Projection$(j, TheChain(k).Lagger) + br$
                n = TheChain(k).Pointer
                IF (n <> EOC) THEN j = n
            END IF
        END IF
        IF (TextWrapping = 1) THEN ' Wrap text at first space from right, send remainder to next line.
            IF (LEN(q$) >= TextWidth) THEN
                FOR m = LEN(q$) TO 1 STEP -1
                    c$ = MID$(q$, m, 1)
                    IF (c$ = " ") OR (c$ = "-") THEN
                        q$ = LEFT$(q$, m)
                        EXIT FOR
                    END IF
                    d$ = c$ + d$
                    IF (m = 1) THEN ' Line is too long for allowed space and contains no wrapping characters.
                        q$ = LEFT$(q$, TextWidth)
                        d$ = ""
                        EXIT FOR
                    END IF
                NEXT
            END IF
        END IF
        LineAsMapped(i) = q$
        i = i + 1
        IF (i >= TextHeight) THEN EXIT DO
        IF (j = k) THEN EXIT DO
    LOOP
    VisibleLines = i - 1
END SUB
 
FUNCTION StateChange
    DIM TheReturn
    MH = 0
    MW = 0
    MT = 0
    DO WHILE _MOUSEINPUT
        MH1 = _MOUSEBUTTON(1)
        MH2 = _MOUSEBUTTON(2)
        MH3 = _MOUSEBUTTON(3)
        MW = _MOUSEWHEEL
        IF (MW <> 0) THEN MT = MW
    LOOP
    MW = MT
 
    IF (MH1 = -1) THEN
        ' Move Cursor1 among text.
        MH = 1
        IF ((_MOUSEX > LeftIndent) AND (_MOUSEX < TextWidth + LeftIndent + 1) AND (_MOUSEY > TopIndent) AND (_MOUSEY < TopIndent + TextHeight)) THEN
            Cursor1.X = _MOUSEX
            q = LeftIndent + LEN(LineAsMapped(_MOUSEY - TopIndent))
            IF (Cursor1.X > q) THEN Cursor1.X = q
            Cursor1.Y = _MOUSEY
            CALL ReassignID1
        END IF
        ' Move by vertical scrollbar.
        IF (_MOUSEX = WindowWidth) THEN
            i = NthL(ID1, ChainLimit + 1)
            j = NthP(ID1, ChainLimit + 1)
            IF (_MOUSEY = WindowHeight) THEN i = j
            IF (_MOUSEY > 1) AND (_MOUSEY < WindowHeight) THEN
                t = LinearCount(i, j)
                f = _MOUSEY / WindowHeight
                FOR k = 1 TO t
                    IF (k / t >= f) THEN EXIT FOR
                    i = TheChain(i).Pointer
                NEXT
            END IF
            StartIndex = i
            ID1 = i
        END IF
        ' Move by horizontal scrollbar.
        IF (_MOUSEY = WindowHeight - 1) THEN
            j = ID1
            i = NthP(StartIndex, FindID(LeftIndent + 1, Cursor1.Y))
            'IF (_MOUSEX = windowwidth - 1) THEN i = NthP(StartIndex, FindID(LeftIndent + LEN(LineAsMapped(Cursor1.Y - TopIndent)), Cursor1.Y) + (HScroll - 1))
            IF (_MOUSEX > 1) AND (_MOUSEX < WindowWidth) THEN
                t = LEN(LineAsMapped(Cursor1.Y - TopIndent))
                f = _MOUSEX / WindowWidth
                FOR k = 1 TO t
                    IF (k / t >= f) THEN EXIT FOR
                    i = TheChain(i).Pointer
                NEXT
            END IF
            ID1 = i
            d = LinearCount(StartIndex, i) - LinearCount(StartIndex, j)
            IF (TextWrapping = 2) THEN HScroll = HScroll + d
            IF HScroll < 1 THEN HScroll = 1
        END IF
    END IF
    IF (MH2 = -1) THEN
        ' Move Cursor2 and copy anything between Cursor1 and Cursor2 to clipboard.
        MH = 1
        IF (_MOUSEX > LeftIndent) AND (_MOUSEX < TextWidth + LeftIndent + 1) AND (_MOUSEY > TopIndent) AND (_MOUSEY < TopIndent + TextHeight + 1) THEN
            Cursor2.X = _MOUSEX
            q = LeftIndent + LEN(LineAsMapped(_MOUSEY - TopIndent))
            IF (Cursor2.X > q) THEN Cursor2.X = q
            Cursor2.Y = _MOUSEY
            CALL ReassignID2
            IF (LinearCount(StartIndex, ID2) > LinearCount(StartIndex, ID1)) THEN _CLIPBOARD$ = Projection$(ID1, ID2)
        END IF
    END IF
    IF (MH3 = -1) THEN
        ' Paste at Cursor1 position.
        MH = 1
        'IF (LinearCount(StartIndex, ID2) >= LinearCount(StartIndex, ID1)) THEN
        CALL InsertRange(ID1, _CLIPBOARD$)
    END IF
    IF (MW = -1) THEN
        ' Wheel up
        MH = 1
        StartIndex = BackBreak(StartIndex)
        CALL ReassignID1
    END IF
    IF (MW = 1) THEN
        ' Wheel down
        MH = 1
        IF (VisibleLines > 1) THEN
            StartIndex = NthP(StartIndex, LEN(LineAsMapped(1)) + 1)
            CALL MapText
        END IF
        CALL ReassignID1
    END IF
 
    KH = 0
    '''k$ = ""
    '''k$ = INKEY$
    '''IF k$ <> "" THEN KH = ASC(k$)
    KH = _KEYHIT
 
    ' Bksp
    IF (KH = 8) THEN
        r = TheChain(ID1).Pointer
        q = TheChain(ID1).Lagger
        CALL UnlinkCell(ID1)
        IF ((r = EOC) AND (q = BOC)) THEN
        ELSE
            IF (q <> BOC) THEN ID1 = q ELSE ID1 = r
            IF (r = EOC) THEN ID2 = ID1
        END IF
    END IF
    ' Tab
    IF (KH = 9) THEN CALL InsertRange(ID1, "    ")
    ' Esc
    IF (KH = 27) THEN
        IF (ID2 <> ID1) THEN ID2 = ID1 ELSE ID2 = StartIndex 'NthL(ID2, 2)
    END IF
    ' Enter, Alphanumerics
    IF (KH = 13) OR ((KH >= 32) AND (KH <= 126)) THEN
        IF (InsertKey = -1) THEN
            IF (ID1 = ID2) THEN
                CALL InsertBefore(ID1, LTRIM$(RTRIM$(CHR$(KH))))
            ELSE
                CALL InsertAfter(ID1, LTRIM$(RTRIM$(CHR$(KH))))
                ID1 = NthP(ID1, 2)
            END IF
        ELSE
            TheChain(ID1).Content = LTRIM$(RTRIM$(CHR$(KH)))
            IF (ID1 = ID2) THEN
                ID1 = NthP(ID1, 2)
                ID2 = ID1
            ELSE
                ID1 = NthP(ID1, 2)
            END IF
        END IF
        IF ((TextWrapping = 2) AND (Cursor1.X - LeftIndent = TextWidth)) THEN HScroll = HScroll + 1
    END IF
    ' F1
    IF (KH = 15104) THEN
        IF (TextWrapping = 2) THEN
            HScroll = HScroll - 1
            IF (HScroll < 1) THEN HScroll = 1
            CALL ReassignID1
            CALL ReassignID2
        END IF
    END IF
    ' F2
    IF (KH = 15360) THEN
        IF (TextWrapping = 2) THEN
            HScroll = HScroll + 1
            CALL ReassignID1
            CALL ReassignID2
        END IF
    END IF
    ' F5
    IF (KH = 16128) THEN
        q$ = Projection$(NthL(ID1, ChainLimit + 1), NthP(ID1, ChainLimit + 1))
        Assimilate q$
    END IF
    ' F4
    'IF (KH = 15872) THEN
    'CALL InsertRange(NthP(ID2, 2), CHR$(10) + "=" + CoreProcess$(Projection(ID1, ID2)))
    'CALL InsertRange(NthP(ID2, 2), CHR$(10) + "=" + SxriptEval$(Projection(ID1, ID2)))
    'ID2 = StartIndex
    'END IF
    ' F6
    IF (KH = 16384) THEN
        OPEN FileName$ FOR OUTPUT AS #1
        q$ = Projection$(NthL(ID1, ChainLimit + 1), NthP(ID1, ChainLimit + 1))
        PRINT #1, q$
        CLOSE #1
    END IF
    ' F7
    IF (KH = 16640) THEN
        GOLSwitch = -GOLSwitch
    END IF
    ' F8 IF (KH = 16896) THEN
    ' Home
    IF (KH = 18176) THEN
        IF (TextWrapping = 2) THEN HScroll = 1
        Cursor1.X = LeftIndent + 1
        CALL ReassignID1
    END IF
    ' UpArrow
    IF (KH = 18432) THEN
        IF (Cursor1.Y > TopIndent + 1) THEN
            Cursor1.Y = Cursor1.Y - 1
        ELSE
            StartIndex = BackBreak(StartIndex)
        END IF
        q = LEN(LineAsMapped(Cursor1.Y - TopIndent)) + 1
        IF (Cursor1.X > q) THEN Cursor1.X = q
        CALL ReassignID1
    END IF
    ' PgUp
    IF (KH = 18688) THEN
        FOR k = 1 TO INT(TextHeight / 2)
            StartIndex = BackBreak(StartIndex)
        NEXT
        CALL ReassignID1
    END IF
    ' LeftArrow
    IF (KH = 19200) THEN
        ID1 = NthL(ID1, 2)
        IF (TextWrapping = 2) THEN
            IF (Cursor1.X = LeftIndent + 1) THEN
                IF (HScroll > 1) THEN
                    HScroll = HScroll - 1
                ELSE
                    j = Cursor1.Y - TopIndent - 1
                    IF (j >= 1) THEN
                        k = LEN(LineAsMapped(j)) - TextWidth + 1
                        IF (k >= 1) THEN
                            HScroll = k
                        END IF
                    END IF
                END IF
            END IF
        ELSE
            IF ((Cursor1.X - LeftIndent = 1) AND Cursor1.Y - TopIndent = 1) THEN
                StartIndex = BackBreak(StartIndex)
            END IF
        END IF
    END IF
    ' RightArrow
    IF (KH = 19712) THEN
        ID1 = NthP(ID1, 2)
        m = Cursor1.X - LeftIndent
        n = LEN(LineAsMapped(Cursor1.Y - TopIndent)) - HScroll + 1
        IF (TextWrapping = 2) THEN
            IF (m >= TextWidth) THEN
                HScroll = HScroll + 1
                CALL ReassignID1
            END IF
            IF (m >= n) THEN
                j = Cursor1.Y - TopIndent + 1
                IF ((j <= TextHeight) AND (VisibleLines > 1)) THEN HScroll = 1
            END IF
        ELSE
            IF ((m >= n) AND (Cursor1.Y - TopIndent = VisibleLines)) THEN
                IF (VisibleLines > 1) THEN StartIndex = NthP(StartIndex, LEN(LineAsMapped(1)) + 1)
            END IF
        END IF
    END IF
    ' End
    IF (KH = 20224) THEN
        Cursor1.X = LeftIndent + LEN(LineAsMapped(Cursor1.Y - TopIndent))
        CALL ReassignID1
        IF (TextWrapping = 2) THEN
            q = LEN(LineAsMapped(Cursor1.Y - TopIndent)) - TextWidth + 1
            IF (q >= 1) THEN HScroll = q
        END IF
    END IF
    ' DownArrow
    IF (KH = 20480) THEN
        IF (Cursor1.Y = TopIndent + VisibleLines) THEN
            IF (VisibleLines > 1) THEN
                StartIndex = NthP(StartIndex, LEN(LineAsMapped(1)) + 1)
                CALL MapText
            END IF
        ELSE
            Cursor1.Y = Cursor1.Y + 1
        END IF
        q = LEN(LineAsMapped(Cursor1.Y - TopIndent)) + 1
        IF (Cursor1.X > q) THEN
            Cursor1.X = q
        END IF
        CALL ReassignID1
    END IF
    ' PgDn
    IF (KH = 20736) THEN
        FOR k = 1 TO INT(TextHeight / 2)
            IF (VisibleLines > 1) THEN
                StartIndex = NthP(StartIndex, LEN(LineAsMapped(1)) + 1)
                CALL MapText
            END IF
        NEXT
        CALL ReassignID1
    END IF
    ' Insert
    IF (KH = 20992) THEN
        InsertKey = -InsertKey
    END IF
    ' Del
    IF (KH = 21248) THEN
        IF (LinearCount(StartIndex, ID2) > LinearCount(StartIndex, ID1)) THEN
            r = TheChain(ID2).Pointer
            q = TheChain(ID1).Lagger
            p = ID1
            CALL UnlinkRange(ID1, ID2)
            IF ((r = EOC) AND (q = BOC)) THEN
                ID1 = p
                ID2 = ID1
                StartIndex = p
            ELSE
                IF (q <> BOC) THEN ID1 = q ELSE ID1 = r
                ID2 = NthP(ID1, 2)
            END IF
        END IF
    END IF
    ' F11
    IF (KH = 34048) THEN TextFormatting = -TextFormatting
    ' F12
    IF (KH = 34304) THEN
        TextWrapping = TextWrapping + 1
        IF (TextWrapping > 2) THEN TextWrapping = 0
        ID1 = StartIndex
        ID2 = ID1
        HScroll = 1
    END IF
    ' Exit sequence
    TheReturn = 0
    IF ((MH <> 0) OR (KH > 0)) THEN
        TheReturn = 1
        CALL MapText
        CALL CalibrateCursor(ID1)
        CALL CalibrateCursor(ID2)
        ' Cursor sync and autoscrolling.
        IF (Cursor1.Y > TopIndent + TextHeight - 1) THEN StartIndex = NthP(StartIndex, LEN(LineAsMapped(1)) + 1)
    END IF
    _KEYCLEAR
    StateChange = TheReturn
END FUNCTION
 
SUB CalibrateCursor (a AS LONG)
    ' Place Cursor under ID on rendered line.
    s = StartIndex
    IF ((TextWrapping = 2) AND (HScroll > 1)) THEN s = NthP(s, HScroll)
    c = LinearCount(s, a)
    k = 0
    i = -1
    FOR j = 1 TO VisibleLines
        n = LEN(LineAsMapped(j))
        IF (k + n < c) THEN
            k = k + n
        ELSE
            i = c - k + 1
            EXIT FOR
        END IF
    NEXT
    IF (i >= LeftIndent + LEN(LineAsMapped(j))) THEN
        IF (j <= VisibleLines) THEN
            i = 1
            j = j + 1
        END IF
    END IF
    IF (a = ID1) THEN
        Cursor1.X = LeftIndent + i
        Cursor1.Y = TopIndent + j
    END IF
    IF (a = ID2) THEN
        Cursor2.X = LeftIndent + i
        Cursor2.Y = TopIndent + j
    END IF
END SUB
 
FUNCTION FindID (a AS INTEGER, b AS LONG)
    ' Find identity under a map location.
    RelX = a - LeftIndent
    RelY = b - TopIndent
    FOR k = 1 TO RelY - 1
        t = t + LEN(LineAsMapped(k))
    NEXT
    t = t + RelX
    FindID = t
END FUNCTION
 
SUB ReassignID1
    ' Reassign identity under Cursor1.
    ID1 = NthP(StartIndex, FindID(Cursor1.X, Cursor1.Y) + (HScroll - 1))
END SUB
 
SUB ReassignID2
    ' Reassign identity under Cursor2.
    ID2 = NthP(StartIndex, FindID(Cursor2.X, Cursor2.Y) + (HScroll - 1))
END SUB
 
SUB ConvertToGrid
    FOR j = 1 TO VisibleLines
        c$ = LineAsMapped(j)
        FOR i = 1 TO LEN(c$) - 1 ' BR offset to exclude break return at line end.
            AuxGrid(i, j, 1) = MID$(c$, i, 1)
        NEXT
    NEXT
END SUB
 
SUB ConvertFromGrid
    q$ = ""
    FOR j = 1 TO VisibleLines
        FOR i = 1 TO LEN(LineAsMapped(j)) - 1
            q$ = q$ + AuxGrid(i, j, 1)
        NEXT
        q$ = q$ + CHR$(13) ' Undoes BR offset.
    NEXT
    Assimilate q$
END SUB
 
SUB GOL
    FOR j = 1 TO VisibleLines
        FOR i = 1 TO LEN(LineAsMapped(j)) - 1
            c$ = AuxGrid(i, j, 1)
            IF (c$ = " ") THEN c$ = "0" ELSE c$ = "1"
            AuxGrid(i, j, 1) = c$
            AuxGrid(i, j, 2) = c$
        NEXT
    NEXT
    FOR j = 2 TO VisibleLines - 2 ' BR offset.
        FOR i = 2 TO LEN(LineAsMapped(j)) - 2 ' BR offset.
            c$ = AuxGrid(i, j, 1)
            a1 = VAL(AuxGrid(i - 1, j + 1, 1))
            a2 = VAL(AuxGrid(i, j + 1, 1))
            a3 = VAL(AuxGrid(i + 1, j + 1, 1))
            a4 = VAL(AuxGrid(i - 1, j, 1))
            a6 = VAL(AuxGrid(i + 1, j, 1))
            a7 = VAL(AuxGrid(i - 1, j - 1, 1))
            a8 = VAL(AuxGrid(i, j - 1, 1))
            a9 = VAL(AuxGrid(i + 1, j - 1, 1))
            t = a1 + a2 + a3 + a4 + a6 + a7 + a8 + a9
            IF (c$ = "1") THEN
                SELECT CASE t
                    CASE IS < 2
                        AuxGrid(i, j, 2) = "0"
                    CASE 2
                        AuxGrid(i, j, 2) = "1"
                    CASE 3
                        AuxGrid(i, j, 2) = "1"
                    CASE IS > 3
                        AuxGrid(i, j, 2) = "0"
                END SELECT
            ELSE
                IF (t = 3) THEN AuxGrid(i, j, 2) = "1"
            END IF
        NEXT
    NEXT
    FOR j = 1 TO VisibleLines
        FOR i = 1 TO LEN(LineAsMapped(j)) - 1
            c$ = AuxGrid(i, j, 2)
            IF (c$ = "0") THEN c$ = " " ELSE c$ = CHR$(219)
            AuxGrid(i, j, 1) = c$
            AuxGrid(i, j, 2) = c$
        NEXT
    NEXT
END SUB
 
SUB ThrowOutput
    'i = NthP(ID1, ChainLimit + 1)
    'FOR k = 1 TO LogTextCount
    '    CALL InsertRange(i, LogText(k) + CHR$(13))
    'NEXT
    LogTextCount = 0
    CALL MapText
    ID1 = NthP(ID1, ChainLimit + 1)
    CALL CalibrateCursor(ID1)
    CALL CalibrateCursor(ID2)
    DO WHILE (Cursor1.Y > TopIndent + TextHeight - 1)
        StartIndex = NthP(StartIndex, LEN(LineAsMapped(1)) + 1)
        CALL MapText
        CALL CalibrateCursor(ID1)
        CALL CalibrateCursor(ID2)
    LOOP
    ID1 = NthP(ID1, ChainLimit + 1)
    CALL PrintEverything
END SUB
 
SUB DisplayText (Col AS INTEGER, Row AS INTEGER, Shade1 AS INTEGER, Shade2 AS INTEGER, Text AS STRING)
    COLOR Shade1, Shade2
    _PRINTSTRING (Col, Row), Text
    'LOCATE Row, Col: PRINT Text
END SUB
 
'REM $Include: 'sxmath.bm'
'REM $Include: 'sxript.bm'

_vince · « **Reply #40 on:** January 22, 2019, 09:37:10 am »

Interesting idea, STxExTIC. I've tried yours before, feels like a novel text editor concept, the next vim, stevesque one could even say. It would be interesting to see a clone of vi (way simpler than vim) in QB64 and your routines have all the functionality for it. Maybe Steve 's got something up his sleeve for the field of text editing, let us know by this eve.

FYI, my own LL routines could be repurposed to hold a single character per node like so:

Code: QB64: [Select]

type nodeType
  'remove this:
        'str as _mem
        'strLen as integer
  'for:
        c as string * 1
 
        n as _mem
        p as _mem
end type
 

then you would no longer need readNode$ and writeNode and so on. Handling a string per node takes up a large portion of the code as they're a separate data structure on their own to be allocated, reallocated, and deallocated.

Next thing I will investigate is LLs in freebasic which has the C-style pointer syntax which is very expressive for these kinds of data structures. Most of the LL functions are one liners. LLs can also be repurposed to act as stacks, queues, trees, and other list-like structures. Beyond LLs we have the countless variants of trees, networks, meshes and so on.

bplus · « **Reply #41 on:** January 22, 2019, 10:50:51 am »

I recognize "a linked list" as a special data structure that has some advantages over arrays specially as STxAxTIC and v have described and demonstrated with editors.

But getting back to what Steve was trying to show was a different kind of linking of lists. He didn't seem to take to ideas of databasing and the advanced database term "relational database", so I have another simpler term to try: Concatenate

Isn't Steve simply concatenating lists, adding one to another and showing manipulations of lists both individually and as a whole concatenated list. The tricky part I imagine, is dealing with mixing of different type lists.

SMcNeill · « **Reply #42 on:** January 22, 2019, 12:55:06 pm »

Quote from: bplus on January 22, 2019, 10:50:51 am

Isn't Steve simply concatenating lists, adding one to another and showing manipulations of lists both individually and as a whole concatenated list. The tricky part I imagine, is dealing with mixing of different type lists.

It isn’t really concatenation, as the lists “link” element by element. “Links things together in a chain or series...”

So a list of “1, 2, 3, 4” concatetaned with “5, 6, 7, 8” produces “1,2,3,4,5,6,7,8”... Think “dog” + “food” = “dog-food”.

This takes those 2 lists and “links” them so “1 - 5”, “2 - 6”, “3 - 7”, “4 - 8” all share the same properties and work and behave alike.

What we’re doing here is Linking Relational Database Tables — https://www.relationaldbdesign.com/relational-database-design/module2/linking-relational-database-tables.php.

Quote

The power of relational databases stems from the fact that tables can be linked, enabling users to gain access to data across tables.

Two tables are linked when they have a matching field, that is, a field in each table containing similar data.

And that’s what the demo here does for us. It just doesn’t seem to me that “Linking Relational Database Table Management Library” comes across as a BASIC sounding name, so “Linked Table Library” (or “Linked List Library” as I like to call it since a “LIST” *is* just a table with a single column of information) seems much simpler and more appropriate to me.

News:

Author Topic: Lists Linking Demo (Read 13439 times)

SMcNeill

Re: Lists Linking Demo

Pete

Re: Lists Linking Demo

_vince

Re: Lists Linking Demo

Pete

Re: Lists Linking Demo

SMcNeill

Re: Lists Linking Demo

Pete

Re: Lists Linking Demo

TempodiBasic

Re: Lists Linking Demo

Pete

Re: Lists Linking Demo

_vince

Re: Lists Linking Demo

STxAxTIC

Re: Lists Linking Demo

_vince

Re: Lists Linking Demo

bplus

Re: Lists Linking Demo

SMcNeill

Re: Lists Linking Demo