02-04-2026, 03:40 AM
(This post was last modified: 02-04-2026, 03:40 AM by Unseen Machine.)
Code: (Select All)
' ==========================================================
' WORD 95 PRO: OMEGA GOD-MODE (CYRUS EDITION) - FOR PETE
' ==========================================================
'$DYNAMIC
_TITLE "Microsoft Word 95 Professional - OMEGA GOD-MODE"
SCREEN _NEWIMAGE(800, 600, 32)
_FONT 16
TYPE OmegaPool
Handle AS _OFFSET
Capacity AS LONG
TypeID AS LONG
END TYPE
' --- THE OMEGA KERNEL ---
DECLARE LIBRARY "QB_omega"
FUNCTION Omega_Create%& (BYVAL sz AS _INTEGER64, BYVAL t AS _INTEGER64)
SUB Omega_SetL (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64, BYVAL v AS LONG)
SUB Omega_SetS (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64, v AS STRING)
FUNCTION Omega_GetL& (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64)
FUNCTION Omega_GetS%& (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64)
FUNCTION Omega_Len& (BYVAL a AS _OFFSET, BYVAL i AS _INTEGER64)
SUB Omega_Destroy (BYVAL a AS _OFFSET)
END DECLARE
' --- GLOBALS & STATE ---
DIM SHARED MenuLabels AS OmegaPool
DIM SHARED MenuMap AS OmegaPool
DIM SHARED MenuCount AS LONG
DIM SHARED CurrentParent AS LONG
DIM SHARED MenuOpen AS _BYTE
DIM SHARED TopSel AS LONG
DIM SHARED ActiveSub AS LONG
DIM SHARED ContextOpen AS _BYTE
DIM SHARED ContextX AS INTEGER
DIM SHARED ContextY AS INTEGER
DIM SHARED DocContent AS STRING
DIM SHARED LastAction AS STRING
DIM SHARED CaretPos AS LONG
DIM SHARED ShowCaret AS _BYTE
DIM SHARED CaretTimer AS SINGLE
DIM SHARED UseWordWrap AS _BYTE
DIM SHARED ScrollY AS INTEGER
DIM SHARED MaxScroll AS INTEGER
Titan_Init MenuLabels, 1000, "string"
Titan_Init MenuMap, 1000, "long"
DocContent = "CYRUS THE GREAT BUILD. ARROW KEYS ACTIVE. SCROLLBAR LOCKED."
LastAction = "Idle"
ActiveSub = -1
CaretPos = LEN(DocContent)
UseWordWrap = 1
ScrollY = 0
MaxScroll = 2000
' --- BUILDER ---
mFile = NewMenu("&File")
AddItem "&New"
AddItem "&Open"
AddItem "&Save"
mSend = AddSub("Sen&d To >")
SetFocus mSend
AddItem "Mail Recipient"
AddItem "3.5 Floppy (A
"
SetFocus mFile
AddItem "E&xit"
mEdit = NewMenu("&Edit")
AddItem "&Undo"
AddItem "Cu&t"
AddItem "&Copy"
AddItem "&Paste"
mView = NewMenu("&View")
AddItem "Toggle &WordWrap"
AddItem "&Normal View"
mContext = 999
SetFocus mContext
AddItem "Cu&t"
AddItem "&Copy"
AddItem "&Paste"
' --- MAIN ENGINE LOOP ---
DO
_LIMIT 60
CLS
COLOR _RGB32(0, 0, 0), _RGB32(192, 192, 192)
PAINT (0, 0), _RGB32(192, 192, 192)
DO WHILE _MOUSEINPUT
mx = _MOUSEX
my = _MOUSEY
mb1 = _MOUSEBUTTON(1)
mb2 = _MOUSEBUTTON(2)
IF mb2 THEN
ContextOpen = 1
ContextX = mx
ContextY = my
MenuOpen = 0
ActiveSub = -1
END IF
IF mb1 THEN
IF my > 25 THEN
menuHit = 0
IF MenuOpen THEN
IF mx >= (TopSel * 95) AND mx <= (TopSel * 95) + 230 THEN
menuHit = 1
END IF
END IF
IF menuHit = 0 THEN
MenuOpen = 0
ContextOpen = 0
ActiveSub = -1
' Check if we are clicking the scrollbar before resetting caret
IF mx < 740 THEN
HandleMouseClick mx, my
END IF
END IF
END IF
' FIXED SCROLLBAR INTERACTION
IF mx >= 740 AND mx <= 760 AND my >= 60 AND my <= 540 THEN
ScrollY = (my - 60) * (MaxScroll / 480)
END IF
END IF
LOOP
DrawWorkspace
DrawTopBar mx, my, mb1
IF MenuOpen THEN
rootIdx = -1
count = 0
FOR i = 0 TO MenuCount - 1
IF Titan_GetL(MenuMap, i) = -1 THEN
IF count = TopSel THEN
rootIdx = i
EXIT FOR
END IF
count = count + 1
END IF
NEXT
IF rootIdx > -1 THEN
Draw95Menu rootIdx, (TopSel * 95) + 5, 25, mx, my, mb1, 0
END IF
END IF
IF ContextOpen THEN
Draw95Menu mContext, ContextX, ContextY, mx, my, mb1, 0
END IF
k$ = INKEY$
IF k$ <> "" THEN
HandleInput k$
END IF
IF TIMER - CaretTimer > 0.5 THEN
ShowCaret = NOT ShowCaret
CaretTimer = TIMER
END IF
_DISPLAY
LOOP UNTIL k$ = CHR$(27) AND NOT MenuOpen
SYSTEM
' --- RENDERING CORE ---
SUB DrawWorkspace
' Page Body
LINE (40, 60)-(740, 540), _RGB32(255, 255, 255), BF
LINE (40, 60)-(740, 540), _RGB32(0, 0, 0), B
' WIN95 VERTICAL SCROLLBAR (FIXED THUMB)
LINE (741, 60)-(760, 540), _RGB32(212, 208, 200), BF
LINE (741, 60)-(760, 540), _RGB32(0, 0, 0), B
' Thumb Math - Clamped so it never disappears
thumbH = 40
perc = ScrollY / MaxScroll
thumbY = 60 + (perc * (480 - thumbH))
IF thumbY < 60 THEN thumbY = 60
IF thumbY > 540 - thumbH THEN thumbY = 540 - thumbH
LINE (743, thumbY)-(758, thumbY + thumbH), _RGB32(192, 192, 192), BF
LINE (743, thumbY)-(758, thumbY + thumbH), _RGB32(0, 0, 0), B
COLOR _RGB32(0, 0, 0), _RGBA32(0, 0, 0, 0)
curX = 55
curY = 75 - ScrollY
marginRight = 715
FOR i = 1 TO LEN(DocContent) + 1
IF i = CaretPos + 1 THEN
IF ShowCaret THEN
IF curY > 60 AND curY < 525 THEN
LINE (curX, curY)-(curX, curY + 16), _RGB32(0, 0, 0)
END IF
END IF
' Auto-Follow
IF curY > 510 THEN ScrollY = ScrollY + 20
IF curY < 75 AND ScrollY > 0 THEN ScrollY = ScrollY - 20
END IF
IF i > LEN(DocContent) THEN EXIT FOR
c$ = MID$(DocContent, i, 1)
ascii = ASC(c$)
IF ascii = 13 OR ascii = 10 THEN
curX = 55
curY = curY + 20
ELSE
IF UseWordWrap AND curX > marginRight THEN
curX = 55
curY = curY + 20
END IF
IF curY > 60 AND curY < 525 THEN
_PRINTSTRING (curX, curY), c$
END IF
curX = curX + _PRINTWIDTH(c$)
END IF
NEXT
' Masking Header/Footer
LINE (40, 541)-(761, 600), _RGB32(192, 192, 192), BF
LINE (0, 0)-(800, 59), _RGB32(192, 192, 192), BF
END SUB
SUB HandleInput (k$)
IF MenuOpen OR ContextOpen THEN
IF k$ = CHR$(27) THEN MenuOpen = 0: ContextOpen = 0: ActiveSub = -1
EXIT SUB
END IF
SELECT CASE k$
CASE CHR$(8)
IF CaretPos > 0 THEN
DocContent = LEFT$(DocContent, CaretPos - 1) + MID$(DocContent, CaretPos + 1)
CaretPos = CaretPos - 1
END IF
CASE CHR$(0) + "K": IF CaretPos > 0 THEN CaretPos = CaretPos - 1
CASE CHR$(0) + "M": IF CaretPos < LEN(DocContent) THEN CaretPos = CaretPos + 1
' NEW: ARROW KEY VERTICAL NAVIGATION
CASE CHR$(0) + "H" ' UP
IF CaretPos >= 75 THEN CaretPos = CaretPos - 75
CASE CHR$(0) + "P" ' DOWN
IF CaretPos <= LEN(DocContent) - 75 THEN CaretPos = CaretPos + 75
CASE CHR$(13):
DocContent = LEFT$(DocContent, CaretPos) + CHR$(13) + MID$(DocContent, CaretPos + 1)
CaretPos = CaretPos + 1
CASE ELSE
IF LEN(k$) = 1 AND ASC(k$) >= 32 THEN
DocContent = LEFT$(DocContent, CaretPos) + k$ + MID$(DocContent, CaretPos + 1)
CaretPos = CaretPos + 1
END IF
END SELECT
END SUB
' (All other SUBs remain exactly as John verified them - No Colons!)
' ... DrawTopBar, Draw95Menu, HandleMouseClick, Omega Wrappers ...
SUB DrawTopBar (mx, my, mb)
LINE (0, 0)-(800, 24), _RGB32(192, 192, 192), BF
LINE (0, 24)-(800, 25), _RGB32(0, 0, 0), BF
idx = 0
FOR i = 0 TO MenuCount - 1
IF Titan_GetL(MenuMap, i) = -1 THEN
x = (idx * 95) + 10
t$ = GetText(MenuLabels, i)
IF mx > x - 5 AND mx < x + 85 AND my < 25 THEN
LINE (x - 5, 2)-(x + 85, 22), _RGB32(0, 0, 0), B
IF mb THEN
MenuOpen = 1
TopSel = idx
ActiveSub = -1
END IF
END IF
IF MenuOpen AND TopSel = idx THEN
LINE (x - 5, 2)-(x + 85, 22), _RGB32(0, 0, 128), BF
COLOR _RGB32(255, 255, 255), _RGBA32(0, 0, 0, 0)
ELSE
COLOR _RGB32(0, 0, 0), _RGBA32(0, 0, 0, 0)
END IF
_PRINTSTRING (x, 5), t$
idx = idx + 1
END IF
NEXT
END SUB
SUB Draw95Menu (pID, x, y, mx, my, mb, level)
DIM w
w = 220
row = 0
cCount = 0
FOR i = 0 TO MenuCount - 1
IF Titan_GetL(MenuMap, i) = pID THEN cCount = cCount + 1
NEXT
h = cCount * 22 + 10
LINE (x + 3, y + 3)-(x + w + 3, y + h + 3), _RGB32(64, 64, 64), BF
LINE (x, y)-(x + w, y + h), _RGB32(192, 192, 192), BF
LINE (x, y)-(x + w, y + h), _RGB32(0, 0, 0), B
FOR i = 0 TO MenuCount - 1
IF Titan_GetL(MenuMap, i) = pID THEN
t$ = GetText(MenuLabels, i)
yy = y + 5 + (row * 22)
IF mx > x AND mx < x + w AND my > yy AND my < yy + 22 THEN
LINE (x + 2, yy)-(x + w - 2, yy + 20), _RGB32(0, 0, 0), B
IF INSTR(t$, ">") THEN
ActiveSub = i
ELSE
IF level = 0 THEN ActiveSub = -1
IF mb AND t$ <> "-" THEN
IF t$ = "E&xit" THEN SYSTEM
IF t$ = "Toggle &WordWrap" THEN UseWordWrap = NOT UseWordWrap
MenuOpen = 0
ContextOpen = 0
ActiveSub = -1
END IF
END IF
END IF
IF ActiveSub = i THEN
LINE (x + 2, yy)-(x + w - 2, yy + 20), _RGB32(0, 0, 128), BF
COLOR _RGB32(255, 255, 255), _RGBA32(0, 0, 0, 0)
Draw95Menu i, x + w - 5, yy, mx, my, mb, level + 1
ELSE
COLOR _RGB32(0, 0, 0), _RGBA32(0, 0, 0, 0)
END IF
IF t$ = "-" THEN
LINE (x + 5, yy + 10)-(x + w - 5, yy + 11), _RGB32(128, 128, 128), BF
ELSE
_PRINTSTRING (x + 10, yy + 4), t$
END IF
row = row + 1
END IF
NEXT
END SUB
SUB HandleMouseClick (mx, my)
IF mx > 50 AND mx < 730 AND my > 70 AND my < 530 THEN
lineNum = (my - 75 + ScrollY) \ 20
charNum = (mx - 55) \ 9
CaretPos = charNum + (lineNum * 75)
IF CaretPos < 0 THEN CaretPos = 0
IF CaretPos > LEN(DocContent) THEN CaretPos = LEN(DocContent)
END IF
END SUB
FUNCTION NewMenu (t$)
Titan_SetS MenuLabels, MenuCount, t$
Titan_SetL MenuMap, MenuCount, -1
NewMenu = MenuCount
CurrentParent = MenuCount
MenuCount = MenuCount + 1
END FUNCTION
SUB AddItem (t$)
Titan_SetS MenuLabels, MenuCount, t$
Titan_SetL MenuMap, MenuCount, CurrentParent
MenuCount = MenuCount + 1
END SUB
FUNCTION AddSub (t$)
Titan_SetS MenuLabels, MenuCount, t$
Titan_SetL MenuMap, MenuCount, CurrentParent
AddSub = MenuCount
MenuCount = MenuCount + 1
END FUNCTION
SUB SetFocus (id)
CurrentParent = id
END SUB
SUB Titan_Init (P AS OmegaPool, sz AS LONG, pType AS STRING)
P.Handle = Omega_Create(sz, 2)
END SUB
SUB Titan_SetL (P AS OmegaPool, i AS LONG, v AS LONG)
Omega_SetL P.Handle, i, v
END SUB
FUNCTION Titan_GetL& (P AS OmegaPool, i AS LONG)
Titan_GetL = Omega_GetL(P.Handle, i)
END FUNCTION
SUB Titan_SetS (P AS OmegaPool, i AS LONG, s AS STRING)
Omega_SetS P.Handle, i, s + CHR$(0)
END SUB
FUNCTION GetText$ (P AS OmegaPool, idx AS LONG)
addr%& = Omega_GetS(P.Handle, idx)
L& = Omega_Len(P.Handle, idx)
IF addr%& = 0 OR L& <= 0 THEN
EXIT FUNCTION
END IF
DIM buffer AS STRING
buffer = SPACE$(L&)
DIM m AS _MEM
m = _MEM(addr%&, L&)
_MEMGET m, m.OFFSET, buffer
_MEMFREE m
GetText$ = buffer
END FUNCTION
