// 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.