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>
This commit is contained in:
493
examples/get_five.prg
Normal file
493
examples/get_five.prg
Normal file
@@ -0,0 +1,493 @@
|
||||
// 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.
|
||||
Reference in New Issue
Block a user