想像 想象 Visualiseren Visualiser Visualisierung Οραματιζομαστε Visualizzare Visualizar Visualise Visualizar Debug aide for Script-fu in GIMP

;;;returns called parameter e.g if you need to visualise
;;;a complex unknown variable returned from a call to a GIMP procedure
;;;such as (set! myreturn (car gimp-image-get-active-vectors))
;;;then (set! (visualise myreturn) (car gimp-image-get-active-vectors))
;;;will print the visualisation of the return on the error console
;;;without affecting the running of the program
;;; it is run for the side effect of printing visualisation of called parameter
;;;(visualise-string myreturn) will return a string-ified representation
;;;想像 trad Chinese ; 想象 simplified Chinese; Visualiseren Dutch
;;;Visualiser French; Visualisierung German; Οραματιζομαστε Greek
;;;Visualizzare Italian; Visualizar Portugese
;;;Visualise English Russian Japanese Korean; Visualizar Spanish 
;;;© David M. W. Martin Tue 29 Apr 2008
;;;include visualise and visualise-string 
;;;© David M. W. Martin Thu 18 Jun 2009 11:44:34 BST



(define (visualise object )
        
        (visualise-worker object #t)); prints stringification returns the object
        
(define (visualise-string object )
 
        (visualise-worker object #f)); prints nothing returns a stringification

 
(define (visualise-worker object option);called by visualise & visualise-string
 (if (>= (string->number (substring (car(gimp-version)) 0 3)) 2.4)
 ()(gimp-message "visualise only works on gimp version 2.4 and above"))

(let* (  (output-handler (car(gimp-message-get-handler)))(str "")
         (my-output-string (string-append 
         "visualise object running on gimp version "(car(gimp-version))"\n"))
          (char-string "")(indent ""))
;***************************** helpers *****************************************
 (define (increase-indent)(set! indent (string-append indent "|\t")))
 (define (decrease-indent)(let* ((str-len (string-length indent)))
 (set! indent (substring indent 0 (- str-len 2)))))
 (define (output-append visualisation)
(set! my-output-string  (string-append my-output-string  indent visualisation)))
;***************************** parse obj *************************************
(define  ( parse obj ) 
 (let* ((iter-list '())(iter-vector #('())))
(cond  
  ( (pair? obj) ;;; Scheme actually has no true list type. It has a pair type,
       ;;; and there is an *interpretation* of the trees built using this type
       ;;; as lists.  Olin Shivers
   (parse (car obj)) (if (not (list? obj)) (parse (cdr obj)))
 (set! my-output-string  (string-append  my-output-string  indent
 "a pair \n" )) 
   (if (list? obj)(begin (output-append (string-append "begin list of length "
                         (number->string (length obj) )" comprising\n"))
  (increase-indent)
      (do ((iter-vector 0 (+ iter-vector 1)))((= iter-vector (length obj))(begin
      (decrease-indent)(output-append (string-append "end list of length "
              (number->string (length obj) )"\n"))))
  (parse (list-ref obj iter-vector))))))
      
  ( (vector? obj)(begin (output-append(string-append "# begin vector of length "
     (number->string (vector-length obj))" comprising\n"))
 (increase-indent) 
      (do ((iter-list 0 (+ iter-list 1)))((= iter-list(vector-length obj))(begin
 (decrease-indent)(output-append (string-append "end vector of length " 
                 (number->string (vector-length obj))"\n"))))
    (parse (vector-ref obj iter-list)))))
     
  ( (string? obj) (output-append (string-append   
  "\t\"" obj "\" is string of length "(number->string(string-length obj))"\n")))
           
  ( (boolean? obj)(if (eqv? obj #f)
   (output-append (string-append "\t#f boolean FALSE\n"))      
  (output-append (string-append "\t#t boolean TRUE\n"))))
                 
  ((symbol? obj)(output-append (string-append
    "\t\""(symbol->string obj)"\" is symbol\n")))

 ( (char? obj)(cond 
 ((char-numeric? obj)(output-append (string-append "\t\""
                     (number->string (char->integer obj)) 
                     " (dec) is numeric char \"" 
                     (make-string 1 obj) "\"\n")))  
 ((char-whitespace? obj) (case  (char->integer obj)
  ((10)(set! str "newline"))
  ((32)(set! str "space"))
  ((9)(set! str "tab"))
  ((13)(set! str "return")))
                 (output-append (string-append  "\t\""
                 (number->string (char->integer obj) ) 
                 " (dec) is whitespace char \"" str "\"\n")))
     ((char-alphabetic? obj)(cond 
      ((char-upper-case? obj)
          (output-append (string-append "\t\"" 
          (number->string (char->integer obj))
          " (dec) is upper-case alphabetic char \"" 
          (make-string 1 obj) "\"\n") ))
      ((char-lower-case? obj)
                 (output-append (string-append  "\t\""
                 (number->string (char->integer obj))
                 " (dec) is lower-case alphabetic char \"" 
                 (make-string 1 obj) "\"\n") ))))     
     ((memv obj '(#\! #\$ #\% #\& #\* #\+ #\- #\. #\\ #\: 
                  #\< #\= #\> #\? #\@ #\^ #\_ #\~ #\" #\/ #\' #\`));" balance
                        (output-append (string-append  "\t\""
                        (number->string (char->integer obj))
                        " (dec) is extended alphabetic char \"" 
                        (make-string 1 obj) "\"\n")))   
        (else (gimp-message "unknown char"))))
 ;no complex? or rational? in script-fu
 ( (number? obj)(cond 
 ((integer? obj)(cond
 ((positive? obj)(cond  ((exact? obj)(output-append (string-append  
        "\t"(number->string obj) " is exact positive integer number\n")))
    ((inexact? obj)(output-append (string-append  
        "\t"(number->string obj)" is inexact positive integer number\n")))))
 ((negative? obj)(cond  ((exact? obj)(output-append (string-append   
        "\t"(number->string obj)" is exact negative integer number\n")))
    ((inexact? obj)(output-append (string-append   
        "\t"(number->string obj)" is inexact negative integer number\n")))))
 ((zero? obj)(cond  ((exact? obj)(output-append (string-append   
         "\t"(number->string obj) " is exact  integer zero\n")))
    ((inexact? obj)(output-append (string-append   
        "\t"(number->string obj) " is exact  integer zero\n")))))))  
 ((real? obj)(cond 
 ((positive? obj)(cond  ((exact? obj)(output-append (string-append   
        "\t"(number->string obj)  " is exact positive real number\n")))
    ((inexact? obj)(output-append (string-append   
        "\t"(number->string obj)  " is inexact positive real number\n")))))
 ((negative? obj)(cond  ((exact? obj)(output-append (string-append   
        "\t"(number->string obj )  " is exact negative real number\n")))
    ((inexact? obj)(output-append (string-append   
        "\t"(number->string obj )" is inexact negative real number\n")))))
 ((zero? obj)(cond  ((exact? obj)(output-append (string-append   
        "\t"(number->string obj )  " is exact real zero\n")))
    ((inexact? obj)(output-append (string-append   
        "\t"(number->string obj )" is inexact real zero\n")))))))))           
  ( (port? obj)(output-append (string-append "object is port\n" )))  
  ( (procedure? obj)(output-append (string-append "a procedure\n")))  
  ( (null? obj)(output-append (string-append  "\tthing is null\n" )))  
  ((environment? obj)(output-append (string-append "\tthing is environment\n")))  
  ( (eof-object? obj)(output-append (string-append "\tthing is eof-object\n")))  
(else (output-append 
(string-append "error-unknown type in cond expression\n"))#f))));end parse 
;****************************** end parse **************************************
 
(parse object)
 (gimp-message-set-handler ERROR-CONSOLE)
(cond 
  ((eqv? option #t) (gimp-message my-output-string) object)
  ((eqv? option #f) my-output-string))));end visualise-worker