Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Add new paint method ?
#9
(02-06-2019, 03:45 AM)Jack Parker Wrote: Indeed, I mis-spoke I'm using gimp-drawable-edit-fill (but wrapped in a function so i forgot the detailed spelling)

Found "schemers.org" which has posted the R5RS, to which tinyscheme is an approximation.

For the record, here is an tinyscheme/script-fu implementation of ~ prin1
suitable for (gimp-message (stringify obj)) if you want to see intermediate results

I'm not set up to put it in a git or sourceforge repo, but feel free to copy and use.

Unlike the REPL, this does not hang on recursive structure, but truncates to the first ~200 chars
(more or less if you supply a second arg)

For example:
> (load ".../GIMP/2.10/scripts/stringify.scm")
stringify#<EOF>#t
> (define x '(1 2 3 replace-me-with-x)))
x
> (stringify x)
"(1 2 3 'replace-me-with-x)"
> (stringify (set-cdr! (cddr x) x))
"(3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 3 1 2 ..."
> (stringify (set-cdr! (cddr x) x) 30)
"(3 1 2 3 1 2 3 1 2 3 1 2 3 1 ..."

;; stringify.scm
;; return a string rendition of a lisp object.
;; [better than] what the top-level REPL does, now available for use.
;;
;; suitable for gimp-message if you want to see intermediate results
;; creates a readable string, compare to "prin1"
;;
;; License: Free Open Source, copy, modify and use as you wish.
;; No warranty expressed or implied, use at your own risk.

(define (stringify obj . args)                  ; returns String
  (define max_size 0)
  (define buffer ())                    ;use cons and reverse...
  (define size 0)

  (define (buffer-add str) (set! buffer (cons str buffer)))
    
  (define (buffer->string)
    (if (>= size max_size)
        (buffer-add "..."))
    (let* ((buf (reverse buffer)))
      (apply string-append buf)))


  (define (buffer-append str)
    (if (string? str) ; when full, pair->string may return nil
        (begin
          (set! size (+ size (string-length str)))
          (if (< size max_size)
              (buffer-add str)
              ))))
           
  (define (obj->string obj nullstr)             ;return string
    (cond ((null? obj) nullstr)
          ((symbol? obj) (string-append "'" (symbol->string obj)))
          ((string? obj) (string-append "\"" obj "\""))
          ((number? obj) (number->string obj))
          ((vector? obj) (vector->string obj))
          ((pair?   obj) (pair->string obj))
          (#t "???")
          )
    )

  (define (pair->string obj) ; return (tail->string ...) ==> ")"
    (if (< size max_size)
        (begin
          (buffer-append "(")
          (buffer-append (obj->string (car obj) "nil")) ; or "()"
          (tail->string (cdr obj))
          )
        )
    )

  (define (tail->string obj) ;; return ")"
    (if (< size max_size)
        (begin
          (cond
           ((pair? obj)
            (buffer-append " ")
            (buffer-append (obj->string (car obj) "nil" ))
            (tail->string (cdr obj))
            )
           ((null? obj))
           (#t 
            (buffer-append " . ")
            (buffer-append (obj->string obj ""))
            ))
          ")")
        )
    )

  (define (vector->string obj)
    ;; left as an exercise for the motivated reader
    (if (< size max_size)
        (let ((len (vector-length obj)))
          (buffer-append 
           (string-append "[vector: " (number->string len) "]")))
        )
    )

  (set! max_size (if (and (pair? args) (number? (car args))) (car args) 200))
  (buffer-append (obj->string obj "()"))
  (buffer->string)
  
  )

Can't help notice that all this looks like built-in Python functionality. Of course, there is almost half a century between Lisp and Python Smile
Reply


Messages In This Thread
Add new paint method ? - by Jack Parker - 02-03-2019, 10:48 PM
RE: Add new paint method ? - by Ofnuts - 02-04-2019, 05:50 AM
RE: Add new paint method ? - by Jack Parker - 02-05-2019, 06:59 AM
RE: Add new paint method ? - by Ofnuts - 02-05-2019, 07:32 AM
RE: Add new paint method ? - by Jack Parker - 02-05-2019, 07:04 PM
RE: Add new paint method ? - by Ofnuts - 02-05-2019, 08:27 PM
RE: Add new paint method ? - by Jack Parker - 02-05-2019, 10:56 PM
RE: Add new paint method ? - by Jack Parker - 02-06-2019, 03:45 AM
RE: Add new paint method ? - by Ofnuts - 02-06-2019, 05:30 AM
RE: Add new paint method ? - by Jack Parker - 02-06-2019, 11:28 PM
RE: Add new paint method ? - by Ofnuts - 02-07-2019, 06:57 AM
RE: Add new paint method ? - by Jack Parker - 02-16-2019, 08:03 PM
RE: Add new paint method ? - by Ofnuts - 02-16-2019, 09:12 PM
RE: Add new paint method ? - by Jack Parker - 02-20-2019, 12:29 AM
RE: Add new paint method ? - by Ofnuts - 02-20-2019, 08:38 AM

Forum Jump: