Files
five/examples/tbrowse.prg
Charles KWON OhJun 59568f3301 Five v0.9 — Harbour + Go fusion language
- Compiler: PP → Lexer → Parser → Analyzer → Gengo pipeline
- Parser: 232/236 (98%) Harbour compatibility, registry-based dispatch
- RTL: 351 Harbour-compatible functions
- RDD: DBF/NTX/CDX engines with Rushmore bitmap optimization
- Go Interop: IMPORT + pkg.Func() + obj:Method() with FastPath (15M calls/sec)
- HB_FUNC API: Full Harbour C API compatible Go bridge
- Concurrency: SPAWN/LAUNCH/GOROUTINE, <-, WATCH, PARALLEL FOR, ASYNC/AWAIT
- Extensions: Multi-return, DEFER, Slice, f-string, Nil-safe ?:, CONST
- Macro Compiler: Runtime AST parsing and evaluation
- Debugger: TUI debugger with source display, breakpoints, stepping
- FRB: Native + Pcode dual mode runtime binary
- Tests: 13 packages ALL PASS

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-31 09:41:50 +09:00

397 lines
8.7 KiB
Plaintext

// Five TBrowse — ported from Harbour src/rtl/tbrowse.prg
// Minimal implementation for dbEdit functionality
// Full Harbour TBrowse: 2719 lines — this is the essential core
// ============================================================
// TBColumn class
// ============================================================
CLASS TBColumn
DATA cHeading INIT ""
DATA bBlock INIT NIL
DATA cColSep INIT ""
DATA cHeadSep INIT ""
DATA cFootSep INIT ""
DATA cFooting INIT ""
DATA nWidth INIT 0
DATA cPicture INIT ""
METHOD Init(cHeading, bBlock)
ENDCLASS
METHOD Init(cHeading, bBlock) CLASS TBColumn
::cHeading := cHeading
::bBlock := bBlock
RETURN Self
// Constructor function
FUNCTION TBColumnNew(cHeading, bBlock)
RETURN TBColumn():Init(cHeading, bBlock)
// ============================================================
// TBrowse class
// ============================================================
CLASS TBrowse
DATA nTop INIT 0
DATA nLeft INIT 0
DATA nBottom INIT 24
DATA nRight INIT 79
DATA aColumns INIT {}
DATA nColPos INIT 1
DATA nRowPos INIT 1
DATA nRowCount INIT 0
DATA nColOffset INIT 1
DATA bSkipBlock INIT NIL
DATA bGoTopBlock INIT NIL
DATA bGoBottomBlock INIT NIL
DATA cHeadSep INIT ""
DATA cColSep INIT ""
DATA cFootSep INIT ""
DATA cColorSpec INIT ""
DATA lStable INIT .F.
DATA lHitTop INIT .F.
DATA lHitBottom INIT .F.
DATA lAutoLite INIT .T.
DATA lConfigured INIT .F.
METHOD Init(nTop, nLeft, nBottom, nRight)
METHOD addColumn(oCol)
METHOD getColumn(n)
METHOD colCount()
METHOD up()
METHOD down()
METHOD left()
METHOD right()
METHOD pageUp()
METHOD pageDown()
METHOD goTop()
METHOD goBottom()
METHOD home()
METHOD end()
METHOD stabilize()
METHOD forceStable()
METHOD refreshAll()
METHOD refreshCurrent()
METHOD hiLite()
METHOD deHilite()
METHOD configure()
METHOD dispRow(nRow)
METHOD dispFrames()
ENDCLASS
METHOD Init(nTop, nLeft, nBottom, nRight) CLASS TBrowse
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
::nRowCount := nBottom - nTop - 1
IF ::nRowCount < 1
::nRowCount := 1
ENDIF
RETURN Self
METHOD addColumn(oCol) CLASS TBrowse
AAdd(::aColumns, oCol)
RETURN Self
METHOD getColumn(n) CLASS TBrowse
IF n >= 1 .AND. n <= Len(::aColumns)
RETURN ::aColumns[n]
ENDIF
RETURN NIL
METHOD colCount() CLASS TBrowse
RETURN Len(::aColumns)
// --- Navigation ---
METHOD down() CLASS TBrowse
LOCAL nSkipped
IF ::nRowPos < ::nRowCount
// Cursor within screen: skip one record
nSkipped := Eval(::bSkipBlock, 1)
IF nSkipped > 0
::nRowPos += 1
ELSE
::lHitBottom := .T.
ENDIF
ELSE
// Cursor at bottom: scroll data
nSkipped := Eval(::bSkipBlock, 1)
IF nSkipped <= 0
::lHitBottom := .T.
ENDIF
ENDIF
::lStable := .F.
RETURN Self
METHOD up() CLASS TBrowse
LOCAL nSkipped
IF ::nRowPos > 1
nSkipped := Eval(::bSkipBlock, -1)
IF nSkipped < 0
::nRowPos -= 1
ELSE
::lHitTop := .T.
ENDIF
ELSE
nSkipped := Eval(::bSkipBlock, -1)
IF nSkipped >= 0
::lHitTop := .T.
ENDIF
ENDIF
::lStable := .F.
RETURN Self
METHOD pageDown() CLASS TBrowse
LOCAL nSkipped := Eval(::bSkipBlock, ::nRowCount)
IF nSkipped <= 0
::lHitBottom := .T.
ENDIF
::lStable := .F.
RETURN Self
METHOD pageUp() CLASS TBrowse
LOCAL nSkipped := Eval(::bSkipBlock, -::nRowCount)
IF nSkipped >= 0
::lHitTop := .T.
ENDIF
::lStable := .F.
RETURN Self
METHOD goTop() CLASS TBrowse
Eval(::bGoTopBlock)
::nRowPos := 1
::lStable := .F.
RETURN Self
METHOD goBottom() CLASS TBrowse
Eval(::bGoBottomBlock)
::nRowPos := ::nRowCount
::lStable := .F.
RETURN Self
METHOD left() CLASS TBrowse
IF ::nColPos > 1
::nColPos -= 1
IF ::nColPos < ::nColOffset
::nColOffset := ::nColPos
ENDIF
ENDIF
::lStable := .F.
RETURN Self
METHOD right() CLASS TBrowse
IF ::nColPos < Len(::aColumns)
::nColPos += 1
ENDIF
::lStable := .F.
RETURN Self
METHOD home() CLASS TBrowse
::nColPos := 1
::nColOffset := 1
::lStable := .F.
RETURN Self
METHOD end() CLASS TBrowse
::nColPos := Len(::aColumns)
::lStable := .F.
RETURN Self
// --- Display ---
METHOD configure() CLASS TBrowse
::lConfigured := .T.
RETURN Self
METHOD stabilize() CLASS TBrowse
IF !::lConfigured
::configure()
ENDIF
::dispFrames()
// Position back to current row
LOCAL nSaveSkip := Eval(::bSkipBlock, -(::nRowPos - 1))
LOCAL i
FOR i := 1 TO ::nRowCount
::dispRow(i)
IF i < ::nRowCount
Eval(::bSkipBlock, 1)
ENDIF
NEXT
// Restore to current position
Eval(::bSkipBlock, -(::nRowCount - ::nRowPos))
::lStable := .T.
::lHitTop := .F.
::lHitBottom := .F.
RETURN .T.
METHOD forceStable() CLASS TBrowse
DO WHILE !::lStable
::stabilize()
ENDDO
RETURN Self
METHOD refreshAll() CLASS TBrowse
::lStable := .F.
RETURN Self
METHOD refreshCurrent() CLASS TBrowse
::lStable := .F.
RETURN Self
METHOD dispFrames() CLASS TBrowse
LOCAL i, oCol, x, cSep, nWidth
// Ensure colOffset makes colPos visible
IF ::nColPos < ::nColOffset
::nColOffset := ::nColPos
ENDIF
// Check if colPos fits on screen
DO WHILE .T.
x := ::nLeft
LOCAL lVisible := .F.
FOR i := ::nColOffset TO Len(::aColumns)
oCol := ::aColumns[i]
nWidth := ::colWidth(oCol)
IF x + nWidth > ::nRight + 1
EXIT
ENDIF
x += nWidth
IF i = ::nColPos
lVisible := .T.
EXIT
ENDIF
IF Len(::cColSep) > 0
x += Len(::cColSep)
ENDIF
NEXT
IF lVisible
EXIT
ENDIF
::nColOffset += 1
ENDDO
// Draw header
SetPos(::nTop, ::nLeft)
x := ::nLeft
FOR i := ::nColOffset TO Len(::aColumns)
oCol := ::aColumns[i]
nWidth := ::colWidth(oCol)
IF x + nWidth > ::nRight + 1
EXIT
ENDIF
IF i = ::nColPos
DevOut(PadR(oCol:cHeading, nWidth))
ELSE
DevOut(PadR(oCol:cHeading, nWidth))
ENDIF
x += nWidth
IF i < Len(::aColumns) .AND. Len(::cColSep) > 0
DevOut(::cColSep)
x += Len(::cColSep)
ENDIF
NEXT
// Draw header separator
IF Len(::cHeadSep) > 0
SetPos(::nTop + 1, ::nLeft)
cSep := Left(::cHeadSep, 1)
DevOut(Replicate(cSep, ::nRight - ::nLeft + 1))
ENDIF
RETURN Self
METHOD dispRow(nRow) CLASS TBrowse
LOCAL i, oCol, x, nWidth, cVal, nScreenRow
nScreenRow := ::nTop + 1 + nRow // +1 for header separator
IF Len(::cHeadSep) > 0
nScreenRow += 1
ENDIF
SetPos(nScreenRow, ::nLeft)
x := ::nLeft
FOR i := ::nColOffset TO Len(::aColumns)
oCol := ::aColumns[i]
nWidth := ::colWidth(oCol)
IF x + nWidth > ::nRight + 1
EXIT
ENDIF
IF oCol:bBlock != NIL
cVal := PadR(Eval(oCol:bBlock), nWidth)
ELSE
cVal := Space(nWidth)
ENDIF
IF nRow = ::nRowPos .AND. i = ::nColPos
// Current cell: reverse video
DevOut(Chr(27) + "[7m" + cVal + Chr(27) + "[0m")
ELSEIF nRow = ::nRowPos
// Current row highlight
DevOut(Chr(27) + "[47;30m" + cVal + Chr(27) + "[0m")
ELSE
DevOut(cVal)
ENDIF
x += nWidth
IF i < Len(::aColumns) .AND. Len(::cColSep) > 0
DevOut(::cColSep)
x += Len(::cColSep)
ENDIF
NEXT
RETURN Self
METHOD hiLite() CLASS TBrowse
RETURN Self
METHOD deHilite() CLASS TBrowse
RETURN Self
FUNCTION colWidth(oCol)
LOCAL nW := oCol:nWidth
IF nW <= 0
nW := Len(oCol:cHeading)
IF nW < 10
nW := 10
ENDIF
ENDIF
RETURN nW
// ============================================================
// TBrowseDB — convenience constructor
// ============================================================
FUNCTION TBrowseDB(nTop, nLeft, nBottom, nRight)
LOCAL o := TBrowse():Init(nTop, nLeft, nBottom, nRight)
o:bSkipBlock := {|n| DBSkipBlock(n)}
o:bGoTopBlock := {|| dbGoTop()}
o:bGoBottomBlock := {|| dbGoBottom()}
RETURN o
FUNCTION DBSkipBlock(nRecs)
LOCAL nSkipped := 0
IF nRecs > 0
DO WHILE nSkipped < nRecs
SKIP
IF EOF()
SKIP -1
EXIT
ENDIF
nSkipped++
ENDDO
ELSEIF nRecs < 0
DO WHILE nSkipped > nRecs
SKIP -1
IF BOF()
EXIT
ENDIF
nSkipped--
ENDDO
ENDIF
RETURN nSkipped