From b7c8bce2a47c84b043329dadbe46b28ceaf67733 Mon Sep 17 00:00:00 2001 From: OpenCodeMCP-BetaTest Date: Wed, 8 Apr 2026 01:07:01 +0200 Subject: [PATCH] fix(#54): editor de fields para cluster-control/indicator en FP y BD MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - panel.red: open-cluster-fp-edit-dialog ahora edita FIELDS (nombre:tipo) además de valores — soluciona que los puertos no aparecían en BD - panel.red: añadido handler para cluster-indicator (antes ignorado) - canvas.red: dbl-click en BD sobre cluster-control/indicator abre editor de campos (antes solo bundle/unbundle lo hacían) - panel.red: fp-cluster-sync-and-refresh sincroniza fields FP→BD vía canvas-ref - tests/test-model.red: 7 tests de regresión bug #54 Co-Authored-By: Claude Sonnet 4.6 --- src/ui/diagram/canvas.red | 5 ++ src/ui/panel/panel.red | 116 +++++++++++++++++++++++++++++++++++--- tests/test-model.red | 56 ++++++++++++++++++ 3 files changed, 168 insertions(+), 9 deletions(-) diff --git a/src/ui/diagram/canvas.red b/src/ui/diagram/canvas.red index a3c16b6..aab4638 100644 --- a/src/ui/diagram/canvas.red +++ b/src/ui/diagram/canvas.red @@ -2394,6 +2394,7 @@ render-diagram: func [model canvas-width canvas-height /local canvas-face] [ if node/type = 'const [open-const-edit-dialog node face exit] if find [str-const str-control] node/type [open-str-edit-dialog node face exit] if find [arr-const arr-control] node/type [open-arr-edit-dialog node face exit] + if find [cluster-control cluster-indicator] node/type [open-cluster-edit-dialog node face exit] if find [bundle unbundle] node/type [open-cluster-edit-dialog node face exit] rename-dialog-node: node rename-dialog-canvas: face @@ -2436,6 +2437,10 @@ render-diagram: func [model canvas-width canvas-height /local canvas-face] [ open-arr-edit-dialog node face exit ] + if find [cluster-control cluster-indicator] node/type [ + open-cluster-edit-dialog node face + exit + ] if find [bundle unbundle] node/type [ open-cluster-edit-dialog node face exit diff --git a/src/ui/panel/panel.red b/src/ui/panel/panel.red index 4be5669..b7559a9 100644 --- a/src/ui/panel/panel.red +++ b/src/ui/panel/panel.red @@ -661,20 +661,114 @@ fp-cluster-value-text: func [item /local lines fn ft fval] [ trim lines ] -; Abre diálogo para editar los valores de un cluster-control en el FP. -open-cluster-fp-edit-dialog: func [item panel-face model /local cur-text] [ - cur-text: fp-cluster-value-text item +; Parsea el texto del área de edición ("nombre:tipo" por línea) a [nombre 'tipo ...]. +; Copiado y adaptado de parse-cluster-fields-text en canvas.red +parse-cluster-fields-text: func [text /local result lines parts fname ftype] [ + result: copy [] + foreach line split text "^/" [ + line: trim line + if not empty? line [ + parts: split line ":" + if (length? parts) >= 2 [ + fname: to-word trim parts/1 + ftype: to-word trim parts/2 + unless find [number boolean string] ftype [ftype: 'number] + append result fname + append result to lit-word! ftype + ] + ] + ] + result +] + +; Aplica campos y valores de cluster al item y refresca ambos paneles +fp-cluster-sync-and-refresh: func [item new-fields new-values panel-face model /local pos _cref bd-node] [ + ; Guardar campos en item/config/fields + either pos: find item/config 'fields [ + pos/2: new-fields + ][ + append item/config reduce ['fields new-fields] + ] + + ; Guardar valores en item/value + item/value: new-values + + ; Buscar nodo BD correspondiente y actualizar sus campos + _cref: select model 'canvas-ref + if _cref [ + foreach nd _cref/extra/nodes [ + if nd/name = item/name [ + ; Aplicar campos al nodo BD (mismo patrón que apply-cluster-fields) + either pos: find nd/config 'fields [ + pos/2: new-fields + ][ + append nd/config reduce ['fields new-fields] + ] + break + ] + ] + ; Refrescar BD + _cref/draw: render-bd _cref/extra + show _cref + ] + + ; Refrescar FP + panel-face/draw: render-fp-panel model model/size/x model/size/y +] + +; Abre diálogo para editar los campos y valores de un cluster-control/indicator en el FP. +open-cluster-fp-edit-dialog: func [item panel-face model /local cur-fields-text cur-values-text] [ + ; Construir texto de campos ("nombre:tipo" por línea) + cur-fields-text: copy "" + foreach [fn ft] fp-cluster-fields item [ + append cur-fields-text rejoin [form fn ":" form to-word ft "^/"] + ] + + ; Construir texto de valores ("nombre: valor" por línea) + cur-values-text: copy "" + foreach [fn ft] fp-cluster-fields item [ + fval: select any [item/value copy []] fn + fval-str: either none? fval [""] [form fval] + append cur-values-text rejoin [form fn ": " fval-str "^/"] + ] + view/no-wait compose/deep [ title "Editar cluster" - text "Campos (campo: valor por línea):" return - area 220x120 (cur-text) return + text "CAMPOS (nombre:tipo por línea — Tipos: number boolean string)" return + fp-clust-fields-area: area 260x90 (cur-fields-text) return + text "VALORES (nombre: valor por línea):" return + fp-clust-values-area: area 260x90 (cur-values-text) return button "OK" [ - foreach pf face/parent/pane [ - if pf/type = 'area [ - fp-cluster-apply-and-refresh (item) copy pf/text (panel-face) (model) - break + ; Parsear campos + new-fields: parse-cluster-fields-text copy fp-clust-fields-area/text + + ; Parsear valores + lines: split trim fp-clust-values-area/text "^/" + result: copy [] + foreach line lines [ + line: trim line + if empty? line [continue] + parts: split line ":" + if 2 > length? parts [continue] + k: to-word trim parts/1 + v: trim parts/2 + ; Buscar tipo del campo en new-fields + ft: 'number + i: 1 + while [i <= (length? new-fields)] [ + if new-fields/:i = k [ft: new-fields/(i + 1)] + i: i + 2 + ] + append result k + append result case [ + ft = 'boolean [any [find [true yes on] to-word v false]] + ft = 'string [v] + true [any [attempt [to-float v] 0.0]] ] ] + + ; Aplicar cambios y refrescar + fp-cluster-sync-and-refresh (item) new-fields result (panel-face) (model) unview ] button "Cancelar" [unview] @@ -919,6 +1013,9 @@ render-panel: func [model panel-width panel-height /local panel-face] [ all [hit hit/type = 'cluster-control] [ open-cluster-fp-edit-dialog hit face face/extra ] + all [hit hit/type = 'cluster-indicator] [ + open-cluster-fp-edit-dialog hit face face/extra + ] all [hit hit/type = 'control] [ open-edit-dialog hit face face/extra ] @@ -938,6 +1035,7 @@ render-panel: func [model panel-width panel-height /local panel-face] [ all [hit hit/type = 'str-control] [open-str-fp-edit-dialog hit face face/extra] all [hit hit/type = 'arr-control] [open-arr-fp-edit-dialog hit face face/extra] all [hit hit/type = 'cluster-control] [open-cluster-fp-edit-dialog hit face face/extra] + all [hit hit/type = 'cluster-indicator] [open-cluster-fp-edit-dialog hit face face/extra] all [hit hit/type = 'control] [open-edit-dialog hit face face/extra] ; indicador: no hacer nada ] diff --git a/tests/test-model.red b/tests/test-model.red index 91f3033..c5f6094 100644 --- a/tests/test-model.red +++ b/tests/test-model.red @@ -298,4 +298,60 @@ assert "bundle gen-name bundle_1" (nb1/name = "bundle_1") assert "bundle gen-name bundle_2" (nb2/name = "bundle_2") assert "unbundle gen-name unbundle_1" (nu1/name = "unbundle_1") +; ── tests de regresión para bug #54 ───────────────────────────────────── + +suite "cluster-fields — regresión bug #54" + +reset-name-counters +n1: make-node [type: 'bundle] + +assert "cluster-fields devuelve [] cuando no hay config/fields" ([] = cluster-fields n1) + +reset-name-counters +n2: make-node [ + type: 'bundle + config: [fields [nombre 'string voltaje 'number]] +] + +assert "cluster-fields devuelve campos cuando existen en config" ( + 4 = length? cluster-fields n2 +) +assert "cluster-fields devuelve nombres y tipos correctos" ( + (cluster-fields n2) = [nombre 'string voltaje 'number] +) + +reset-name-counters +n3: make-node [type: 'bundle] + +; Simular añadir fields con el patrón usado en el código +either pos: find n3/config 'fields [ + pos/2: [nombre 'string voltaje 'number] +][ + append n3/config reduce ['fields [nombre 'string voltaje 'number]] +] + +assert "cluster-fields devuelve campos añadidos dinámicamente" ( + 4 = length? cluster-fields n3 +) +assert "cluster-fields devuelve nombres y tipos correctos tras añadir" ( + (cluster-fields n3) = [nombre 'string voltaje 'number] +) + +reset-name-counters +c1: make-node [ + type: 'bundle + config: [fields [x 'number y 'number]] +] +c2: make-node [ + type: 'bundle + config: [fields [nombre 'string]] +] + +assert "cluster-control puede tener fields distintos al indicator" ( + (cluster-fields c1) = [x 'number y 'number] +) +assert "cluster-indicator puede tener fields distintos al control" ( + (cluster-fields c2) = [nombre 'string] +) + print "--- tests finalizados ---"