' Define fundamental structures.
MemLimit = 64000
BOC = -1
EOC = MemLimit
' Define text window properties.
TextWrapping = 1
TextFormatting = -1
TopIndent = 1
LeftIndent = 1
TextHeight
= _HEIGHT - 2 * TopIndent
TextWidth
= _WIDTH - 2 * LeftIndent
HScroll = 1
InsertKey = 1
' Initiate text inside window.
DIM SHARED StartIndex
' First visible character address.
' Load text file into memory if applicable, use example string if not.
q$ = ""
'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."
' Create memory space for string.
' Create character list.
' Prime main loop.
CALL CalibrateCursor
(ID1
) CALL CalibrateCursor
(ID2
)
IF StateChange
THEN PrintEverything
FOR i
= 1 TO VisibleLines
c$ = LineAsMapped(i)
IF ((TextFormatting
= 1) AND (TextWrapping
<> 2)) THEN c$ = c$ + "_"
c$ = "qXed" + DEBUG$
p1 = LinearCount(StartIndex, ID1)
p2 = LinearCount(StartIndex, ID2)
pe = LinearCount(StartIndex, EOC)
c$ = TheChain(ID2).Content
c$ = TheChain(ID1).Content
d$ = TheChain(ID1).Content
e$ = TheChain(ID2).Content
IF (LinearCount
(StartIndex
, ID2
) > LinearCount
(StartIndex
, ID1
)) THEN
p = LinearCount(ID1, NthP(ID1, MemLimit + 1))
q = LinearCount(NthL(ID1, MemLimit + 1), NthP(ID1, MemLimit + 1))
c$ = "[F6=Save] [F11=Formatting] [F12=Wrapping: " + d$ + "]"
IF (TextWrapping
= 2) THEN c$
= "[F1/2=HScroll] " + c$
c$ = "[Esc=Sync] [Mouse2=Copy] [Mouse3=Paste]"
IF (InsertKey
= 1) THEN c$
= "[Ins] " + c$
' Load a string to initialize chain.
TheChain(k).Identity = 0
StartIndex = 1
PreviousIdentity = BOC
NextIdentity = NextOpenIdentity(StartIndex)
j = NextIdentity
TheChain(j).Identity = j
TheChain
(j
).Content
= ReFormat$
(MID$(a
, k
, 1)) TheChain(j).Lagger = PreviousIdentity
PreviousIdentity = j
NextIdentity = NextOpenIdentity(j)
TheChain(j).Pointer = NextIdentity
TheChain(j).Pointer = EOC
PRINT TheChain
(j
).Content
ID1 = StartIndex
ID2 = ID1
c$ = a
ReFormat = c$
' Returns the address that is b jumps ahead of address a.
i = a
k = 0
j = 0
k = k + 1
j = TheChain(i).Identity
i = TheChain(j).Pointer
NthP = j
' Returns the address holding b first enLinearCountered from a.
i = a
j = TheChain(i).Identity
i = TheChain(j).Pointer
j = BOC
NthPC = j
' Returns the address that is b jumps behind address a.
i = a
k = 0
k = k + 1
j = TheChain(i).Identity
i = TheChain(j).Lagger
NthL = j
' Returns first nonzero identity.
PRINT "Out of memory: "; MemLimit
NextOpenIdentity = j
' Function for scrolling up.
j = a
lastbreak = 0
c$ = ""
k = TheChain(j).Lagger
lastbreak = j
j = k
d$ = TheChain(j).Content
IF ((TextWrapping
= 1) AND (d$
= " ")) THEN lastbreak
= j
c$ = d$ + c$
IF (lastbreak
<> 0) THEN j
= TheChain
(lastbreak
).Identity
BackBreak = j
' 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
' 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
' Inserts a sub-chain anywhere.
' Remove single cell from chain and clear identity.
ap = TheChain(a).Pointer
al = TheChain(a).Lagger
TheChain(a).Content = " "
'ID1 = a
'ID2 = ID1
TheChain(a).Identity = 0
TheChain(al).Pointer = ap
TheChain(ap).Lagger = al
IF (ap
= EOC
) THEN TheChain
(al
).Pointer
= EOC
StartIndex = ap
TheChain(ap).Lagger = BOC
' Remove sub-chain and clear identity of each cell.
bp = TheChain(b).Pointer
al = TheChain(a).Lagger
CALL UnlinkRange
(NthP
(a
, 2), b
) TheChain(a).Content = " "
TheChain(a).Pointer = bp
k = a
TheChain(k).Identity = 0
k = TheChain(k).Pointer
TheChain(b).Identity = 0
TheChain(bp).Lagger = al
IF (al
= BOC
) THEN StartIndex
= bp
ELSE TheChain
(al
).Pointer
= bp
' Returns number of links between two addresses.
i = a
k = 0
k = k + 1
j = TheChain(i).Identity
i = TheChain(j).Pointer
LinearCount = k
' Returns the linear content for all address between a and b, inclusive.
TheReturn = ""
TheReturn = TheChain(a).Content
j = a
c$ = TheChain(j).Content
TheReturn = TheReturn + c$
k = TheChain(j).Pointer
j = k
Projection$ = TheReturn
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$ = ""
IF (TextWrapping
= 2) THEN r
= MemLimit
+ 1 k1 = NthP(j, r)
c1 = LinearCount(j, k1)
c2 = LinearCount(j, k2)
IF (c2
= 0) THEN ' Line is blank-returned. k = k2
q$ = q$ + br$
j = NthP(k, 2)
IF (c1
= c2
) THEN ' Possible end of chain. k = TheChain(k1).Lagger
q$ = q$ + Projection$(j, k)
j = NthP(k, 2)
IF (c1
< c2
) THEN ' Width limit case (not always maximum). k = k1
q$ = q$ + Projection$(j, k)
j = NthP(k, 2)
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 (TextWrapping
= 1) THEN ' Wrap text at first space from right, send remainder to next line. d$ = c$ + d$
IF (m
= 1) THEN ' Line is too long for allowed space and contains no wrapping characters. q$
= LEFT$(q$
, TextWidth
) d$ = ""
LineAsMapped(i) = q$
i = i + 1
VisibleLines = i - 1
TheReturn = 0
MH = 0
IF (MH1
= -1) THEN ' Move Cursor1. MH = 1
q
= LeftIndent
+ LEN(LineAsMapped
(_MOUSEY - TopIndent
)) IF (Cursor1.X
> q
) THEN Cursor1.X
= q
IF (MH2
= -1) THEN ' Move Cursor2 and copy anything between Cursor1 and Cursor2 to clipboard. MH = 1
q
= LeftIndent
+ LEN(LineAsMapped
(_MOUSEY - TopIndent
)) IF (Cursor2.X
> q
) THEN Cursor2.X
= q
IF (LinearCount
(StartIndex
, ID2
) > LinearCount
(StartIndex
, ID1
)) THEN _CLIPBOARD$ = Projection$
(ID1
, ID2
) IF (MH3
= -1) THEN ' Paste at Cursor1 position. MH = 1
KH = 0
' Bksp
r = TheChain(ID1).Pointer
q = TheChain(ID1).Lagger
' Tab
' Esc
IF (ID2
<> ID1
) THEN ID2
= ID1
ELSE ID2
= NthL
(ID2
, MemLimit
+ 1) ' Enter, Alphanumerics
ID1 = NthP(ID1, 2)
ID1 = NthP(ID1, 2)
ID2 = ID1
ID1 = NthP(ID1, 2)
' F1
HScroll = HScroll - 1
IF (HScroll
< 1) THEN HScroll
= 1 ' F2
HScroll = HScroll + 1
' F5
q$ = Projection$(NthL(ID1, MemLimit + 1), NthP(ID1, MemLimit + 1))
Assimilate q$
' F4
'CALL InsertRange(NthP(ID2, 2), "=" + SxriptEval$(Projection(ID1, ID2)))
' F6
q$ = Projection$(NthL(ID1, MemLimit + 1), NthP(ID1, MemLimit + 1))
' F7
' F8
' Home
IF (TextWrapping
= 2) THEN HScroll
= 1 Cursor1.X = LeftIndent + 1
' UpArrow
IF (Cursor1.Y
> TopIndent
+ 1) THEN Cursor1.Y = Cursor1.Y - 1
StartIndex = BackBreak(StartIndex)
q
= LEN(LineAsMapped
(Cursor1.Y
- TopIndent
)) + 1 IF (Cursor1.X
> q
) THEN Cursor1.X
= q
' LeftArrow
ID1 = NthL(ID1, 2)
IF (Cursor1.X
= LeftIndent
+ 1) THEN HScroll = HScroll - 1
j = Cursor1.Y - TopIndent - 1
k
= LEN(LineAsMapped
(j
)) - TextWidth
+ 1 HScroll = k
' RightArrow
ID1 = NthP(ID1, 2)
m = Cursor1.X - LeftIndent
n
= LEN(LineAsMapped
(Cursor1.Y
- TopIndent
)) - HScroll
+ 1 HScroll = HScroll + 1
j = Cursor1.Y - TopIndent + 1
HScroll = 1
' End
Cursor1.X
= LeftIndent
+ LEN(LineAsMapped
(Cursor1.Y
- TopIndent
)) q
= LEN(LineAsMapped
(Cursor1.Y
- TopIndent
)) - TextWidth
+ 1 ' DownArrow
IF (Cursor1.Y
= TopIndent
+ VisibleLines
) THEN StartIndex
= NthP
(StartIndex
, LEN(LineAsMapped
(1)) + 1) Cursor1.Y = Cursor1.Y + 1
q
= LEN(LineAsMapped
(Cursor1.Y
- TopIndent
)) + 1 Cursor1.X = q
' Insert
InsertKey = -InsertKey
' Del
IF (LinearCount
(StartIndex
, ID2
) > LinearCount
(StartIndex
, ID1
)) THEN r = TheChain(ID2).Pointer
q = TheChain(ID1).Lagger
p = ID1
CALL UnlinkRange
(ID1
, ID2
) ID1 = p
ID2 = ID1
StartIndex = p
ID2 = NthP(ID1, 2)
' F11
IF (KH
= 34048) THEN TextFormatting
= -TextFormatting
' F12
TextWrapping = TextWrapping + 1
IF (TextWrapping
> 2) THEN TextWrapping
= 0 ID1 = StartIndex
ID2 = ID1
HScroll = 1
' Cursor sync and autoscrolling.
TheReturn = 1
CALL CalibrateCursor
(ID1
) CALL CalibrateCursor
(ID2
) IF (Cursor1.Y
> TopIndent
+ TextHeight
- 1) THEN StartIndex
= NthP
(StartIndex
, LEN(LineAsMapped
(1)) + 1) StateChange = TheReturn
' 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
FOR j
= 1 TO VisibleLines
k = k + n
i = c - k + 1
IF (i
>= LeftIndent
+ LEN(LineAsMapped
(j
))) THEN i = LeftIndent
j = j + 1
i
= LeftIndent
+ LEN(LineAsMapped
(j
)) Cursor1.X = LeftIndent + i
Cursor1.Y = TopIndent + j
Cursor2.X = LeftIndent + i
Cursor2.Y = TopIndent + j
' Find identity under a map location.
RelX = a - LeftIndent
RelY = b - TopIndent
t
= t
+ LEN(LineAsMapped
(k
)) t = t + RelX
FindID = t
' Reassign identity under Cursor1.
ID1 = NthP(StartIndex, FindID(Cursor1.X, Cursor1.Y) + (HScroll - 1))
' Reassign identity under Cursor2.
ID2 = NthP(StartIndex, FindID(Cursor2.X, Cursor2.Y) + (HScroll - 1))
FOR j
= 1 TO VisibleLines
c$ = LineAsMapped(j)
FOR i
= 1 TO LEN(c$
) - 1 ' BR offset to exclude break return at line end. FunGrid
(i
, j
, 1) = MID$(c$
, i
, 1)
q$ = ""
FOR j
= 1 TO VisibleLines
q$ = q$ + FunGrid(i, j, 1)
q$
= q$
+ CHR$(13) ' Undoes BR offset. Assimilate q$
FOR j
= 1 TO VisibleLines
c$ = FunGrid(i, j, 1)
FunGrid(i, j, 1) = c$
FunGrid(i, j, 2) = c$
FOR j
= 2 TO VisibleLines
- 2 ' BR offset. FOR i
= 2 TO LEN(LineAsMapped
(j
)) - 2 ' BR offset. c$ = FunGrid(i, j, 1)
a1
= VAL(FunGrid
(i
- 1, j
+ 1, 1)) a2
= VAL(FunGrid
(i
, j
+ 1, 1)) a3
= VAL(FunGrid
(i
+ 1, j
+ 1, 1)) a4
= VAL(FunGrid
(i
- 1, j
, 1)) a6
= VAL(FunGrid
(i
+ 1, j
, 1)) a7
= VAL(FunGrid
(i
- 1, j
- 1, 1)) a8
= VAL(FunGrid
(i
, j
- 1, 1)) a9
= VAL(FunGrid
(i
+ 1, j
- 1, 1)) t = a1 + a2 + a3 + a4 + a6 + a7 + a8 + a9
FunGrid(i, j, 2) = "0"
FunGrid(i, j, 2) = "1"
FunGrid(i, j, 2) = "1"
FunGrid(i, j, 2) = "0"
IF (t
= 3) THEN FunGrid
(i
, j
, 2) = "1" FOR j
= 1 TO VisibleLines
c$ = FunGrid(i, j, 2)
FunGrid(i, j, 1) = c$
FunGrid(i, j, 2) = c$