Red-Serial.red

Red [
    Title:   "Red-Serial - Serial Port Library for Red"
    Author:  "ANLACO"
    File:    %Red-Serial.red
    Rights:  "Copyright (C) 2026 ANLACO. All rights reserved."
    License: "BSD-3-Clause"
    Purpose: {
        High-level Red interface for serial port communication.
        Provides idiomatic Red API similar to Rebol ports.
    }
    Usage: {
        port: open-serial %/dev/ttyUSB0 115200
        write port "Hello"
        data: read port 100
        line: read-line port
        close port
    }
]

;-- ============================================================================
;-- Include Red/System layer
;-- ============================================================================

#system [
    #include %system/serial-api.reds
]

;-- ============================================================================
;-- Constants (Red level)
;-- ============================================================================

;-- Parity
parity-none:  0
parity-odd:   1
parity-even:  2
parity-mark:  3
parity-space: 4

;-- Stop bits
stopbits-1:   1
stopbits-1.5: 15
stopbits-2:   2

;-- Flow control
flow-none:    0
flow-xonxoff: 1
flow-rtscts:  2
flow-dsrdtr:  3

;-- ============================================================================
;-- Routines - Bridge to Red/System (internal, use _ prefix convention)
;-- ============================================================================

;-- Create new port handle
_serial-new: routine [
    return: [integer!]
    /local
        port [serial-port!]
][
    port: serial-new
    as integer! port
]

;-- Free port
_serial-free: routine [
    handle [integer!]
][
    serial-free as serial-port! handle
]

;-- Open port
_serial-open: routine [
    handle  [integer!]
    device  [string!]
    return: [integer!]
    /local
        port    [serial-port!]
        dev     [c-string!]
        len     [integer!]
        cp      [integer!]
        s       [series!]
        p       [byte-ptr!]
        unit    [integer!]
        i       [integer!]
][
    port: as serial-port! handle
    s: GET_BUFFER(device)
    unit: GET_UNIT(s)
    len: string/rs-length? as red-string! device
    dev: as c-string! allocate len + 1
    
    p: (as byte-ptr! s/offset) + (device/head << (log-b unit))
    i: 1  ;-- c-string index is 1-based
    while [i <= len] [
        cp: string/get-char p unit
        dev/i: as byte! cp
        i: i + 1
        p: p + unit
    ]
    dev/i: null-byte  ;-- null terminate
    
    len: serial-open port dev
    free as byte-ptr! dev
    len
]

;-- Close port
_serial-close: routine [
    handle  [integer!]
    return: [integer!]
][
    serial-close as serial-port! handle
]

;-- Configure port
_serial-configure: routine [
    handle  [integer!]
    baud    [integer!]
    bits    [integer!]
    parity  [integer!]
    stop    [integer!]
    flow    [integer!]
    return: [integer!]
][
    serial-configure as serial-port! handle baud bits parity stop flow
]

;-- Set timeout
_serial-set-timeout: routine [
    handle      [integer!]
    read-ms     [integer!]
    write-ms    [integer!]
    return:     [integer!]
][
    serial-set-timeout as serial-port! handle read-ms write-ms
]

;-- Write string
_serial-write-string: routine [
    handle  [integer!]
    data    [string!]
    return: [integer!]
    /local
        port    [serial-port!]
        str     [c-string!]
        len     [integer!]
        cp      [integer!]
        s       [series!]
        p       [byte-ptr!]
        unit    [integer!]
        i       [integer!]
][
    port: as serial-port! handle
    s: GET_BUFFER(data)
    unit: GET_UNIT(s)
    len: string/rs-length? as red-string! data
    str: as c-string! allocate len + 1
    
    p: (as byte-ptr! s/offset) + (data/head << (log-b unit))
    i: 0
    while [i < len] [
        cp: string/get-char p unit
        str/i: as byte! cp
        i: i + 1
        p: p + unit
    ]
    str/len: null-byte
    
    len: serial-write port as byte-ptr! str len
    free as byte-ptr! str
    len
]

;-- Write binary
_serial-write-binary: routine [
    handle  [integer!]
    data    [binary!]
    return: [integer!]
    /local
        port [serial-port!]
        buf  [byte-ptr!]
        s    [series!]
][
    port: as serial-port! handle
    s: GET_BUFFER(data)
    buf: as byte-ptr! s/offset
    serial-write port buf as integer! (as byte-ptr! s/tail) - buf
]

;-- Read bytes into string (simplified)
_serial-read: routine [
    handle  [integer!]
    size    [integer!]
    return: [string!]
    /local
        port    [serial-port!]
        buf     [byte-ptr!]
        result  [integer!]
        str     [red-string!]
        i       [integer!]
][
    port: as serial-port! handle
    buf: allocate size + 1
    result: serial-read port buf size
    
    str: string/rs-make-at stack/push* size + 1
    
    if result > 0 [
        i: 0
        while [i < result] [
            string/append-char GET_BUFFER(str) as integer! buf/i
            i: i + 1
        ]
    ]
    free buf
    str/header: TYPE_STRING
    str
]

;-- Read single byte
_serial-read-byte: routine [
    handle  [integer!]
    return: [integer!]
][
    serial-read-byte as serial-port! handle
]

;-- Write single byte
_serial-write-byte: routine [
    handle  [integer!]
    b       [integer!]
    return: [integer!]
][
    serial-write-byte as serial-port! handle as byte! b
]

;-- Get available bytes
_serial-available: routine [
    handle  [integer!]
    return: [integer!]
][
    serial-available as serial-port! handle
]

;-- Flush buffers
_serial-flush: routine [
    handle  [integer!]
    input?  [logic!]
    output? [logic!]
    return: [integer!]
][
    serial-flush as serial-port! handle input? output?
]

;-- Drain output
_serial-drain: routine [
    handle  [integer!]
    return: [integer!]
][
    serial-drain as serial-port! handle
]

;-- Set DTR
_serial-set-dtr: routine [
    handle  [integer!]
    state   [logic!]
    return: [integer!]
][
    serial-set-dtr as serial-port! handle state
]

;-- Set RTS
_serial-set-rts: routine [
    handle  [integer!]
    state   [logic!]
    return: [integer!]
][
    serial-set-rts as serial-port! handle state
]

;-- Get CTS
_serial-get-cts: routine [
    handle  [integer!]
    return: [logic!]
][
    serial-get-cts as serial-port! handle
]

;-- Get DSR
_serial-get-dsr: routine [
    handle  [integer!]
    return: [logic!]
][
    serial-get-dsr as serial-port! handle
]

;-- Get CD
_serial-get-cd: routine [
    handle  [integer!]
    return: [logic!]
][
    serial-get-cd as serial-port! handle
]

;-- Get RI
_serial-get-ri: routine [
    handle  [integer!]
    return: [logic!]
][
    serial-get-ri as serial-port! handle
]

;-- Is open?
_serial-is-open: routine [
    handle  [integer!]
    return: [logic!]
][
    serial-is-open? as serial-port! handle
]

;-- Get last error
_serial-last-error: routine [
    handle  [integer!]
    return: [integer!]
][
    serial-last-error as serial-port! handle
]

;-- ============================================================================
;-- Serial Port Object Prototype
;-- ============================================================================

serial-port-proto: context [
    ;-- Internal handle
    _handle: 0
    
    ;-- Port info
    device: none
    baudrate: 9600
    databits: 8
    parity: 0
    stopbits: 1
    flowcontrol: 0
    timeout: 5000   ;-- 5 seconds default
    
    ;-- State
    open?: false
]

;-- ============================================================================
;-- High-Level API Functions  
;-- ============================================================================

open-serial: function [
    "Open a serial port"
    device [file! string!] "Device path, e.g., %/dev/ttyUSB0 or 'COM1'"
    /config "Configure port"
        baud [integer!] "Baudrate (default: 9600)"
        bits [integer!] "Data bits 5-8 (default: 8)"
        par [integer!] "Parity: 0=none,1=odd,2=even (default: 0)"
        stop [integer!] "Stop bits: 1,2 (default: 1)"
        flow [integer!] "Flow: 0=none,1=xonxoff,2=rtscts (default: 0)"
    /timeout
        ms [integer!] "Read/write timeout in milliseconds"
    return: [object! none!]
][
    ;-- Convert file! to string
    dev: either file? device [to-string device][device]
    
    ;-- Create port object
    port: make serial-port-proto [
        device: dev
        baudrate: any [baud 9600]
        databits: any [bits 8]
        parity: any [par 0]
        stopbits: any [stop 1]
        flowcontrol: any [flow 0]
        timeout: any [ms 1000]
    ]
    
    ;-- Allocate handle
    port/_handle: _serial-new
    if port/_handle = 0 [return none]
    
    ;-- Open port first
    result: _serial-open port/_handle dev
    if result <> 0 [
        _serial-free port/_handle
        return none
    ]
    
    ;-- Set timeout in the Red/System structure BEFORE configure
    _serial-set-timeout port/_handle port/timeout port/timeout
    
    ;-- Configure (this applies timeout via platform/configure)
    result: _serial-configure 
        port/_handle 
        port/baudrate 
        port/databits 
        port/parity 
        port/stopbits 
        port/flowcontrol
    
    if result <> 0 [
        _serial-close port/_handle
        _serial-free port/_handle
        return none
    ]
    
    port/open?: true
    port
]

close-serial: function [
    "Close a serial port"
    port [object!]
][
    if port/open? [
        _serial-close port/_handle
        _serial-free port/_handle
        port/open?: false
        port/_handle: 0
    ]
]

write-serial: function [
    "Write data to serial port"
    port [object!]
    data [string! binary! char! integer!]
    return: [integer!] "Bytes written or -1 on error"
][
    unless port/open? [return -1]
    
    case [
        string? data [_serial-write-string port/_handle data]
        binary? data [_serial-write-binary port/_handle data]
        char? data [_serial-write-byte port/_handle to-integer data]
        integer? data [_serial-write-byte port/_handle data]
    ]
]

read-serial: function [
    "Read data from serial port"
    port [object!]
    size [integer!] "Maximum bytes to read"
    return: [string! none!]
][
    unless port/open? [return none]
    result: _serial-read port/_handle size
    either empty? result [none][result]
]

read-line-serial: function [
    "Read a line (until newline) from serial port"
    port [object!]
    return: [string! none!]
][
    unless port/open? [return none]
    
    line: make string! 256
    attempts: 0
    
    forever [
        byte: _serial-read-byte port/_handle
        
        case [
            byte = 10 [break]           ;-- LF - end of line
            byte = -6 [                 ;-- timeout
                attempts: attempts + 1
                if attempts > 100 [break]  ;-- give up after 100 timeouts
            ]
            byte < 0 [break]            ;-- error
            byte <> 13 [                ;-- ignore CR
                append line to-char byte
                attempts: 0
            ]
        ]
    ]
    
    either empty? line [none][line]
]

available-serial: function [
    "Get number of bytes available to read"
    port [object!]
    return: [integer!]
][
    unless port/open? [return 0]
    _serial-available port/_handle
]

flush-serial: function [
    "Flush serial port buffers"
    port [object!]
    /input "Flush input buffer"
    /output "Flush output buffer"
][
    unless port/open? [exit]
    in?: either input [true][either output [false][true]]
    out?: either output [true][either input [false][true]]
    _serial-flush port/_handle in? out?
]

drain-serial: function [
    "Wait for all output data to be transmitted"
    port [object!]
][
    unless port/open? [exit]
    _serial-drain port/_handle
]

;-- ============================================================================
;-- Control Line Functions
;-- ============================================================================

set-dtr: function [
    "Set DTR line state"
    port [object!]
    state [logic!]
][
    unless port/open? [exit]
    _serial-set-dtr port/_handle state
]

set-rts: function [
    "Set RTS line state"
    port [object!]
    state [logic!]
][
    unless port/open? [exit]
    _serial-set-rts port/_handle state
]

get-cts: function [
    "Get CTS line state"
    port [object!]
    return: [logic!]
][
    unless port/open? [return false]
    _serial-get-cts port/_handle
]

get-dsr: function [
    "Get DSR line state"
    port [object!]
    return: [logic!]
][
    unless port/open? [return false]
    _serial-get-dsr port/_handle
]

get-cd: function [
    "Get Carrier Detect state"
    port [object!]
    return: [logic!]
][
    unless port/open? [return false]
    _serial-get-cd port/_handle
]

get-ri: function [
    "Get Ring Indicator state"
    port [object!]
    return: [logic!]
][
    unless port/open? [return false]
    _serial-get-ri port/_handle
]