'$EXEICON:'qXedlogo.ico'
'$RESIZE:ON
'REM $Include: 'sxmath.bi'
'REM $Include: 'sxript.bi'
'_FREEIMAGE scrHand&
' Define fundamental structures.
ChainLimit = 128000
BOC = -1
EOC = ChainLimit
' Define text window properties.
TopIndent = 1
LeftIndent = 1
TextHeight = WindowHeight - 2 * TopIndent
TextWidth = WindowWidth - 2 * LeftIndent
HScroll = 1
TextWrapping = 0
TextFormatting = -1
InsertKey = -1
' Initiate text inside window.
' Auxiliary 2D text grid.
GOLSwitch = -1
' 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." 'q$ = " "
' Create memory space for string. a
' Create character list.
' Prime main loop.
CALL CalibrateCursor
(ID1
) CALL CalibrateCursor
(ID2
)
' Main loop.
'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
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 c$ = c$ + "_"
d$
= MID$(c$
, HScroll
, TextWidth
) CALL DisplayText
(LeftIndent
+ 1, TopIndent
+ i
, 7, 1, d$
)
' 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)
c$ = TheChain(ID2).Content
CALL DisplayText
(Cursor2.X
, Cursor2.Y
, 0, 6, c$
)
' Cursor1
IF ((Cursor1.X
> 0 AND Cursor1.X
< WindowWidth
) AND ((Cursor1.Y
> 0) AND (Cursor1.Y
< WindowHeight
))) THEN c$ = TheChain(ID1).Content
IF ((Cursor1.X
= Cursor2.X
) AND (Cursor1.Y
= Cursor2.Y
)) THEN a = 16: b = 5
a = 16: b = 3
CALL DisplayText
(Cursor1.X
, Cursor1.Y
, a
, b
, c$
)
' Cursor status
d$ = TheChain(ID1).Content
e$ = TheChain(ID2).Content
a = 0: b = 3
IF ((Cursor1.X
= Cursor2.X
) AND (Cursor1.Y
= Cursor2.Y
)) THEN a = 15: b = 5
CALL DisplayText
(2, WindowHeight
, a
, b
, c$
) a = 6: b = 0
IF (LinearCount
(StartIndex
, ID2
) > LinearCount
(StartIndex
, ID1
)) THEN a = 0: b = 6
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
i
= 2 + INT(r
* (WindowWidth
- 2)) 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))
CALL DisplayText
(WindowWidth
, 1 + INT(r
* (WindowHeight
- 1)), 8, 7, "<")
' Help
c$ = "[F6=Save] [F11=Format] [F12=Wrap: " + d$ + "]"
IF (TextWrapping
= 2) THEN c$
= "[F1/2=HScroll] " + c$
CALL DisplayText
(WindowWidth
- LEN(c$
), 1, 15, 0, c$
) c$ = "[Esc=Sync] [Mouse2=Copy] [Mouse3=Paste]"
IF (InsertKey
= 1) THEN c$
= "[Ins] " + c$
CALL DisplayText
(WindowWidth
- LEN(c$
), WindowHeight
, 15, 0, c$
)
' Pointer
' 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 = NthP(ID1, ChainLimit + 1)
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: "; ChainLimit
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 number of links between two addresses, with exit condition.
i = a
k = 0
k = k + 1
j = TheChain(i).Identity
i = TheChain(j).Pointer
LinearCount2 = 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 k1
= NthP
(j
, r
) ELSE k1
= EOC
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)
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
MH = 0
MW = 0
MT = 0
MW = MT
' Move Cursor1 among text.
MH = 1
q
= LeftIndent
+ LEN(LineAsMapped
(_MOUSEY - TopIndent
)) IF (Cursor1.X
> q
) THEN Cursor1.X
= q
' Move by vertical scrollbar.
i = NthL(ID1, ChainLimit + 1)
j = NthP(ID1, ChainLimit + 1)
t = LinearCount(i, j)
i = TheChain(i).Pointer
StartIndex = i
ID1 = i
' Move by horizontal scrollbar.
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))
t
= LEN(LineAsMapped
(Cursor1.Y
- TopIndent
)) i = TheChain(i).Pointer
ID1 = i
d = LinearCount(StartIndex, i) - LinearCount(StartIndex, j)
IF (TextWrapping
= 2) THEN HScroll
= HScroll
+ d
IF HScroll
< 1 THEN HScroll
= 1 ' 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
) ' Paste at Cursor1 position.
MH = 1
'IF (LinearCount(StartIndex, ID2) >= LinearCount(StartIndex, ID1)) THEN
' Wheel up
MH = 1
StartIndex = BackBreak(StartIndex)
' Wheel down
MH = 1
StartIndex
= NthP
(StartIndex
, LEN(LineAsMapped
(1)) + 1)
KH = 0
'''k$ = ""
'''k$ = INKEY$
'''IF k$ <> "" THEN KH = ASC(k$)
' Bksp
r = TheChain(ID1).Pointer
q = TheChain(ID1).Lagger
' Tab
' Esc
IF (ID2
<> ID1
) THEN ID2
= ID1
ELSE ID2
= StartIndex
'NthL(ID2, 2) ' Enter, Alphanumerics
ID1 = NthP(ID1, 2)
ID1 = NthP(ID1, 2)
ID2 = ID1
ID1 = NthP(ID1, 2)
IF ((TextWrapping
= 2) AND (Cursor1.X
- LeftIndent
= TextWidth
)) THEN HScroll
= HScroll
+ 1 ' F1
HScroll = HScroll - 1
IF (HScroll
< 1) THEN HScroll
= 1 ' F2
HScroll = HScroll + 1
' F5
q$ = Projection$(NthL(ID1, ChainLimit + 1), NthP(ID1, ChainLimit + 1))
Assimilate q$
' 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
q$ = Projection$(NthL(ID1, ChainLimit + 1), NthP(ID1, ChainLimit + 1))
' F7
GOLSwitch = -GOLSwitch
' F8 IF (KH = 16896) THEN
' 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
' PgUp
StartIndex = BackBreak(StartIndex)
' 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
IF ((Cursor1.X
- LeftIndent
= 1) AND Cursor1.Y
- TopIndent
= 1) THEN StartIndex = BackBreak(StartIndex)
' 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
IF ((j
<= TextHeight
) AND (VisibleLines
> 1)) THEN HScroll
= 1 IF ((m
>= n
) AND (Cursor1.Y
- TopIndent
= VisibleLines
)) THEN IF (VisibleLines
> 1) THEN StartIndex
= NthP
(StartIndex
, LEN(LineAsMapped
(1)) + 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
' PgDn
StartIndex
= NthP
(StartIndex
, LEN(LineAsMapped
(1)) + 1) ' 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
' Exit sequence
TheReturn = 0
TheReturn = 1
CALL CalibrateCursor
(ID1
) CALL CalibrateCursor
(ID2
) ' Cursor sync and autoscrolling.
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
i = -1
FOR j
= 1 TO VisibleLines
k = k + n
i = c - k + 1
IF (i
>= LeftIndent
+ LEN(LineAsMapped
(j
))) THEN i = 1
j = j + 1
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. AuxGrid
(i
, j
, 1) = MID$(c$
, i
, 1)
q$ = ""
FOR j
= 1 TO VisibleLines
q$ = q$ + AuxGrid(i, j, 1)
q$
= q$
+ CHR$(13) ' Undoes BR offset. Assimilate q$
FOR j
= 1 TO VisibleLines
c$ = AuxGrid(i, j, 1)
AuxGrid(i, j, 1) = c$
AuxGrid(i, j, 2) = c$
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
AuxGrid(i, j, 2) = "0"
AuxGrid(i, j, 2) = "1"
AuxGrid(i, j, 2) = "1"
AuxGrid(i, j, 2) = "0"
IF (t
= 3) THEN AuxGrid
(i
, j
, 2) = "1" FOR j
= 1 TO VisibleLines
c$ = AuxGrid(i, j, 2)
AuxGrid(i, j, 1) = c$
AuxGrid(i, j, 2) = c$
'i = NthP(ID1, ChainLimit + 1)
'FOR k = 1 TO LogTextCount
' CALL InsertRange(i, LogText(k) + CHR$(13))
'NEXT
LogTextCount = 0
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 CalibrateCursor
(ID1
) CALL CalibrateCursor
(ID2
) ID1 = NthP(ID1, ChainLimit + 1)
'LOCATE Row, Col: PRINT Text
'REM $Include: 'sxmath.bm'
'REM $Include: 'sxript.bm'