five/examples/get_five.prg

// Five GET System — simplified port of Harbour tget.prg + tgetlist.prg
// Compiles via gengo to native binary
// Copyright (c) 2026 Charles KWON OhJun (charleskwonohjun@gmail.com)

// GetNew(nRow, nCol, bBlock, cVarName, cPicture, cColorSpec) — create Get object
// Harbour pattern: bBlock = {|x| IIF(x == NIL, var, var := x)}
FUNCTION GetNew(nRow, nCol, bBlock, cVarName, cPicture, cColorSpec)
   LOCAL oGet, xVal

   IF nRow = NIL
      nRow := Row()
   ENDIF
   IF nCol = NIL
      nCol := Col()
   ENDIF

   // Get current value from block
   xVal := Eval(bBlock)

   oGet := Get():New()
   oGet:nRow := nRow
   oGet:nCol := nCol
   oGet:bBlock := bBlock
   oGet:cName := cVarName
   oGet:cPicture := cPicture
   oGet:xOriginal := xVal
   oGet:cType := ValType(xVal)
   oGet:nPos := 1
   oGet:lChanged := .F.
   oGet:lClear := .F.
   oGet:lHasFocus := .F.
   oGet:xExitState := 0
   oGet:bPostBlock := NIL
   oGet:bPreBlock := NIL

   IF cColorSpec != NIL
      oGet:cColorSpec := cColorSpec
   ELSE
      oGet:cColorSpec := "W/N,W+/B"
   ENDIF

   // Build display buffer
   IF cPicture != NIL .AND. Len(cPicture) > 0
      oGet:cBuffer := Transform(xVal, cPicture)
   ELSE
      oGet:cBuffer := __GetDefaultBuffer(xVal)
   ENDIF
   oGet:nDispLen := Len(oGet:cBuffer)

   RETURN oGet

// Default buffer: format value for editing
FUNCTION __GetDefaultBuffer(xVal)
   LOCAL cType := ValType(xVal)
   IF cType = "C"
      RETURN xVal
   ELSEIF cType = "N"
      RETURN Str(xVal)
   ELSEIF cType = "D"
      RETURN DToC(xVal)
   ELSEIF cType = "L"
      IF xVal
         RETURN "T"
      ELSE
         RETURN "F"
      ENDIF
   ENDIF
   RETURN ""

// === Get Class ===

CLASS Get
   DATA nRow      INIT 0
   DATA nCol      INIT 0
   DATA bBlock
   DATA cName     INIT ""
   DATA cPicture
   DATA cType     INIT "C"
   DATA cBuffer   INIT ""
   DATA nPos      INIT 1
   DATA nDispLen  INIT 0
   DATA lChanged  INIT .F.
   DATA lClear    INIT .F.
   DATA lHasFocus INIT .F.
   DATA xOriginal
   DATA bPostBlock
   DATA bPreBlock
   DATA cColorSpec INIT "W/N,W+/B"
   DATA xExitState INIT 0

   METHOD New()
   METHOD input(cChar)
   METHOD display()
   METHOD setFocus()
   METHOD killFocus()
   METHOD varGet()
   METHOD varPut(xValue)
   METHOD assign()
   METHOD unTransform()
   METHOD updateBuffer()
   METHOD insert(cChar)
   METHOD overStrike(cChar)
   METHOD backSpace()
   METHOD delete()
   METHOD home()
   METHOD end()
   METHOD left()
   METHOD right()
   METHOD toDecPos()
   METHOD delEnd()
ENDCLASS

METHOD New() CLASS Get
   RETURN Self

METHOD display() CLASS Get
   SetPos(::nRow, ::nCol)
   IF ::lHasFocus
      DevOut(Chr(27) + "[7m" + ::cBuffer + Chr(27) + "[0m")
   ELSE
      DevOut(::cBuffer)
   ENDIF
   RETURN Self

METHOD setFocus() CLASS Get
   ::lHasFocus := .T.
   ::xOriginal := Eval(::bBlock)
   ::updateBuffer()
   ::nPos := 1
   ::lClear := .T.
   ::lChanged := .F.
   ::display()
   SetPos(::nRow, ::nCol + ::nPos - 1)
   SetCursor(1)
   RETURN Self

METHOD killFocus() CLASS Get
   IF ::lChanged
      ::assign()
   ENDIF
   ::lHasFocus := .F.
   ::display()
   SetCursor(0)
   RETURN Self

METHOD varGet() CLASS Get
   RETURN Eval(::bBlock)

METHOD varPut(xValue) CLASS Get
   Eval(::bBlock, xValue)
   RETURN xValue

METHOD assign() CLASS Get
   LOCAL xVal
   xVal := ::unTransform()
   ::varPut(xVal)
   RETURN Self

METHOD unTransform() CLASS Get
   LOCAL cBuf
   cBuf := ::cBuffer

   IF ::cType = "N"
      cBuf := AllTrim(cBuf)
      RETURN Val(cBuf)
   ELSEIF ::cType = "D"
      RETURN CToD(AllTrim(cBuf))
   ELSEIF ::cType = "L"
      cBuf := Upper(AllTrim(cBuf))
      RETURN (cBuf = "T" .OR. cBuf = "Y" .OR. cBuf = ".T.")
   ENDIF
   RETURN cBuf

METHOD updateBuffer() CLASS Get
   LOCAL xVal
   xVal := Eval(::bBlock)
   IF ::cPicture != NIL .AND. Len(::cPicture) > 0
      ::cBuffer := Transform(xVal, ::cPicture)
   ELSE
      ::cBuffer := __GetDefaultBuffer(xVal)
   ENDIF
   IF ::nDispLen > 0 .AND. Len(::cBuffer) < ::nDispLen
      ::cBuffer := PadR(::cBuffer, ::nDispLen)
   ENDIF
   RETURN Self

// Input() — validate character based on field type and picture mask (Harbour compatible)
METHOD input(cChar) CLASS Get
   LOCAL cPic

   // Type-based filtering
   IF ::cType = "N"
      IF cChar = "-"
         // minus allowed anywhere in numeric
      ELSEIF cChar = "." .OR. cChar = ","
         ::toDecPos()
         RETURN ""
      ELSEIF !(cChar $ "0123456789+")
         RETURN ""
      ENDIF
   ELSEIF ::cType = "D"
      IF !(cChar $ "0123456789")
         RETURN ""
      ENDIF
   ELSEIF ::cType = "L"
      IF !(Upper(cChar) $ "YNTF")
         RETURN ""
      ENDIF
   ENDIF

   // Picture mask filtering
   IF ::cPicture != NIL .AND. Len(::cPicture) > 0
      IF Left(::cPicture, 1) = "@"
         // Function picture — apply uppercase if @!
         IF "!" $ Upper(::cPicture)
            cChar := Upper(cChar)
         ENDIF
      ELSE
         // Mask picture — check character at current position
         IF ::nPos <= Len(::cPicture)
            cPic := Upper(SubStr(::cPicture, ::nPos, 1))
            IF cPic = "A"
               IF !(cChar >= "A" .AND. cChar <= "Z") .AND. !(cChar >= "a" .AND. cChar <= "z")
                  RETURN ""
               ENDIF
            ELSEIF cPic = "9"
               IF !(cChar >= "0" .AND. cChar <= "9") .AND. !(cChar $ "-+")
                  RETURN ""
               ENDIF
               IF !(::cType = "N") .AND. cChar $ "-+"
                  RETURN ""
               ENDIF
            ELSEIF cPic = "#"
               IF !(cChar >= "0" .AND. cChar <= "9") .AND. cChar != " " .AND. !(cChar $ ".+-")
                  RETURN ""
               ENDIF
            ELSEIF cPic = "N"
               IF !(cChar >= "A" .AND. cChar <= "Z") .AND. !(cChar >= "a" .AND. cChar <= "z") .AND. !(cChar >= "0" .AND. cChar <= "9")
                  RETURN ""
               ENDIF
            ELSEIF cPic = "!"
               cChar := Upper(cChar)
            ELSEIF cPic = "L" .OR. cPic = "Y"
               IF !(Upper(cChar) $ "YNTF")
                  RETURN ""
               ENDIF
            ENDIF
            // X = any character, pass through
         ENDIF
      ENDIF
   ENDIF

   RETURN cChar

METHOD insert(cChar) CLASS Get
   LOCAL cLeft, cRight
   cChar := ::input(Left(cChar, 1))
   IF cChar = ""
      RETURN Self
   ENDIF
   IF ::lClear
      ::cBuffer := Space(::nDispLen)
      ::nPos := 1
      ::lClear := .F.
   ENDIF
   IF ::nPos <= ::nDispLen
      cLeft := Left(::cBuffer, ::nPos - 1) + cChar
      cRight := SubStr(::cBuffer, ::nPos, ::nDispLen - ::nPos)
      ::cBuffer := Left(cLeft + cRight, ::nDispLen)
      ::nPos++
      ::lChanged := .T.
   ENDIF
   RETURN Self

METHOD overStrike(cChar) CLASS Get
   cChar := ::input(Left(cChar, 1))
   IF cChar = ""
      RETURN Self
   ENDIF
   IF ::lClear
      ::cBuffer := Space(::nDispLen)
      ::nPos := 1
      ::lClear := .F.
   ENDIF
   IF ::nPos <= ::nDispLen
      ::cBuffer := Left(::cBuffer, ::nPos - 1) + cChar + SubStr(::cBuffer, ::nPos + 1)
      ::nPos++
      ::lChanged := .T.
   ENDIF
   RETURN Self

METHOD backSpace() CLASS Get
   ::lClear := .F.
   IF ::nPos > 1
      ::nPos--
      ::cBuffer := Left(::cBuffer, ::nPos - 1) + SubStr(::cBuffer, ::nPos + 1) + " "
      ::lChanged := .T.
   ENDIF
   RETURN Self

METHOD delete() CLASS Get
   ::lClear := .F.
   IF ::nPos <= ::nDispLen
      ::cBuffer := Left(::cBuffer, ::nPos - 1) + SubStr(::cBuffer, ::nPos + 1) + " "
      ::lChanged := .T.
   ENDIF
   RETURN Self

METHOD home() CLASS Get
   ::nPos := 1
   ::lClear := .F.
   RETURN Self

METHOD end() CLASS Get
   ::nPos := Len(AllTrim(::cBuffer)) + 1
   IF ::nPos > ::nDispLen
      ::nPos := ::nDispLen
   ENDIF
   ::lClear := .F.
   RETURN Self

METHOD left() CLASS Get
   ::lClear := .F.
   IF ::nPos > 1
      ::nPos--
   ENDIF
   RETURN Self

METHOD right() CLASS Get
   ::lClear := .F.
   IF ::nPos < ::nDispLen
      ::nPos++
   ENDIF
   RETURN Self

METHOD toDecPos() CLASS Get
   LOCAL nDot
   ::lClear := .F.
   nDot := At(".", ::cBuffer)
   IF nDot > 0
      ::nPos := nDot + 1
   ENDIF
   RETURN Self

METHOD delEnd() CLASS Get
   ::lClear := .F.
   IF ::nPos <= ::nDispLen
      ::cBuffer := Left(::cBuffer, ::nPos - 1) + Space(::nDispLen - ::nPos + 1)
      ::lChanged := .T.
   ENDIF
   RETURN Self

// === ReadModal — process GETLIST ===

FUNCTION ReadModal(aGetList)
   LOCAL i, oGet, nKey, lDone, nLen, lInsert

   nLen := Len(aGetList)
   IF nLen = 0
      RETURN .F.
   ENDIF

   lInsert := .F.
   i := 1
   lDone := .F.

   oGet := aGetList[i]

   // Pre-validate (WHEN)
   IF oGet:bPreBlock != NIL
      IF !Eval(oGet:bPreBlock)
         RETURN .F.
      ENDIF
   ENDIF

   oGet:setFocus()

   DO WHILE !lDone
      SetPos(oGet:nRow, oGet:nCol + oGet:nPos - 1)
      SetCursor(1)
      nKey := Inkey(0)
      SetCursor(0)

      DO CASE
      CASE nKey = 13 .OR. nKey = 10    // Enter (CR or LF) — next field or exit
         oGet:killFocus()
         IF oGet:bPostBlock != NIL
            IF !Eval(oGet:bPostBlock)
               oGet:setFocus()
               LOOP
            ENDIF
         ENDIF
         i++
         IF i > nLen
            lDone := .T.
         ELSE
            oGet := aGetList[i]
            IF oGet:bPreBlock != NIL
               IF !Eval(oGet:bPreBlock)
                  i++
                  IF i > nLen
                     lDone := .T.
                  ELSE
                     oGet := aGetList[i]
                  ENDIF
                  LOOP
               ENDIF
            ENDIF
            oGet:setFocus()
         ENDIF

      CASE nKey = 27    // ESC — abort
         oGet:killFocus()
         lDone := .T.

      CASE nKey = 5     // Up — previous field
         oGet:killFocus()
         IF oGet:bPostBlock != NIL
            IF !Eval(oGet:bPostBlock)
               oGet:setFocus()
               LOOP
            ENDIF
         ENDIF
         IF i > 1
            i--
            oGet := aGetList[i]
            oGet:setFocus()
         ELSE
            oGet:setFocus()
         ENDIF

      CASE nKey = 24 .OR. nKey = 9    // Down or Tab — next field
         oGet:killFocus()
         IF oGet:bPostBlock != NIL
            IF !Eval(oGet:bPostBlock)
               oGet:setFocus()
               LOOP
            ENDIF
         ENDIF
         i++
         IF i > nLen
            i := nLen
            oGet := aGetList[i]
            oGet:setFocus()
         ELSE
            oGet := aGetList[i]
            oGet:setFocus()
         ENDIF

      CASE nKey = 19    // Left
         oGet:left()
         oGet:display()

      CASE nKey = 4     // Right
         oGet:right()
         oGet:display()

      CASE nKey = 1     // Home
         oGet:home()
         oGet:display()

      CASE nKey = 6     // End
         oGet:end()
         oGet:display()

      CASE nKey = 8 .OR. nKey = 127   // Backspace
         oGet:backSpace()
         oGet:display()

      CASE nKey = 7     // Del
         oGet:delete()
         oGet:display()

      CASE nKey = 25    // Ctrl+Y — delete to end
         oGet:delEnd()
         oGet:display()

      CASE nKey = 22    // Ins — toggle insert
         lInsert := !lInsert

      CASE nKey >= 32 .AND. nKey <= 255   // Printable character
         IF lInsert
            oGet:insert(Chr(nKey))
         ELSE
            oGet:overStrike(Chr(nKey))
         ENDIF
         oGet:display()

      ENDCASE
   ENDDO

   SetCursor(1)
   RETURN .T.