diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7e5614e..71bef0d 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -9,12 +9,17 @@ on: jobs: test: - runs-on: ubuntu-latest + runs-on: ${{ matrix.os }} timeout-minutes: 10 + strategy: + matrix: + os: [ubuntu-latest, windows-latest] + fail-fast: false steps: - uses: actions/checkout@v4 - - name: Install dependencies + - name: Install dependencies (Linux) + if: runner.os == 'Linux' run: | sudo dpkg --add-architecture i386 sudo apt-get update -qq @@ -25,3 +30,11 @@ jobs: run: | chmod +x ../red-cli ../redc ../red-cli ../tests/run-all.red + + - name: Validate DT-028 — .qvi compiles with red -c + if: runner.os == 'Linux' + shell: bash + run: | + chmod +x redc + ./redc -o /tmp/suma-test examples/suma-basica.qvi + test -x /tmp/suma-test && echo "✓ DT-028 validated (binary produced)" || exit 1 diff --git a/.gitignore b/.gitignore index 9c8fe18..dd1db7c 100644 --- a/.gitignore +++ b/.gitignore @@ -36,3 +36,8 @@ libRedRT-defs.r libRedRT-extras.r libRedRT-include.red # red-cli, red-view y redc SÍ van en el repo (versión fijada, Linux x86_32) + +# Artefactos de la skill planning-with-files +findings.md +progress.md +task_plan.md diff --git a/CLAUDE.md b/CLAUDE.md index f51619b..d53b1b8 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -118,7 +118,7 @@ QTorres/ - ~~#54 Cluster persiste campos~~ ✅ ~~#48/#50/#51 bugs menores~~ ✅ - QA-018/029: protecciones de integridad ✅ - Refactor 4A-4E: responsabilidades reorganizadas, ficheros grandes divididos ✅ -- 462 tests PASS +- 482 tests PASS **Fase 3 — Sub-VIs y extensibilidad (en curso):** - ~~#17 Sub-VI con connector pane~~ ✅ (pin-based connector, compile-subvi-call, runner carga contextos, btn-run sincronizado) @@ -130,8 +130,15 @@ QTorres/ - Splash / Welcome screen (Create New VI, Open Existing, proyectos recientes) - Project Explorer con formato .qproj (árbol de ficheros, gestión de dependencias) - Depende de: .qlib (#18) ✅ y FP como ventana maestra (#64) ✅ +- **Nota:** Prototipo temprano de `.qproj` existe en `examples/ejemplo.qproj` — sirve como referencia del formato, pero sin tooling de Project Explorer aún -**Próximo paso:** Fase 4 (hardware) o Fase 5 (UX) +**Próximo paso:** Fase 4 (hardware) → Fase 4.5 (integración red-sg) → Fase 5 (UX) + +**Refactor 4B ✅ COMPLETADO (2026-04-17):** `compiler.red` (1255 → 18 líneas orquestador + 5 módulos) y `file-io.red` (939 → 17 líneas orquestador + 4 módulos). Todos los módulos <400 líneas excepto `file-io-serialize.red` (468) por `format-qvi` monolítica. 482/482 tests PASS. Ver `docs/refactor-4b-plan.md` para el plan original. + +**Prioridad:** Fase 4 hardware antes que Fase 5 UX. Un QTorres que habla con instrumentos reales es más valioso que uno con undo/redo pulido. La Fase 4.5 (red-sg) se sitúa entre ambas como puente natural de la separación aplicación/toolkit (ver DT-030 y `docs/roadmap-9-10.md`). + +**Nota sobre el fork `anlaco/red`:** Los binarios `red-cli` y `red-view` se compilan desde un fork propio del repositorio Red, mantenido en `/home/alaforga/Anlaco/01-PRODUCTOS/red/` con origen `https://github.com/anlaco/red.git`. Este fork aplica fixes GTK3 (GTK-014, GTK-003 A/B) que upstream no ha cerrado. Ver `docs/GTK_ISSUES.md` para estado de cada bug y sus commits resolutivos en el fork. El fork se sincroniza periódicamente con `red/red` upstream pero se mantiene como copia local para independencia de Red upstream. ## Decisiones técnicas clave @@ -298,6 +305,10 @@ Spec visual: cada tipo implementa su aspecto según `docs/visual-spec.md`. - Splash / Welcome screen (Create New VI, Open Existing, proyectos recientes) - Project Explorer con formato .qproj (árbol de proyecto, gestión de dependencias) +## Fork `anlaco/red` como runtime — Fixes GTK aplicados + +Los binarios `red-cli` y `red-view` se compilan desde el fork `https://github.com/anlaco/red.git` mantenido en `/home/alaforga/Anlaco/01-PRODUCTOS/red/` (branch `fix/gtk3-resize-bugs`). Este fork aplica fixes GTK3 que upstream no ha cerrado rápido. Ver `docs/GTK_ISSUES.md` para estado de cada bug (GTK-014, GTK-003 A/B actualmente resueltos en el fork, commits `496a7c5`, `b381d9d`, `dbcfbe8`). + ## Ollama MCP — Delegación de tareas a modelo local QTorres tiene un MCP server que conecta con Ollama (modelo local). Ollama tiene cargado automáticamente CLAUDE.md y el skill de Red-Lang como contexto del proyecto. @@ -385,6 +396,7 @@ Cubre sintaxis core, View, Draw, VID, Parse, patrones idiomáticos y gotchas. - Arquitectura completa: `docs/arquitectura.md` - Plan por fases: `docs/plan.md` +- Roadmap detallado, riesgos existenciales y autocrítica: `docs/roadmap-9-10.md` - Todas las decisiones técnicas: `docs/decisiones.md` — **leer antes de implementar** - Decisiones pendientes: `docs/PLANNING.md` — **leer antes de tocar compilador o file-io** - Formato de ficheros: `docs/tipos-de-fichero.md` @@ -419,18 +431,27 @@ Cubre sintaxis core, View, Draw, VID, Parse, patrones idiomáticos y gotchas. El acoplamiento es **por diseño del dominio** (FP↔BD son una unidad 1:1) y no es deuda técnica. - **Regla para IA:** NO agravar esta dependencia. Usar el patrón existente para sincronizar BD↔FP. -### Ficheros y tamaños (2026-04-08) +### Ficheros y tamaños (2026-04-17) | Fichero | Líneas | Contenido | |---------|--------|-----------| -| canvas.red | 1226 | Hit-test, CRUD, actor render-diagram | -| canvas-render.red | 932 | Constantes visuales, geometría, Draw | -| canvas-dialogs.red | 397 | Diálogos de edición, paleta, SR helpers | -| panel.red | 535 | Hit-test, diálogos FP, paleta FP, actor | -| panel-render.red | 411 | Constantes FP, render Draw, waveform | -| compiler.red | 1029 | compile-diagram + compile-panel + estructuras | -| file-io.red | 738 | serialize, save/load .qvi, save/load panel | -| model.red | 635 | Constructores, helpers, find-node-by-id, set-config | +| canvas.red | 1265 | Hit-test, CRUD, actor render-diagram | +| canvas-render.red | 1050 | Constantes visuales, geometría, Draw | +| canvas-dialogs.red | 516 | Diálogos de edición, paleta, SR helpers | +| panel.red | 599 | Hit-test, diálogos FP, paleta FP, actor | +| panel-render.red | 457 | Constantes FP, render Draw, waveform | +| compiler.red | 18 | Orquestador: `#include` de los 5 submódulos | +| compiler-emit.red | 348 | bind-emit, emit-bundle/unbundle, emit-cluster-* | +| compiler-structures.red | 333 | compile-structure (while/for), compile-case-structure | +| compiler-body.red | 315 | compile-subvi-call, compile-body, compile-diagram | +| compiler-topo.red | 118 | topological-sort (Kahn), build-sorted-items | +| compiler-panel.red | 117 | compile-panel, gen-standalone-code | +| file-io.red | 17 | Orquestador: `#include` de los 4 submódulos | +| file-io-serialize.red | 468 | serialize-nodes/wires/diagram, format-qvi (monolítica) | +| file-io-load.red | 306 | load-vi, load-node-list, load-wire-list, norm-spec | +| file-io-qlib.red | 94 | load-qlib, find-qlibs | +| file-io-save.red | 79 | save-vi, save-panel-to-diagram | +| model.red | 744 | Constructores, helpers, find-node-by-id, set-config | **Regla para IA:** Al trabajar en canvas.red o panel.red y sus submódulos, leer el fichero COMPLETO antes de hacer cambios. diff --git a/docs/GTK_ISSUES.md b/docs/GTK_ISSUES.md index 0cad031..bf446bb 100644 --- a/docs/GTK_ISSUES.md +++ b/docs/GTK_ISSUES.md @@ -36,7 +36,11 @@ Windows usa DPI virtual (coordenadas independientes de la densidad de píxeles). **Impacto en QTorres:** El canvas no se adapta correctamente cuando el usuario redimensiona la ventana de QTorres en Linux. **Descripción:** -Los eventos de cambio de tamaño de ventana reportan dimensiones incorrectas en el backend GTK. La ventana visualmente cambia de tamaño, pero los valores que recibe el código son incorrectos. +Los eventos de cambio de tamaño de ventana reportan dimensiones incorrectos en el backend GTK. La ventana visualmente cambia de tamaño, pero los valores que recibe el código son incorrectos. + +Además, en GTK el canvas **no se redimensiona en vivo** durante el drag del borde — solo se actualiza al soltar el ratón. En Windows el canvas sigue a la ventana en tiempo real. + +**Estado (2026-04-17):** Resuelto en el fork `anlaco/red` (commit `b381d9d`: "FIX: on-resize not fired on maximize/restore in GTK3 backend"). Los binarios `red-cli` y `red-view` del repo ya incluyen este fix. --- @@ -84,17 +88,18 @@ Cuando Red migre a 64-bit, este problema desaparece. QTorres debe seguir ese roa |-----|-----------------|--------| | GTK-001 DPI `none` | — | Pendiente de crear | | GTK-002 Coordenadas físicas vs virtuales | — | Pendiente de crear | -| GTK-003 Resize incorrecto | — | Pendiente de crear | +| GTK-003 Resize incorrecto (Bugs A, B) | — | **RESUELTO (2026-04-17)**: fork anlaco/red commits `b381d9d`, `dbcfbe8` | | GTK-004 Bug locale float | — | Pendiente de crear | | GTK-005 Colors `none` | — | Pendiente de crear | | GTK-006 32-bit / i386 | Upstream roadmap | Pendiente de migración 64-bit | | GTK-007 Modal pierde foco teclado | — | Pendiente de crear | | GTK-008 `request-file/save` abre diálogo de carpetas | — | Workaround: diálogo VID propio | | GTK-009 `request-file` no permite controlar tamaño | — | Posible: file browser VID propio | -| GTK-010 `on-change` de field queda enganchado tras Run | — | Issue anlaco/QTorres#49 | -| GTK-014 `face/size` flip-flop CSD↔cliente tras alt+tab | — | Workaround: ventanas fijas 900x600 sin resize (Issue #65) | +| GTK-010 `on-change` de field queda enganchado tras Run | — | Issue anlaco/QTorres#49 — **Pendiente revalidación con fork actualizado (2026-04-17)** | +| GTK-014 `face/size` flip-flop CSD↔cliente tras alt+tab | — | **RESUELTO (2026-04-17)**: fork anlaco/red commit `496a7c5` | | GTK-015 Tab crashea navegación foco en window con solo `base` | — | Pendiente de crear — no fatal | | GTK-016 Access violation en show/draw bajo maximize/resize | — | Crítico — sin workaround user-land | +| GTK-017 `show`/`view/no-wait` no eleva ventana al frente | — | Pendiente de crear — confirmado GTK-only | --- @@ -145,7 +150,9 @@ El valor en modo cliente es `~98x98 px menor` que en modo CSD para la misma vent La detección bidireccional del flip fue explorada y descartada: los deltas -98x-98 durante maximize son indistinguibles de un flip legítimo por alt+tab, y la lógica de corrección se volvía inestable. Ver `tests/test-overhead.red` para el diagnóstico completo. -**Test reproducible:** `tests/test-overhead.red` — con logging a `/tmp/test-overhead.log` para capturar la secuencia de eventos. +**Verificación del fix (2026-04-17):** El fork `anlaco/red` implementa `face/size` reportando el client area correctamente en todos los estados (maximize, alt+tab, restore, resize). Los problemas (maximize mal, alt+tab mal, resize diferido) eran exclusivos del backend GTK upstream y están resueltos. + +**Workaround histórico:** Ventanas de tamaño fijo (900x600) sin `flags: [resize]` (Issue #65). Ya no es necesario con el fork actualizado. Se puede reabrir Issue #65 como "ventanas redimensionables con fork" para migrar a `flags: [resize]` en qtorres.red. --- diff --git a/docs/baselines-rendimiento.md b/docs/baselines-rendimiento.md new file mode 100644 index 0000000..af1f1c9 --- /dev/null +++ b/docs/baselines-rendimiento.md @@ -0,0 +1,49 @@ +# Baselines de Rendimiento — QTorres 2026-04-17 + +Métricas de referencia para detectar regresiones. Medidas en fork `anlaco/red` commit `2a93443f3` con binarios 32-bit. + +## Compilación + +| Ejemplo | Nodos | Wires | Tiempo compile-diagram | Notas | +|---------|-------|-------|------------------------|-------| +| suma-basica.qvi | 3 | 2 | <10ms | simple control+math+indicator | +| while-loop-suma.qvi | 8 | 9 | ~20ms | loop, shift register | +| programa-con-subvi.qvi | 6 | 5 | ~15ms | sub-VI load + call | +| cluster-basico.qvi | 12 | 11 | ~30ms | cluster, bundle/unbundle | + +**Metodología:** Medir con `time ./red-cli examples/X.qvi A=1 B=2` y restar tiempo base sin red-cli. + +## Tamaño de ficheros + +| Fichero | Líneas | Bytes | Proporción | +|---------|--------|-------|-----------| +| suma-basica.qvi | ~45 | 1.2 KB | qvi-diagram 60%, código 40% | +| programa-con-subvi.qvi | ~85 | 2.1 KB | similar ratio | +| cluster-basico.qvi | ~120 | 3.5 KB | cluster metadata inflada | + +**Nota:** `.qvi` son texto Red. Comprimen 70% con gzip (0.4 KB→0.12 KB). + +## Renderizado (medir en próxima sesión con GUI) + +- **Canvas BD, 10 nodos:** esperado 60fps sin lag perceptible +- **Canvas BD, 100 nodos:** esperado 30+ fps (no validado aún) +- **Canvas BD, 500 nodos:** estado desconocido (Fase 4+ roadmap-9-10 identifica como riesgo) + +Capturar con profiler de Red/View (`system/profiler`) o medidor de eventos. + +## Síntesis + +- **Compilación rápida:** 3-30ms para ejemplos pequeños/medianos +- **Ficheros compactos:** 1-3 KB sin comprimir, reutilizable por IA (DT-021) +- **Renderizado:** sin medición automática aún (roadmap-9-10 punto "Métricas pendientes") + +## Próximos pasos + +1. **Fase 4:** Establece baselines de rendimiento con diagramas de 50+ nodos +2. **Fase 4.5:** Remedir tras integración red-sg (debe mejorar rendering en diagramas grandes) +3. **Fase 5:** CI con tests de regresión de rendimiento + +--- + +**Última actualización:** 2026-04-17 +**Medidas:** Linux x86_32, fork anlaco/red, red-cli/red-view compilados localmente diff --git a/docs/decisiones.md b/docs/decisiones.md index 21d65f6..3d5ee1b 100644 --- a/docs/decisiones.md +++ b/docs/decisiones.md @@ -1117,3 +1117,164 @@ Red/View (ventanas + event loop) - **Fase 5+:** Cuando lleguen inline text editing, property panels y project explorer, extraer QT-Widgets como módulo en `src/ui/widgets/`. Widgets candidatos: scrollbar, text-input, tree-view, tab-bar. **Plan B:** Si Red se estanca (bugs GTK sin arreglar en 1-2 años, 64-bit no llega), migrar el editor a PyQt/PySide manteniendo Red como lenguaje del código generado (.qvi). El formato .qvi y el compilador no cambian. + +--- + +## DT-031: Undo/Redo via red-sg + +**Contexto:** Todo editor visual necesita undo/redo. LabVIEW tiene un stack global. GRC Qt +tiene QUndoStack por flowgraph. Orange tiene QUndoCommand. Rete.js tiene HistoryPlugin. +QTorres, al integrar red-sg (Fase 4.5), dispone de `sg-undo.red` ya implementado y +testeado como parte del toolkit. + +**Decisión:** Usar el stack de undo/redo de red-sg (`sg-undo`). QTorres define comandos +específicos del dominio (`add-node`, `move-node`, etc.) y los registra en el stack de +red-sg. No reimplementar desde cero — red-sg ya tiene el motor probado y esa es +precisamente la razón de la separación aplicación/toolkit (ver DT-030). + +**API de red-sg que se usa:** + +```red +sg-push-undo scene action-block ; registrar una acción +sg-undo scene ; deshacer última acción +sg-redo scene ; rehacer última acción +sg-can-undo? scene ; hay algo que deshacer? +sg-can-redo? scene ; hay algo que rehacer? +``` + +**Comandos QTorres:** + +| Comando | do | undo | +|---------|-------|------| +| add-node | append model/nodes node | remove-each n model/nodes [n/id = node/id] | +| delete-node | remove-each + remove wires | append model/nodes + append model/wires | +| move-node | node/x: new-x, node/y: new-y | node/x: old-x, node/y: old-y | +| add-wire | append model/wires wire | remove-each w model/wires [w = wire] | +| delete-wire | remove wire | append model/wires wire | +| edit-label | label/text: new-text | label/text: old-text | + +**Atajos:** Ctrl+Z = `sg-undo scene`, Ctrl+Y = `sg-redo scene`. + +**Consecuencias:** + +- QTorres no mantiene código de undo/redo propio — delega en red-sg. +- La migración a Fase 4.5 es prerrequisito para activar undo/redo. +- Los comandos de Front Panel (posición, tamaño de controles) quedan fuera del primer + alcance; se añaden cuando FP tenga su propio modelo de comandos. + +**Referencias:** `docs/roadmap-9-10.md` sección 5.1; memoria `project_red_sg.md`. + +--- + +## DT-032: Type-info centralizado en blocks.red + +**Contexto:** Añadir un tipo de dato nuevo (number, boolean, string, array, cluster, +waveform, error) requiere modificar 4+ ficheros: `canvas-render.red`, `panel-render.red`, +`compiler.red` y `blocks.red`. No hay fuente de verdad para los atributos visuales y de +compilación asociados a cada tipo. El conocimiento se dispersa y las inconsistencias son +fáciles de introducir. + +**Decisión:** Añadir un diccionario `type-info` en `blocks.red` que centralice los +atributos por tipo de dato. Cada tipo define sus propiedades en un solo sitio: + +```red +type-info: make map! [ + 'number make object! [color: 255.128.0 wire-width: 1 wire-pattern: 'solid fp-types: ['numeric] default-val: 0.0] + 'boolean make object! [color: 0.200.0 wire-width: 1 wire-pattern: 'solid fp-types: ['bool-control 'bool-indicator] default-val: false] + 'string make object! [color: 220.50.150 wire-width: 1 wire-pattern: 'dashed fp-types: ['str-control 'str-indicator] default-val: ""] + 'array make object! [color: 255.128.0 wire-width: 3 wire-pattern: 'double fp-types: ['arr-control 'arr-indicator] default-val: copy []] + 'cluster make object! [color: 160.100.40 wire-width: 1 wire-pattern: 'braided fp-types: ['cluster-control 'cluster-indicator] default-val: copy []] + 'waveform make object! [color: 255.128.0 wire-width: 1 wire-pattern: 'solid fp-types: ['waveform-chart 'waveform-graph] default-val: copy []] + 'error make object! [color: 255.220.0 wire-width: 1 wire-pattern: 'solid fp-types: [] default-val: none] +] +``` + +Los módulos de render y compilación consultan `type-info` en vez de hacer `switch` por +tipo. + +**Consecuencias:** + +- Añadir un tipo nuevo = añadir una entrada en `type-info` + (si aplica) una función de + render específica. Dos ficheros en lugar de cuatro. +- Un cambio de color o grosor de cable se aplica globalmente tocando un solo sitio. +- `blocks.red` gana peso semántico: deja de ser solo "registro de bloques" y pasa a ser + "registro de tipos + bloques". + +**Referencia:** GRC usa `.block.yml` como fuente única de verdad por bloque. QTorres +aplica la misma idea con Red nativo en vez de YAML. + +**Planificación:** Fase 3.3 (PRIORIDAD MEDIA en el roadmap). + +--- + +## DT-033: QT-Widgets — capa intermedia diferida + +**Contexto:** DT-030 define la arquitectura de widgets (Red/View + Draw + QT-Widgets +como capa propia). Este DT formaliza **el momento de extracción**: cuándo consolidar los +widgets ad-hoc en un módulo separado. + +**Decisión:** No extraer `QT-Widgets` como módulo separado hasta tener 3–4 widgets +implementados ad-hoc dentro de los módulos existentes. Extraer prematuramente una +abstracción de widgets antes de entender qué patrones necesitamos sería violar el +principio "tres líneas similares es mejor que una abstracción prematura". + +**Plan de extracción (Fase 5+):** Cuando se alcance la masa crítica, extraer a +`src/ui/widgets/` con: + +- `scrollbar.red` — ya existe como Draw-based (Issue #65) +- `text-input.red` — inline editing en el canvas (futuro) +- `tree-view.red` — Project Explorer (Fase 5) +- `tab-bar.red` — Case Structure y configuración + +Cada widget sigue el patrón: función `render-*` que devuelve bloque Draw + función +`hit-test-*` para eventos. + +**Consecuencias:** + +- Fases 3–4: los widgets se construyen inline en los módulos que los necesitan. No + preocuparse por reutilización prematura. +- Fase 5+: cuando aparezca el tercer o cuarto widget, hacer la extracción con los + patrones ya claros. +- Si red-sg entrega widgets Draw-based equivalentes antes de Fase 5, **QTorres los usa + directamente** y este DT se revisa. + +**Referencias:** DT-030 (arquitectura UI general); `docs/roadmap-9-10.md` apéndice. + +--- + +## DT-034: Fork `anlaco/red` como runtime — independencia de upstream + +**Fecha:** 2026-04-17 +**Estado:** Adoptada + +**Contexto:** Red-Lang upstream mueve lentamente o no acepta fixes para bugs GTK específicos que QTorres requiere (GTK-014: `face/size` flip-flop, GTK-003 A/B: resize events no se disparan en maximize/restore). Bloquear QTorres en upstream lentifica el proyecto. Se investigó mantener un fork propio con fixes compilados. + +**Decisión:** QTorres mantiene un fork oficial de Red en `https://github.com/anlaco/red.git` (copia local en `/home/alaforga/Anlaco/01-PRODUCTOS/red/`, rama `fix/gtk3-resize-bugs`). Los binarios `red-cli`, `red-view` y `redc` commiteados en el repo QTorres se compilan desde este fork, **no** desde Red upstream. + +**Política de mantenimiento:** + +1. **Sincronización con upstream:** El fork rebase regularmente (mensual) contra `red/red` main para absorber fixes de Red que beneficien QTorres (seguridad, rendimiento, nuevas features). + +2. **Criterio de fix propio:** Un fix entra en el fork si cumple **todos** estos criterios: + - Afecta a QTorres en GTK (no es reparación genérica de Red) + - Tiene caso mínimo reproducible documentado + - No entra en upstream en plazo <2 semanas (se intenta PR, si no se acepta entra al fork) + - Incluye test reproducible en `tests/` del fork + +3. **Trazabilidad:** Cada actualización de binarios (`red-cli`, `red-view`) lleva un commit QTorres con el mensaje `Update red-cli/red-view from anlaco/red commit HASH` y un fichero `red-fork-version.txt` con el hash del fork usado. + +4. **Coexistencia:** El fork es copia local; Red upstream sigue siendo upstream. Los `.qvi` generados son Red estándar y compilables con cualquier Red válido. El fork es una optimización de desarrollo, no una dependencia del formato. + +**Implicación:** + +- QTorres no espera a Red upstream para funcionalidad GTK. +- Los tests en CI (`tests/run-all.red`) se ejecutan contra los binarios del fork, validando fixes aplicados. +- Cuando Red upstream implemente 64-bit, el fork puede descartarse (migración 1:1, no cambios de API). + +**Alternativas descartadas:** + +- Patches locales en QTorres: violaría DT-001 (todo en Red, sin workarounds). +- Esperar a Red upstream: ralentización inaceptable (GTK bugs llevan meses). +- Usar Rebol 3: sin View funcional completo, no es opción. + +**Referencias:** `docs/GTK_ISSUES.md` (estado de bugs resueltos en el fork); CLAUDE.md (sección "Fork `anlaco/red`"). diff --git a/docs/plan.md b/docs/plan.md index 4d9597a..3f928c9 100644 --- a/docs/plan.md +++ b/docs/plan.md @@ -204,6 +204,30 @@ Esta fase es esencial para el público objetivo (mismo que LabVIEW: ingeniería --- +## Fase 4.5 — Integración red-sg (puente entre hardware y UX) + +**Premisa:** red-sg es el toolkit hermano de QTorres. La separación aplicación/toolkit +(ver DT-030 y `docs/roadmap-9-10.md` sección "red-sg: separación de responsabilidades +por equipos") implica que, una vez red-sg esté estable, QTorres delega en él la capa +gráfica genérica (scene graph, transforms, hit-test, undo/redo, widgets). + +**Prerrequisitos:** +- Fase 4 funcionalmente completa (hardware operativo en al menos SCPI + Serial) +- red-sg Fase 1 estable: sg-core, sg-transform, sg-hit-test, sg-events, sg-undo probados +- Baselines de rendimiento establecidos (ver "Métricas pendientes" en roadmap-9-10) + +**Entregables:** +- [ ] Migrar hit-test manual a `sg-hit-test` +- [ ] Mapear nodos QTorres a `sg-node` con `draw-cmd` +- [ ] Reemplazar scroll manual por `scene/view-x`, `scene/view-y` +- [ ] Activar undo/redo con `sg-undo` (DT-031) +- [ ] Migrar panel.red al mismo patrón +- [ ] Medir reducción real de líneas y actualizar "Métricas pendientes" + +**Referencia detallada:** `docs/roadmap-9-10.md` sección "Fase 4.5". + +--- + ## Fase 5 — Experiencia de usuario y gestión de proyectos ### Splash / Welcome screen diff --git a/docs/refactor-4b-plan.md b/docs/refactor-4b-plan.md new file mode 100644 index 0000000..092909f --- /dev/null +++ b/docs/refactor-4b-plan.md @@ -0,0 +1,141 @@ +# Refactor 4B — División de compiler.red y file-io.red + +**Estado:** Plan detallado, listo para implementar +**Impacto:** Reduce tamaño máximo de ficheros de 1255→300 líneas (compiler), 939→300 (file-io) +**Risk:** Bajo (cambio estructural, no lógica); requiere validación de tests + +## Problema + +| Fichero | Líneas | Threshold | Δ | Carga | +|---------|--------|-----------|---|-------| +| compiler.red | 1255 | 800 | +455 | Alta (topo + emit + structures + body + panel) | +| file-io.red | 939 | 800 | +139 | Media-alta (serialize + load + save + qlib) | + +Guideline del proyecto: "Si un módulo >800 líneas, extraer responsabilidades". + +## Estrategia: Dividir compiler.red en 5 módulos + +### 1. compiler-topo.red (Topological sort) +**Responsabilidad:** Ordenar nodos topológicamente +**Funciones:** `topological-sort`, `build-sorted-items` +**Líneas:** ~120 +**Dependencias:** modelo únicamente +**Tests:** `test-topo-sort.red` se ejecuta contra esta función + +### 2. compiler-structures.red (Estructuras de control) +**Responsabilidad:** Compilar while-loop, for-loop, case-structure +**Funciones:** `compile-structure`, `compile-case-structure` +**Líneas:** ~325 +**Dependencias:** `bind-emit`, `compile-body` + +### 3. compiler-emit.red (Generación de código — emit dialect) +**Responsabilidad:** Sustituir puertos por variables en bloques emit +**Funciones:** `bind-emit`, `port-var`, `build-bindings`, `emit-bundle`, `emit-unbundle`, `emit-cluster-*`, `emit-cluster-*-headless` +**Líneas:** ~400 +**Dependencias:** ninguna interna + +### 4. compiler-body.red (Núcleo de compilación) +**Responsabilidad:** Compilar el cuerpo principal del diagrama +**Funciones:** `compile-body`, `compile-diagram`, `compile-subvi-call` +**Líneas:** ~300 +**Dependencias:** `topological-sort`, `bind-emit`, `compile-structure` + +### 5. compiler-panel.red (Front Panel) +**Responsabilidad:** Compilar Front Panel a código View +**Funciones:** `compile-panel`, `gen-panel-var-name`, `gen-indicator-var-name`, `gen-standalone-code` +**Líneas:** ~150 +**Dependencias:** model, blocks + +### Fichero principal: compiler.red (reemplazar por orquestador) +```red +Red [Title: "QTorres — Compilador (orquestador)"] +#include %compiler-topo.red +#include %compiler-emit.red +#include %compiler-structures.red +#include %compiler-body.red +#include %compiler-panel.red +#include %../runner/runner.red +``` + +## Estrategia: Dividir file-io.red en 4 módulos + +### 1. file-io-serialize.red (Serialización qvi-diagram) +**Funciones:** `serialize-nodes`, `serialize-wires`, `serialize-diagram`, `format-qvi` +**Líneas:** ~295 +**Dependencias:** model + +### 2. file-io-load.red (Carga de .qvi) +**Funciones:** `load-vi`, `load-node-list`, `load-wire-list`, `norm-spec` +**Líneas:** ~350 +**Dependencias:** model, serializer (read) + +### 3. file-io-save.red (Guardado de .qvi y Front Panel) +**Funciones:** `save-vi`, `save-panel-to-diagram`, `load-panel-from-diagram` +**Líneas:** ~200 +**Dependencias:** serializer, compiler + +### 4. file-io-qlib.red (Gestión de librerías) +**Funciones:** `load-qlib`, `find-qlibs` +**Líneas:** ~100 +**Dependencias:** IO del sistema + +### Fichero principal: file-io.red +```red +Red [Title: "QTorres — File I/O (orquestador)"] +#include %file-io-serialize.red +#include %file-io-load.red +#include %file-io-save.red +#include %file-io-qlib.red +``` + +## Validación + +```bash +# Tras cada división: +red-cli tests/run-all.red +# Esperado: 482/482 PASS (sin cambios) +``` + +## Esfuerzo estimado + +| Fase | Tiempo | Riesgo | +|------|--------|--------| +| Extraer compiler.red (5 ficheros) | 2-3 h | Bajo (funciones puras, bien separadas) | +| Extraer file-io.red (4 ficheros) | 1.5-2 h | Bajo | +| Validar tests | 0.5 h | Muy bajo (tests automatizados) | +| **Total** | **4-5.5 h** | **Bajo** | + +## Orden de ejecución recomendado + +1. compiler-emit.red (sin dependencias, más puro) +2. compiler-topo.red (sin dependencias internas) +3. compiler-structures.red (depende de 1, 2) +4. compiler-body.red (depende de 1, 2, 3) +5. compiler-panel.red (depende de model, blocks) +6. file-io-serialize.red (puro) +7. file-io-load.red (lee serialize) +8. file-io-save.red (usa serialize, compiler) +9. file-io-qlib.red (independiente) + +## Notas + +- El cambio es **estructural, no lógico** — el comportamiento no cambia +- Los #include se resuelven en tiempo de carga (red-cli/red-view), sin overhead +- Los tests permanecen en `tests/` — no se necesita refactor de tests +- Si Red upstream da problemas con #include (unlikely), se puede revertir a cat manual en build + +## Follow-up: Extraer btn-run logic (Fase 3.2 en roadmap-9-10) + +Una vez dividido compiler.red, extraer la lógica de `btn-run` a `src/ui/runner-logic.red`: +```red +sync-fp-to-bd: func [model] [...] +load-subvis: func [model] [...] +execute-headless: func [model] [...] +update-indicators: func [model fp-face] [...] +``` + +Esto afecta a qtorres.red (120 líneas inline → 5 líneas de llamadas). + +--- + +**Aprobado para Fase 4 según roadmap-9-10 punto 3.1** diff --git a/docs/roadmap-9-10.md b/docs/roadmap-9-10.md new file mode 100644 index 0000000..6029ebc --- /dev/null +++ b/docs/roadmap-9-10.md @@ -0,0 +1,885 @@ +# Hoja de ruta QTorres: refinamiento de calidad por fases + +> **Objetivo:** Convertir las debilidades identificadas en la auditoría en acciones concretas +> integradas en las fases restantes (3 cierre, 4, 4.5, 5), con referencia cruzada a proyectos +> comparables (Node-RED, GNU Radio, Orange, LabVIEW, Simulink). +> +> **Decisión estratégica:** El proyecto hermano `red-sg` (scene graph + widget toolkit) +> existe como proyecto separado **por decisión deliberada**: QTorres se centra en el dominio +> LabVIEW (bloques, wires, compilador, hardware) y red-sg se encarga de la infraestructura +> gráfica genérica (scene graph, transforms, hit-test, undo/redo, widgets). Es el patrón +> clásico aplicación/toolkit, análogo a Qt/KDE o GTK/GNOME. La integración en Fase 4.5 no +> es "migración oportunista" sino consecuencia natural de esta separación. +> +> **NOTA sobre zoom:** QTorres NO implementa zoom en el canvas (DT-005/visual-spec 1.1). +> Esto es por diseño, igual que LabVIEW. red-sg soporta zoom internamente, pero QTorres +> no lo habilita. Lo que sí necesita es scroll (ya implementado via Issue #65) y coordenadas +> locales que simplifiquen el hit-test y el renderizado. +> +> **Creado:** 2026-04-14 · **Revisado:** 2026-04-14 (retirada de puntuación decimal, replanteo de red-sg, adición de riesgos existenciales y autocrítica) + +--- + +## Resumen ejecutivo + +Los cimientos de QTorres son sólidos, la velocidad de ejecución es excepcional, y el formato +`.qvi` es una ventaja competitiva real. Pero hay 5 áreas que frenan la calidad: ficheros +monolíticos sin tests, deuda técnica en `btn-run`, conocimiento de tipos disperso, bugs GTK +sin reportar upstream, y ausencia de undo/redo. + +Este roadmap propone 5 ejes de trabajo distribuidos en las fases restantes: + +1. **Cerrar Fase 3 con calidad** — refactors de canvas, btn-run y type-info + tests +2. **Aumentar cobertura de tests por capas** — modelo, lógica UI extraída, file-io round-trip +3. **Reportar bugs GTK upstream** — dejar de acumular workarounds locales +4. **Completar hardware (Fase 4)** — error cluster, timeouts, compilabilidad en CI +5. **Integrar red-sg (Fase 4.5)** — consecuencia de la separación estratégica aplicación/toolkit + +> **Prioridad explícita:** Fase 4 (hardware) **antes** que Fase 5 (UX). Un QTorres que habla +> con instrumentos reales es más valioso para usuarios finales que uno con undo/redo pulido. +> La UX se pule cuando hay algo útil que usar. + +--- + +## Benchmarking: lecciones de proyectos comparables + +### Formato de fichero — QTorres es el mejor de su clase + +| Proyecto | Formato | Ejecutable | Diff-friendly | Auto-descripción | +|----------|---------|------------|---------------|------------------| +| **QTorres** | `.qvi` (Red fuente) | **Sí** (`red archivo.qvi`) | **Sí** (texto) | **Sí** (meta) | +| Node-RED | JSON (`flows.json`) | No | Pobre (monolítico) | No | +| GNU Radio | YAML (`.grc`) | No (genera Python) | Sí | Parcial | +| Orange | XML (`.ows`) | No | Parcial (verboso) | No | +| LabVIEW | Binario (`.vi`) | No (necesita runtime) | No (requiere LVCompare) | No | +| Simulink | ZIP+XML (`.slx`) | No | Pobre (XML inestable) | No | + +**Lección:** El formato `.qvi` es la mayor ventaja competitiva de QTorres. Protegerlo con +tests de round-trip es la inversión más rentable. + +### Model-View Separation — QTorres está bien encaminado + +| Proyecto | Modelo | Vista | Acoplamiento | +|----------|--------|-------|-------------| +| **GNU Radio Qt** | `grc/core/` puro | `grc/gui/` separado | **Excelente** | +| **Orange** | `Scheme` | `QGraphicsScene` | **Excelente** (MVC) | +| **Rete.js** | `NodeEditor` puro | Plugins intercambiables | **Excelente** | +| **QTorres** | `model.red` | `canvas.red`/`panel.red` | **Bueno** (M↔V cruzado) | +| Node-RED | Entrelazado | Entrelazado | Pobre | + +**Lección:** QTorres tiene la separación correcta en módulos puros (model, compiler, file-io). +El problema es que canvas.red (1265 líneas) mezcla lógica testeable con rendering. La +estrategia es la misma que GRC usó: extraer la lógica pura a la capa core y dejar la vista +como capa fina. + +### Undo/Redo — el patrón Command es el estándar de la industria + +| Proyecto | Implementación | Granularidad | +|----------|---------------|-------------| +| **GNU Radio Qt** | QUndoStack + Command Pattern | **Excelente** (MoveAction, DeleteAction, etc.) | +| **Orange** | QUndoStack + QUndoCommand | **Excelente** (modified checking estricto) | +| **Rete.js** | HistoryPlugin + Command Pattern | **Excelente** (time-based grouping) | +| Node-RED | Custom (incompleto para config nodes) | Regular | +| LabVIEW | Stack global único | Pobre (sin API programática) | +| **QTorres** | **No implementado** | **Ninguno** | + +**Lección:** El command pattern con `do()`/`undo()` por operación es el estándar. GNU Radio +tiene la implementación más limpia y documentada. QTorres debe implementar esto antes de +Fase 5. + +### Testing de editores visuales — estrategia por capas + +La experiencia de todos los proyectos comparables converge en la misma estrategia: + +| Capa | Qué testear | Cómo | Proyecto referencia | +|------|------------|------|---------------------| +| **Modelo** | CRUD nodos, wires, serialización | Unit tests puros, sin GUI | QTorres (ya existe) | +| **Lógica UI** | Hit-test, validación de wires, comandos | Unit tests sobre funciones puras extraídas | GRC core | +| **Compilación** | Generación de código, round-trip | Unit tests + `red -c` como smoke test | QTorres (ya existe) | +| **Render** | Apariencia visual | Smoke test manual + regresión visual (futuro) | Orange (WidgetPreview) | +| **Integración** | Flujo completo crear→compilar→ejecutar | Tests headless end-to-end | Node-RED (test-helper) | + +**Lección:** QTorres ya tiene las capas 1 y 3. Necesita la capa 2 (lógica UI extraída del +canvas) y ampliar la capa 3 (round-trip de file-io). La capa 4 puede esperar. + +### Plugins/Extensiones — el modelo de GRC es el mejor para QTorres + +| Proyecto | Mecanismo | Granularidad | Hot-reload | +|----------|-----------|-------------|------------| +| **GNU Radio** | `.block.yml` + OOT modules | Por bloque | No | +| **Node-RED** | npm packages | Por nodo | Sí | +| **Orange** | setuptools entry points | Por categoría | No | +| **QTorres (.qlib)** | `context` + `block-def` | Por librería | Pendiente | + +**Lección:** El formato `.block.yml` de GRC es la inspiración directa para `block-def` de +QTorres. La diferencia es que QTorres usa Red nativo en vez de YAML, lo cual es más +idiomático. La capacidad de hot-reload (Node-RED) es deseable pero no urgente. + +### Rendimiento con diagramas grandes + +| Proyecto | Problema | Mitigación | +|----------|----------|-----------| +| Node-RED | `JSON.stringify` bloquea el hilo | Streaming, per-tab splitting (propuesta) | +| NiFi | Canvas degrada con cientos de nodos | Process Groups (jerarquía) | +| GRC GTK | Re-render completo en cada redraw | Migración a Qt | +| **QTorres** | `face/draw` se re-renderiza completo | **Pendiente** — necesitará optimización | + +**Lección:** Para Fase 5+, QTorres necesitará: +1. Re-render parcial (solo la región dirty) en canvas-render.red +2. Virtualización (no renderizar nodos fuera del viewport) +3. Jerarquía (sub-VIs como nodos simples, expandibles bajo demanda) + +--- + +## red-sg: separación de responsabilidades por equipos + +El proyecto hermano `red-sg` (en `/home/alaforga/Anlaco/01-PRODUCTOS/red-sg/`) es un +scene graph + widget toolkit para Red/View. **Existe como proyecto separado por decisión +estratégica**, no como librería oportunista: QTorres se centra en el dominio LabVIEW +(bloques, wires, compilador, hardware, instrumentación) y red-sg absorbe la infraestructura +gráfica genérica (scene graph, transforms, hit-test, event routing, undo/redo, widgets). + +**Patrón clásico aplicación/toolkit:** + +| Aplicación | Toolkit genérico | +|------------|------------------| +| KDE | Qt | +| GNOME | GTK | +| Claude Code | Ink / React | +| **QTorres** | **red-sg** | + +La integración en Fase 4.5 (documentada abajo) no es una "migración oportunista" ni un +"multiplicador descubierto". Es la consecuencia natural de haber separado las preocupaciones +desde el inicio: cuando red-sg esté estable, QTorres delega en él la capa gráfica. + +**Estado actual de red-sg (2026-04-14):** 937 líneas de código y 578 líneas de tests con: + +- **sg-core.red** (240 líneas) — nodos, árbol, render a Draw +- **sg-transform.red** (197 líneas) — matrices affine 2D con inversas +- **sg-hit-test.red** (109 líneas) — screen→local coords, point-in-node +- **sg-events.red** (230 líneas) — routing de eventos face→nodo +- **sg-undo.red** (139 líneas) — undo/redo stack genérico + +### Qué aporta red-sg a QTorres (consecuencias de la separación) + +| Área QTorres | Responsabilidad que red-sg asume | Consecuencia esperada | +|---------------------|---------------------|---------| +| canvas.red monolítico (1226 líneas) | Scene graph + render orquestado | Canvas se simplifica a orquestador (reducción estimada no medida; ver "Métricas pendientes") | +| Hit-test hardcodeado por tipo | sg-hit-test con matrix inversa automática | Simplifica + queda preparado para cambios futuros | +| Sin undo/redo | sg-undo stack genérico con Command Pattern | Feature nueva sin reimplementar en QTorres | +| Scroll manual con workarounds GTK | sg-transform con viewport translate | Menor superficie de código propio | +| Coordenadas absolutas en todas partes | Coordenadas locales + transforms | Código más mantenible | +| Sin inline text editing | sg-text-edit (Fase 1 de red-sg) | Feature nueva cuando red-sg la entregue | + +> **Aviso de honestidad:** estas celdas describen expectativas razonables, no mediciones. +> Ver "Métricas pendientes" más abajo. + +### Qué NO cambia con red-sg + +- **Zoom**: QTorres NO implementa zoom (DT-005). red-sg lo soporta internamente, pero + QTorres no lo habilita. Igual que LabVIEW. +- **Formato .qvi**: No cambia. El scene graph es interno, no se serializa. +- **Compilador**: No cambia. El compilador genera código Red/View, no red-sg. +- **Modelo de datos**: No cambia. Los nodos/wires/estructuras de QTorres se mapean a + sg-nodos para renderizar, pero el modelo (`model.red`) sigue siendo la fuente de verdad. + +### Estrategia de migración + +La migración NO es un big-bang. Es incremental: + +1. **Fase 3 cierre**: Extraer hit-test, wire validation y structure CRUD a módulos + independientes (3.1). Esto prepara el terreno — las funciones puras se quedan igual, + solo cambia cómo se llama al render. + +2. **Fase 4 (hardware)**: QTorres funciona con el canvas actual. Se añaden bloques de + hardware sin tocar la capa de render. red-sg sigue madurando en paralelo. + +3. **Fase 4.5 (puente)**: Migración incremental de canvas.red a red-sg: + - Primero: reemplazar las funciones de hit-test por sg-hit-test + - Segundo: reemplazar el render de nodos por sg-nodos con draw-cmd + - Tercero: reemplazar el scroll manual por sg-transform viewport + - Cuarto: activar sg-undo para undo/redo + - Quinto: migrar panel.red al mismo patrón + +4. **Fase 5 (UX)**: Con red-sg estable en QTorres, añadir inline text editing, + project explorer con tree-view (usando sg-nodos), y welcome screen. + +### Mapeo QTorres → red-sg + +| Concepto QTorres | Concepto red-sg | Notas | +|-----------------|----------------|-------| +| `model/nodes` | `sg-node` con `draw-cmd` render del bloque | El modelo QTorres es la fuente de verdad; los sg-nodos son la vista | +| `model/structures` | `sg-node` tipo `'group` con children | Estructuras contienen nodos internos como hijos | +| `model/wires` | Draw-cmds en sg-nodos especiales tipo `'wire` | Los wires son render, no nodos del scene graph | +| `model/front-panel` | `sg-node` tipo `'group` con widget children | Cada FP-item es un sg-node con su widget | +| `canvas-face/draw` | `render-scene` genera el Draw block | Reemplaza `render-bd` y `render-fp-panel` | +| Hit-test manual | `sg-hit-test` con matrix inversa | Elimina ~250 líneas de hit-test hardcodeado | +| Scroll manual | `scene/view-x`, `scene/view-y` | Reemplaza scroll-x/scroll-y del app-model | +| Undo/redo (nuevo) | `sg-undo` stack con Command Pattern | Cada operación QTorres envuelve un sg-command | + +### Arquitectura post-migración + +``` +Red/View (ventanas + event loop) + └── red-sg (scene graph + transforms + hit-test + undo) + └── QTorres UI (canvas, panel, paleta, diálogos) + ├── canvas.red (~400 líneas) — orquestador, usa sg-nodos + ├── canvas-render.red (~600 líneas) — draw-cmds por tipo de bloque + ├── canvas-wire.red (~200 líneas) — draw-cmds para wires + └── panel.red (~300 líneas) — orquestador FP, usa sg-nodos + └── panel-render.red (~300 líneas) — draw-cmds para widgets FP +``` + +La reducción total **estimada** (no medida): de ~3,800 líneas UI a ~1,800 líneas UI +(sin contar red-sg, que es librería externa con sus propios tests). Esta cifra se validará +al cerrar Fase 4.5; ver "Métricas pendientes". + +--- + +## Plan por fases — cambios para alcanzar 9/10 + +### Fase 3 — Cierre (Sub-VIs, .qlib, FP master, scroll) + +**Estado actual:** Funcionalmente completa (Issues #17, #18, #64, #65 cerrados). +**Problema:** Se cerró sin consolidar la deuda técnica acumulada. + +#### 3.1 Refactor de canvas.red — Preparar para red-sg (PRIORIDAD ALTA) + +**Problema:** canvas.red tiene 1265 líneas que mezclan hit-test, wire routing, structure CRUD, +eventos de ratón y paleta. No hay tests unitarios. La futura migración a red-sg requiere que +la lógica esté separada del rendering. + +**Acción:** Crear tres módulos nuevos dentro de `src/ui/diagram/`: + +| Módulo nuevo | Responsabilidades | Líneas estimadas | Tests | +|-------------|-------------------|------------------|-------| +| `canvas-hit.red` | Todas las funciones `hit-*` y `point-in-*` | ~250 | Unit tests puros | +| `canvas-wire.red` | Validación de wires, tipo matching, wire roto | ~150 | Unit tests puros | +| `canvas-struct.red` | CRUD de estructuras (add/remove nodes, shift registers) | ~200 | Unit tests puros | + +canvas.red queda como orquestador (~600 líneas) que importa de los tres módulos. + +**Conexión con red-sg:** Las funciones puras extraídas (hit-test, wire validation, CRUD) +son las que red-sg reemplazará en la migración. Al separarlas ahora: +- Se pueden testear sin GUI +- La migración a red-sg es incremental: se reemplazan funciones, no se reescribe todo +- El orquestador (canvas.red) queda preparado para cambiar su motor de render + +**Referencia:** GRC separó `grc/core/` (modelo puro) de `grc/gui/` (vista). QTorres hace lo +mismo con hit/wire/struct extraídos del canvas. + +**Issue nuevo:** Refactor canvas: extraer hit-test, wire validation y structure CRUD + +#### 3.2 Extraer lógica de btn-run a funciones nombradas (PRIORIDAD ALTA) + +**Problema:** 120 líneas de lógica inline en el actor `on-down` de btn-run. Lógica duplicada +(waveform-chart se maneja 4 veces con código casi idéntico). + +**Acción:** Crear `src/ui/runner-logic.red` con: + +```red +sync-fp-to-bd: func [model] [...] ; Sincronizar valores FP → BD +load-subvis: func [model] [...] ; Cargar contextos de sub-VIs +execute-headless: func [model] [...] ; Compilar y ejecutar en memoria +update-indicators: func [model fp-face] [...] ; Leer resultados y actualizar FP +``` + +btn-run se reduce a: `sync → load → execute → update → show`. + +**Issue nuevo:** Extraer btn-run a funciones nombradas en runner-logic.red + +#### 3.3 Centralizar type-info en blocks.red (PRIORIDAD MEDIA) + +**Problema:** Añadir un tipo nuevo requiere tocar canvas-render.red, panel-render.red, +compiler.red y blocks.red. No hay fuente de verdad centralizada. + +**Acción:** Añadir un diccionario `type-info` en `blocks.red`: + +```red +type-info: make map! [ + 'number make object! [ + color: 255.128.0 + wire-width: 1 + wire-pattern: 'solid + fp-type: 'numeric + bd-render: 'numeric-render ; referencia a función de render + ] + 'boolean make object! [ + color: 0.200.0 + wire-width: 1 + wire-pattern: 'solid + fp-type: 'bool-control + bd-render: 'bool-render + ] + ; ... etc +] +``` + +Los módulos de render consultan `type-info` en vez de hacer `switch` por tipo. + +**Referencia:** GRC usa `.block.yml` como fuente única de verdad para cada bloque. QTorres +usa `block-def` como fuente de verdad para puertos y emit, pero los hints visuales están +dispersos. `type-info` centraliza los hints visuales junto a los puertos y emit. + +**Issue nuevo:** Centralizar type-info: color, grosor, patrón wire, fp-type en blocks.red + +#### 3.5 Tests de file-io.red (PRIORIDAD ALTA) + +**Problema:** file-io.red tiene 939 líneas sin tests unitarios propios. Solo tiene cobertura +indirecta a través de los tests del compilador. + +**Acción:** Crear `tests/test-file-io.red` con: + +1. **Round-trip básico:** serialize → format-qvi → load → verificar igualdad del modelo +2. **Round-trip con estructuras:** while-loop, for-loop, case-structure +3. **Round-trip con clusters:** bundle/unbundle con campos +4. **Round-trip con sub-VIs:** connector pane y referencias a ficheros +5. **Edge cases:** modelo vacío, modelo con un solo nodo, wires huérfanos + +**Issue nuevo:** Tests unitarios para file-io: round-trip, edge cases, estructuras + +#### 3.6 Tests del runner (PRIORIDAD MEDIA) + +**Acción:** Crear `tests/test-runner.red` con: + +1. Ejecutar un diagrama simple (suma A+B) y verificar resultado +2. Ejecutar un diagrama con while-loop y verificar resultado +3. Ejecutar un diagrama con sub-VI y verificar resultado +4. Verificar que `qtorres-runtime` se limpia correctamente + +**Issue nuevo:** Tests unitarios para runner: ejecución en memoria, sub-VIs, limpieza + +#### 3.7 Reportar bugs GTK upstream (PRIORIDAD ALTA) + +**Problema:** 17 bugs GTK documentados, 0 issues creados en `red/red`. + +**Acción:** Crear issues en `github.com/red/red` para los bugs más críticos, con casos +mínimos reproducibles: + +| Bug | Prioridad | Acción | +|-----|-----------|--------| +| GTK-016 (access violation) | CRÍTICA | Caso mínimo + issue | +| GTK-004 (locale float) | ALTA | Caso mínimo + issue | +| GTK-014 (size flip-flop) | ALTA | Caso mínimo + issue (ya hay test reproducible) | +| GTK-007 (modal pierde foco) | ALTA | Caso mínimo + issue | +| GTK-001 (DPI none) | MEDIA | Caso mínimo + issue | + +**Issue nuevo:** Crear issues en red/red para GTK-016, GTK-004, GTK-014, GTK-007, GTK-001 + +--- + +### Fase 4 — Hardware (SCPI, Serial, TCP/IP, DAQ) + +> **Prioridad estratégica:** Fase 4 va **antes** que Fase 5 (UX). Un QTorres que habla con +> instrumentos reales aporta valor a ingenieros de laboratorio; un QTorres con undo/redo +> pero sin hardware solo aporta valor a quien ya tiene otras herramientas. La UX se pule +> cuando hay algo útil que usar. + +**Premisa:** La Fase 4 añade bloques de comunicación con hardware. Estos bloques tienen +requisitos especiales: timeouts, manejo de errores (DT-029 nivel 2), y operaciones I/O +bloqueantes. Necesitan una base sólida de tests y una arquitectura limpia para funcionar. + +#### 4.1 Error cluster — DT-029 Nivel 2 (PRIORIDAD ALTA) + +**Problema:** Sin error cluster, cualquier fallo de hardware mata el programa. Inaceptable +para instrumentación. + +**Acción:** Implementar error cluster completo: +- Puertos `error-in`/`error-out` en bloques de hardware +- Wire amarillo en el canvas +- Compilador genera checks de error entre nodos +- Modelo de datos ya lo soporta (`type: 'error` en puertos) + +**Referencia:** LabVIEW propaga errores por cable. Es el estándar de la industria para +instrumentación. Sin esto, QTorres no es viable para hardware real. + +**Issue existente:** Parte de DT-029, planificado para Fase 4. + +#### 4.2 Timeout y operaciones I/O no bloqueantes (PRIORIDAD ALTA) + +**Problema:** Red no tiene I/O asíncrono ni timeouts nativos para TCP/serial. Un +`read` bloqueante congela la GUI. + +**Acción:** Implementar un wrapper de I/O con timeout usando `set-timer` o el sistema de +concurrencia cooperativa (DT-027): + +```red +; Patrón: intentar operación con timeout +scpi-query: func [instrument command /timeout ms /local result timer] [ + timer: make object! [expired: false] + ; ... implementar con rate/on-time o callback +] +``` + +**Nota:** Esto es investigación y diseño, no solo implementación. La estrategia exacta +depende de las capacidades de Red para I/O con timeout, que deben validarse primero. + +#### 4.3 Tests de compilación con `red -c` (PRIORIDAD MEDIA) + +**Problema:** DT-028 exige que todo `.qvi` generado sea compilable con `red -c`. No hay +CI que lo verifique. + +**Acción:** Añadir step de CI que: +1. Genera un `.qvi` de ejemplo con cada tipo de bloque +2. Ejecuta `red -c ejemplo.qvi` +3. Verifica que el binario se genera sin errores +4. Ejecuta el binario y verifica que muestra el Front Panel + +**Issue nuevo:** CI: verificar compilabilidad de .qvi con red -c + +--- + +### Fase 4.5 — Migración incremental a red-sg (PUENTE CRÍTICO) + +**Premisa:** La migración a red-sg es el mayor salto de calidad disponible. Simplifica +~2000 líneas de UI, aporta undo/redo probado, y establece coordenadas locales. Se ejecuta +después de Fase 4 (hardware funciona) y antes de Fase 5 (UX). + +**NOTA sobre zoom:** QTorres NO implementa zoom (DT-005, visual-spec 1.1). Igual que +LabVIEW. red-sg soporta zoom internamente, pero QTorres no lo habilita. Lo que sí usa +de red-sg es: scene graph, coordenadas locales, hit-test con transforms inversas, +event routing y undo/redo. + +#### 4.5.1 Migrar hit-test a sg-hit-test (PRIORIDAD ALTA) + +**Acción:** Reemplazar las funciones `hit-*` de `canvas-hit.red` por `sg-hit-test`: +- Los nodos QTorres se mapean a `sg-node` con su draw-cmd +- `sg-hit-test` hace el walk del árbol con matrix inversa +- Elimina ~250 líneas de hit-test manual + +**Precondición:** canvas-hit.red ya extraído (3.1). +**Postcondición:** Las funciones de hit-test de QTorres delegan en red-sg. + +#### 4.5.2 Migrar render de nodos a sg-nodos (PRIORIDAD ALTA) + +**Acción:** Cada nodo QTorres (add, sub, control, etc.) se convierte en un `sg-node` +con su `draw-cmd` generado por `canvas-render.red`: + +```red +; Antes: render-bd genera un bloque Draw gigante +face/draw: render-bd model + +; Después: cada nodo es un sg-node, render-scene genera el Draw +node: make-sg-node [ + type: 'qtorres-block + x: n/x y: n/y + draw-cmd: render-node-draw n ; función existente, adaptada a coords locales +] +sg-add-child scene/root node +face/draw: render-scene scene +``` + +**Beneficio:** Los nodos tienen coordenadas locales. El render se genera desde el +scene graph, no desde una función monolítica. Las estructuras (while-loop, case) +son `sg-node` tipo `'group` con children. + +#### 4.5.3 Migrar scroll a sg-transform viewport (PRIORIDAD MEDIA) + +**Acción:** Reemplazar el scroll manual (scroll-x/scroll-y en app-model + scrollbars +Draw-based) por `scene/view-x` y `scene/view-y` de red-sg: + +```red +; Antes: scroll manual +model/scroll-x: model/scroll-x + delta +face/draw: render-bd model + +; Después: viewport de red-sg +scene/view-x: scene/view-x + delta +face/draw: render-scene scene +``` + +**Beneficio:** El scroll es una transform del viewport, no un offset en cada nodo. +Más simple, más robusto, sin workarounds GTK para tamaño de ventana. + +#### 4.5.4 Activar undo/redo con sg-undo (PRIORIDAD ALTA) + +**Acción:** Conectar el stack de undo/redo de red-sg a las operaciones del canvas: + +```red +; Al mover un nodo: +sg-push-undo scene [action: 'move-node target: node old-x: node/x old-y: node/y] +node/x: new-x node/y: new-y + +; Ctrl+Z en on-key: +sg-undo scene +face/draw: render-scene scene +``` + +Ver DT-031 para los comandos específicos. + +#### 4.5.5 Migrar panel.red a sg-nodos (PRIORIDAD MEDIA) + +**Acción:** Igual que 4.5.2 pero para el Front Panel. Cada fp-item se convierte en +un `sg-node` con su draw-cmd. Los widgets de instrumentación (numeric, boolean, chart) +son sg-nodos con draw-cmds específicos. + +**Conexión con red-sg Fase 2:** Cuando red-sg tenga widgets Draw-based (numeric field, +boolean LED, slider), QTorres puede usarlos directamente en vez de draw-cmds custom. + +**Issue nuevo:** Migración incremental a red-sg: hit-test → render → scroll → undo → panel + +--- + +### Fase 5 — UX y gestión de proyectos + +**Premisa:** La Fase 5 es donde el proyecto pasa de "funciona para el desarrollador" a +"es usable por un ingeniero". Requiere undo/redo, mejor UX y gestión de proyectos. + +#### 5.1 Undo/Redo via red-sg (PRIORIDAD CRÍTICA) + +**Problema:** Sin undo/redo, cualquier error del usuario es irreversible. Es la feature +de UX más importante para un editor visual. + +**Acción:** Usar `sg-undo.red` de red-sg como motor de undo/redo. La librería ya tiene +un stack genérico con `sg-push-undo`/`sg-undo`/`sg-redo` probado con tests. + +Integración en QTorres: + +```red +; Cada operación del canvas envuelve una acción sg-undo +sg-push-undo scene compose [ + action: 'move-node + target: (node) ; el nodo afectado + old-x: (node/x) ; estado anterior + old-y: (node/y) + new-x: (new-x) ; estado nuevo + new-y: (new-y) +] + +; Ctrl+Z → sg-undo scene +; Ctrl+Y → sg-redo scene +``` + +**Comandos mínimos para Fase 5:** + +| Comando | `do` | `undo` | +|---------|------|--------| +| add-node | Añadir nodo al modelo | Eliminar nodo del modelo | +| delete-node | Eliminar nodo (+ wires conectados) | Restaurar nodo y wires | +| move-node | Actualizar x, y | Restaurar x, y anteriores | +| add-wire | Añadir wire al modelo | Eliminar wire | +| delete-wire | Eliminar wire | Restaurar wire | +| edit-label | Actualizar label/text | Restaurar label/text anterior | +| add-structure | Añadir estructura | Eliminar estructura | + +**Ventaja sobre implementación desde cero:** red-sg ya tiene el stack probado con tests. +QTorres solo necesita definir los comandos específicos del dominio (add-node, move-node, etc.) +y conectarlos al stack existente. + +**Atajo Ctrl+Z / Ctrl+Y:** Conectar al stack en el `on-key` de las ventanas BD y FP. + +**Issue nuevo:** Integrar sg-undo de red-sg para Undo/Redo (DT-031) + +#### 5.2 Dirty flags en app-model — DESCARTADO + +**Propuesta original:** añadir flags de dirty (`bd`, `fp`, `file`) en `app-model` para +sincronización automática entre Block Diagram y Front Panel. + +**Motivo de descarte (2026-04-14):** El acoplamiento BD↔FP es **unidad 1:1 por diseño del +dominio** (ver `CLAUDE.md` sección "Problemas conocidos de arquitectura" y memoria +`project_fp_bd_architecture.md`). Añadir dirty flags introduce estado mutable compartido +que hay que mantener sincronizado, lo cual duplica el problema que pretende resolver. + +**Criterio de reintroducción:** si aparece un bug real de desincronización BD↔FP que no +se pueda resolver con el patrón actual (render explícito al mutar), reabrir esta decisión. +Mientras tanto, no implementar. + +#### 5.3 Welcome screen y Project Explorer (funcionalidad de Fase 5) + +**Estas son features nuevas, no refactor.** Se implementan según el plan existente. +Pero deben usar los comandos undo/redo (5.1) para todas las operaciones, y los dirty +flags (5.2) para indicar cambios sin guardar. + +**Issue existentes:** #Splash, #Project Explorer + +--- + +## Resumen de Issues nuevos + +| # | Issue | Fase | Prioridad | +|---|-------|------|-----------| +| 1 | Refactor canvas: extraer hit-test, wire, struct (prepara red-sg) | 3 | ALTA | +| 2 | Extraer btn-run a runner-logic.red | 3 | ALTA | +| 3 | Centralizar type-info en blocks.red | 3 | MEDIA | +| 4 | Tests file-io: round-trip, edge cases | 3 | ALTA | +| 5 | Tests runner: ejecución en memoria | 3 | MEDIA | +| 6 | Crear issues red/red para GTK bugs | 3 | ALTA | +| 7 | Error cluster (DT-029 Nivel 2) | 4 | ALTA | +| 8 | I/O con timeout para hardware | 4 | ALTA | +| 9 | CI: verificar compilabilidad con red -c | 4 | MEDIA | +| 10 | Integración incremental con red-sg (canvas → scene graph) | 4.5 | ALTA | +| 11 | Undo/Redo via sg-undo de red-sg (DT-031) | 5 | ALTA | + +> **Nota sobre priorización:** ALTA/MEDIA/BAJA es una guía relativa, no un ranking fino. +> No se asignan decimales porque cualquier impacto cuantitativo sería pseudocientífico +> (no hay baseline medido; ver "Métricas pendientes"). + +**Evolución cualitativa esperada por dimensión:** + +| Dimensión | Actual | Tras Fase 3 | Tras Fase 4 | Tras Fase 4.5 | Tras Fase 5 | +|-----------|--------|-------------|-------------|----------------|-------------| +| Arquitectura | Bueno | Muy bueno | Muy bueno | Excelente | Excelente | +| Cobertura de tests | Débil | Buena | Buena | Buena | Muy buena | +| Código limpio (canvas/panel) | Regular | Bueno | Bueno | Muy bueno | Muy bueno | +| UX (undo/redo, welcome) | Ausente | Ausente | Ausente | Parcial | Completa | +| Plataforma (GTK estable) | Regular | Buena | Buena | Buena | Buena | +| Documentación | Muy buena | Muy buena | Muy buena | Muy buena | Muy buena | + +La integración con red-sg (Fase 4.5) no es un "multiplicador" extraordinario sino la +consecuencia esperada de la separación aplicación/toolkit. Sin ella, QTorres tendría +que reimplementar el scene graph, el hit-test con transforms, el undo/redo genérico y +los widgets Draw-based dentro de su propio código, duplicando esfuerzo y desenfocándose +de su dominio (bloques, wires, compilación, hardware). + +--- + +## Contraste Red-Lang vs. alternativas + +### ¿Por qué Red-Lang y no X? + +| Alternativa | Ventaja sobre Red | Desventaja vs Red | Veredicto | +|-------------|-------------------|-------------------|-----------| +| **Python + PyQt** | Ecosistema, 64-bit, async, tests | Binario grande (200MB+), 2 lenguajes, no homoicónico | No — rompe DT-001 | +| **JavaScript + Electron** | Ecosistema web, 64-bit, async | Binario enorme (300MB+), no nativo, Chromium | No — rompe DT-001 | +| **Rust + egui** | Rendimiento, 64-bit, safety | Curva de aprendizaje, ecosistema pequeño, no homoicónico | No — rompe DT-001 | +| **C++ + Qt** | Rendimiento, madurez, QGraphicsScene | Compilación compleja, binario grande, no homoicónico | No — rompe DT-001 | +| **Rebol 3** | Estabilidad, 64-bit (R3) | Comunidad menor, sin View completo, sin compilación nativa | No — sin View completo | + +**Conclusión:** Red-Lang es la única opción que cumple DT-001 (todo en Red, sin dependencias +externas, binario < 1 MB, compilable a nativo). El riesgo principal es la madurez del +runtime (32-bit, bugs GTK, sin concurrencia), mitigado por la estrategia de contribuir +fixes upstream. + +### Riesgos específicos de Red-Lang y mitigaciones + +| Riesgo | Impacto | Probabilidad | Mitigación | +|--------|---------|-------------|-----------| +| 32-bit en sistemas sin i386 | Alto — no funciona en distros modernas | Alta (ya ocurre) | Plan B: empaquetar con Docker o VM para Linux. Windows funciona. | +| Bugs GTK sin fix upstream | Alto — canvas visual roto en Linux | Media | Reportar bugs con casos mínimos. Workaround: ventanas fijas (ya hecho). | +| Red nunca llega a 1.0 | Crítico — proyecto huérfano | Baja (proyecto activo) | El código generado es Red estándar. Si Red muere, se puede reescribir el editor en otra tecnología manteniendo el formato .qvi. | +| Red no añade concurrencia | Medio — loops paralelos limitados | Media | DT-027 ya define el modelo cooperativo. Si Red añade actors/CSP, se migra sin cambiar la arquitectura. | +| Red migra a 64-bit | Positivo — soluciona GTK y i386 | Alta (en roadmap) | QTorres se beneficia automáticamente. Los .qvi generados no cambian. | + +--- + +## Riesgos existenciales y plan de mitigación + +Tres riesgos pueden invalidar el proyecto entero. Se les da sección propia porque "Docker +o VM" no es un plan, es una mitigación parcial. Aquí el plan real. + +### Riesgo 1 (CRÍTICO): 32-bit en distros Linux modernas + +**Problema:** Red es 32-bit. Las distros modernas (Fedora 40+, Ubuntu 24.04 server) +eliminan o dificultan las libs i386 por defecto. Sin ellas, `red-view` no arranca. + +**Plan escalonado:** + +1. **Corto plazo (Fase 3):** Documentar en `README.md` las instrucciones exactas para + instalar libs 32-bit en las 3 distros principales (Ubuntu, Fedora, Arch). Verificado + al ejecutar `red-view src/qtorres.red`. +2. **Medio plazo (Fase 4):** Crear imagen Docker oficial con Red 32-bit + dependencias + GTK + tests en verde. Uso doble: CI reproducible + onboarding de nuevos contributors + en distros hostiles. +3. **Seguimiento trimestral:** Monitorear el roadmap 64-bit de Red (issues en `red/red`). + Probar cualquier branch/preview 64-bit en cuanto esté disponible. +4. **Cuando Red publique 64-bit:** migración es transparente para `.qvi` (código Red + estándar). Los cambios se concentran en QTorres/red-sg para cualquier API rota. + +### Riesgo 2 (ALTO): Red nunca llega a 1.0 + +**Problema:** Si el proyecto Red se detiene, QTorres queda huérfano de runtime. + +**Mitigación estructural:** El formato `.qvi` es Red estándar. Si Red muere, el editor +QTorres puede reescribirse en otra tecnología (Rust + egui, C++ + Qt) **preservando los +ficheros de usuario** — los `.qvi` siguen siendo válidos como descripción del diagrama +aunque se pierda la ejecución directa. Es la ventaja de `qvi-diagram` como fuente de +verdad (DT-011). + +**Probabilidad:** Baja — proyecto activo con commits recientes. Pero el plan B existe +por diseño, no por casualidad. + +### Riesgo 3 (MEDIO): Bugs GTK bloqueantes sin fix upstream + +**Problema:** 17 bugs GTK documentados en `docs/GTK_ISSUES.md`, 0 reportados upstream. +Cada workaround local añade complejidad y deuda técnica. + +**Plan:** + +1. Fase 3.7: crear 5 issues en `red/red` con casos mínimos (prioridad: GTK-016, GTK-004, + GTK-014, GTK-007, GTK-001). +2. Política: cada bug GTK nuevo que se detecte requiere issue upstream antes del + workaround local. No acumular. +3. Mantener `docs/GTK_ISSUES.md` como registro con links a issues upstream y estado. + +--- + +## Métricas pendientes + +Este roadmap hace varias afirmaciones cuantitativas ("-2000 líneas", "reducción de +canvas.red a ~400 líneas") que son **estimaciones, no mediciones**. No hay baseline de +rendimiento ni de productividad. Declararlo explícito para evitar falsa precisión. + +**Baselines por establecer (antes de Fase 4.5):** + +| Métrica | Valor actual | Método de medición | +|---------|--------------|---------------------| +| Número máximo de nodos renderizables a 60fps | Desconocido | Benchmark con diagramas sintéticos de 10, 100, 500, 1000 nodos | +| Tiempo de compilación de VI mediano (20 nodos) | Desconocido | Medir `compile-diagram` sobre corpus de `examples/` | +| Tamaño medio de `.qvi` en producción | Desconocido | Estadística sobre ejemplos + VIs reales de usuario | +| Líneas de código UI tras extraer hit/wire/struct | Desconocido | `wc -l` post Fase 3.1 | +| Líneas de código UI tras integración red-sg | Desconocido | `wc -l` post Fase 4.5 | + +**Acción:** Fase 4.5 debe establecer baselines antes de integrar red-sg para poder +cuantificar el impacto real de la migración. Sin baseline, cualquier afirmación de +mejora será anecdótica. + +--- + +## Principios rectores para mantener la calidad + +1. **Refactorizar antes de añadir.** Si un módulo supera las 800 líneas, extraer + responsabilidades antes de añadir features. + +2. **Todo código testeable tiene tests.** Si se puede extraer a una función pura, tiene + test. Si depende de View, se documenta como "test manual". + +3. **Un tipo nuevo toca 2 ficheros, no 4.** `type-info` en `blocks.red` + la función de + render en el módulo correspondiente. No dispersar el conocimiento. + +4. **Cada Issue cerrado tiene tests.** No se merge sin tests que verifiquen el + comportamiento. + +5. **Cada bug GTK reportado upstream.** No acumular workarounds locales. + +6. **La documentación es la verdad.** Si el código y la documentación discrepan, + actualizar la documentación. Si la decisión cambia, crear una DT nueva. + +7. **El formato .qvi es sagrado.** Cualquier cambio en el formato debe pasar por + tests de round-trip antes de merge. + +--- + +## Apéndice: DT nuevas propuestas + +### DT-031: Undo/Redo via red-sg + +**Contexto:** Todo editor visual necesita undo/redo. LabVIEW tiene un stack global. GRC Qt +tiene QUndoStack por flowgraph. Orange tiene QUndoCommand. Rete.js tiene HistoryPlugin. +QTorres tiene red-sg con `sg-undo.red` ya implementado y testeado. + +**Decisión:** Usar el stack de undo/redo de red-sg (`sg-undo`). QTorres define comandos +específicos del dominio (add-node, move-node, etc.) y los registra en el stack de red-sg. +No reimplementar desde cero — red-sg ya tiene el motor probado. + +**Stack en scene:** + +```red +; sg-undo ya proporciona: +sg-push-undo scene action-block ; registrar una acción +sg-undo scene ; deshacer última acción +sg-redo scene ; rehacer última acción +sg-can-undo? scene ; hay algo que deshacer? +sg-can-redo? scene ; hay algo que rehacer? +``` + +**Comandos QTorres:** + +| Comando | do | undo | +|---------|-------|------| +| add-node | append model/nodes node | remove-each n model/nodes [n/id = node/id] | +| delete-node | remove-each + remove wires | append model/nodes + append model/wires | +| move-node | node/x: new-x, node/y: new-y | node/x: old-x, node/y: old-y | +| add-wire | append model/wires wire | remove-each w model/wires [w = wire] | +| delete-wire | remove wire | append model/wires wire | +| edit-label | label/text: new-text | label/text: old-text | + +**Atajos:** Ctrl+Z = `sg-undo scene`, Ctrl+Y = `sg-redo scene`. + +**Limitación de Fase 5:** No se implementa undo para operaciones de Front Panel (posición, +tamaño de controles) hasta que FP tenga su propio modelo de comandos. + +### DT-032: Type-info centralizado + +**Contexto:** Añadir un tipo de dato nuevo requiere modificar 4+ ficheros (canvas-render, +panel-render, compiler, blocks). No hay fuente de verdad para los atributos visuales. + +**Decisión:** Añadir `type-info` como diccionario en `blocks.red`. Cada tipo de dato define +sus atributos visuales y de compilación en un solo sitio: + +```red +type-info: make map! [ + 'number make object! [color: 255.128.0 wire-width: 1 wire-pattern: 'solid fp-types: ['numeric] default-val: 0.0] + 'boolean make object! [color: 0.200.0 wire-width: 1 wire-pattern: 'solid fp-types: ['bool-control 'bool-indicator] default-val: false] + 'string make object! [color: 220.50.150 wire-width: 1 wire-pattern: 'dashed fp-types: ['str-control 'str-indicator] default-val: ""] + 'array make object! [color: 255.128.0 wire-width: 3 wire-pattern: 'double fp-types: ['arr-control 'arr-indicator] default-val: copy []] + 'cluster make object! [color: 160.100.40 wire-width: 1 wire-pattern: 'braided fp-types: ['cluster-control 'cluster-indicator] default-val: copy []] + 'waveform make object! [color: 255.128.0 wire-width: 1 wire-pattern: 'solid fp-types: ['waveform-chart 'waveform-graph] default-val: copy []] + 'error make object! [color: 255.220.0 wire-width: 1 wire-pattern: 'solid fp-types: [] default-val: none] +] +``` + +Los módulos de render y compilación consultan `type-info` en vez de hacer `switch` por tipo. +Añadir un tipo nuevo = añadir una entrada en `type-info` + la función de render. + +### DT-033: QT-Widgets — capa intermedia formalizada + +**Contexto:** DT-030 ya define la arquitectura de widgets (Red/View + Draw + QT-Widgets). +Este DT formaliza el momento de extracción. + +**Decisión:** No extraer QT-Widgets como módulo separado hasta tener 3-4 widgets +implementados ad-hoc dentro de los módulos existentes. En ese momento, extraer a +`src/ui/widgets/` con: + +- `scrollbar.red` — ya existe como Draw-based (Issue #65) +- `text-input.red` — inline editing en el canvas (futuro) +- `tree-view.red` — Project Explorer (Fase 5) +- `tab-bar.red` — para Case Structure y configuración + +Cada widget sigue el patrón: función `render-*` que devuelve bloque Draw + función +`hit-test-*` para eventos. + +**Plan de extracción:** Fase 5+, después de tener scroll + text-input funcionando ad-hoc. + +--- + +## Autocrítica del roadmap + +Este documento es una hoja de ruta, no un contrato. Para evitar leerlo como si fuera +una verdad revelada, se listan aquí sus puntos débiles conocidos: + +### Supuestos no validados + +1. **"-2000 líneas de UI tras Fase 4.5"** — estimación sin baseline. Las migraciones + reales suelen añadir código de puente antes de reducir. La cifra real se conocerá + al cerrar 4.5. +2. **"Undo/redo de red-sg es probado"** — red-sg tiene tests propios, pero **nunca se + ha integrado en QTorres**. La integración puede descubrir cosas que los tests + aislados no cubren. +3. **Priorización ALTA/MEDIA/BAJA** — sigue siendo subjetiva. Menos deshonesta que la + puntuación decimal original, pero no es objetiva. +4. **"Fase 4 antes que Fase 5"** — es la opinión actual del autor del roadmap. Un + usuario real podría considerar undo/redo más urgente que SCPI si su caso de uso + no incluye hardware. + +### Decisiones que este documento no justifica + +- **Por qué Fase 4.5 y no integrar red-sg ya en Fase 3** — porque red-sg aún no está + maduro para producción. Pero no hay criterio escrito de "cuándo red-sg está listo". +- **Por qué no reportar bugs GTK inmediatamente al detectarlos** — política histórica + de acumular y reportar en bloque. Debería cambiarse. +- **Por qué no hay métricas de rendimiento ya** — no se han priorizado. Reconocido + como deuda en "Métricas pendientes". + +### Qué hace frágil este roadmap + +- **Dependencia fuerte de red-sg:** si red-sg se retrasa o cambia de alcance, Fase 4.5 + se bloquea y hay que reimplementar capacidades dentro de QTorres. +- **Dependencia de Red 64-bit para Linux moderno:** fuera de nuestro control. +- **Estimaciones de esfuerzo ausentes:** no se dice "Fase 3 tarda 2 semanas". Quien + lea esto no puede planificar recursos. + +### Revisión programada + +Este roadmap debe revisarse **al cierre de cada fase**, no al final. Los supuestos que +hoy parecen razonables pueden invalidarse al medir. Cualquier cifra que aparezca aquí +y no se haya medido, debe marcarse explícitamente como "estimación". \ No newline at end of file diff --git a/examples/README-EXAMPLES.md b/examples/README-EXAMPLES.md new file mode 100644 index 0000000..251acba --- /dev/null +++ b/examples/README-EXAMPLES.md @@ -0,0 +1,43 @@ +# Ejemplos QTorres + +Corpus de VIs funcionales que demuestran features del proyecto. + +## Ejemplos unitarios (features Fase 1-3) + +- `suma-basica.qvi` — Aritmética básica (Fase 1) +- `suma-subvi.qvi` — Sub-VI standalone (Fase 3) +- `programa-con-subvi.qvi` — Llamada a sub-VI (Fase 3) +- `while-loop-basico.qvi` — While Loop (Fase 2) +- `while-loop-suma.qvi` — While Loop con shift registers (Fase 2) +- `for-loop-basico.qvi` — For Loop (Fase 2) +- `case-numeric.qvi` — Case Structure selector numérico (Fase 2) +- `case-boolean.qvi` — Case Structure selector booleano (Fase 2) +- `cluster-basico.qvi` — Cluster con Bundle/Unbundle (Fase 2) +- `waveform-demo.qvi` — Waveform Chart/Graph (Fase 2) + +## Librerías + +- `math.qlib` / `math/` — Librería ejemplo con Add, Subtract (Fase 3) +- `usa-libreria.qvi` — VI que consume math.qlib (Fase 3) + +## Proyecto (Fase 5 pendiente) + +- `ejemplo.qproj` — Prototipo temprano de formato `.qproj`. Define proyecto con 3 VIs y target executable. Sin tooling Project Explorer aún (Fase 5). + +## Ejecución + +**Headless (terminal):** +```bash +./red-cli examples/suma-basica.qvi A=5.0 B=3.0 +# Salida: 8.0 +``` + +**UI (ventana):** +```bash +./red-view examples/suma-basica.qvi +# Abre ventana con Front Panel +``` + +## Validación + +Todos los ejemplos pasan en `tests/run-all.red` (482 tests PASS). diff --git a/red-cli b/red-cli index 4d5220c..83aa9a4 100755 Binary files a/red-cli and b/red-cli differ diff --git a/red-fork-version.txt b/red-fork-version.txt new file mode 100644 index 0000000..405b5a5 --- /dev/null +++ b/red-fork-version.txt @@ -0,0 +1,16 @@ +Fork: https://github.com/anlaco/red.git +Branch: fix/gtk3-resize-bugs +Commit: 2a93443f3 (BUGFIX: correct GTK3 window state constants and add fullscreen support) +Date: 2026-04-17 + +Fixes aplicados en este commit: +- GTK-014: face/size flip-flop CSD↔cliente (commit 496a7c5) +- GTK-003 Bug A: on-resize no se dispara en maximize/restore (commit b381d9d) +- GTK-003 Bug B: base/panel no se repinta tras maximize/restore (commit dbcfbe8) +- GTK-003 fullscreen support añadido (commit 2a93443) + +Para actualizar a nuevo commit del fork: + cd /home/alaforga/Anlaco/01-PRODUCTOS/red + git pull origin fix/gtk3-resize-bugs + # recompilar red-cli/red-view si cambian archivos en /runtime + # actualizar este fichero con el nuevo commit hash diff --git a/red-view b/red-view index 456da98..bcc34e2 100755 Binary files a/red-view and b/red-view differ diff --git a/src/compiler/compiler-body.red b/src/compiler/compiler-body.red new file mode 100644 index 0000000..2764899 --- /dev/null +++ b/src/compiler/compiler-body.red @@ -0,0 +1,315 @@ +Red [ + Title: "QTorres — Compilador (body: compile-body, compile-diagram, sub-VI calls)" + Purpose: "Núcleo del compilador — orquesta emit + estructuras para generar cuerpo y layout" +] + +; ══════════════════════════════════════════════════ +; SUBVI COMPILATION (Fase 3) +; ══════════════════════════════════════════════════ + +; Genera código para llamar a un sub-VI. +; La función del sub-VI viene de node/config/func-name. +; Los argumentos vienen de los wires conectados a los puertos de entrada del connector. +; Los resultados se asignan a variables de los puertos de salida. +compile-subvi-call: func [ + node [object!] + diagram [object!] + /local func-name connector inputs outputs code arg-vars out-var w src pin-word +][ + code: copy [] + + ; Obtener función y connector del config + func-name: select node/config 'func-name + connector: select node/config 'connector + if any [none? func-name none? connector] [return code] + + inputs: any [select connector 'inputs copy []] + outputs: any [select connector 'outputs copy []] + + ; Recolectar argumentos de los wires conectados a cada puerto de entrada + ; inputs es [pin label id pin label id ...] + arg-vars: copy [] + repeat i ((length? inputs) / 3) [ + pin-word: to-word rejoin ["p" inputs/(i * 3 - 2)] ; pin → 'p1, 'p2... + found: false + foreach w diagram/wires [ + if all [ + w/to-node = node/id + (to-word w/to-port) = pin-word + ][ + src: find-node-by-id diagram/nodes w/from-node + if src [ + append arg-vars port-var src to-word w/from-port + found: true + ] + ] + ] + ; Si no hay wire, usar valor por defecto 0.0 + if not found [append arg-vars 0.0] + ] + + ; Generar llamada: resultado: func-name/exec arg1 arg2 ... + ; outputs es [pin label id pin label id ...] + ; Por simplicidad, asumimos una sola salida (la primera) + if not empty? outputs [ + out-pin: to-word rejoin ["p" outputs/1] ; pin del primer output + out-var: port-var node out-pin + append code to-set-word out-var + ] + + ; Añadir la llamada a la función: func-name/exec (append/only para no extender el path) + append/only code to-path reduce [to-word func-name 'exec] + foreach arg arg-vars [append code arg] + + code +] + +; ══════════════════════════════════════════════════ +; COMPILE-BODY +; ══════════════════════════════════════════════════ +; +; Genera el bloque de cómputo headless listo para ejecutar con do. +; Incluye todos los nodos normales y las estructuras. + +compile-body: func [ + diagram [object!] + /with-prints ; añade print por indicador — solo para ejecución standalone (red-cli .qvi) + /local sorted code item bdef +][ + sorted: build-sorted-items diagram + code: copy [] + foreach item sorted [ + case [ + find [while-loop for-loop case-structure] item/type [ + append code compile-structure/no-gui item diagram + ] + item/type = 'bundle [append code emit-bundle item diagram] + item/type = 'unbundle [append code emit-unbundle item diagram] + item/type = 'cluster-control [append code emit-cluster-control-headless item diagram] + item/type = 'cluster-indicator [append code emit-cluster-indicator-headless item diagram] + item/type = 'subvi [append code compile-subvi-call item diagram] + true [ + bdef: find-block item/type + if all [bdef bdef/emit] [ + append code bind-emit bdef/emit (build-bindings item diagram bdef) + ] + ] + ] + ] + + ; Prints para modo standalone (red-cli .qvi) — solo con /with-prints + if with-prints [ + foreach item sorted [ + bdef: find-block item/type + if none? bdef [continue] + if bdef/category = 'output [ + if all [in diagram 'wires block? diagram/wires] [ + foreach w diagram/wires [ + if w/to-node = item/id [ + src: find-node-by-id diagram/nodes w/from-node + if src [ + src-var: port-var src to-word w/from-port + lbl: either all [item/label object? item/label] [item/label/text] [any [item/name ""]] + ; Construir [print rejoin ["label" ": " form var-word]] sin compose + append code 'print + append code 'rejoin + append/only code reduce [copy lbl ": " 'form to-word src-var] + ] + ] + ] + ] + ] + ] + ] + + code +] + +; ══════════════════════════════════════════════════ +; COMPILE-DIAGRAM +; ══════════════════════════════════════════════════ +; +; Genera los componentes de código para un VI completo: +; /headless: block! ejecutable con do (usa config defaults) +; /ui-layout: block! para view layout (controles + botón Run + indicadores) +; +; Para nodos de categoría 'input: el run-body lee de campos de texto del UI. +; Para nodos de categoría 'output: el run-body escribe en etiquetas del UI. +; Para nodos math: usa bind-emit igual que compile-body. + +compile-diagram: func [ + diagram [object!] + /local sorted headless run-body ui-layout item node bdef face-n cfg-val w src src-var bindings +][ + sorted: build-sorted-items diagram + headless: compile-body/with-prints diagram + + ; ── Cuerpo del botón Run (modo UI) ──────────────────────── + run-body: copy [] + foreach item sorted [ + case [ + find [while-loop for-loop] item/type [ + append run-body compile-structure item diagram + ] + item/type = 'case-structure [ + append run-body compile-case-structure/no-gui item diagram + ] + item/type = 'bundle [append run-body emit-bundle item diagram] + item/type = 'unbundle [append run-body emit-unbundle item diagram] + item/type = 'cluster-control [append run-body emit-cluster-control item diagram] + item/type = 'cluster-indicator [append run-body emit-cluster-indicator item diagram] + item/type = 'subvi [append run-body compile-subvi-call item diagram] + true [ + node: item + bdef: find-block node/type + if none? bdef [continue] + case [ + bdef/category = 'input [ + case [ + node-array-input? node [ + ; Array control: valor fijo del config (no hay field editable — DT-028) + if bdef/emit [ + append run-body bind-emit bdef/emit (build-bindings node diagram bdef) + ] + ] + true [ + face-sym: to-word rejoin ["f_" node/id] + case [ + node-boolean-input? node [ + append run-body compose [(to-set-word port-var node 'result) (to-path reduce [face-sym 'data])] + ] + node-string-input? node [ + append run-body compose [(to-set-word port-var node 'result) (to-path reduce [face-sym 'text])] + ] + true [ + append run-body compose [(to-set-word port-var node 'result) to-float (to-path reduce [face-sym 'text])] + ] + ] + ] + ] + ] + bdef/category = 'output [ + face-sym: to-word rejoin ["t_" node/id] + foreach w diagram/wires [ + if w/to-node = node/id [ + ; Fuente: nodo normal + src: find-node-by-id diagram/nodes w/from-node + if src [ + src-var: port-var src to-word w/from-port + append run-body compose [(to set-path! reduce [face-sym 'text]) form (src-var)] + ] + ; Fuente: estructura (SR-right → indicador externo) + if all [in diagram 'structures block? diagram/structures] [ + foreach st diagram/structures [ + if st/id = w/from-node [ + src-var: to-word rejoin ["_" form w/from-port] + append run-body compose [(to set-path! reduce [face-sym 'text]) form (src-var)] + ] + ] + ] + ] + ] + ] + true [ + if bdef/emit [ + bindings: build-bindings node diagram bdef + append run-body bind-emit bdef/emit bindings + ] + ] + ] + ] + ] + ] + + ; ── Layout del Front Panel ──────────────────────────────── + ui-layout: copy [] + foreach item sorted [ + if in item 'shift-regs [continue] ; saltar estructuras + node: item + bdef: find-block node/type + if none? bdef [continue] + if bdef/category = 'input [ + ; Array control: sin widget — valor fijo, no aparece en UI layout + if node-array-input? node [continue] + + face-n: to-word rejoin ["f_" node/id] + ; any [none false] = none en Red (false es falsy) → usar either/none? explícito + cfg-val: either none? select node/config 'default [ + case [ + node-boolean-input? node [false] + node-string-input? node [""] + true [0.0] + ] + ][ + select node/config 'default + ] + node-label: either all [node/label object? node/label] [node/label/text] [any [node/name ""]] + append ui-layout 'text + ; UI layout usa label/text (display) para textos visibles (DT-024) + append ui-layout node-label + append ui-layout to-set-word face-n + case [ + node-boolean-input? node [ + ; Control booleano: check face, lee face/data (logic!) + append ui-layout 'check + append ui-layout node-label + append ui-layout cfg-val + ] + node-string-input? node [ + ; Control string: field editable, lee face/text directamente + append ui-layout 'field + append ui-layout cfg-val + ] + true [ + append ui-layout 'field + append ui-layout form cfg-val + ] + ] + ] + ] + + append ui-layout 'button + append ui-layout "Run" + append/only ui-layout run-body + foreach item sorted [ + if in item 'shift-regs [continue] ; saltar estructuras + node: item + bdef: find-block node/type + if none? bdef [continue] + if bdef/category = 'output [ + face-n: to-word rejoin ["t_" node/id] + append ui-layout 'text + ; UI layout usa label/text (display) para textos visibles (DT-024) + append ui-layout either all [node/label object? node/label] [node/label/text] [any [node/name ""]] + append ui-layout to-set-word face-n + append ui-layout 'text + append ui-layout "---" + ] + ] + + ; ── Recopilar sub-VIs referenciados para #include (Fase 3) ──────────── + subvi-files: copy [] + subvi-names: copy [] + foreach item sorted [ + if item/type = 'subvi [ + if all [in item 'file file? item/file] [ + ; Evitar duplicados + if not find subvi-files item/file [ + append subvi-files item/file + ; Recopilar nombre de función para validación + func-nm: select item/config 'func-name + if func-nm [ + append subvi-names func-nm + ] + ] + ] + ] + ] + + result-map: make map! [] + result-map/headless: headless + result-map/ui-layout: ui-layout + result-map/subvi-files: subvi-files + result-map/subvi-names: subvi-names + result-map +] diff --git a/src/compiler/compiler-emit.red b/src/compiler/compiler-emit.red new file mode 100644 index 0000000..d9077de --- /dev/null +++ b/src/compiler/compiler-emit.red @@ -0,0 +1,348 @@ +Red [ + Title: "QTorres — Compilador (emit dialect)" + Purpose: "Sustitución de puertos por variables y emisión de código para bundle/unbundle/cluster" +] + +; ══════════════════════════════════════════════════ +; DIALECTO: emit +; ══════════════════════════════════════════════════ +; El compilador no usa interpolación de strings. +; Cada bloque registrado define un bloque `emit` que es código Red +; con palabras que hacen referencia a los puertos del bloque. +; +; Ejemplo: +; El bloque 'add tiene: emit [result: a + b] +; El nodo "Suma" recibe wire de "A" en puerto 'a y de "B" en puerto 'b +; El compilador sustituye: a → A, b → B, result → Suma +; Resultado: [Suma: A + B] + +; ══════════════════════════════════════════════════ +; BIND-EMIT +; ══════════════════════════════════════════════════ +; +; Sustituye los nombres de puertos en un bloque emit por variables reales. +; +; emit-block: bloque con palabras que corresponden a puertos +; bindings: bloque plano de pares [puerto valor ...] + +bind-emit: func [ + emit-block [block!] + bindings [block!] + /local result item k v +][ + result: copy [] + foreach item emit-block [ + case [ + word? item [ + v: select bindings item + either none? v [ + append result item + ][ + either block? v [append/only result v] [append result v] + ] + ] + set-word? item [ + k: to-word item + v: select bindings k + append result either all [v any [word? v lit-word? v]] [to-set-word v] [item] + ] + block? item [ + append/only result bind-emit item bindings + ] + true [append result item] + ] + ] + result +] + +; ══════════════════════════════════════════════════ +; HELPERS +; ══════════════════════════════════════════════════ + +; Nombre de variable para el puerto de salida de un nodo. +; Convenio: name_portname (ej: add_1_result) +; Usa node/name (DT-024), nunca node/label/text. +port-var: func [node [object!] port-name [word! lit-word!]] [ + to-word rejoin [node/name "_" to-word port-name] +] + +; Construye los bindings [puerto var ...] para un nodo concreto del diagrama: +; - puertos de salida: variable propia (label_portname) +; - puertos de entrada: variable del nodo fuente conectado por wire +; - configs: valor del nodo o el default de la definición +build-bindings: func [ + node [object!] + diagram [object!] + bdef [object!] + /local bindings p w src cfg-val found _var +][ + bindings: copy [] + + foreach p bdef/outputs [ + append bindings p/name + append bindings port-var node p/name + ] + + foreach p bdef/inputs [ + foreach w diagram/wires [ + if all [w/to-node = node/id (to-word w/to-port) = p/name] [ + case [ + w/from-node < 0 [ + _var: either w/from-node = -1 [ + to-word rejoin ["_" form w/from-port] + ][ + w/from-port + ] + append bindings p/name + append bindings _var + ] + true [ + src: find-node-by-id diagram/nodes w/from-node + either src [ + append bindings p/name + append bindings port-var src w/from-port + ][ + if all [in diagram 'structures block? diagram/structures] [ + foreach st diagram/structures [ + if st/id = w/from-node [ + append bindings p/name + append bindings to-word rejoin ["_" form w/from-port] + ] + ] + ] + ] + ] + ] + ] + ] + ] + + foreach cfg bdef/configs [ + cfg-val: either none? select node/config cfg/name [cfg/default] [select node/config cfg/name] + append bindings cfg/name + append/only bindings cfg-val + ] + + bindings +] + +; Devuelve true si el primer output del bloque es de tipo array. +node-array-input?: func [node /local bdef] [ + bdef: find-block to-word node/type + if all [bdef not empty? bdef/outputs] [ + return bdef/outputs/1/type = 'array + ] + false +] + +; Devuelve true si el primer output del bloque es de tipo booleano. +node-boolean-input?: func [node /local bdef] [ + bdef: find-block to-word node/type + if all [bdef not empty? bdef/outputs] [ + return bdef/outputs/1/type = 'boolean + ] + false +] + +; Devuelve true si el primer output del bloque es de tipo string. +node-string-input?: func [node /local bdef] [ + bdef: find-block to-word node/type + if all [bdef not empty? bdef/outputs] [ + return bdef/outputs/1/type = 'string + ] + false +] + +; ══════════════════════════════════════════════════ +; EMIT-BUNDLE / EMIT-UNBUNDLE +; ══════════════════════════════════════════════════ +; +; Los nodos bundle/unbundle tienen puertos dinámicos (config/fields), +; por lo que no pueden usar el flujo estándar bind-emit + build-bindings. +; Generan código directamente manipulando bloques Red. + +; Genera código para un nodo bundle: +; bundle_1_result: make object! [campo1: var1 campo2: var2 ...] +emit-bundle: func [ + node [object!] + diagram [object!] + /local result-var fields obj-body fn ft w src-nd field-var code +][ + result-var: port-var node 'result + fields: cluster-fields node + obj-body: copy [] + + foreach [fn ft] fields [ + field-var: fn + foreach w diagram/wires [ + if all [w/to-node = node/id (to-word w/to-port) = fn] [ + src-nd: find-node-by-id diagram/nodes w/from-node + if src-nd [field-var: port-var src-nd to-word w/from-port] + ] + ] + append obj-body to-set-word fn + append obj-body field-var + ] + + code: copy [] + append code to-set-word result-var + append code 'make + append code object! + append/only code obj-body + code +] + +; Genera código para un nodo unbundle: +; unbundle_1_campo1: cluster_var/campo1 +; unbundle_1_campo2: cluster_var/campo2 ... +emit-unbundle: func [ + node [object!] + diagram [object!] + /local fields cluster-var fn ft w src-nd out-var code +][ + fields: cluster-fields node + cluster-var: none + + foreach w diagram/wires [ + if all [w/to-node = node/id (to-word w/to-port) = 'cluster-in] [ + src-nd: find-node-by-id diagram/nodes w/from-node + if src-nd [cluster-var: port-var src-nd to-word w/from-port] + ] + ] + if none? cluster-var [ + print rejoin ["WARNING: Unbundle '" node/name "' — cluster-in no conectado"] + return copy [] + ] + + code: copy [] + foreach [fn ft] fields [ + out-var: port-var node fn + append code to-set-word out-var + append/only code to-path reduce [cluster-var fn] + ] + code +] + +; Genera código para un nodo cluster-control: +; ctrl_1_out: make object! [campo1: to-float ctrl_1_campo1_fld/text ...] +emit-cluster-control: func [ + node [object!] + diagram [object!] + /local out-var fp-item fields fn ft fld-name obj-body code +][ + out-var: port-var node 'out + fp-item: none + foreach it diagram/front-panel [ + if it/name = node/name [fp-item: it break] + ] + fields: either fp-item [fp-cluster-fields fp-item] [copy []] + obj-body: copy [] + foreach [fn ft] fields [ + fld-name: to-word rejoin [form node/name "_" form fn "_fld"] + append obj-body to-set-word fn + append obj-body compose [ + (switch ft [ + boolean [compose [any [attempt [to-logic (to-path reduce [fld-name 'data])] false]]] + string [to-path reduce [fld-name 'text]] + ]) + ] + if not find [boolean string] ft [ + clear back tail obj-body + append/only obj-body to-path reduce [fld-name 'text] + last-val: last obj-body + remove back tail obj-body + append obj-body 'to-float + append obj-body last-val + ] + ] + code: copy [] + append code to-set-word out-var + append code 'make + append code object! + append/only code obj-body + code +] + +; Genera código para un nodo cluster-indicator: +emit-cluster-indicator: func [ + node [object!] + diagram [object!] + /local fields in-var w src-nd fp-item fn ft fld-name code +][ + in-var: none + foreach w diagram/wires [ + if all [w/to-node = node/id (to-word w/to-port) = 'in] [ + src-nd: find-node-by-id diagram/nodes w/from-node + if src-nd [in-var: port-var src-nd to-word w/from-port] + ] + ] + if none? in-var [return copy []] + fp-item: none + foreach it diagram/front-panel [ + if it/name = node/name [fp-item: it break] + ] + fields: either fp-item [fp-cluster-fields fp-item] [copy []] + code: copy [] + foreach [fn ft] fields [ + fld-name: to-word rejoin [form node/name "_" form fn "_ind"] + append code to-set-path reduce [fld-name 'text] + append/only code to-path reduce [in-var fn] + ] + code +] + +; Versión headless de emit-cluster-control: usa config 'default en lugar de faces del FP. +emit-cluster-control-headless: func [ + node [object!] + diagram [object!] + /local out-var fp-item fields defaults fn ft fval obj-body code +][ + out-var: port-var node 'out + fp-item: none + foreach it diagram/front-panel [if it/name = node/name [fp-item: it break]] + fields: either fp-item [fp-cluster-fields fp-item] [copy []] + defaults: either fp-item [select fp-item/config 'default] [none] + obj-body: copy [] + foreach [fn ft] fields [ + fval: either defaults [select defaults fn] [none] + append obj-body to-set-word fn + case [ + ft = 'boolean [append obj-body any [all [logic? fval fval] false]] + ft = 'string [append obj-body any [all [string? fval fval] ""]] + true [append obj-body any [fval 0.0]] + ] + ] + code: copy [] + append code to-set-word out-var + append code 'make + append code object! + append/only code obj-body + code +] + +; Versión headless de emit-cluster-indicator: imprime cada campo del cluster. +emit-cluster-indicator-headless: func [ + node [object!] + diagram [object!] + /local fp-item fields in-var w src-nd fn ft lbl code +][ + in-var: none + foreach w diagram/wires [ + if all [w/to-node = node/id (to-word w/to-port) = 'in] [ + src-nd: find-node-by-id diagram/nodes w/from-node + if src-nd [in-var: port-var src-nd to-word w/from-port] + ] + ] + if none? in-var [return copy []] + fp-item: none + foreach it diagram/front-panel [if it/name = node/name [fp-item: it break]] + fields: either fp-item [fp-cluster-fields fp-item] [copy []] + lbl: either all [node/label object? node/label] [node/label/text] [any [node/name ""]] + code: copy [] + foreach [fn ft] fields [ + append code compose [ + print rejoin [(rejoin [lbl " — " form fn]) ": " form (to-path reduce [in-var fn])] + ] + ] + code +] diff --git a/src/compiler/compiler-panel.red b/src/compiler/compiler-panel.red new file mode 100644 index 0000000..72a5d34 --- /dev/null +++ b/src/compiler/compiler-panel.red @@ -0,0 +1,117 @@ +Red [ + Title: "QTorres — Compilador (Front Panel)" + Purpose: "Compila el Front Panel a código View (movido desde panel.red — 4A refactor)" +] + +gen-panel-var-name: func [item /local s fc] [ + s: copy item/name + if not empty? s [ + fc: uppercase copy/part s 1 + s: rejoin [fc skip s 1] + ] + to-word rejoin ["f" s] +] + +gen-indicator-var-name: func [item /local s fc] [ + s: copy item/name + if not empty? s [ + fc: uppercase copy/part s 1 + s: rejoin [fc skip s 1] + ] + to-word rejoin ["l" s] +] + +compile-panel: func [model /local cmds item ctrl-field-name ind-var-name fn ft fval fld-name] [ + cmds: copy [] + + foreach item model/front-panel [ + case [ + find [control str-control] item/type [ + ctrl-field-name: gen-panel-var-name item + append cmds compose [ + label (item/label/text) + (to-set-word ctrl-field-name) field 120 (form item/default) + return + ] + ] + item/type = 'bool-control [ + ctrl-field-name: gen-panel-var-name item + append cmds compose [ + label (item/label/text) + (to-set-word ctrl-field-name) check (item/label/text) (item/default) + return + ] + ] + item/type = 'arr-control [ + ind-var-name: gen-indicator-var-name item + append cmds compose [ + label (item/label/text) + (to-set-word ind-var-name) text 120 (rejoin ["[" form item/default "]"]) + return + ] + ] + item/type = 'cluster-control [ + foreach [fn ft] fp-cluster-fields item [ + fld-name: to-word rejoin [form item/name "_" form fn] + fval: select any [item/default copy []] fn + append cmds compose [label (rejoin [item/label/text " — " form fn])] + case [ + ft = 'boolean [ + append cmds compose [ + (to-set-word fld-name) check (form fn) (any [fval false]) + return + ] + ] + true [ + append cmds compose [ + (to-set-word fld-name) field 120 (form any [fval ""]) + return + ] + ] + ] + ] + ] + item/type = 'cluster-indicator [ + foreach [fn ft] fp-cluster-fields item [ + fld-name: to-word rejoin [form item/name "_" form fn] + fval: select any [item/default copy []] fn + append cmds compose [ + label (rejoin [item/label/text " — " form fn]) + (to-set-word fld-name) text 120 (form any [fval ""]) + return + ] + ] + ] + find [waveform-chart waveform-graph] item/type [ + ind-var-name: gen-indicator-var-name item + append cmds compose [ + label (item/label/text) + (to-set-word ind-var-name) base 200x160 draw [] + return + ] + ] + true [ + ind-var-name: gen-indicator-var-name item + append cmds compose [ + label (item/label/text) + (to-set-word ind-var-name) text 120 (form item/default) + return + ] + ] + ] + ] + + append cmds compose [button "Run" []] + cmds +] + +gen-standalone-code: func [model /local vid-code] [ + vid-code: compile-panel model + rejoin [ + "Red [title: {QTorres Panel Demo} Needs: 'View]" newline + "qvi-diagram: []" newline + "view layout [" newline + " " mold vid-code newline + "]" + ] +] diff --git a/src/compiler/compiler-structures.red b/src/compiler/compiler-structures.red new file mode 100644 index 0000000..e13ce99 --- /dev/null +++ b/src/compiler/compiler-structures.red @@ -0,0 +1,333 @@ +Red [ + Title: "QTorres — Compilador (estructuras de control)" + Purpose: "Compilación de while-loop, for-loop y case-structure" +] + +; ══════════════════════════════════════════════════ +; COMPILE-STRUCTURE +; ══════════════════════════════════════════════════ +; +; Genera el bloque de código para una estructura while-loop: +; _sr_name: ; por cada SR +; _while_N_i: 0 +; until [ +; +; _sr_name: ; actualización SR +; _while_N_i: _while_N_i + 1 +; ; true si no conectada +; ] +; +; outer-diagram: diagrama que contiene la estructura (para wires externos de SR). + +compile-structure: func [ + st [object!] + outer-diagram [object!] + /no-gui ; omite do-events/no-wait (modo headless — sin View) + /local iter-sym sub-diag sorted code loop-body until-body node bdef cond-expr cond-node + sr sr-sym init-val w src src-node n-sym n-val +][ + ; ── CASE-STRUCTURE: compila a case/either ────────────────────── + if st/type = 'case-structure [ + return compile-case-structure/no-gui st outer-diagram + ] + + iter-sym: to-word rejoin ["_" st/name "_i"] + + ; Sub-diagrama ficticio: expone nodes/wires para topological-sort y build-bindings + sub-diag: make object! [ + nodes: st/nodes + wires: st/wires + ] + + code: copy [] + + ; ── FOR-LOOP: compila a loop N [...] ─────────────────────── + if st/type = 'for-loop [ + ; Resolver wire de N obligatorio desde outer-diagram/wires + n-sym: to-word rejoin ["_" st/name "_N"] + n-val: none + foreach w outer-diagram/wires [ + if all [w/to-node = st/id w/to-port = 'count] [ + src: find-node-by-id outer-diagram/nodes w/from-node + if src [n-val: port-var src to-word w/from-port] + ] + ] + if none? n-val [ + print rejoin ["ERROR: For Loop '" st/name "' — terminal N no conectado (obligatorio)"] + return copy [] + ] + + ; Init N (to-integer: controles producen float!, loop requiere integer!) + append code to-set-word n-sym + append code 'to-integer + append code n-val + + ; Init SRs (mismo patrón que while-loop) + foreach sr st/shift-regs [ + sr-sym: to-word rejoin ["_" sr/name] + init-val: sr/init-value + foreach w outer-diagram/wires [ + if all [w/to-node = st/id (to-word w/to-port) = to-word sr/name] [ + src: find-node-by-id outer-diagram/nodes w/from-node + if src [init-val: port-var src to-word w/from-port] + ] + ] + append code to-set-word sr-sym + append code init-val + ] + + ; Init contador de iteración + append code to-set-word iter-sym + append code 0 + + ; Compilar cuerpo interno + loop-body: copy [] + sorted: either empty? st/nodes [copy []] [topological-sort sub-diag] + foreach node sorted [ + bdef: find-block node/type + if all [bdef bdef/emit] [ + append loop-body bind-emit bdef/emit (build-bindings node sub-diag bdef) + ] + ] + + ; Actualización de SRs + foreach sr st/shift-regs [ + sr-sym: to-word rejoin ["_" sr/name] + foreach w st/wires [ + if all [w/to-node = -2 (to-word w/to-port) = to-word sr/name] [ + foreach src-node st/nodes [ + if src-node/id = w/from-node [ + append loop-body to-set-word sr-sym + append loop-body port-var src-node to-word w/from-port + ] + ] + ] + ] + ] + + ; Incrementar _i + append loop-body to-set-word iter-sym + append loop-body iter-sym + append loop-body to-word "+" + append loop-body 1 + + ; GUI responsiva (DT-027) — solo en modo UI (no en headless) + unless no-gui [append/only loop-body to-path [do-events no-wait]] + + ; loop N [body] + append code 'loop + append code n-sym + append/only code loop-body + + return code + ] + + ; ── WHILE-LOOP: compila a until [...] ────────────────────── + + ; ── Inicialización de shift registers ────────────────────── + foreach sr st/shift-regs [ + sr-sym: to-word rejoin ["_" sr/name] + init-val: sr/init-value ; valor por defecto (literal) + ; ¿Hay un wire externo que inicializa este SR? + foreach w outer-diagram/wires [ + if all [w/to-node = st/id (to-word w/to-port) = to-word sr/name] [ + src: find-node-by-id outer-diagram/nodes w/from-node + if src [init-val: port-var src to-word w/from-port] + ] + ] + append code to-set-word sr-sym + append code init-val + ] + + ; Inicialización del contador de iteración + append code to-set-word iter-sym + append code 0 + + ; Compilar cuerpo interno + until-body: copy [] + sorted: either empty? st/nodes [copy []] [topological-sort sub-diag] + foreach node sorted [ + bdef: find-block node/type + if all [bdef bdef/emit] [ + append until-body bind-emit bdef/emit (build-bindings node sub-diag bdef) + ] + ] + + ; ── Actualización de shift registers (antes del incremento) ─ + foreach sr st/shift-regs [ + sr-sym: to-word rejoin ["_" sr/name] + foreach w st/wires [ + if all [w/to-node = -2 (to-word w/to-port) = to-word sr/name] [ + foreach src-node st/nodes [ + if src-node/id = w/from-node [ + append until-body to-set-word sr-sym + append until-body port-var src-node to-word w/from-port + ] + ] + ] + ] + ] + + ; Incrementar iteración: _iter: _iter + 1 + append until-body to-set-word iter-sym + append until-body iter-sym + append until-body to-word "+" + append until-body 1 + + ; Ceder control a la GUI una vez por iteración (DT-027 Fase 2) + ; do-events/no-wait: procesa eventos pendientes y vuelve inmediatamente + ; Solo en modo UI — en headless no hay View y do-events cuelga + unless no-gui [append/only until-body to-path [do-events no-wait]] + + ; Condición final (última expresión del until) + cond-expr: either st/cond-wire [ + cond-node: find-node-by-id st/nodes st/cond-wire/from + either cond-node [ + port-var cond-node st/cond-wire/port + ][ + true + ] + ][ + true ; sin condición conectada: ejecuta una vez + ] + append until-body cond-expr + + ; until [body] + append code 'until + append/only code until-body + + code +] + +; ══════════════════════════════════════════════════ +; COMPILE-CASE-STRUCTURE +; ══════════════════════════════════════════════════ +; +; Genera el bloque de código para una Case Structure: +; _case_selector: +; case _case_selector [ +; 0 [] +; 1 [] +; default [] +; ] +; +; Si el selector es booleano, genera: +; _case_selector: +; either _case_selector [] [] +; +; outer-diagram: diagrama que contiene la estructura. + +compile-case-structure: func [ + st [object!] + outer-diagram [object!] + /no-gui + /local code sel-var sel-type sel-node sel-port frame bdef sub-diag sorted frame-code case-block case-item + frame-label +][ + code: copy [] + + ; ── Resolver selector wire ─────────────────────────────────── + sel-var: none + sel-type: 'number ; default + if st/selector-wire [ + sel-node: find-node-by-id outer-diagram/nodes st/selector-wire/from + if sel-node [ + sel-port: to-word st/selector-wire/port + sel-var: port-var sel-node sel-port + ; Detectar tipo del selector + bdef: find-block sel-node/type + if bdef [ + foreach p bdef/outputs [ + if p/name = sel-port [sel-type: p/type] + ] + ] + ] + ] + if none? sel-var [ + print rejoin ["WARNING: Case Structure '" st/name "' — selector no conectado, usando 0"] + sel-var: 0 + ] + + ; Variable del selector + append code to-set-word to-word rejoin ["_" st/name "_selector"] + append code sel-var + + ; ── Selector booleano → either ───────────────────────────────── + if sel-type = 'boolean [ + case-block: copy [] + append case-block 'either + append case-block to-word rejoin ["_" st/name "_selector"] + + ; Frame true (primer frame) + frame-code: copy [] + if all [block? st/frames not empty? st/frames] [ + frame: st/frames/1 + sub-diag: make object! [nodes: frame/nodes wires: frame/wires] + sorted: either empty? frame/nodes [copy []] [topological-sort sub-diag] + foreach node sorted [ + bdef: find-block node/type + if all [bdef bdef/emit] [ + append frame-code bind-emit bdef/emit (build-bindings node sub-diag bdef) + ] + ] + ] + append/only case-block frame-code + + ; Frame false (segundo frame si existe) + frame-code: copy [] + if all [block? st/frames (length? st/frames) >= 2] [ + frame: st/frames/2 + sub-diag: make object! [nodes: frame/nodes wires: frame/wires] + sorted: either empty? frame/nodes [copy []] [topological-sort sub-diag] + foreach node sorted [ + bdef: find-block node/type + if all [bdef bdef/emit] [ + append frame-code bind-emit bdef/emit (build-bindings node sub-diag bdef) + ] + ] + ] + append/only case-block frame-code + + append code case-block + return code + ] + + ; ── Selector numérico → case [sel = 0 [...] sel = 1 [...] true [...]] ── + sel-word: to-word rejoin ["_" st/name "_selector"] + inner-block: copy [] + has-default: false + + if block? st/frames [ + foreach frame st/frames [ + frame-code: copy [] + sub-diag: make object! [nodes: frame/nodes wires: frame/wires] + sorted: either empty? frame/nodes [copy []] [topological-sort sub-diag] + foreach node sorted [ + bdef: find-block node/type + if all [bdef bdef/emit] [ + append frame-code bind-emit bdef/emit (build-bindings node sub-diag bdef) + ] + ] + frame-label: any [attempt [to-integer frame/label] 'default] + either frame-label = 'default [ + append inner-block true + has-default: true + ][ + append inner-block sel-word + append inner-block '= + append inner-block frame-label + ] + append/only inner-block frame-code + ] + ] + + ; Añadir default vacío si no hay ninguno + if not has-default [ + append inner-block true + append/only inner-block copy [] + ] + + append code 'case + append/only code inner-block + code +] diff --git a/src/compiler/compiler-topo.red b/src/compiler/compiler-topo.red new file mode 100644 index 0000000..e6cc2b8 --- /dev/null +++ b/src/compiler/compiler-topo.red @@ -0,0 +1,118 @@ +Red [ + Title: "QTorres — Compilador (topological sort)" + Purpose: "Ordenación topológica de nodos del diagrama (algoritmo de Kahn)" +] + +; ══════════════════════════════════════════════════ +; TOPOLOGICAL-SORT +; ══════════════════════════════════════════════════ +; +; Algoritmo de Kahn (BFS). +; Entrada: un objeto diagrama con /nodes y /wires (make-diagram). +; Salida: un block! con los nodos en orden de compilación, +; o un error si se detecta un ciclo. + +topological-sort: func [ + diagram [object!] + /local nodes wires in-degree id-to-node queue result nid w +][ + nodes: diagram/nodes + wires: diagram/wires + + in-degree: make map! [] + id-to-node: make map! [] + foreach n nodes [ + in-degree/(n/id): 0 + id-to-node/(n/id): n + ] + + foreach w wires [ + ; Ignorar wires con extremos virtuales (IDs negativos: iter, SR-left, SR-right) + if all [w/from-node >= 0 w/to-node >= 0] [ + in-degree/(w/to-node): in-degree/(w/to-node) + 1 + ] + ] + + queue: copy [] + foreach n nodes [ + if in-degree/(n/id) = 0 [append queue n/id] + ] + + result: copy [] + while [not empty? queue] [ + nid: take queue + append result id-to-node/:nid + foreach w wires [ + if all [w/from-node = nid w/to-node >= 0] [ + in-degree/(w/to-node): in-degree/(w/to-node) - 1 + if in-degree/(w/to-node) = 0 [append queue w/to-node] + ] + ] + ] + + if (length? result) <> (length? nodes) [ + cause-error 'user 'message ["topological-sort: ciclo detectado en el diagrama"] + ] + + result +] + +; ══════════════════════════════════════════════════ +; BUILD-SORTED-ITEMS +; ══════════════════════════════════════════════════ +; +; Extiende topological-sort para incluir estructuras (while-loop) +; junto con los nodos normales en el orden de compilación. +; +; Las estructuras participan como nodos virtuales: +; - Dependencia entrada: wire externo a SR-left (to-node = st/id) +; - Dependencia salida: wire externo desde SR-right (from-node = st/id) +; +; Devuelve un bloque con objetos (nodo o estructura) en orden topológico. +; Para distinguirlos: los objetos de estructura tienen campo 'shift-regs. + +build-sorted-items: func [ + diagram [object!] + /local all-items in-degree id-to-item queue result nid w item +][ + all-items: copy diagram/nodes + if all [in diagram 'structures block? diagram/structures] [ + foreach st diagram/structures [append all-items st] + ] + + in-degree: make map! [] + id-to-item: make map! [] + foreach item all-items [ + in-degree/(item/id): 0 + id-to-item/(item/id): item + ] + + foreach w diagram/wires [ + if w/from-node >= 0 [ + if not none? select in-degree w/to-node [ + in-degree/(w/to-node): in-degree/(w/to-node) + 1 + ] + ] + ] + + queue: copy [] + foreach item all-items [ + if in-degree/(item/id) = 0 [append queue item/id] + ] + + result: copy [] + while [not empty? queue] [ + nid: take queue + append result id-to-item/:nid + foreach w diagram/wires [ + if w/from-node = nid [ + if not none? select in-degree w/to-node [ + in-degree/(w/to-node): in-degree/(w/to-node) - 1 + if in-degree/(w/to-node) = 0 [append queue w/to-node] + ] + ] + ] + ] + + result +] diff --git a/src/compiler/compiler.red b/src/compiler/compiler.red index 517b036..5c00909 100644 --- a/src/compiler/compiler.red +++ b/src/compiler/compiler.red @@ -1,1255 +1,18 @@ Red [ - Title: "QTorres — Compilador" + Title: "QTorres — Compilador (orquestador)" Purpose: "Transforma un diagrama (modelo de grafo) en código Red dentro del .qvi" ] -; ══════════════════════════════════════════════════ -; DIALECTO: emit -; ══════════════════════════════════════════════════ -; El compilador no usa interpolación de strings. -; Cada bloque registrado define un bloque `emit` que es código Red -; con palabras que hacen referencia a los puertos del bloque. -; -; El compilador: -; 1. Ordena los nodos topológicamente -; 2. Para cada nodo, busca su definición en el block-registry -; 3. Toma el bloque `emit` y sustituye las palabras de los puertos -; por los nombres reales de las variables (que vienen de los wires) -; 4. El resultado es código Red generado por manipulación de bloques Red -; -; Ejemplo: -; El bloque 'add tiene: emit [result: a + b] -; El nodo "Suma" recibe wire de "A" en puerto 'a y de "B" en puerto 'b -; El compilador sustituye: a → A, b → B, result → Suma -; Resultado: [Suma: A + B] -; -; Esto es manipulación de bloques Red, no strings. El código generado -; es un bloque Red que se puede componer, inspeccionar y ejecutar. - -; ══════════════════════════════════════════════════ -; TOPOLOGICAL-SORT -; ══════════════════════════════════════════════════ -; -; Algoritmo de Kahn (BFS). -; Entrada: un objeto diagrama con /nodes y /wires (make-diagram). -; Salida: un block! con los nodos en orden de compilación, -; o un error si se detecta un ciclo. - -topological-sort: func [ - diagram [object!] - /local nodes wires in-degree id-to-node queue result nid w -][ - nodes: diagram/nodes - wires: diagram/wires - - in-degree: make map! [] - id-to-node: make map! [] - foreach n nodes [ - in-degree/(n/id): 0 - id-to-node/(n/id): n - ] - - foreach w wires [ - ; Ignorar wires con extremos virtuales (IDs negativos: iter, SR-left, SR-right) - if all [w/from-node >= 0 w/to-node >= 0] [ - in-degree/(w/to-node): in-degree/(w/to-node) + 1 - ] - ] - - queue: copy [] - foreach n nodes [ - if in-degree/(n/id) = 0 [append queue n/id] - ] - - result: copy [] - while [not empty? queue] [ - nid: take queue - append result id-to-node/:nid - foreach w wires [ - if all [w/from-node = nid w/to-node >= 0] [ - in-degree/(w/to-node): in-degree/(w/to-node) - 1 - if in-degree/(w/to-node) = 0 [append queue w/to-node] - ] - ] - ] - - if (length? result) <> (length? nodes) [ - cause-error 'user 'message ["topological-sort: ciclo detectado en el diagrama"] - ] - - result -] - -; ══════════════════════════════════════════════════ -; BUILD-SORTED-ITEMS -; ══════════════════════════════════════════════════ -; -; Extiende topological-sort para incluir estructuras (while-loop) -; junto con los nodos normales en el orden de compilación. -; -; Las estructuras participan como nodos virtuales: -; - Dependencia entrada: wire externo a SR-left (to-node = st/id) -; - Dependencia salida: wire externo desde SR-right (from-node = st/id) -; -; Devuelve un bloque con objetos (nodo o estructura) en orden topológico. -; Para distinguirlos: los objetos de estructura tienen campo 'shift-regs. - -build-sorted-items: func [ - diagram [object!] - /local all-items in-degree id-to-item queue result nid w item -][ - all-items: copy diagram/nodes - if all [in diagram 'structures block? diagram/structures] [ - foreach st diagram/structures [append all-items st] - ] - - in-degree: make map! [] - id-to-item: make map! [] - foreach item all-items [ - in-degree/(item/id): 0 - id-to-item/(item/id): item - ] - - foreach w diagram/wires [ - if w/from-node >= 0 [ - if not none? select in-degree w/to-node [ - in-degree/(w/to-node): in-degree/(w/to-node) + 1 - ] - ] - ] - - queue: copy [] - foreach item all-items [ - if in-degree/(item/id) = 0 [append queue item/id] - ] - - result: copy [] - while [not empty? queue] [ - nid: take queue - append result id-to-item/:nid - foreach w diagram/wires [ - if w/from-node = nid [ - if not none? select in-degree w/to-node [ - in-degree/(w/to-node): in-degree/(w/to-node) - 1 - if in-degree/(w/to-node) = 0 [append queue w/to-node] - ] - ] - ] - ] - - result -] - -; ══════════════════════════════════════════════════ -; BIND-EMIT -; ══════════════════════════════════════════════════ -; -; Sustituye los nombres de puertos en un bloque emit por variables reales. -; -; emit-block: bloque con palabras que corresponden a puertos -; Ejemplo: [result: a + b] -; bindings: bloque plano de pares [puerto valor ...] -; Los valores pueden ser cualquier tipo Red. -; Ejemplo: [a X b Y result Suma] -; -; Maneja word!, set-word! y bloques anidados. El resto pasa sin cambios. - -bind-emit: func [ - emit-block [block!] - bindings [block!] - /local result item k v -][ - result: copy [] - foreach item emit-block [ - case [ - word? item [ - v: select bindings item - either none? v [ - append result item - ][ - ; /only para block! values (ej: array defaults) — evita aplanar - either block? v [append/only result v] [append result v] - ] - ] - set-word? item [ - k: to-word item - v: select bindings k - append result either all [v any [word? v lit-word? v]] [to-set-word v] [item] - ] - block? item [ - append/only result bind-emit item bindings - ] - true [append result item] - ] - ] - result -] - -; ══════════════════════════════════════════════════ -; HELPERS -; ══════════════════════════════════════════════════ - -; Nombre de variable para el puerto de salida de un nodo. -; Convenio: name_portname (ej: add_1_result) -; Usa node/name (DT-024), nunca node/label/text. -port-var: func [node [object!] port-name [word! lit-word!]] [ - to-word rejoin [node/name "_" to-word port-name] -] - -; Construye los bindings [puerto var ...] para un nodo concreto del diagrama: -; - puertos de salida: variable propia (label_portname) -; - puertos de entrada: variable del nodo fuente conectado por wire -; - configs: valor del nodo o el default de la definición -build-bindings: func [ - node [object!] - diagram [object!] - bdef [object!] - /local bindings p w src cfg-val found _var -][ - bindings: copy [] - - foreach p bdef/outputs [ - append bindings p/name - append bindings port-var node p/name - ] - - foreach p bdef/inputs [ - foreach w diagram/wires [ - if all [w/to-node = node/id (to-word w/to-port) = p/name] [ - case [ - ; Nodos virtuales negativos: iter (-3) y SR-left (-1) - w/from-node < 0 [ - ; Iter (-3): from-port ya es la variable (_while_N_i) - ; SR-left (-1): from-port es sr/name → variable es _sr_name - _var: either w/from-node = -1 [ - to-word rejoin ["_" form w/from-port] - ][ - w/from-port - ] - append bindings p/name - append bindings _var - ] - ; Nodo fuente normal - true [ - src: find-node-by-id diagram/nodes w/from-node - either src [ - append bindings p/name - append bindings port-var src w/from-port - ][ - ; Nodo fuente es una estructura (SR-right → externo) - if all [in diagram 'structures block? diagram/structures] [ - foreach st diagram/structures [ - if st/id = w/from-node [ - append bindings p/name - append bindings to-word rejoin ["_" form w/from-port] - ] - ] - ] - ] - ] - ] - ] - ] - ] - - foreach cfg bdef/configs [ - ; any [none false] = none en Red → usar either/none? explícito - cfg-val: either none? select node/config cfg/name [cfg/default] [select node/config cfg/name] - append bindings cfg/name - ; /only evita aplanar block! values (ej: array defaults como [1.0 2.0]) - append/only bindings cfg-val - ] - - bindings -] - -; Devuelve true si el primer output del bloque es de tipo array. -node-array-input?: func [node /local bdef] [ - bdef: find-block to-word node/type - if all [bdef not empty? bdef/outputs] [ - return bdef/outputs/1/type = 'array - ] - false -] - -; Devuelve true si el primer output del bloque es de tipo booleano. -node-boolean-input?: func [node /local bdef] [ - bdef: find-block to-word node/type - if all [bdef not empty? bdef/outputs] [ - return bdef/outputs/1/type = 'boolean - ] - false -] - -; Devuelve true si el primer output del bloque es de tipo string. -node-string-input?: func [node /local bdef] [ - bdef: find-block to-word node/type - if all [bdef not empty? bdef/outputs] [ - return bdef/outputs/1/type = 'string - ] - false -] - -; ══════════════════════════════════════════════════ -; COMPILE-STRUCTURE -; ══════════════════════════════════════════════════ -; -; Genera el bloque de código para una estructura while-loop: -; _sr_name: ; por cada SR -; _while_N_i: 0 -; until [ -; -; _sr_name: ; actualización SR -; _while_N_i: _while_N_i + 1 -; ; true si no conectada -; ] -; -; outer-diagram: diagrama que contiene la estructura (para wires externos de SR). - -compile-structure: func [ - st [object!] - outer-diagram [object!] - /no-gui ; omite do-events/no-wait (modo headless — sin View) - /local iter-sym sub-diag sorted code loop-body until-body node bdef cond-expr cond-node - sr sr-sym init-val w src src-node n-sym n-val -][ - ; ── CASE-STRUCTURE: compila a case/either ────────────────────── - if st/type = 'case-structure [ - return compile-case-structure/no-gui st outer-diagram - ] - - iter-sym: to-word rejoin ["_" st/name "_i"] - - ; Sub-diagrama ficticio: expone nodes/wires para topological-sort y build-bindings - sub-diag: make object! [ - nodes: st/nodes - wires: st/wires - ] - - code: copy [] - - ; ── FOR-LOOP: compila a loop N [...] ─────────────────────── - if st/type = 'for-loop [ - ; Resolver wire de N obligatorio desde outer-diagram/wires - n-sym: to-word rejoin ["_" st/name "_N"] - n-val: none - foreach w outer-diagram/wires [ - if all [w/to-node = st/id w/to-port = 'count] [ -src: find-node-by-id outer-diagram/nodes w/from-node - if src [n-val: port-var src to-word w/from-port] - ] - ] - if none? n-val [ - print rejoin ["ERROR: For Loop '" st/name "' — terminal N no conectado (obligatorio)"] - return copy [] - ] - - ; Init N (to-integer: controles producen float!, loop requiere integer!) - append code to-set-word n-sym - append code 'to-integer - append code n-val - - ; Init SRs (mismo patrón que while-loop) - foreach sr st/shift-regs [ - sr-sym: to-word rejoin ["_" sr/name] - init-val: sr/init-value - foreach w outer-diagram/wires [ - if all [w/to-node = st/id (to-word w/to-port) = to-word sr/name] [ -src: find-node-by-id outer-diagram/nodes w/from-node - if src [init-val: port-var src to-word w/from-port] - ] - ] - append code to-set-word sr-sym - append code init-val - ] - - ; Init contador de iteración - append code to-set-word iter-sym - append code 0 - - ; Compilar cuerpo interno - loop-body: copy [] - sorted: either empty? st/nodes [copy []] [topological-sort sub-diag] - foreach node sorted [ - bdef: find-block node/type - if all [bdef bdef/emit] [ - append loop-body bind-emit bdef/emit (build-bindings node sub-diag bdef) - ] - ] - - ; Actualización de SRs - foreach sr st/shift-regs [ - sr-sym: to-word rejoin ["_" sr/name] - foreach w st/wires [ - if all [w/to-node = -2 (to-word w/to-port) = to-word sr/name] [ - foreach src-node st/nodes [ - if src-node/id = w/from-node [ - append loop-body to-set-word sr-sym - append loop-body port-var src-node to-word w/from-port - ] - ] - ] - ] - ] - - ; Incrementar _i - append loop-body to-set-word iter-sym - append loop-body iter-sym - append loop-body to-word "+" - append loop-body 1 - - ; GUI responsiva (DT-027) — solo en modo UI (no en headless) - unless no-gui [append/only loop-body to-path [do-events no-wait]] - - ; loop N [body] - append code 'loop - append code n-sym - append/only code loop-body - - return code - ] - - ; ── WHILE-LOOP: compila a until [...] ────────────────────── - - ; ── Inicialización de shift registers ────────────────────── - foreach sr st/shift-regs [ - sr-sym: to-word rejoin ["_" sr/name] - init-val: sr/init-value ; valor por defecto (literal) - ; ¿Hay un wire externo que inicializa este SR? - foreach w outer-diagram/wires [ - if all [w/to-node = st/id (to-word w/to-port) = to-word sr/name] [ -src: find-node-by-id outer-diagram/nodes w/from-node - if src [init-val: port-var src to-word w/from-port] - ] - ] - append code to-set-word sr-sym - append code init-val - ] - - ; Inicialización del contador de iteración - append code to-set-word iter-sym - append code 0 - - ; Compilar cuerpo interno - until-body: copy [] - sorted: either empty? st/nodes [copy []] [topological-sort sub-diag] - foreach node sorted [ - bdef: find-block node/type - if all [bdef bdef/emit] [ - append until-body bind-emit bdef/emit (build-bindings node sub-diag bdef) - ] - ] - - ; ── Actualización de shift registers (antes del incremento) ─ - foreach sr st/shift-regs [ - sr-sym: to-word rejoin ["_" sr/name] - foreach w st/wires [ - if all [w/to-node = -2 (to-word w/to-port) = to-word sr/name] [ - foreach src-node st/nodes [ - if src-node/id = w/from-node [ - append until-body to-set-word sr-sym - append until-body port-var src-node to-word w/from-port - ] - ] - ] - ] - ] - - ; Incrementar iteración: _iter: _iter + 1 - append until-body to-set-word iter-sym - append until-body iter-sym - append until-body to-word "+" - append until-body 1 - - ; Ceder control a la GUI una vez por iteración (DT-027 Fase 2) - ; do-events/no-wait: procesa eventos pendientes y vuelve inmediatamente - ; Solo en modo UI — en headless no hay View y do-events cuelga - unless no-gui [append/only until-body to-path [do-events no-wait]] - - ; Condición final (última expresión del until) - cond-expr: either st/cond-wire [ - cond-node: find-node-by-id st/nodes st/cond-wire/from - either cond-node [ - port-var cond-node st/cond-wire/port - ][ - true - ] - ][ - true ; sin condición conectada: ejecuta una vez - ] - append until-body cond-expr - - ; until [body] - append code 'until - append/only code until-body - - code -] - -; ══════════════════════════════════════════════════ -; COMPILE-CASE-STRUCTURE -; ══════════════════════════════════════════════════ -; -; Genera el bloque de código para una Case Structure: -; _case_selector: -; case _case_selector [ -; 0 [] -; 1 [] -; default [] -; ] -; -; Si el selector es booleano, genera: -; _case_selector: -; either _case_selector [] [] -; -; outer-diagram: diagrama que contiene la estructura. - -compile-case-structure: func [ - st [object!] - outer-diagram [object!] - /no-gui - /local code sel-var sel-type sel-node sel-port frame bdef sub-diag sorted frame-code case-block case-item - frame-label -][ - code: copy [] - - ; ── Resolver selector wire ─────────────────────────────────── - sel-var: none - sel-type: 'number ; default - if st/selector-wire [ -sel-node: find-node-by-id outer-diagram/nodes st/selector-wire/from - if sel-node [ - sel-port: to-word st/selector-wire/port - sel-var: port-var sel-node sel-port - ; Detectar tipo del selector - bdef: find-block sel-node/type - if bdef [ - foreach p bdef/outputs [ - if p/name = sel-port [sel-type: p/type] - ] - ] - ] - ] - if none? sel-var [ - print rejoin ["WARNING: Case Structure '" st/name "' — selector no conectado, usando 0"] - sel-var: 0 - ] - - ; Variable del selector - append code to-set-word to-word rejoin ["_" st/name "_selector"] - append code sel-var - - ; ── Selector booleano → either ───────────────────────────────── - if sel-type = 'boolean [ - case-block: copy [] - append case-block 'either - append case-block to-word rejoin ["_" st/name "_selector"] - - ; Frame true (primer frame) - frame-code: copy [] - if all [block? st/frames not empty? st/frames] [ - frame: st/frames/1 - sub-diag: make object! [nodes: frame/nodes wires: frame/wires] - sorted: either empty? frame/nodes [copy []] [topological-sort sub-diag] - foreach node sorted [ - bdef: find-block node/type - if all [bdef bdef/emit] [ - append frame-code bind-emit bdef/emit (build-bindings node sub-diag bdef) - ] - ] - ] - append/only case-block frame-code - - ; Frame false (segundo frame si existe) - frame-code: copy [] - if all [block? st/frames (length? st/frames) >= 2] [ - frame: st/frames/2 - sub-diag: make object! [nodes: frame/nodes wires: frame/wires] - sorted: either empty? frame/nodes [copy []] [topological-sort sub-diag] - foreach node sorted [ - bdef: find-block node/type - if all [bdef bdef/emit] [ - append frame-code bind-emit bdef/emit (build-bindings node sub-diag bdef) - ] - ] - ] - append/only case-block frame-code - - append code case-block - return code - ] - - ; ── Selector numérico → case [sel = 0 [...] sel = 1 [...] true [...]] ── - sel-word: to-word rejoin ["_" st/name "_selector"] - inner-block: copy [] - has-default: false - - if block? st/frames [ - foreach frame st/frames [ - frame-code: copy [] - sub-diag: make object! [nodes: frame/nodes wires: frame/wires] - sorted: either empty? frame/nodes [copy []] [topological-sort sub-diag] - foreach node sorted [ - bdef: find-block node/type - if all [bdef bdef/emit] [ - append frame-code bind-emit bdef/emit (build-bindings node sub-diag bdef) - ] - ] - frame-label: any [attempt [to-integer frame/label] 'default] - either frame-label = 'default [ - append inner-block true - has-default: true - ][ - append inner-block sel-word - append inner-block '= - append inner-block frame-label - ] - append/only inner-block frame-code - ] - ] - - ; Añadir default vacío si no hay ninguno - if not has-default [ - append inner-block true - append/only inner-block copy [] - ] - - append code 'case - append/only code inner-block - code -] - -; ══════════════════════════════════════════════════ -; EMIT-BUNDLE / EMIT-UNBUNDLE -; ══════════════════════════════════════════════════ -; -; Los nodos bundle/unbundle tienen puertos dinámicos (config/fields), -; por lo que no pueden usar el flujo estándar bind-emit + build-bindings. -; Generan código directamente manipulando bloques Red. - -; Genera código para un nodo bundle: -; bundle_1_result: make object! [campo1: var1 campo2: var2 ...] -emit-bundle: func [ - node [object!] - diagram [object!] - /local result-var fields obj-body fn ft w src-nd field-var code -][ - result-var: port-var node 'result - fields: cluster-fields node - obj-body: copy [] - - foreach [fn ft] fields [ - ; Buscar el wire que entrega este campo - field-var: fn ; si no hay wire, el campo queda sin valor (warning implícito) - foreach w diagram/wires [ - if all [w/to-node = node/id (to-word w/to-port) = fn] [ - src-nd: find-node-by-id diagram/nodes w/from-node - if src-nd [field-var: port-var src-nd to-word w/from-port] - ] - ] - append obj-body to-set-word fn - append obj-body field-var - ] - - ; Genera: result-var: make object! [fn1: var1 fn2: var2 ...] - code: copy [] - append code to-set-word result-var - append code 'make - append code object! - append/only code obj-body - code -] - -; Genera código para un nodo unbundle: -; unbundle_1_campo1: cluster_var/campo1 -; unbundle_1_campo2: cluster_var/campo2 ... -emit-unbundle: func [ - node [object!] - diagram [object!] - /local fields cluster-var fn ft w src-nd out-var code -][ - fields: cluster-fields node - cluster-var: none - - foreach w diagram/wires [ - if all [w/to-node = node/id (to-word w/to-port) = 'cluster-in] [ - src-nd: find-node-by-id diagram/nodes w/from-node - if src-nd [cluster-var: port-var src-nd to-word w/from-port] - ] - ] - if none? cluster-var [ - print rejoin ["WARNING: Unbundle '" node/name "' — cluster-in no conectado"] - return copy [] - ] - - code: copy [] - foreach [fn ft] fields [ - ; Genera: unbundle_1_fn: cluster_var/fn - out-var: port-var node fn - append code to-set-word out-var - append/only code to-path reduce [cluster-var fn] - ] - code -] - -; Genera código para un nodo cluster-control: -; ctrl_1_out: make object! [campo1: to-float ctrl_1_campo1_fld/text ...] -; Los nombres de las faces del FP siguen el patrón: rejoin [node/name "_" fn "_fld"] -emit-cluster-control: func [ - node [object!] - diagram [object!] - /local out-var fp-item fields fn ft fld-name obj-body code -][ - out-var: port-var node 'out - ; Buscar el item FP correspondiente para obtener los campos - fp-item: none - foreach it diagram/front-panel [ - if it/name = node/name [fp-item: it break] - ] - fields: either fp-item [fp-cluster-fields fp-item] [copy []] - obj-body: copy [] - foreach [fn ft] fields [ - fld-name: to-word rejoin [form node/name "_" form fn "_fld"] - append obj-body to-set-word fn - append obj-body compose [ - (switch ft [ - boolean [compose [any [attempt [to-logic (to-path reduce [fld-name 'data])] false]]] - string [to-path reduce [fld-name 'text]] - ]) - ] - if not find [boolean string] ft [ - ; numeric por defecto - clear back tail obj-body - append/only obj-body to-path reduce [fld-name 'text] - ; wrap con to-float - last-val: last obj-body - remove back tail obj-body - append obj-body 'to-float - append obj-body last-val - ] - ] - code: copy [] - append code to-set-word out-var - append code 'make - append code object! - append/only code obj-body - code -] - -; Genera código para un nodo cluster-indicator: -; Para cada campo, actualiza el text face del FP con el valor del campo del cluster. -emit-cluster-indicator: func [ - node [object!] - diagram [object!] - /local fields in-var w src-nd fp-item fn ft fld-name code -][ - ; Encontrar el wire de entrada (puerto 'in) - in-var: none - foreach w diagram/wires [ - if all [w/to-node = node/id (to-word w/to-port) = 'in] [ - src-nd: find-node-by-id diagram/nodes w/from-node - if src-nd [in-var: port-var src-nd to-word w/from-port] - ] - ] - if none? in-var [return copy []] - ; Buscar item FP para obtener campos - fp-item: none - foreach it diagram/front-panel [ - if it/name = node/name [fp-item: it break] - ] - fields: either fp-item [fp-cluster-fields fp-item] [copy []] - code: copy [] - foreach [fn ft] fields [ - fld-name: to-word rejoin [form node/name "_" form fn "_ind"] - ; fld-name/text: form in-var/fn - append code to-set-path reduce [fld-name 'text] - append/only code to-path reduce [in-var fn] - ] - code -] - -; ══════════════════════════════════════════════════ -; COMPILE-BODY -; ══════════════════════════════════════════════════ -; -; Genera el bloque de cómputo headless listo para ejecutar con do. -; Incluye todos los nodos normales y las estructuras. - -; Versión headless de emit-cluster-control: usa config 'default en lugar de faces del FP. -emit-cluster-control-headless: func [ - node [object!] - diagram [object!] - /local out-var fp-item fields defaults fn ft fval obj-body code -][ - out-var: port-var node 'out - fp-item: none - foreach it diagram/front-panel [if it/name = node/name [fp-item: it break]] - fields: either fp-item [fp-cluster-fields fp-item] [copy []] - defaults: either fp-item [select fp-item/config 'default] [none] - obj-body: copy [] - foreach [fn ft] fields [ - fval: either defaults [select defaults fn] [none] - append obj-body to-set-word fn - case [ - ft = 'boolean [append obj-body any [all [logic? fval fval] false]] - ft = 'string [append obj-body any [all [string? fval fval] ""]] - true [append obj-body any [fval 0.0]] - ] - ] - code: copy [] - append code to-set-word out-var - append code 'make - append code object! - append/only code obj-body - code -] - -; Versión headless de emit-cluster-indicator: imprime cada campo del cluster. -emit-cluster-indicator-headless: func [ - node [object!] - diagram [object!] - /local fp-item fields in-var w src-nd fn ft lbl code -][ - in-var: none - foreach w diagram/wires [ - if all [w/to-node = node/id (to-word w/to-port) = 'in] [ - src-nd: find-node-by-id diagram/nodes w/from-node - if src-nd [in-var: port-var src-nd to-word w/from-port] - ] - ] - if none? in-var [return copy []] - fp-item: none - foreach it diagram/front-panel [if it/name = node/name [fp-item: it break]] - fields: either fp-item [fp-cluster-fields fp-item] [copy []] - lbl: either all [node/label object? node/label] [node/label/text] [any [node/name ""]] - code: copy [] - foreach [fn ft] fields [ - append code compose [ - print rejoin [(rejoin [lbl " — " form fn]) ": " form (to-path reduce [in-var fn])] - ] - ] - code -] - -; ══════════════════════════════════════════════════ -; SUBVI COMPILATION (Fase 3) -; ══════════════════════════════════════════════════ - -; Genera código para llamar a un sub-VI. -; La función del sub-VI viene de node/config/func-name. -; Los argumentos vienen de los wires conectados a los puertos de entrada del connector. -; Los resultados se asignan a variables de los puertos de salida. -compile-subvi-call: func [ - node [object!] - diagram [object!] - /local func-name connector inputs outputs code arg-vars out-var w src pin-word -][ - code: copy [] - - ; Obtener función y connector del config - func-name: select node/config 'func-name - connector: select node/config 'connector - if any [none? func-name none? connector] [return code] - - inputs: any [select connector 'inputs copy []] - outputs: any [select connector 'outputs copy []] - - ; Recolectar argumentos de los wires conectados a cada puerto de entrada - ; inputs es [pin label id pin label id ...] - arg-vars: copy [] - repeat i ((length? inputs) / 3) [ - pin-word: to-word rejoin ["p" inputs/(i * 3 - 2)] ; pin → 'p1, 'p2... - found: false - foreach w diagram/wires [ - if all [ - w/to-node = node/id - (to-word w/to-port) = pin-word - ][ - src: find-node-by-id diagram/nodes w/from-node - if src [ - append arg-vars port-var src to-word w/from-port - found: true - ] - ] - ] - ; Si no hay wire, usar valor por defecto 0.0 - if not found [append arg-vars 0.0] - ] - - ; Generar llamada: resultado: func-name/exec arg1 arg2 ... - ; outputs es [pin label id pin label id ...] - ; Por simplicidad, asumimos una sola salida (la primera) - if not empty? outputs [ - out-pin: to-word rejoin ["p" outputs/1] ; pin del primer output - out-var: port-var node out-pin - append code to-set-word out-var - ] - - ; Añadir la llamada a la función: func-name/exec (append/only para no extender el path) - append/only code to-path reduce [to-word func-name 'exec] - foreach arg arg-vars [append code arg] - - code -] - -compile-body: func [ - diagram [object!] - /with-prints ; añade print por indicador — solo para ejecución standalone (red-cli .qvi) - /local sorted code item bdef -][ - sorted: build-sorted-items diagram - code: copy [] - foreach item sorted [ - case [ - find [while-loop for-loop case-structure] item/type [ - append code compile-structure/no-gui item diagram - ] - item/type = 'bundle [append code emit-bundle item diagram] - item/type = 'unbundle [append code emit-unbundle item diagram] - item/type = 'cluster-control [append code emit-cluster-control-headless item diagram] - item/type = 'cluster-indicator [append code emit-cluster-indicator-headless item diagram] - item/type = 'subvi [append code compile-subvi-call item diagram] - true [ - bdef: find-block item/type - if all [bdef bdef/emit] [ - append code bind-emit bdef/emit (build-bindings item diagram bdef) - ] - ] - ] - ] - - ; Prints para modo standalone (red-cli .qvi) — solo con /with-prints - if with-prints [ - foreach item sorted [ - bdef: find-block item/type - if none? bdef [continue] - if bdef/category = 'output [ - if all [in diagram 'wires block? diagram/wires] [ - foreach w diagram/wires [ - if w/to-node = item/id [ - src: find-node-by-id diagram/nodes w/from-node - if src [ - src-var: port-var src to-word w/from-port - lbl: either all [item/label object? item/label] [item/label/text] [any [item/name ""]] - ; Construir [print rejoin ["label" ": " form var-word]] sin compose - append code 'print - append code 'rejoin - append/only code reduce [copy lbl ": " 'form to-word src-var] - ] - ] - ] - ] - ] - ] - ] - - code -] - -; ══════════════════════════════════════════════════ -; COMPILE-DIAGRAM -; ══════════════════════════════════════════════════ -; -; Genera los componentes de código para un VI completo: -; /headless: block! ejecutable con do (usa config defaults) -; /ui-layout: block! para view layout (controles + botón Run + indicadores) -; -; Para nodos de categoría 'input: el run-body lee de campos de texto del UI. -; Para nodos de categoría 'output: el run-body escribe en etiquetas del UI. -; Para nodos math: usa bind-emit igual que compile-body. - -compile-diagram: func [ - diagram [object!] - /local sorted headless run-body ui-layout item node bdef face-n cfg-val w src src-var bindings -][ - sorted: build-sorted-items diagram - headless: compile-body/with-prints diagram - - ; ── Cuerpo del botón Run (modo UI) ──────────────────────── - run-body: copy [] - foreach item sorted [ - case [ - find [while-loop for-loop] item/type [ - append run-body compile-structure item diagram - ] - item/type = 'case-structure [ - append run-body compile-case-structure/no-gui item diagram - ] - item/type = 'bundle [append run-body emit-bundle item diagram] - item/type = 'unbundle [append run-body emit-unbundle item diagram] - item/type = 'cluster-control [append run-body emit-cluster-control item diagram] - item/type = 'cluster-indicator [append run-body emit-cluster-indicator item diagram] - item/type = 'subvi [append run-body compile-subvi-call item diagram] - true [ - node: item - bdef: find-block node/type - if none? bdef [continue] - case [ - bdef/category = 'input [ - case [ - node-array-input? node [ - ; Array control: valor fijo del config (no hay field editable — DT-028) - if bdef/emit [ - append run-body bind-emit bdef/emit (build-bindings node diagram bdef) - ] - ] - true [ - face-sym: to-word rejoin ["f_" node/id] - case [ - node-boolean-input? node [ - append run-body compose [(to-set-word port-var node 'result) (to-path reduce [face-sym 'data])] - ] - node-string-input? node [ - append run-body compose [(to-set-word port-var node 'result) (to-path reduce [face-sym 'text])] - ] - true [ - append run-body compose [(to-set-word port-var node 'result) to-float (to-path reduce [face-sym 'text])] - ] - ] - ] - ] - ] - bdef/category = 'output [ - face-sym: to-word rejoin ["t_" node/id] - foreach w diagram/wires [ - if w/to-node = node/id [ - ; Fuente: nodo normal - src: find-node-by-id diagram/nodes w/from-node - if src [ - src-var: port-var src to-word w/from-port - append run-body compose [(to set-path! reduce [face-sym 'text]) form (src-var)] - ] - ; Fuente: estructura (SR-right → indicador externo) - if all [in diagram 'structures block? diagram/structures] [ - foreach st diagram/structures [ - if st/id = w/from-node [ - src-var: to-word rejoin ["_" form w/from-port] - append run-body compose [(to set-path! reduce [face-sym 'text]) form (src-var)] - ] - ] - ] - ] - ] - ] - true [ - if bdef/emit [ - bindings: build-bindings node diagram bdef - append run-body bind-emit bdef/emit bindings - ] - ] - ] - ] - ] - ] - - ; ── Layout del Front Panel ──────────────────────────────── - ui-layout: copy [] - foreach item sorted [ - if in item 'shift-regs [continue] ; saltar estructuras - node: item - bdef: find-block node/type - if none? bdef [continue] - if bdef/category = 'input [ - ; Array control: sin widget — valor fijo, no aparece en UI layout - if node-array-input? node [continue] - - face-n: to-word rejoin ["f_" node/id] - ; any [none false] = none en Red (false es falsy) → usar either/none? explícito - cfg-val: either none? select node/config 'default [ - case [ - node-boolean-input? node [false] - node-string-input? node [""] - true [0.0] - ] - ][ - select node/config 'default - ] - node-label: either all [node/label object? node/label] [node/label/text] [any [node/name ""]] - append ui-layout 'text - ; UI layout usa label/text (display) para textos visibles (DT-024) - append ui-layout node-label - append ui-layout to-set-word face-n - case [ - node-boolean-input? node [ - ; Control booleano: check face, lee face/data (logic!) - append ui-layout 'check - append ui-layout node-label - append ui-layout cfg-val - ] - node-string-input? node [ - ; Control string: field editable, lee face/text directamente - append ui-layout 'field - append ui-layout cfg-val - ] - true [ - append ui-layout 'field - append ui-layout form cfg-val - ] - ] - ] - ] - - append ui-layout 'button - append ui-layout "Run" - append/only ui-layout run-body - foreach item sorted [ - if in item 'shift-regs [continue] ; saltar estructuras - node: item - bdef: find-block node/type - if none? bdef [continue] - if bdef/category = 'output [ - face-n: to-word rejoin ["t_" node/id] - append ui-layout 'text - ; UI layout usa label/text (display) para textos visibles (DT-024) - append ui-layout either all [node/label object? node/label] [node/label/text] [any [node/name ""]] - append ui-layout to-set-word face-n - append ui-layout 'text - append ui-layout "---" - ] - ] - - ; ── Recopilar sub-VIs referenciados para #include (Fase 3) ──────────── - subvi-files: copy [] - subvi-names: copy [] - foreach item sorted [ - if item/type = 'subvi [ - if all [in item 'file file? item/file] [ - ; Evitar duplicados - if not find subvi-files item/file [ - append subvi-files item/file - ; Recopilar nombre de función para validación - func-nm: select item/config 'func-name - if func-nm [ - append subvi-names func-nm - ] - ] - ] - ] - ] - - result-map: make map! [] - result-map/headless: headless - result-map/ui-layout: ui-layout - result-map/subvi-files: subvi-files - result-map/subvi-names: subvi-names - result-map -] - -; ══════════════════════════════════════════════════════════ -; COMPILE-PANEL (movido desde panel.red — 4A refactor) -; ══════════════════════════════════════════════════════════ - -gen-panel-var-name: func [item /local s fc] [ - s: copy item/name - if not empty? s [ - fc: uppercase copy/part s 1 - s: rejoin [fc skip s 1] - ] - to-word rejoin ["f" s] -] - -gen-indicator-var-name: func [item /local s fc] [ - s: copy item/name - if not empty? s [ - fc: uppercase copy/part s 1 - s: rejoin [fc skip s 1] - ] - to-word rejoin ["l" s] -] - -compile-panel: func [model /local cmds item ctrl-field-name ind-var-name fn ft fval fld-name] [ - cmds: copy [] - - foreach item model/front-panel [ - case [ - find [control str-control] item/type [ - ctrl-field-name: gen-panel-var-name item - append cmds compose [ - label (item/label/text) - (to-set-word ctrl-field-name) field 120 (form item/default) - return - ] - ] - item/type = 'bool-control [ - ctrl-field-name: gen-panel-var-name item - append cmds compose [ - label (item/label/text) - (to-set-word ctrl-field-name) check (item/label/text) (item/default) - return - ] - ] - item/type = 'arr-control [ - ind-var-name: gen-indicator-var-name item - append cmds compose [ - label (item/label/text) - (to-set-word ind-var-name) text 120 (rejoin ["[" form item/default "]"]) - return - ] - ] - item/type = 'cluster-control [ - foreach [fn ft] fp-cluster-fields item [ - fld-name: to-word rejoin [form item/name "_" form fn] - fval: select any [item/default copy []] fn - append cmds compose [label (rejoin [item/label/text " — " form fn])] - case [ - ft = 'boolean [ - append cmds compose [ - (to-set-word fld-name) check (form fn) (any [fval false]) - return - ] - ] - true [ - append cmds compose [ - (to-set-word fld-name) field 120 (form any [fval ""]) - return - ] - ] - ] - ] - ] - item/type = 'cluster-indicator [ - foreach [fn ft] fp-cluster-fields item [ - fld-name: to-word rejoin [form item/name "_" form fn] - fval: select any [item/default copy []] fn - append cmds compose [ - label (rejoin [item/label/text " — " form fn]) - (to-set-word fld-name) text 120 (form any [fval ""]) - return - ] - ] - ] - find [waveform-chart waveform-graph] item/type [ - ind-var-name: gen-indicator-var-name item - append cmds compose [ - label (item/label/text) - (to-set-word ind-var-name) base 200x160 draw [] - return - ] - ] - true [ - ind-var-name: gen-indicator-var-name item - append cmds compose [ - label (item/label/text) - (to-set-word ind-var-name) text 120 (form item/default) - return - ] - ] - ] - ] - - append cmds compose [button "Run" []] - cmds -] - -gen-standalone-code: func [model /local vid-code] [ - vid-code: compile-panel model - rejoin [ - "Red [title: {QTorres Panel Demo} Needs: 'View]" newline - "qvi-diagram: []" newline - "view layout [" newline - " " mold vid-code newline - "]" - ] -] +; Módulos del compilador (orden importa por dependencias): +; topo — topological-sort, build-sorted-items +; emit — bind-emit, port-var, build-bindings, emit-bundle/unbundle/cluster-* +; structures — compile-structure (while/for), compile-case-structure +; body — compile-body, compile-diagram, compile-subvi-call +; panel — compile-panel, gen-panel-var-name, gen-indicator-var-name, gen-standalone-code +#include %compiler-topo.red +#include %compiler-emit.red +#include %compiler-structures.red +#include %compiler-body.red +#include %compiler-panel.red #include %../runner/runner.red diff --git a/src/io/file-io-load.red b/src/io/file-io-load.red new file mode 100644 index 0000000..fae8378 --- /dev/null +++ b/src/io/file-io-load.red @@ -0,0 +1,306 @@ +Red [ + Title: "QTorres — File I/O (carga de .qvi)" + Purpose: "load-vi + helpers — reconstruye el modelo desde un .qvi" +] + +; ══════════════════════════════════════════════════ +; LOAD-VI +; ══════════════════════════════════════════════════ +; +; Lee un fichero .qvi, extrae qvi-diagram y reconstruye el modelo en memoria. +; El código generado se ignora — QTorres recompila desde qvi-diagram (DT-011). +; Un .qvi con solo qvi-diagram (sin código generado) es válido. + +; Convierte set-words a words en un bloque (recursivo para sub-bloques). +; Permite que make-node/make-wire funcionen igual con .qvi nuevos (set-words) +; y con .qvi antiguos (words). model.red no necesita cambios. +norm-spec: func [spec [block!] /local result item] [ + result: copy [] + foreach item spec [ + case [ + set-word? item [append result to-word item] + block? item [append/only result norm-spec item] + true [append result item] + ] + ] + result +] + +; Parsea una lista de nodos [node [...] ...] y devuelve objetos make-node. +; Si abs-x/abs-y están dados, convierte coords relativas a absolutas. +load-node-list: func [ + nodes-data [block!] names [block!] + /absolute abs-x abs-y + /local node-spec nx ny n +][ + collect [ + parse nodes-data [ + any [ + 'node set node-spec block! ( + ; Convertir coords relativas a absolutas si se indica + if absolute [ + nx: any [select node-spec 'x 0] + ny: any [select node-spec 'y 0] + node-spec: copy node-spec + if pos: find node-spec 'x [pos/2: nx + abs-x] + if pos: find node-spec 'y [pos/2: ny + abs-y] + ] + ; Subvi: cargar connector desde el fichero referenciado + n: either (select node-spec 'type) = 'subvi [ + make-subvi-node node-spec + ][ + make-node node-spec + ] + if select node-spec 'name [append names select node-spec 'name] + keep n + ) + | skip + ] + ] + ] +] + +; Parsea una lista de wires [wire [...] ...] y devuelve objetos make-wire. +load-wire-list: func [wires-data [block!] /local wire-spec] [ + collect [ + parse wires-data [ + any [ + 'wire set wire-spec block! ( + keep make-wire compose [ + from: (select wire-spec 'from) + from-port: (any [select wire-spec 'from-port select wire-spec 'port]) + to: (select wire-spec 'to) + to-port: (any [select wire-spec 'to-port select wire-spec 'port]) + ] + ) + | skip + ] + ] + ] +] + +load-vi: func [ + path [file!] + /local src pos qd bd-data nodes-data wires-data structs-data d names st-spec st st-nodes st-wires cond-data + sr-data sr-spec frame-data fr-spec fr-nodes fr-wires sel-data fr st-kw st-label-text +][ + src: load path + + ; Buscar el set-word qvi-diagram: en el bloque cargado + pos: find src to-set-word 'qvi-diagram + if none? pos [ + cause-error 'user 'message ["load-vi: qvi-diagram no encontrado en " mold path] + ] + ; Normalizar set-words → words en todo el qvi-diagram + qd: norm-spec pos/2 + + bd-data: select qd 'block-diagram + if none? bd-data [ + cause-error 'user 'message ["load-vi: block-diagram no encontrado"] + ] + + d: make-diagram any [select qd 'name form path] + + nodes-data: select bd-data 'nodes + wires-data: select bd-data 'wires + structs-data: select bd-data 'structures + + ; Recopilar names para sincronizar contadores (DT-024) + names: copy [] + + if nodes-data [d/nodes: load-node-list nodes-data names] + if wires-data [d/wires: load-wire-list wires-data] + + ; ── Cargar structures (while-loop, for-loop, case-structure) ─────── + if all [structs-data block? structs-data] [ + parse structs-data [ + any [ + set st-kw ['while-loop | 'for-loop | 'case-structure] set st-spec block! ( + st: make-structure compose [ + id: (any [select st-spec 'id 0]) + type: (st-kw) + name: (any [select st-spec 'name ""]) + x: (any [select st-spec 'x 0]) + y: (any [select st-spec 'y 0]) + w: (any [select st-spec 'w 300]) + h: (any [select st-spec 'h 200]) + active-frame: (any [select st-spec 'active-frame 0]) + ] + ; Label + st-label-text: case [ + st-kw = 'for-loop ["For Loop"] + st-kw = 'case-structure ["Case Structure"] + true ["While Loop"] + ] + st/label: either select st-spec 'label [ + make-label select st-spec 'label + ][ + make-label compose [text: (st-label-text) visible: true] + ] + ; Shift registers (solo para loops) + if find [while-loop for-loop] st-kw [ + sr-data: any [select st-spec 'shift-registers []] + parse sr-data [ + any [ + 'sr set sr-spec block! ( + append st/shift-regs make-shift-register compose [ + id: (any [select sr-spec 'id 0]) + name: (any [select sr-spec 'name ""]) + data-type: (any [select sr-spec 'data-type 'number]) + init-value: (any [select sr-spec 'init-value 0.0]) + y-offset: (any [select sr-spec 'y-offset 40]) + ] + if select sr-spec 'name [append names select sr-spec 'name] + ) + | skip + ] + ] + ] + ; Frames (solo para case-structure) + if st-kw = 'case-structure [ + frame-data: any [select st-spec 'frames []] + parse frame-data [ + any [ + 'frame set fr-spec block! ( + fr: make-frame fr-spec + ; Nodos del frame: coords relativas → absolutas + fr-nodes: any [select fr-spec 'nodes []] + fr/nodes: load-node-list/absolute fr-nodes names st/x st/y + ; Wires del frame + fr-wires: any [select fr-spec 'wires []] + fr/wires: load-wire-list fr-wires + append st/frames fr + ) + | skip + ] + ] + ; Selector wire + sel-data: select st-spec 'selector + st/selector-wire: either all [sel-data not empty? sel-data] [ + make object! [ + from: any [select sel-data 'from 0] + port: any [select sel-data 'port 'result] + ] + ][ + none + ] + ] + ; Nodos internos (para loops): coords relativas → absolutas + if find [while-loop for-loop] st-kw [ + st-nodes: any [select st-spec 'nodes []] + st/nodes: load-node-list/absolute st-nodes names st/x st/y + st-wires: any [select st-spec 'wires []] + st/wires: load-wire-list st-wires + ] + ; Wire de condición solo para while-loop + if st-kw = 'while-loop [ + cond-data: select st-spec 'condition + st/cond-wire: either all [cond-data not empty? cond-data] [ + make object! [ + from: any [select cond-data 'from 0] + port: any [select cond-data 'port 'result] + ] + ][ + none + ] + ] + if st/name [append names st/name] + append d/structures st + ) + | skip + ] + ] + ] + + ; ── Cargar connector (Fase 3: Sub-VI) ──────────────────────────────── + conn-data: select qd 'connector + if all [conn-data block? conn-data not empty? conn-data] [ + d/connector: copy [] + parse conn-data [ + any [ + 'input set conn-spec block! ( + append d/connector reduce [ + 'input + any [select conn-spec 'pin 0] + any [select conn-spec 'label ""] + any [select conn-spec 'id 0] + ] + ) + | 'output set conn-spec block! ( + append d/connector reduce [ + 'output + any [select conn-spec 'pin 0] + any [select conn-spec 'label ""] + any [select conn-spec 'id 0] + ] + ) + | skip + ] + ] + ] + + ; Sincronizar contadores de names + unless empty? names [sync-name-counters names] + + ; Cargar front-panel + d/front-panel: either value? 'load-panel-from-diagram [ + load-panel-from-diagram qd + ][ + copy [] + ] + + d +] + +; ══════════════════════════════════════════════════════════ +; LOAD-PANEL-FROM-DIAGRAM — Phase 4 +; ══════════════════════════════════════════════════════════ +; +; Carga front-panel items desde qvi-diagram (formato: qd). +; Retorna bloque de objetos make-fp-item. + +load-panel-from-diagram: func [qd [block!] /local fp-raw items item kw id type name lbl default config offset item-spec] [ + fp-raw: select qd to-set-word 'front-panel + items: copy [] + + unless block? fp-raw [return items] + + parse fp-raw [ + any [ + set kw word! set item-spec block! ( + ; Construir spec completo para make-fp-item + spec: copy [] + append spec to-set-word 'id + append spec any [select item-spec 'id 0] + append spec to-set-word 'type + append spec any [select item-spec 'type 'control] + append spec to-set-word 'name + append spec any [select item-spec 'name ""] + + ; Normalizar label + lbl-block: any [select item-spec 'label [text: ""]] + unless block? lbl-block [lbl-block: compose [text: (lbl-block)]] + if none? select lbl-block 'text [append lbl-block compose [text: ""]] + if none? select lbl-block 'visible [append lbl-block compose [visible: true]] + if none? select lbl-block 'offset [append lbl-block compose [offset: 0x0]] + append spec to-set-word 'label + append/only spec lbl-block + + append spec to-set-word 'default + append/only spec any [select item-spec 'default copy []] + + append spec to-set-word 'config + append/only spec any [select item-spec 'config copy []] + + append spec to-set-word 'offset + append spec any [select item-spec 'offset 0x0] + + item: make-fp-item spec + append items item + ) + | skip + ] + ] + + items +] diff --git a/src/io/file-io-qlib.red b/src/io/file-io-qlib.red new file mode 100644 index 0000000..6c8dfa5 --- /dev/null +++ b/src/io/file-io-qlib.red @@ -0,0 +1,94 @@ +Red [ + Title: "QTorres — File I/O (gestión de librerías .qlib)" + Purpose: "load-qlib + find-qlibs — librerías de VIs con namespacing" +] + +; ══════════════════════════════════════════════════════════ +; QLIB — Librería de VIs con namespacing +; ══════════════════════════════════════════════════════════ +; +; Una .qlib es un FICHERO de texto con extension .qlib que actua como +; manifiesto. Los .qvi miembros viven junto a el (misma carpeta o subdir). +; +; Formato del fichero .qlib: +; qlib [ +; name: "math" +; version: 1 +; description: "Operaciones matematicas" +; members: [%math/add.qvi %math/subtract.qvi] +; ] +; +; Estructura tipica: +; proyecto/ +; math.qlib <- manifiesto +; math/ +; add.qvi +; subtract.qvi + +; Carga un fichero .qlib y devuelve un objeto con: +; name, version, description, dir, members (bloque de file! absolutos) +; Devuelve none si el fichero no es un .qlib valido. +load-qlib: func [ + "Carga el manifiesto de un fichero .qlib" + qlib-file [file!] + /local base-dir raw qd name version desc members-raw members m abs-path +][ + if dir? qlib-file [return none] + if not exists? qlib-file [return none] + raw: attempt [load qlib-file] + if not block? raw [return none] + if any [empty? raw raw/1 <> 'qlib] [return none] + qd: raw/2 + if not block? qd [return none] + + ; Directorio base = directorio que contiene el .qlib + base-dir: first split-path qlib-file + + name: any [select qd 'name ""] + version: any [select qd 'version 1] + desc: any [select qd 'description ""] + members-raw: any [select qd 'members copy []] + + ; Resolver rutas de miembros relativas al directorio del .qlib + members: copy [] + foreach m members-raw [ + if file? m [ + abs-path: to-file rejoin [form base-dir form m] + if exists? abs-path [append members abs-path] + ] + ] + + make object! compose/only [ + name: (name) + version: (version) + description: (desc) + dir: (base-dir) + members: (members) + ] +] + +; Busca ficheros .qlib en el directorio dado. +; Uso: find-qlibs/from system/options/path +; Devuelve bloque de objetos qlib (puede estar vacio). +find-qlibs: func [ + "Busca ficheros .qlib en el directorio dado" + /from project-dir [file!] + /local search-dirs libs d qlib-file obj +][ + search-dirs: copy [] + if from [append search-dirs clean-path project-dir] + + libs: copy [] + foreach p search-dirs [ + if all [p exists? p dir? p] [ + foreach d read p [ + if all [not dir? d %.qlib = suffix? d] [ + qlib-file: to-file rejoin [form p form d] + obj: load-qlib qlib-file + if obj [append libs obj] + ] + ] + ] + ] + libs +] diff --git a/src/io/file-io-save.red b/src/io/file-io-save.red new file mode 100644 index 0000000..a32f7bc --- /dev/null +++ b/src/io/file-io-save.red @@ -0,0 +1,79 @@ +Red [ + Title: "QTorres — File I/O (guardado de .qvi y Front Panel)" + Purpose: "save-vi + save-panel-to-diagram" +] + +; ══════════════════════════════════════════════════ +; SAVE-VI +; ══════════════════════════════════════════════════ +; +; Escribe el fichero .qvi completo: +; 1. Cabecera Red con Needs: 'View +; 2. qvi-diagram: [...] — fuente de verdad (DT-011) +; 3. Código generado: modo dual UI/headless (DT-009, DT-012) +; +; Run NO llama a save-vi. Son operaciones independientes (DT-010). + +save-vi: func [ + path [file!] + diagram [object!] + /local compiled qd content fp-items +][ + compiled: compile-diagram diagram + qd: serialize-diagram diagram + ; Incluir front-panel si está disponible (requiere panel.red cargado) + fp-items: select diagram 'front-panel + if all [ + value? 'save-panel-to-diagram + block? fp-items + not empty? fp-items + ][ + append qd save-panel-to-diagram fp-items + ] + ; Detectar si es un Sub-VI (tiene connector definido) + either all [in diagram 'connector block? diagram/connector not empty? diagram/connector] [ + content: format-qvi/subvi diagram/name qd compiled + ][ + content: format-qvi diagram/name qd compiled + ] + write path content + path +] + +; ══════════════════════════════════════════════════════════ +; SAVE-PANEL-TO-DIAGRAM (movido desde panel.red — 4A refactor) +; ══════════════════════════════════════════════════════════ + +save-panel-to-diagram: func [front-panel-items /local items item kw spec] [ + items: copy [] + foreach item front-panel-items [ + kw: case [ + item/type = 'control ['control] + item/type = 'bool-control ['bool-control] + item/type = 'bool-indicator ['bool-indicator] + item/type = 'str-control ['str-control] + item/type = 'str-indicator ['str-indicator] + item/type = 'arr-control ['arr-control] + item/type = 'arr-indicator ['arr-indicator] + item/type = 'cluster-control ['cluster-control] + item/type = 'cluster-indicator ['cluster-indicator] + item/type = 'waveform-chart ['waveform-chart] + item/type = 'waveform-graph ['waveform-graph] + true ['indicator] + ] + spec: copy [] + repend spec [to-set-word 'id item/id to-set-word 'type item/type to-set-word 'name item/name] + append spec to-set-word 'label + append/only spec compose/deep [text: (item/label/text) visible: (item/label/visible) offset: (item/label/offset)] + append spec to-set-word 'default + either block? item/value [append/only spec copy item/value] [append spec item/value] + if item/data-type = 'cluster [ + append spec to-set-word 'config + append/only spec copy any [item/config copy []] + ] + repend spec [to-set-word 'offset item/offset] + append items kw + append/only items spec + ] + reduce [to-set-word 'front-panel items] +] diff --git a/src/io/file-io-serialize.red b/src/io/file-io-serialize.red new file mode 100644 index 0000000..1f04051 --- /dev/null +++ b/src/io/file-io-serialize.red @@ -0,0 +1,468 @@ +Red [ + Title: "QTorres — File I/O (serialización + formato .qvi)" + Purpose: "serialize-diagram + format-qvi: convierte modelo → texto .qvi" +] + +; ══════════════════════════════════════════════════ +; SERIALIZE-DIAGRAM +; ══════════════════════════════════════════════════ +; +; Convierte el objeto diagrama en memoria al formato de bloque qvi-diagram. +; Formato nuevo (DT-022/024): +; node [id: 1 type: 'control name: "ctrl_1" label: [text: "A" visible: true] x: 100 y: 100] +; wire [from: 1 from-port: 'result to: 2 to-port: 'a] + +; Serializa una lista de nodos a bloque [node [...] node [...] ...] +; Si rel-x/rel-y están dados, las coords se hacen relativas a ese offset. +serialize-nodes: func [ + nodes [block!] /relative rel-x rel-y + /local nodes-block n lbl-block nx ny node-spec-blk +][ + nodes-block: copy [] + foreach n nodes [ + lbl-block: either all [n/label object? n/label] [ + compose [text: (n/label/text) visible: (n/label/visible)] + ][ + compose [text: (either string? n/label [n/label] [""]) visible: (true)] + ] + nx: either relative [n/x - rel-x] [n/x] + ny: either relative [n/y - rel-y] [n/y] + ; Incluir config si no está vacío (permite round-trip de valores de constantes) + node-spec-blk: compose/only [ + id: (n/id) type: (n/type) + name: (either select n 'name [n/name] [""]) + label: (lbl-block) + x: (nx) y: (ny) + ] + if all [in n 'config not empty? n/config] [ + append node-spec-blk 'config + append/only node-spec-blk copy n/config + ] + ; Incluir file para nodos subvi (Fase 3) + if all [in n 'file n/file] [ + append node-spec-blk 'file + append/only node-spec-blk n/file + ] + append nodes-block 'node + append/only nodes-block node-spec-blk + ] + nodes-block +] + +; Serializa una lista de wires a bloque [wire [...] wire [...] ...] +serialize-wires: func [wires [block!] /local wires-block w] [ + wires-block: copy [] + foreach w wires [ + append wires-block 'wire + append/only wires-block compose [ + from: (w/from-node) from-port: (w/from-port) + to: (w/to-node) to-port: (w/to-port) + ] + ] + wires-block +] + +serialize-diagram: func [ + diagram [object!] + /local nodes-block wires-block structs-block st lbl-block st-nodes-block st-wires-block cond-spec + sr-block sr +][ + nodes-block: serialize-nodes diagram/nodes + wires-block: serialize-wires diagram/wires + + ; ── Structures (while-loop, for-loop, case-structure) ─────────────── + structs-block: copy [] + if all [object? diagram in diagram 'structures block? diagram/structures] [ + foreach st diagram/structures [ + lbl-text: either all [st/label object? st/label] [st/label/text] [ + case [ + st/type = 'for-loop ["For Loop"] + st/type = 'case-structure ["Case Structure"] + true ["While Loop"] + ] + ] + lbl-block: compose [text: (lbl-text) visible: (true)] + ; Shift registers + sr-block: copy [] + if in st 'shift-regs [ + foreach sr st/shift-regs [ + append sr-block 'sr + append/only sr-block compose [ + id: (sr/id) name: (sr/name) data-type: (sr/data-type) + init-value: (sr/init-value) y-offset: (sr/y-offset) + ] + ] + ] + ; Nodos internos: coords RELATIVAS a la estructura + st-nodes-block: serialize-nodes/relative st/nodes st/x st/y + st-wires-block: serialize-wires st/wires + ; Keyword de estructura según tipo + append structs-block st/type + ; Bloque de datos según tipo + case [ + st/type = 'for-loop [ + append/only structs-block compose/only [ + id: (st/id) name: (st/name) label: (lbl-block) + x: (st/x) y: (st/y) w: (st/w) h: (st/h) + shift-registers: (sr-block) + nodes: (st-nodes-block) + wires: (st-wires-block) + ] + ] + st/type = 'while-loop [ + cond-spec: either st/cond-wire [ + compose [from: (st/cond-wire/from) port: (st/cond-wire/port)] + ][ + none + ] + append/only structs-block compose/only [ + id: (st/id) name: (st/name) label: (lbl-block) + x: (st/x) y: (st/y) w: (st/w) h: (st/h) + shift-registers: (sr-block) + condition: (either cond-spec [cond-spec] [[]]) + nodes: (st-nodes-block) + wires: (st-wires-block) + ] + ] + st/type = 'case-structure [ + ; Frames + frames-block: copy [] + foreach fr st/frames [ + fr-nodes-block: serialize-nodes/relative fr/nodes st/x st/y + fr-wires-block: serialize-wires fr/wires + append frames-block 'frame + append/only frames-block compose/only [ + id: (fr/id) label: (fr/label) + nodes: (fr-nodes-block) + wires: (fr-wires-block) + ] + ] + ; Selector wire + sel-spec: either st/selector-wire [ + compose [from: (st/selector-wire/from) port: (st/selector-wire/port)] + ][ + none + ] + append/only structs-block compose/only [ + id: (st/id) name: (st/name) label: (lbl-block) + x: (st/x) y: (st/y) w: (st/w) h: (st/h) + frames: (frames-block) + active-frame: (st/active-frame) + selector: (either sel-spec [sel-spec] [[]]) + ] + ] + ] + ] + ] + + ; ── Connector (solo si el VI se usa como sub-VI, Fase 3) ────────────── + connector-block: copy [] + if all [in diagram 'connector block? diagram/connector not empty? diagram/connector] [ + foreach conn-item diagram/connector [ + ; conn-item: [type pin label id] donde type es 'input o 'output + append connector-block conn-item/1 + append/only connector-block compose/only [ + pin: (conn-item/2) label: (conn-item/3) id: (conn-item/4) + ] + ] + ] + + compose/only [ + meta: [description: "" version: 1 author: "" tags: []] + icon: [] + block-diagram: (compose/only [ + nodes: (nodes-block) + wires: (wires-block) + structures: (structs-block) + ]) + connector: (connector-block) + ] +] + +; ══════════════════════════════════════════════════ +; FORMAT-QVI +; ══════════════════════════════════════════════════ +; +; Construye el string .qvi con formato multi-línea e indentación. +; qd usa set-words como claves (de serialize-diagram), se navega con to-set-word. + +format-qvi: func [ + diagram-name [string!] + qd [block!] ; resultado de serialize-diagram (set-words como claves) + compiled [map!] ; resultado de compile-diagram + /subvi ; si true, genera context [exec: func [...]] en lugar de either + /local meta-raw bd-raw nodes-raw wires-raw structs-raw fp-raw + nodes-str wires-str structs-str layout-str fp-str + node-block wire-block struct-block sr-block fp-kw fp-spec i item kind-pos + st-nodes-raw st-wires-raw st-srs-raw st-nodes-str st-wires-str st-srs-str + fr-block fr-nodes-raw fr-wires-raw fr-nodes-str fr-wires-str frames-raw frames-str + has-connector +][ + ; Detectar si el diagrama tiene connector (para modo sub-VI) + has-connector: any [subvi false] + ; Navegar qd con to-set-word (claves son set-words) + meta-raw: any [select qd to-set-word 'meta [description: "" version: 1 author: "" tags: []]] + bd-raw: select qd to-set-word 'block-diagram + nodes-raw: either bd-raw [select bd-raw to-set-word 'nodes] [copy []] + wires-raw: either bd-raw [select bd-raw to-set-word 'wires] [copy []] + structs-raw: either bd-raw [select bd-raw to-set-word 'structures] [copy []] + + ; ── Nodes ────────────────────────────────────────────────────────────── + nodes-str: copy "" + if nodes-raw [ + parse nodes-raw [ + any [ + 'node set node-block block! ( + append nodes-str rejoin [" node " mold node-block "^/"] + ) + | skip + ] + ] + ] + + ; ── Wires ────────────────────────────────────────────────────────────── + wires-str: copy "" + if wires-raw [ + parse wires-raw [ + any [ + 'wire set wire-block block! ( + append wires-str rejoin [" wire " mold wire-block "^/"] + ) + | skip + ] + ] + ] + + ; ── Structures ───────────────────────────────────────────────────────── + structs-str: copy "" + if all [structs-raw not empty? structs-raw] [ + parse structs-raw [ + any [ + set struct-kw ['while-loop | 'for-loop | 'case-structure] set struct-block block! ( + st-nodes-raw: any [select struct-block 'nodes []] + st-wires-raw: any [select struct-block 'wires []] + st-srs-raw: any [select struct-block 'shift-registers []] + st-nodes-str: copy "" + parse st-nodes-raw [ + any [ + 'node set node-block block! ( + append st-nodes-str rejoin [" node " mold node-block "^/"] + ) | skip + ] + ] + st-wires-str: copy "" + parse st-wires-raw [ + any [ + 'wire set wire-block block! ( + append st-wires-str rejoin [" wire " mold wire-block "^/"] + ) | skip + ] + ] + st-srs-str: copy "" + parse st-srs-raw [ + any [ + 'sr set sr-block block! ( + append st-srs-str rejoin [" sr " mold sr-block "^/"] + ) | skip + ] + ] + ; ── Case Structure: frames ───────────────────────────── + frames-str: copy "" + if struct-kw = 'case-structure [ + frames-raw: any [select struct-block 'frames []] + parse frames-raw [ + any [ + 'frame set fr-block block! ( + fr-nodes-raw: any [select fr-block 'nodes []] + fr-wires-raw: any [select fr-block 'wires []] + fr-nodes-str: copy "" + parse fr-nodes-raw [ + any [ + 'node set node-block block! ( + append fr-nodes-str rejoin [" node " mold node-block "^/"] + ) | skip + ] + ] + fr-wires-str: copy "" + parse fr-wires-raw [ + any [ + 'wire set wire-block block! ( + append fr-wires-str rejoin [" wire " mold wire-block "^/"] + ) | skip + ] + ] + append frames-str rejoin [ + " frame [^/" + " id: " mold any [select fr-block 'id 0] + " label: " mold any [select fr-block 'label "0"] "^/" + " nodes: [^/" fr-nodes-str " ]^/" + " wires: [^/" fr-wires-str " ]^/" + " ]^/" + ] + ) | skip + ] + ] + ] + append structs-str rejoin [ + " " form struct-kw " [^/" + " id: " mold any [select struct-block 'id 0] + " name: " mold any [select struct-block 'name ""] + " label: " mold any [select struct-block 'label []] "^/" + " x: " mold any [select struct-block 'x 0] + " y: " mold any [select struct-block 'y 0] + " w: " mold any [select struct-block 'w 300] + " h: " mold any [select struct-block 'h 200] "^/" + either empty? st-srs-str [""] [rejoin [ + " shift-registers: [^/" st-srs-str " ]^/" + ]] + ; condition solo en while-loop + either struct-kw = 'while-loop [ + rejoin [" condition: " mold any [select struct-block 'condition []] "^/"] + ][""] + ; frames y selector solo en case-structure + either struct-kw = 'case-structure [ + rejoin [ + either empty? frames-str [""] [rejoin [ + " frames: [^/" frames-str " ]^/" + ]] + " active-frame: " mold any [select struct-block 'active-frame 0] "^/" + " selector: " mold any [select struct-block 'selector []] "^/" + ] + ][""] + " nodes: [^/" st-nodes-str " ]^/" + " wires: [^/" st-wires-str " ]^/" + " ]^/" + ] + ) + | skip + ] + ] + ] + + ; ── Front Panel (opcional — solo si qd incluye front-panel:) ────────── + fp-raw: select qd to-set-word 'front-panel + fp-str: copy "" + if fp-raw [ + parse fp-raw [ + any [ + set fp-kw word! set fp-spec block! ( + append fp-str rejoin [" " form fp-kw " " mold fp-spec "^/"] + ) + | skip + ] + ] + ] + + ; ── Layout del Front Panel ───────────────────────────────────────────── + ; Estructura: [text "lbl" f_N: field "val" ... button "Run" [...] text "lbl" t_N: text "---" ...] + layout-str: copy "" + i: 1 + while [i <= length? compiled/ui-layout] [ + item: compiled/ui-layout/:i + case [ + item = 'button [ + append layout-str rejoin [ + " button " mold compiled/ui-layout/(i + 1) " " + mold compiled/ui-layout/(i + 2) "^/" + ] + i: i + 3 + ] + item = 'text [ + kind-pos: i + 3 + append layout-str rejoin [ + " text " mold compiled/ui-layout/(i + 1) " " + mold compiled/ui-layout/(i + 2) " " + mold compiled/ui-layout/:kind-pos " " + mold compiled/ui-layout/(i + 4) "^/" + ] + i: i + 5 + ] + true [ + append layout-str rejoin [" " mold item "^/"] + i: i + 1 + ] + ] + ] + + ; ── Generar includes para sub-VIs (Fase 3) ───────────────────────────── + includes-str: copy "" + svf-list: select compiled 'subvi-files + if all [block? svf-list not empty? svf-list] [ + ; Guardar valor actual de qtorres-runtime + append includes-str "_saved-qtorres-runtime: value? 'qtorres-runtime^/" + append includes-str "qtorres-runtime: true^/" + foreach svf svf-list [ + append includes-str rejoin ["#include " mold svf "^/"] + ] + ; Restore se hace al final del código generado + ] + + ; ── Generar código según modo: VI normal o Sub-VI (Fase 3) ───────────── + either has-connector [ + ; Modo Sub-VI: generar context [exec: func [...] [...]] + func-name: to-word diagram-name + generated-code: rejoin [ + either empty? includes-str [""] [rejoin [ + includes-str + "; --- Restaurar qtorres-runtime si estaba definido ---^/" + "if not _saved-qtorres-runtime [unset 'qtorres-runtime]^/^/" + ]] + "; --- Helpers de runtime ---^/" + "arr-subset-helper: func [arr st ln] [copy/part skip arr to-integer st to-integer ln]^/^/" + "; --- CÓDIGO GENERADO — no editar, se regenera al guardar ---^/" + func-name ": context [^/" + " exec: func [] [^/" ; TODO: extraer parámetros del connector + " " mold/only compiled/headless "^/" + " ]^/" + "]^/^/" + "; --- Standalone guard ---^/" + "if not value? 'qtorres-runtime [^/" + " view layout [^/" + layout-str + " ]^/" + "]^/" + ] + ][ + ; Modo VI normal: either UI/headless + generated-code: rejoin [ + either empty? includes-str [""] [rejoin [ + includes-str + "; --- Restaurar qtorres-runtime si estaba definido ---^/" + "if not _saved-qtorres-runtime [unset 'qtorres-runtime]^/^/" + ]] + "; --- Helpers de runtime ---^/" + "arr-subset-helper: func [arr st ln] [copy/part skip arr to-integer st to-integer ln]^/^/" + "; --- CÓDIGO GENERADO — no editar, se regenera al guardar ---^/" + "either empty? system/options/args [^/" + " view layout [^/" + layout-str + " ]^/" + "][^/" + " " mold/only compiled/headless "^/" + "]^/" + ] + ] + + rejoin [ + "Red [Title: " mold diagram-name " Needs: 'View]^/^/" + "qvi-diagram: [^/" + " meta: " mold meta-raw "^/" + " icon: []^/" + " block-diagram: [^/" + " nodes: [^/" + nodes-str + " ]^/" + " wires: [^/" + wires-str + " ]^/" + either empty? structs-str [""] [rejoin [ + " structures: [^/" + structs-str + " ]^/" + ]] + " ]^/" + either empty? fp-str [""] [rejoin [" front-panel: [^/" fp-str " ]^/"]] + "]^/^/" + generated-code + ] +] diff --git a/src/io/file-io.red b/src/io/file-io.red index c449659..6e10ddc 100644 --- a/src/io/file-io.red +++ b/src/io/file-io.red @@ -1,939 +1,17 @@ Red [ - Title: "QTorres — File I/O" + Title: "QTorres — File I/O (orquestador)" Purpose: "Guardar y cargar VIs (.qvi), proyectos (.qproj) y otros tipos de fichero QTorres" ] -; ══════════════════════════════════════════════════ -; SERIALIZE-DIAGRAM -; ══════════════════════════════════════════════════ -; -; Convierte el objeto diagrama en memoria al formato de bloque qvi-diagram. -; Formato nuevo (DT-022/024): -; node [id: 1 type: 'control name: "ctrl_1" label: [text: "A" visible: true] x: 100 y: 100] -; wire [from: 1 from-port: 'result to: 2 to-port: 'a] +; Módulos de I/O (orden importa por dependencias): +; serialize — serialize-nodes/wires/diagram, format-qvi +; load — load-vi, load-node-list, load-wire-list, norm-spec, load-panel-from-diagram +; save — save-vi, save-panel-to-diagram (usa serialize + compile-diagram) +; qlib — load-qlib, find-qlibs -; Serializa una lista de nodos a bloque [node [...] node [...] ...] -; Si rel-x/rel-y están dados, las coords se hacen relativas a ese offset. -serialize-nodes: func [ - nodes [block!] /relative rel-x rel-y - /local nodes-block n lbl-block nx ny node-spec-blk -][ - nodes-block: copy [] - foreach n nodes [ - lbl-block: either all [n/label object? n/label] [ - compose [text: (n/label/text) visible: (n/label/visible)] - ][ - compose [text: (either string? n/label [n/label] [""]) visible: (true)] - ] - nx: either relative [n/x - rel-x] [n/x] - ny: either relative [n/y - rel-y] [n/y] - ; Incluir config si no está vacío (permite round-trip de valores de constantes) - node-spec-blk: compose/only [ - id: (n/id) type: (n/type) - name: (either select n 'name [n/name] [""]) - label: (lbl-block) - x: (nx) y: (ny) - ] - if all [in n 'config not empty? n/config] [ - append node-spec-blk 'config - append/only node-spec-blk copy n/config - ] - ; Incluir file para nodos subvi (Fase 3) - if all [in n 'file n/file] [ - append node-spec-blk 'file - append/only node-spec-blk n/file - ] - append nodes-block 'node - append/only nodes-block node-spec-blk - ] - nodes-block -] - -; Serializa una lista de wires a bloque [wire [...] wire [...] ...] -serialize-wires: func [wires [block!] /local wires-block w] [ - wires-block: copy [] - foreach w wires [ - append wires-block 'wire - append/only wires-block compose [ - from: (w/from-node) from-port: (w/from-port) - to: (w/to-node) to-port: (w/to-port) - ] - ] - wires-block -] - -serialize-diagram: func [ - diagram [object!] - /local nodes-block wires-block structs-block st lbl-block st-nodes-block st-wires-block cond-spec - sr-block sr -][ - nodes-block: serialize-nodes diagram/nodes - wires-block: serialize-wires diagram/wires - - ; ── Structures (while-loop, for-loop, case-structure) ─────────────── - structs-block: copy [] - if all [object? diagram in diagram 'structures block? diagram/structures] [ - foreach st diagram/structures [ - lbl-text: either all [st/label object? st/label] [st/label/text] [ - case [ - st/type = 'for-loop ["For Loop"] - st/type = 'case-structure ["Case Structure"] - true ["While Loop"] - ] - ] - lbl-block: compose [text: (lbl-text) visible: (true)] - ; Shift registers - sr-block: copy [] - if in st 'shift-regs [ - foreach sr st/shift-regs [ - append sr-block 'sr - append/only sr-block compose [ - id: (sr/id) name: (sr/name) data-type: (sr/data-type) - init-value: (sr/init-value) y-offset: (sr/y-offset) - ] - ] - ] - ; Nodos internos: coords RELATIVAS a la estructura - st-nodes-block: serialize-nodes/relative st/nodes st/x st/y - st-wires-block: serialize-wires st/wires - ; Keyword de estructura según tipo - append structs-block st/type - ; Bloque de datos según tipo - case [ - st/type = 'for-loop [ - append/only structs-block compose/only [ - id: (st/id) name: (st/name) label: (lbl-block) - x: (st/x) y: (st/y) w: (st/w) h: (st/h) - shift-registers: (sr-block) - nodes: (st-nodes-block) - wires: (st-wires-block) - ] - ] - st/type = 'while-loop [ - cond-spec: either st/cond-wire [ - compose [from: (st/cond-wire/from) port: (st/cond-wire/port)] - ][ - none - ] - append/only structs-block compose/only [ - id: (st/id) name: (st/name) label: (lbl-block) - x: (st/x) y: (st/y) w: (st/w) h: (st/h) - shift-registers: (sr-block) - condition: (either cond-spec [cond-spec] [[]]) - nodes: (st-nodes-block) - wires: (st-wires-block) - ] - ] - st/type = 'case-structure [ - ; Frames - frames-block: copy [] - foreach fr st/frames [ - fr-nodes-block: serialize-nodes/relative fr/nodes st/x st/y - fr-wires-block: serialize-wires fr/wires - append frames-block 'frame - append/only frames-block compose/only [ - id: (fr/id) label: (fr/label) - nodes: (fr-nodes-block) - wires: (fr-wires-block) - ] - ] - ; Selector wire - sel-spec: either st/selector-wire [ - compose [from: (st/selector-wire/from) port: (st/selector-wire/port)] - ][ - none - ] - append/only structs-block compose/only [ - id: (st/id) name: (st/name) label: (lbl-block) - x: (st/x) y: (st/y) w: (st/w) h: (st/h) - frames: (frames-block) - active-frame: (st/active-frame) - selector: (either sel-spec [sel-spec] [[]]) - ] - ] - ] - ] - ] - - ; ── Connector (solo si el VI se usa como sub-VI, Fase 3) ────────────── - connector-block: copy [] - if all [in diagram 'connector block? diagram/connector not empty? diagram/connector] [ - foreach conn-item diagram/connector [ - ; conn-item: [type pin label id] donde type es 'input o 'output - append connector-block conn-item/1 - append/only connector-block compose/only [ - pin: (conn-item/2) label: (conn-item/3) id: (conn-item/4) - ] - ] - ] - - compose/only [ - meta: [description: "" version: 1 author: "" tags: []] - icon: [] - block-diagram: (compose/only [ - nodes: (nodes-block) - wires: (wires-block) - structures: (structs-block) - ]) - connector: (connector-block) - ] -] - -; ══════════════════════════════════════════════════ -; FORMAT-QVI -; ══════════════════════════════════════════════════ -; -; Construye el string .qvi con formato multi-línea e indentación. -; qd usa set-words como claves (de serialize-diagram), se navega con to-set-word. - -format-qvi: func [ - diagram-name [string!] - qd [block!] ; resultado de serialize-diagram (set-words como claves) - compiled [map!] ; resultado de compile-diagram - /subvi ; si true, genera context [exec: func [...]] en lugar de either - /local meta-raw bd-raw nodes-raw wires-raw structs-raw fp-raw - nodes-str wires-str structs-str layout-str fp-str - node-block wire-block struct-block sr-block fp-kw fp-spec i item kind-pos - st-nodes-raw st-wires-raw st-srs-raw st-nodes-str st-wires-str st-srs-str - fr-block fr-nodes-raw fr-wires-raw fr-nodes-str fr-wires-str frames-raw frames-str - has-connector -][ - ; Detectar si el diagrama tiene connector (para modo sub-VI) - has-connector: any [subvi false] - ; Navegar qd con to-set-word (claves son set-words) - meta-raw: any [select qd to-set-word 'meta [description: "" version: 1 author: "" tags: []]] - bd-raw: select qd to-set-word 'block-diagram - nodes-raw: either bd-raw [select bd-raw to-set-word 'nodes] [copy []] - wires-raw: either bd-raw [select bd-raw to-set-word 'wires] [copy []] - structs-raw: either bd-raw [select bd-raw to-set-word 'structures] [copy []] - - ; ── Nodes ────────────────────────────────────────────────────────────── - nodes-str: copy "" - if nodes-raw [ - parse nodes-raw [ - any [ - 'node set node-block block! ( - append nodes-str rejoin [" node " mold node-block "^/"] - ) - | skip - ] - ] - ] - - ; ── Wires ────────────────────────────────────────────────────────────── - wires-str: copy "" - if wires-raw [ - parse wires-raw [ - any [ - 'wire set wire-block block! ( - append wires-str rejoin [" wire " mold wire-block "^/"] - ) - | skip - ] - ] - ] - - ; ── Structures ───────────────────────────────────────────────────────── - structs-str: copy "" - if all [structs-raw not empty? structs-raw] [ - parse structs-raw [ - any [ - set struct-kw ['while-loop | 'for-loop | 'case-structure] set struct-block block! ( - st-nodes-raw: any [select struct-block 'nodes []] - st-wires-raw: any [select struct-block 'wires []] - st-srs-raw: any [select struct-block 'shift-registers []] - st-nodes-str: copy "" - parse st-nodes-raw [ - any [ - 'node set node-block block! ( - append st-nodes-str rejoin [" node " mold node-block "^/"] - ) | skip - ] - ] - st-wires-str: copy "" - parse st-wires-raw [ - any [ - 'wire set wire-block block! ( - append st-wires-str rejoin [" wire " mold wire-block "^/"] - ) | skip - ] - ] - st-srs-str: copy "" - parse st-srs-raw [ - any [ - 'sr set sr-block block! ( - append st-srs-str rejoin [" sr " mold sr-block "^/"] - ) | skip - ] - ] - ; ── Case Structure: frames ───────────────────────────── - frames-str: copy "" - if struct-kw = 'case-structure [ - frames-raw: any [select struct-block 'frames []] - parse frames-raw [ - any [ - 'frame set fr-block block! ( - fr-nodes-raw: any [select fr-block 'nodes []] - fr-wires-raw: any [select fr-block 'wires []] - fr-nodes-str: copy "" - parse fr-nodes-raw [ - any [ - 'node set node-block block! ( - append fr-nodes-str rejoin [" node " mold node-block "^/"] - ) | skip - ] - ] - fr-wires-str: copy "" - parse fr-wires-raw [ - any [ - 'wire set wire-block block! ( - append fr-wires-str rejoin [" wire " mold wire-block "^/"] - ) | skip - ] - ] - append frames-str rejoin [ - " frame [^/" - " id: " mold any [select fr-block 'id 0] - " label: " mold any [select fr-block 'label "0"] "^/" - " nodes: [^/" fr-nodes-str " ]^/" - " wires: [^/" fr-wires-str " ]^/" - " ]^/" - ] - ) | skip - ] - ] - ] - append structs-str rejoin [ - " " form struct-kw " [^/" - " id: " mold any [select struct-block 'id 0] - " name: " mold any [select struct-block 'name ""] - " label: " mold any [select struct-block 'label []] "^/" - " x: " mold any [select struct-block 'x 0] - " y: " mold any [select struct-block 'y 0] - " w: " mold any [select struct-block 'w 300] - " h: " mold any [select struct-block 'h 200] "^/" - either empty? st-srs-str [""] [rejoin [ - " shift-registers: [^/" st-srs-str " ]^/" - ]] - ; condition solo en while-loop - either struct-kw = 'while-loop [ - rejoin [" condition: " mold any [select struct-block 'condition []] "^/"] - ][""] - ; frames y selector solo en case-structure - either struct-kw = 'case-structure [ - rejoin [ - either empty? frames-str [""] [rejoin [ - " frames: [^/" frames-str " ]^/" - ]] - " active-frame: " mold any [select struct-block 'active-frame 0] "^/" - " selector: " mold any [select struct-block 'selector []] "^/" - ] - ][""] - " nodes: [^/" st-nodes-str " ]^/" - " wires: [^/" st-wires-str " ]^/" - " ]^/" - ] - ) - | skip - ] - ] - ] - - ; ── Front Panel (opcional — solo si qd incluye front-panel:) ────────── - fp-raw: select qd to-set-word 'front-panel - fp-str: copy "" - if fp-raw [ - parse fp-raw [ - any [ - set fp-kw word! set fp-spec block! ( - append fp-str rejoin [" " form fp-kw " " mold fp-spec "^/"] - ) - | skip - ] - ] - ] - - ; ── Layout del Front Panel ───────────────────────────────────────────── - ; Estructura: [text "lbl" f_N: field "val" ... button "Run" [...] text "lbl" t_N: text "---" ...] - layout-str: copy "" - i: 1 - while [i <= length? compiled/ui-layout] [ - item: compiled/ui-layout/:i - case [ - item = 'button [ - append layout-str rejoin [ - " button " mold compiled/ui-layout/(i + 1) " " - mold compiled/ui-layout/(i + 2) "^/" - ] - i: i + 3 - ] - item = 'text [ - kind-pos: i + 3 - append layout-str rejoin [ - " text " mold compiled/ui-layout/(i + 1) " " - mold compiled/ui-layout/(i + 2) " " - mold compiled/ui-layout/:kind-pos " " - mold compiled/ui-layout/(i + 4) "^/" - ] - i: i + 5 - ] - true [ - append layout-str rejoin [" " mold item "^/"] - i: i + 1 - ] - ] - ] - - ; ── Generar includes para sub-VIs (Fase 3) ───────────────────────────── - includes-str: copy "" - svf-list: select compiled 'subvi-files - if all [block? svf-list not empty? svf-list] [ - ; Guardar valor actual de qtorres-runtime - append includes-str "_saved-qtorres-runtime: value? 'qtorres-runtime^/" - append includes-str "qtorres-runtime: true^/" - foreach svf svf-list [ - append includes-str rejoin ["#include " mold svf "^/"] - ] - ; Restore se hace al final del código generado - ] - - ; ── Generar código según modo: VI normal o Sub-VI (Fase 3) ───────────── - either has-connector [ - ; Modo Sub-VI: generar context [exec: func [...] [...]] - ; El standalone guard se incluye automáticamente - ; TODO: extraer parámetros del connector para el func - func-name: to-word diagram-name - generated-code: rejoin [ - either empty? includes-str [""] [rejoin [ - includes-str - "; --- Restaurar qtorres-runtime si estaba definido ---^/" - "if not _saved-qtorres-runtime [unset 'qtorres-runtime]^/^/" - ]] - "; --- Helpers de runtime ---^/" - "arr-subset-helper: func [arr st ln] [copy/part skip arr to-integer st to-integer ln]^/^/" - "; --- CÓDIGO GENERADO — no editar, se regenera al guardar ---^/" - func-name ": context [^/" - " exec: func [] [^/" ; TODO: extraer parámetros del connector - " " mold/only compiled/headless "^/" - " ]^/" - "]^/^/" - "; --- Standalone guard ---^/" - "if not value? 'qtorres-runtime [^/" - " view layout [^/" - layout-str - " ]^/" - "]^/" - ] - ][ - ; Modo VI normal: either UI/headless - generated-code: rejoin [ - either empty? includes-str [""] [rejoin [ - includes-str - "; --- Restaurar qtorres-runtime si estaba definido ---^/" - "if not _saved-qtorres-runtime [unset 'qtorres-runtime]^/^/" - ]] - "; --- Helpers de runtime ---^/" - "arr-subset-helper: func [arr st ln] [copy/part skip arr to-integer st to-integer ln]^/^/" - "; --- CÓDIGO GENERADO — no editar, se regenera al guardar ---^/" - "either empty? system/options/args [^/" - " view layout [^/" - layout-str - " ]^/" - "][^/" - " " mold/only compiled/headless "^/" - "]^/" - ] - ] - - rejoin [ - "Red [Title: " mold diagram-name " Needs: 'View]^/^/" - "qvi-diagram: [^/" - " meta: " mold meta-raw "^/" - " icon: []^/" - " block-diagram: [^/" - " nodes: [^/" - nodes-str - " ]^/" - " wires: [^/" - wires-str - " ]^/" - either empty? structs-str [""] [rejoin [ - " structures: [^/" - structs-str - " ]^/" - ]] - " ]^/" - either empty? fp-str [""] [rejoin [" front-panel: [^/" fp-str " ]^/"]] - "]^/^/" - generated-code - ] -] - -; ══════════════════════════════════════════════════ -; SAVE-VI -; ══════════════════════════════════════════════════ -; -; Escribe el fichero .qvi completo: -; 1. Cabecera Red con Needs: 'View -; 2. qvi-diagram: [...] — fuente de verdad (DT-011) -; 3. Código generado: modo dual UI/headless (DT-009, DT-012) -; -; Run NO llama a save-vi. Son operaciones independientes (DT-010). - -save-vi: func [ - path [file!] - diagram [object!] - /local compiled qd content fp-items -][ - compiled: compile-diagram diagram - qd: serialize-diagram diagram - ; Incluir front-panel si está disponible (requiere panel.red cargado) - fp-items: select diagram 'front-panel - if all [ - value? 'save-panel-to-diagram - block? fp-items - not empty? fp-items - ][ - append qd save-panel-to-diagram fp-items - ] - ; Detectar si es un Sub-VI (tiene connector definido) - either all [in diagram 'connector block? diagram/connector not empty? diagram/connector] [ - content: format-qvi/subvi diagram/name qd compiled - ][ - content: format-qvi diagram/name qd compiled - ] - write path content - path -] - -; ══════════════════════════════════════════════════ -; LOAD-VI -; ══════════════════════════════════════════════════ -; -; Lee un fichero .qvi, extrae qvi-diagram y reconstruye el modelo en memoria. -; El código generado se ignora — QTorres recompila desde qvi-diagram (DT-011). -; Un .qvi con solo qvi-diagram (sin código generado) es válido. - -; Convierte set-words a words en un bloque (recursivo para sub-bloques). -; Permite que make-node/make-wire funcionen igual con .qvi nuevos (set-words) -; y con .qvi antiguos (words). model.red no necesita cambios. -norm-spec: func [spec [block!] /local result item] [ - result: copy [] - foreach item spec [ - case [ - set-word? item [append result to-word item] - block? item [append/only result norm-spec item] - true [append result item] - ] - ] - result -] - -; Parsea una lista de nodos [node [...] ...] y devuelve objetos make-node. -; Si abs-x/abs-y están dados, convierte coords relativas a absolutas. -load-node-list: func [ - nodes-data [block!] names [block!] - /absolute abs-x abs-y - /local node-spec nx ny n -][ - collect [ - parse nodes-data [ - any [ - 'node set node-spec block! ( - ; Convertir coords relativas a absolutas si se indica - if absolute [ - nx: any [select node-spec 'x 0] - ny: any [select node-spec 'y 0] - node-spec: copy node-spec - if pos: find node-spec 'x [pos/2: nx + abs-x] - if pos: find node-spec 'y [pos/2: ny + abs-y] - ] - ; Subvi: cargar connector desde el fichero referenciado - n: either (select node-spec 'type) = 'subvi [ - make-subvi-node node-spec - ][ - make-node node-spec - ] - if select node-spec 'name [append names select node-spec 'name] - keep n - ) - | skip - ] - ] - ] -] - -; Parsea una lista de wires [wire [...] ...] y devuelve objetos make-wire. -load-wire-list: func [wires-data [block!] /local wire-spec] [ - collect [ - parse wires-data [ - any [ - 'wire set wire-spec block! ( - keep make-wire compose [ - from: (select wire-spec 'from) - from-port: (any [select wire-spec 'from-port select wire-spec 'port]) - to: (select wire-spec 'to) - to-port: (any [select wire-spec 'to-port select wire-spec 'port]) - ] - ) - | skip - ] - ] - ] -] - -load-vi: func [ - path [file!] - /local src pos qd bd-data nodes-data wires-data structs-data d names st-spec st st-nodes st-wires cond-data - sr-data sr-spec frame-data fr-spec fr-nodes fr-wires sel-data fr st-kw st-label-text -][ - src: load path - - ; Buscar el set-word qvi-diagram: en el bloque cargado - pos: find src to-set-word 'qvi-diagram - if none? pos [ - cause-error 'user 'message ["load-vi: qvi-diagram no encontrado en " mold path] - ] - ; Normalizar set-words → words en todo el qvi-diagram - qd: norm-spec pos/2 - - bd-data: select qd 'block-diagram - if none? bd-data [ - cause-error 'user 'message ["load-vi: block-diagram no encontrado"] - ] - - d: make-diagram any [select qd 'name form path] - - nodes-data: select bd-data 'nodes - wires-data: select bd-data 'wires - structs-data: select bd-data 'structures - - ; Recopilar names para sincronizar contadores (DT-024) - names: copy [] - - if nodes-data [d/nodes: load-node-list nodes-data names] - if wires-data [d/wires: load-wire-list wires-data] - - ; ── Cargar structures (while-loop, for-loop, case-structure) ─────── - if all [structs-data block? structs-data] [ - parse structs-data [ - any [ - set st-kw ['while-loop | 'for-loop | 'case-structure] set st-spec block! ( - st: make-structure compose [ - id: (any [select st-spec 'id 0]) - type: (st-kw) - name: (any [select st-spec 'name ""]) - x: (any [select st-spec 'x 0]) - y: (any [select st-spec 'y 0]) - w: (any [select st-spec 'w 300]) - h: (any [select st-spec 'h 200]) - active-frame: (any [select st-spec 'active-frame 0]) - ] - ; Label - st-label-text: case [ - st-kw = 'for-loop ["For Loop"] - st-kw = 'case-structure ["Case Structure"] - true ["While Loop"] - ] - st/label: either select st-spec 'label [ - make-label select st-spec 'label - ][ - make-label compose [text: (st-label-text) visible: true] - ] - ; Shift registers (solo para loops) - if find [while-loop for-loop] st-kw [ - sr-data: any [select st-spec 'shift-registers []] - parse sr-data [ - any [ - 'sr set sr-spec block! ( - append st/shift-regs make-shift-register compose [ - id: (any [select sr-spec 'id 0]) - name: (any [select sr-spec 'name ""]) - data-type: (any [select sr-spec 'data-type 'number]) - init-value: (any [select sr-spec 'init-value 0.0]) - y-offset: (any [select sr-spec 'y-offset 40]) - ] - if select sr-spec 'name [append names select sr-spec 'name] - ) - | skip - ] - ] - ] - ; Frames (solo para case-structure) - if st-kw = 'case-structure [ - frame-data: any [select st-spec 'frames []] - parse frame-data [ - any [ - 'frame set fr-spec block! ( - fr: make-frame fr-spec - ; Nodos del frame: coords relativas → absolutas - fr-nodes: any [select fr-spec 'nodes []] - fr/nodes: load-node-list/absolute fr-nodes names st/x st/y - ; Wires del frame - fr-wires: any [select fr-spec 'wires []] - fr/wires: load-wire-list fr-wires - append st/frames fr - ) - | skip - ] - ] - ; Selector wire - sel-data: select st-spec 'selector - st/selector-wire: either all [sel-data not empty? sel-data] [ - make object! [ - from: any [select sel-data 'from 0] - port: any [select sel-data 'port 'result] - ] - ][ - none - ] - ] - ; Nodos internos (para loops): coords relativas → absolutas - if find [while-loop for-loop] st-kw [ - st-nodes: any [select st-spec 'nodes []] - st/nodes: load-node-list/absolute st-nodes names st/x st/y - st-wires: any [select st-spec 'wires []] - st/wires: load-wire-list st-wires - ] - ; Wire de condición solo para while-loop - if st-kw = 'while-loop [ - cond-data: select st-spec 'condition - st/cond-wire: either all [cond-data not empty? cond-data] [ - make object! [ - from: any [select cond-data 'from 0] - port: any [select cond-data 'port 'result] - ] - ][ - none - ] - ] - if st/name [append names st/name] - append d/structures st - ) - | skip - ] - ] - ] - - ; ── Cargar connector (Fase 3: Sub-VI) ──────────────────────────────── - conn-data: select qd 'connector - if all [conn-data block? conn-data not empty? conn-data] [ - d/connector: copy [] - parse conn-data [ - any [ - 'input set conn-spec block! ( - append d/connector reduce [ - 'input - any [select conn-spec 'pin 0] - any [select conn-spec 'label ""] - any [select conn-spec 'id 0] - ] - ) - | 'output set conn-spec block! ( - append d/connector reduce [ - 'output - any [select conn-spec 'pin 0] - any [select conn-spec 'label ""] - any [select conn-spec 'id 0] - ] - ) - | skip - ] - ] - ] - - ; Sincronizar contadores de names - unless empty? names [sync-name-counters names] - - ; Cargar front-panel - d/front-panel: either value? 'load-panel-from-diagram [ - load-panel-from-diagram qd - ][ - copy [] - ] - - d -] - -; ══════════════════════════════════════════════════════════ -; LOAD-PANEL-FROM-DIAGRAM — Phase 4 -; ══════════════════════════════════════════════════════════ -; -; Carga front-panel items desde qvi-diagram (formato: qd). -; Retorna bloque de objetos make-fp-item. -; -load-panel-from-diagram: func [qd [block!] /local fp-raw items item kw id type name lbl default config offset item-spec] [ - fp-raw: select qd to-set-word 'front-panel - items: copy [] - - unless block? fp-raw [return items] - - parse fp-raw [ - any [ - set kw word! set item-spec block! ( - ; Construir spec completo para make-fp-item - spec: copy [] - append spec to-set-word 'id - append spec any [select item-spec 'id 0] - append spec to-set-word 'type - append spec any [select item-spec 'type 'control] - append spec to-set-word 'name - append spec any [select item-spec 'name ""] - - ; Normalizar label - lbl-block: any [select item-spec 'label [text: ""]] - unless block? lbl-block [lbl-block: compose [text: (lbl-block)]] - if none? select lbl-block 'text [append lbl-block compose [text: ""]] - if none? select lbl-block 'visible [append lbl-block compose [visible: true]] - if none? select lbl-block 'offset [append lbl-block compose [offset: 0x0]] - append spec to-set-word 'label - append/only spec lbl-block - - append spec to-set-word 'default - append/only spec any [select item-spec 'default copy []] - - append spec to-set-word 'config - append/only spec any [select item-spec 'config copy []] - - append spec to-set-word 'offset - append spec any [select item-spec 'offset 0x0] - - item: make-fp-item spec - append items item - ) - | skip - ] - ] - - items -] - -; ══════════════════════════════════════════════════════════ -; SAVE-PANEL-TO-DIAGRAM (movido desde panel.red — 4A refactor) -; ══════════════════════════════════════════════════════════ - -save-panel-to-diagram: func [front-panel-items /local items item kw spec] [ - items: copy [] - foreach item front-panel-items [ - kw: case [ - item/type = 'control ['control] - item/type = 'bool-control ['bool-control] - item/type = 'bool-indicator ['bool-indicator] - item/type = 'str-control ['str-control] - item/type = 'str-indicator ['str-indicator] - item/type = 'arr-control ['arr-control] - item/type = 'arr-indicator ['arr-indicator] - item/type = 'cluster-control ['cluster-control] - item/type = 'cluster-indicator ['cluster-indicator] - item/type = 'waveform-chart ['waveform-chart] - item/type = 'waveform-graph ['waveform-graph] - true ['indicator] - ] - spec: copy [] - repend spec [to-set-word 'id item/id to-set-word 'type item/type to-set-word 'name item/name] - append spec to-set-word 'label - append/only spec compose/deep [text: (item/label/text) visible: (item/label/visible) offset: (item/label/offset)] - append spec to-set-word 'default - either block? item/value [append/only spec copy item/value] [append spec item/value] - if item/data-type = 'cluster [ - append spec to-set-word 'config - append/only spec copy any [item/config copy []] - ] - repend spec [to-set-word 'offset item/offset] - append items kw - append/only items spec - ] - reduce [to-set-word 'front-panel items] -] - -; ══════════════════════════════════════════════════════════ -; QLIB — Librería de VIs con namespacing -; ══════════════════════════════════════════════════════════ -; -; Una .qlib es un FICHERO de texto con extension .qlib que actua como -; manifiesto. Los .qvi miembros viven junto a el (misma carpeta o subdir). -; -; Formato del fichero .qlib: -; qlib [ -; name: "math" -; version: 1 -; description: "Operaciones matematicas" -; members: [%math/add.qvi %math/subtract.qvi] -; ] -; -; Estructura tipica: -; proyecto/ -; math.qlib <- manifiesto -; math/ -; add.qvi -; subtract.qvi - -; Carga un fichero .qlib y devuelve un objeto con: -; name, version, description, dir, members (bloque de file! absolutos) -; Devuelve none si el fichero no es un .qlib valido. -load-qlib: func [ - "Carga el manifiesto de un fichero .qlib" - qlib-file [file!] - /local base-dir raw qd name version desc members-raw members m abs-path -][ - if dir? qlib-file [return none] - if not exists? qlib-file [return none] - raw: attempt [load qlib-file] - if not block? raw [return none] - if any [empty? raw raw/1 <> 'qlib] [return none] - qd: raw/2 - if not block? qd [return none] - - ; Directorio base = directorio que contiene el .qlib - base-dir: first split-path qlib-file - - name: any [select qd 'name ""] - version: any [select qd 'version 1] - desc: any [select qd 'description ""] - members-raw: any [select qd 'members copy []] - - ; Resolver rutas de miembros relativas al directorio del .qlib - members: copy [] - foreach m members-raw [ - if file? m [ - abs-path: to-file rejoin [form base-dir form m] - if exists? abs-path [append members abs-path] - ] - ] - - make object! compose/only [ - name: (name) - version: (version) - description: (desc) - dir: (base-dir) - members: (members) - ] -] - -; Busca ficheros .qlib en el directorio dado. -; Uso: find-qlibs/from system/options/path -; Devuelve bloque de objetos qlib (puede estar vacio). -find-qlibs: func [ - "Busca ficheros .qlib en el directorio dado" - /from project-dir [file!] - /local search-dirs libs d qlib-file obj -][ - search-dirs: copy [] - if from [append search-dirs clean-path project-dir] - - libs: copy [] - foreach p search-dirs [ - if all [p exists? p dir? p] [ - foreach d read p [ - if all [not dir? d %.qlib = suffix? d] [ - qlib-file: to-file rejoin [form p form d] - obj: load-qlib qlib-file - if obj [append libs obj] - ] - ] - ] - ] - libs -] +#include %file-io-serialize.red +#include %file-io-load.red +#include %file-io-save.red +#include %file-io-qlib.red #include %../ui/diagram/canvas.red diff --git a/tests/test-issue-49-gtk010.red b/tests/test-issue-49-gtk010.red new file mode 100644 index 0000000..748087a --- /dev/null +++ b/tests/test-issue-49-gtk010.red @@ -0,0 +1,35 @@ +Red [ + Title: "Test para Issue #49 — GTK-010: on-change enganchado tras Run" + Purpose: "Validar si GTK-010 (field on-change queda enganchado después de Run) está resuelto en fork" + Manual: true + Platform: "Linux GTK3 only" +] + +comment { + CASO DE TEST MANUAL PARA GTK-010 + + GTK-010: `on-change` de field nativo queda enganchado tras ejecutar Run. + Síntoma: después de pulsar Run una vez, los controles string del Front Panel + se auto-actualizan al escribir, sin necesidad de volver a pulsar Run. + Comportamiento esperado: indicadores solo se actualizan al pulsar Run explícitamente. + + CÓMO REVALIDAR: + 1. Abrir QTorres: ./red-view src/qtorres.red + 2. Crear VI simple con string control (default: "Hola") y string indicator (default: "---") + 3. Conectar control → indicator + 4. Pulsar Run — indicator muestra "Hola" + 5. EN EL CONTROL, escribir "Mundo" + 6. SIN pulsar Run, observar: + - ESPERADO (bug fijo): indicator sigue mostrando "Hola" + - ACTUAL (bug presente): indicator se actualiza a "Mundo" automáticamente + 7. Pulsar Run — indicator debe mostrar "Mundo" + + ESTADO (2026-04-17): + - Fork anlaco/red tiene fixes GTK hasta commit 2a93443 + - Los fixes no cubren explícitamente GTK-010 (on-change enganchado) + - Requiere verificación manual en próxima sesión con GUI + + NOTA PARA IA: + Este test no puede automatizarse con red-cli (headless). + Añadir a checklist QA manual de Fase 3. +}