Comunidad Gambas-es
Extendiendo la clase JSON - Encode2 - Versión para impresión

+- Comunidad Gambas-es (https://gambas-es.org)
+-- Foro: Gambas (https://gambas-es.org/forum-3.html)
+--- Foro: Aplicaciones/Fragmentos de Código (https://gambas-es.org/forum-8.html)
+--- Tema: Extendiendo la clase JSON - Encode2 (/thread-543.html)

Extendiendo la clase JSON - Encode2 - tincho - 20-08-2021

Hola amigos.
Aquí les propongo una función que formatea un texto Json de una forma mas legible para humanos.
Gracias al aporte de  Laurent Carlier
https://gitlab.com/lordheavy/alpha/-/blob/master/.src/ConfigManager.class#L100
Para usar esto les recomiendo que creen una clase en vuestro proyecto llamada JSON (en mayúsculas) y luego pongan esto dentro y luego llamen al método normalmente desde todas partes con JSON.Encode2

Código:
' Gambas class file

' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

Export

'' Encode in JSON format in a human readable way. Based on a Laurent tool

Static Public Function Encode2(vData As Variant) As String
 
  Dim sInput As String
  Dim sOutput As String
  Dim iStream As Stream
 
  Dim $sReadChar As String
  Dim $iTab As Integer
  Dim $bQuote, $bBracket As Boolean
 
  sInput = JSON.Encode(vData)
 
  iStream = Open String sInput For Read
 
  While (Not Eof(iStream))
    $sReadChar = Read #iStream, 1
    If ($sReadChar = "{" And Not $bQuote) Then
      $iTab += 1
      $sReadChar &= "\n" & Space$($iTab * 2)
    Else If ($sReadChar = "}" And Not $bQuote) Then
      $iTab -= 1
      $sReadChar = "\n" & Space$($iTab * 2) & $sReadChar
    Else If ($sReadChar = "\"") Then
      $bQuote = Not $bQuote
    Else If ($sReadChar = "[") Then
      $bBracket = True
    Else If ($sReadChar = "]") Then
      $bBracket = False
    Else If ($sReadChar = ":" And Not $bQuote) Then
      $sReadChar &= " "
    Else If ($sReadChar = "," And Not $bQuote) Then
      If (Not $bBracket) Then
        $sReadChar &= "\n" & Space$($iTab * 2)
      Else
        $sReadChar &= " "
      Endif
    Endif
    sOutput &= $sReadChar
  Wend
 
  Close iStream
  ' replace null with ""
  sOutput = Replace(sOutput, " null", " \"\"")
 
  Return sOutput
 
End


RE: Extendiendo la clase JSON - Encode2 - tincho - 29-04-2022

Hay un "error" en esta función y no logro encontrar por que la primera colección no es formateada como las siguientes.
A ver si a alguien se le ocurre que puede ser.

Código:
[{
  "Entity": "line", "Index": 0, "Block": false, "Level": 1, "Color": 1, "Style": 1, "Weight": 2, "Points": [[236, 37],
  [286, 37]]
},
{
  "Entity": "line",
  "Index": 1,
  "Block": false,
  "Level": 1,
  "Color": 1,
  "Style": 1,
  "Weight": 2,
  "Points": [[251, 35],
  [251, 38]]
},
{
  "Entity": "line",
  "Index": 2,
  "Block": false,
  "Level": 1,
  "Color": 1,
  "Style": 1,
  "Weight": 2,
  "Points": [[236, 41],
  [286, 41]]
}]


RE: Extendiendo la clase JSON - Encode2 - tercoide - 30-04-2022

no tenes un programa ejemplo que exponga el error?

RE: Extendiendo la clase JSON - Encode2 - tincho - 30-04-2022

Si, podes descargarte Gauchosketch desde:
https://gitlab.com/belmotek/gauchosketch
Luego tener que seguir los siguientes pasos:
  1. Abrir el programa y crear un documento
  2. Dibujar, al menos dos lineas, y luego guardar
[Imagen: 1RCrUjg.png]
El archivo generado estara en /home/USUARIO/.config/gauchosketch/ con extension .json
Lo que quiero lograr es que la primera entidad este "formateada" igual que el resto.

RE: Extendiendo la clase JSON - Encode2 - Shordi - 30-04-2022

Le he echado un ojo, pero ni idea, oiga.
Al principio he pensado que podría ser cosa de usar Variant, cuyo tipo no está definido hasta que se opera con él... pero si es eso no lo he podido arreglar.
El bucle de read stream que  usas para el formateo me parece muy engorroso... pero si funciona para las entidades siguientes no veo por qué no puede funcionar para la primera, así que... nada.

Sólo una cosa: en mi aparato el fondo para dibujar es negro y las líneas rojas... con lo que el cursor, negro, no se vé.

Saludos

RE: Extendiendo la clase JSON - Encode2 - tincho - 30-04-2022

(30-04-2022, 19:35)Shordi escribió: Le he echado un ojo, pero ni idea, oiga. Sólo una cosa: en mi aparato el fondo para dibujar es negro y las líneas rojas... con lo que el cursor, negro, no se vé.

ok, gracias por echar un vistazo.
Respecto al cursor, este debería adaptarse a tu escritorio, voy a cambiar el tema de mi escritorio a claro a ver si logro reproducir ese comportamiento.

RE: Extendiendo la clase JSON - Encode2 - tercoide - 01-05-2022

(30-04-2022, 19:35)Shordi escribió: Sólo una cosa: en mi aparato el fondo para dibujar es negro y las líneas rojas... con lo que el cursor, negro, no se vé.

Idem
Código:
[{
  "Entity": "circle",
  "Index": 0,
  "Block": false,
  "Level": 1,
  "Color": 1,
  "Style": 1,
  "Weight": 2,
  "Points": [[409, 290], [581, 188]]
},
{
  "Entity": "polyline",
  "Index": 1,
  "Block": false,
  "Level": 1,
  "Color": 1,
  "Style": 1,
  "Weight": 2,
  "Points": [[282, 115], [732, 67], [974, 233], [892, 493], [793, 261], [694, 588]]
},
{
  "Entity": "line",
  "Index": 2,
  "Block": false,
  "Level": 1,
  "Color": 2,
  "Style": 1,
  "Weight": 2,
  "Points": [[85, 62], [786, 401]]
}]

este es el codigo que resuelve el problemita (me tomo un buen rato pues estaba tricky)

Código:
Static Public Function Encode2(vData As Variant) As String

  Dim sInput As String
  Dim sOutput As String
  Dim iStream As Stream

  Dim $sReadChar As String
  Dim $iTab As Integer
  Dim $bQuote, $bBracket As Boolean
  Dim $BracketLevel As Integer            ' Nuevo

  sInput = JSON.Encode(vData)

  iStream = Open String sInput For Read

  While (Not Eof(iStream))
    $sReadChar = Read #iStream, 1
    If ($sReadChar = "{" And Not $bQuote) Then
      $iTab += 1
      $sReadChar &= "\n" & Space$($iTab * 2)
    Else If ($sReadChar = "}" And Not $bQuote) Then
      $iTab -= 1
      $sReadChar = "\n" & Space$($iTab * 2) & $sReadChar
    Else If ($sReadChar = "\"") Then
      $bQuote = Not $bQuote
    Else If ($sReadChar = "[") Then

      Inc $BracketLevel

      $bBracket = True

    Else If ($sReadChar = "]") Then
      $bBracket = False
      Dec $BracketLevel
    Else If ($sReadChar = ":" And Not $bQuote) Then
      $sReadChar &= " "
    Else If ($sReadChar = "," And Not $bQuote) Then

      If $BracketLevel > 1 Then             ' solo agrego un salto de linea si no hay abierto nuevos brackets
        $sReadChar &= " "                   
      Else
        $sReadChar &= "\n" & Space$($iTab * 2) 
      End If

    Endif
    sOutput &= $sReadChar
  Wend

  Close iStream
  ' replace null with ""
  sOutput = Replace(sOutput, " null", " \"\"")

  Return sOutput

End


RE: Extendiendo la clase JSON - Encode2 - tincho - 01-05-2022

(01-05-2022, 00:17)tercoide escribió: Idem

Actualice el código por el tema del color del cursor, debería verse bien ahora ya que se adapta al color del DrawingArea.
 
(01-05-2022, 00:17)tercoide escribió: este es el codigo que resuelve el problemita (me tomo un buen rato pues estaba tricky)

Buenisimo, funciona re bien. Gracias che.
[Imagen: 8MbqCo0.png]
Viendo tu código veo que le agregaste una variable. Perfecto, ya con este código puedo guardar los archivos en un formato "minimalista", que sera el formato de los bloques para las librerías de símbolos.

[Imagen: JEP5Tw8.png]

RE: Extendiendo la clase JSON - Encode2 - Shordi - 01-05-2022

Ahora sí se se ve bien el cursor. Blanco sobre Negro.

Saludos

RE: Extendiendo la clase JSON - Encode2 - tincho - 01-05-2022

(01-05-2022, 17:13)Shordi escribió: Ahora sí se se ve bien el cursor. Blanco sobre Negro.

Perfecto, gracias por corroborarlo.