five/examples/tbrowse_five.prg

// Five TBrowse — ported from Harbour src/rtl/tbrowse.prg
// Using Harbour's nMoveOffset + setPosition + scrollBuffer pattern

CLASS TBColumn
   DATA cHeading  INIT ""
   DATA bBlock    INIT NIL
   DATA nWidth    INIT 0
   DATA cColSep   INIT ""
   DATA cHeadSep  INIT ""
   METHOD Init(cHeading, bBlock)
ENDCLASS

METHOD Init(cHeading, bBlock) CLASS TBColumn
   ::cHeading := cHeading
   ::bBlock := bBlock
   ::nWidth := Len(::cHeading)
   IF ::nWidth < 10
      ::nWidth := 10
   ENDIF
   RETURN Self

CLASS TBrowse
   DATA nTop       INIT 0
   DATA nLeft      INIT 0
   DATA nBottom    INIT 22
   DATA nRight     INIT 79
   DATA aColumns   INIT {}
   DATA nColPos    INIT 1
   DATA nRowPos    INIT 1
   DATA nRowCount  INIT 20
   DATA nColOffset INIT 1

   DATA bSkipBlock     INIT NIL
   DATA bGoTopBlock    INIT NIL
   DATA bGoBottomBlock INIT NIL

   DATA cHeadSep  INIT "-"
   DATA cColSep   INIT " | "

   DATA lStable    INIT .F.
   DATA lHitTop    INIT .F.
   DATA lHitBottom INIT .F.
   DATA lFrames    INIT .T.

   // Harbour internal: movement offset (accumulated by up/down/pgup/pgdn)
   DATA nMoveOffset INIT 0
   // Buffer position: which row in buffer is current data position
   DATA nBufferPos  INIT 1
   // Last row with valid data
   DATA nLastRow    INIT 0

   METHOD Init(nTop, nLeft, nBottom, nRight)
   METHOD addColumn(oCol)
   METHOD colCount()

   METHOD down()
   METHOD up()
   METHOD pageDown()
   METHOD pageUp()
   METHOD goTop()
   METHOD goBottom()
   METHOD left()
   METHOD right()
   METHOD home()
   METHOD end()

   METHOD stabilize()
   METHOD forceStable()
   METHOD refreshAll()
   METHOD setPosition()
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
   ::nLastRow := ::nRowCount
   RETURN Self

METHOD addColumn(oCol) CLASS TBrowse
   AAdd(::aColumns, oCol)
   RETURN Self

METHOD colCount() CLASS TBrowse
   RETURN Len(::aColumns)

// Harbour pattern: navigation just sets offset, stabilize does actual work
METHOD down() CLASS TBrowse
   ::nMoveOffset += 1
   ::lStable := .F.
   RETURN Self

METHOD up() CLASS TBrowse
   ::nMoveOffset -= 1
   ::lStable := .F.
   RETURN Self

METHOD pageDown() CLASS TBrowse
   ::nMoveOffset += ::nRowCount
   ::lStable := .F.
   RETURN Self

METHOD pageUp() CLASS TBrowse
   ::nMoveOffset -= ::nRowCount
   ::lStable := .F.
   RETURN Self

METHOD goTop() CLASS TBrowse
   Eval(::bGoTopBlock)
   ::nRowPos := 1
   ::nBufferPos := 1
   ::nMoveOffset := 0
   ::nLastRow := ::nRowCount
   ::lStable := .F.
   ::lFrames := .T.
   RETURN Self

METHOD goBottom() CLASS TBrowse
   Eval(::bGoBottomBlock)
   ::nRowPos := ::nRowCount
   ::nBufferPos := ::nRowCount
   ::nMoveOffset := 0
   ::nLastRow := ::nRowCount
   ::lStable := .F.
   ::lFrames := .T.
   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

// Harbour setPosition: apply nMoveOffset via skipBlock, handle scroll
METHOD setPosition() CLASS TBrowse
   LOCAL nMoved, nMoveOffset, nNewPos

   nMoveOffset := ::nMoveOffset + (::nRowPos - ::nBufferPos)
   nNewPos := ::nBufferPos + nMoveOffset

   // Adjust for page movement beyond screen edges
   IF nNewPos < 1
      IF ::nMoveOffset < -1
         nMoveOffset -= (::nRowPos - 1)
      ENDIF
   ELSEIF nNewPos > ::nLastRow
      IF ::nMoveOffset > 1
         nMoveOffset += (::nLastRow - ::nRowPos)
      ENDIF
   ELSE
      ::nRowPos := nNewPos
   ENDIF

   // Actually skip records
   nMoved := Eval(::bSkipBlock, nMoveOffset)

   IF nMoved > 0
      ::nBufferPos += nMoved
      IF ::nBufferPos > ::nRowCount
         // Scrolled past bottom of screen — adjust
         ::nBufferPos := ::nRowCount
      ENDIF
      IF ::nBufferPos > ::nLastRow
         ::nLastRow := ::nBufferPos
      ENDIF
      ::nRowPos := ::nBufferPos
   ELSEIF nMoved < 0
      ::nBufferPos += nMoved
      IF ::nBufferPos < 1
         ::nBufferPos := 1
      ENDIF
      ::nRowPos := ::nBufferPos
   ELSE
      // nMoved == 0: couldn't move
      IF nMoveOffset > 0
         ::lHitBottom := .T.
         ::nLastRow := ::nBufferPos
      ELSEIF nMoveOffset < 0
         ::lHitTop := .T.
      ENDIF
      ::nRowPos := ::nBufferPos
   ENDIF

   ::nMoveOffset := 0
   RETURN Self

// Harbour stabilize: setPosition + redraw all rows
METHOD stabilize() CLASS TBrowse
   LOCAL i, nScreenWidth, r, x, w, cVal, ci
   LOCAL nSkip, lPastEOF := .F., nActualRows := 0
   LOCAL lVisible := .F., nUsed := 0

   nScreenWidth := ::nRight - ::nLeft + 1

   // Apply pending movement
   IF ::nMoveOffset != 0
      ::setPosition()
   ENDIF

   // Adjust colOffset so nColPos is always visible
   IF ::nColPos < ::nColOffset
      ::nColOffset := ::nColPos
   ENDIF
   // Check if nColPos fits on screen from nColOffset
   lVisible := .F.
   nUsed := 0
   DO WHILE !lVisible
      nUsed := 0
      FOR ci := ::nColOffset TO Len(::aColumns)
         nUsed += ::aColumns[ci]:nWidth
         IF ci > ::nColOffset .AND. Len(::cColSep) > 0
            nUsed += Len(::cColSep)
         ENDIF
         IF nUsed > nScreenWidth
            EXIT
         ENDIF
         IF ci = ::nColPos
            lVisible := .T.
            EXIT
         ENDIF
      NEXT
      IF !lVisible
         ::nColOffset += 1
         IF ::nColOffset > ::nColPos
            ::nColOffset := ::nColPos
            EXIT
         ENDIF
      ENDIF
   ENDDO
   ::lFrames := .T.

   // Skip back from current position to first visible row
   Eval(::bSkipBlock, -(::nRowPos - 1))

   // Draw header
   IF ::lFrames
      SetPos(::nTop, ::nLeft)
      x := 0
      FOR i := ::nColOffset TO Len(::aColumns)
         w := ::aColumns[i]:nWidth
         IF x + w > nScreenWidth
            EXIT
         ENDIF
         IF i = ::nColPos
            DevOut(Chr(27) + "[1;7m" + PadR(::aColumns[i]:cHeading, w) + Chr(27) + "[0m")
         ELSE
            DevOut(Chr(27) + "[7m" + PadR(::aColumns[i]:cHeading, w) + Chr(27) + "[0m")
         ENDIF
         x += w
         IF i < Len(::aColumns) .AND. Len(::cColSep) > 0
            DevOut(::cColSep)
            x += Len(::cColSep)
         ENDIF
      NEXT

      // Separator
      IF Len(::cHeadSep) > 0
         SetPos(::nTop + 1, ::nLeft)
         DevOut(Replicate(Left(::cHeadSep, 1), nScreenWidth))
      ENDIF
      ::lFrames := .F.
   ENDIF

   // Data rows
   FOR r := 1 TO ::nRowCount
      SetPos(::nTop + 2 + r - 1, ::nLeft)
      x := 0
      IF lPastEOF
         DevOut(Space(nScreenWidth))
      ELSE
         nActualRows := r
         FOR i := ::nColOffset TO Len(::aColumns)
            w := ::aColumns[i]:nWidth
            IF x + w > nScreenWidth
               EXIT
            ENDIF
            IF ::aColumns[i]:bBlock != NIL
               cVal := PadR(Eval(::aColumns[i]:bBlock), w)
            ELSE
               cVal := Space(w)
            ENDIF
            IF r = ::nRowPos .AND. i = ::nColPos
               DevOut(Chr(27) + "[7m" + cVal + Chr(27) + "[0m")
            ELSEIF r = ::nRowPos
               DevOut(Chr(27) + "[47;30m" + cVal + Chr(27) + "[0m")
            ELSE
               DevOut(cVal)
            ENDIF
            x += w
            IF i < Len(::aColumns) .AND. Len(::cColSep) > 0
               DevOut(::cColSep)
               x += Len(::cColSep)
            ENDIF
         NEXT
      ENDIF

      IF r < ::nRowCount .AND. !lPastEOF
         nSkip := Eval(::bSkipBlock, 1)
         IF nSkip = 0
            lPastEOF := .T.
         ENDIF
      ENDIF
   NEXT

   // Update nLastRow
   IF nActualRows > 0
      ::nLastRow := nActualRows
   ENDIF
   IF ::nRowPos > ::nLastRow
      ::nRowPos := ::nLastRow
   ENDIF

   // Restore to current row
   IF !lPastEOF
      Eval(::bSkipBlock, -(::nRowCount - ::nRowPos))
   ELSE
      Eval(::bSkipBlock, -(nActualRows - 1))
      IF ::nRowPos > 1
         Eval(::bSkipBlock, ::nRowPos - 1)
      ENDIF
   ENDIF

   ::nBufferPos := ::nRowPos
   ::lStable := .T.
   ::lHitTop := .F.
   ::lHitBottom := .F.
   RETURN .T.

METHOD forceStable() CLASS TBrowse
   DO WHILE !::stabilize()
   ENDDO
   RETURN Self

METHOD refreshAll() CLASS TBrowse
   ::lStable := .F.
   ::lFrames := .T.
   RETURN Self

// TBrowseDB 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 TBColumnNew(cHeading, bBlock)
   RETURN TBColumn():Init(cHeading, bBlock)

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

FUNCTION dbGoTop()
   GO TOP
   RETURN NIL

FUNCTION dbGoBottom()
   GO BOTTOM
   RETURN NIL