I'm working on my first script-fu and scheme is still not very clear for me.
My script works fine but I want to add an other parameter (onlyvisible) and I have a line causing illegal function error in a certain place but not in an other place.
Thank you for your help :-)
Here is my line:
(display " onlyvisible: ")(display onlyvisible)(newline)
Here is my code:
(define (pitibalrog-test img filename onlyvisible)
(let*
(
(imgcopy (car ( gimp-image-duplicate img))) ; Copy to avoid changes on the original image
)
(display " onlyvisible: ")(display onlyvisible)(newline)
(pitibalrog-export-layers imgcopy (gimp-image-get-layers imgcopy) filename onlyvisible)
)
)
(define (pitibalrog-export-layers img listlayers filename onlyvisible)
(let*
(
(nblayers (car listlayers))
(layers (cadr listlayers))
(display "EXPORT LAYERS: LAYERS = ")(display layers)(newline)
(display " onlyvisible: ")(display onlyvisible)(newline) ; <--- HERE IT WORKS
(index 0)
(basename (unbreakupstr (butlast (strbreakup filename ".")) "."))
(extension (car (last (strbreakup filename "."))))
(layer)
)
(display " onlyvisible: ")(display onlyvisible)(newline) ; <--- HERE IS THE PROBLEM
(while (< index nblayers)
(set! layer (aref layers index))
(gimp-item-set-visible layer FALSE)
(set! index (+ index 1))
)
(set! index 0)
(while (< index nblayers)
(set! layer (aref layers index))
(set! filename (string-append basename (car(gimp-drawable-get-name layer)) "." extension))
(pitibalrog-export-layer img layer filename onlyvisible)
(set! index (+ index 1))
)
)
)
(define (pitibalrog-export-layer img layer filename onlyvisible)
(display " - export layer: ")(display layer)(newline)
(gimp-item-set-visible layer TRUE)
; LAYER GROUP
(when (= (car(gimp-item-is-group layer)) 1)
(display "Layer ")(display layer)(display " is a group")(newline)
(pitibalrog-export-layers img (gimp-item-get-children layer) filename onlyvisible)
)
; REAL LAYER
(when (= (car(gimp-item-is-group layer)) 0)
(display "Layer ")(display layer)(display " is not a group")(newline)
; (gimp-file-save RUN-NONINTERACTIVE img layer filename filename) ; NO MASK HANDLING!!!
(gimp-file-save RUN-WITH-LAST-VALS img layer filename filename)
)
(gimp-item-set-visible layer FALSE)
)
(script-fu-register "pitibalrog-test"
"<Image>/Script-Fu/Utils/pitibalrog-test..."
"Export all layers of the image in separete files" ;comment
"pitiBalrog" ;author
"pitiBalrog" ;copyright
"November 2012" ;date
"*A"
SF-IMAGE "img" 0
SF-FILENAME "destination" ""
SF-TOGGLE "Export only visible layers" TRUE
)
Disclaimer: I have never done any work with script-fu, so I have no idea what those script-fu specific procedures do. Scheme, however, I can do.
Please look closely at the syntax required for the let special form:
(let <List of forms that assign values>
<body>)
I think your main problem comes from the fact that in scheme you are allowed to change the value of almost anything -- there are very few reserved words like other languages. So, when you say (let ((display 3)) <body>), display no longer points to the procedure that displays things to the REPL. Then, in the body of your let* when you say (display " onlyvisible") you're trying to call something as a function that is not a function -- in this case whatever the value of layers is.
In general, all code that needs to do something like display should be in body of the function. For example:
(let ((foo 3) ; associate symbol foo with the value 3
(bar "I'm a string!") ; associate symbol bar with a string
(* '(a b c))) ; associate symbol * with a list '(a b c)
(display foo) ;\
(newline) ; \
(display bar)) ; }-- expressions that make up the body
(newline) ; /
(display *) ; /
(* 3 4)) ;/ --- this is the same type of error you made
;;Output
3
I'm a string!
(a b c)
ERROR -- invalid function
Finally, please do not format scheme code as you would C or Java, etc. Here is the schemer-friendly version of your first procedure:
(define (pitibalrog-test img filename onlyvisible)
(let ((img copy (car (gimp-image-duplicate img))))
(display " onlyvisible: ")
(display onlyvisible)
(newline)
(pitibalrog-export-layers imgcopy (gimp-image-get-layers imgcopy) filename onlyvisible)))
Well formatted code makes schemers happy and you are more likely to receive speedy help.
Related
I am trying to create a function that takes another function as a parameter and calls the functions in a loop.
The code below should get the function and the number of times the loop should execute:
(define (forLoop loopBody reps)
(let
(
(fun (car loopBody))
(str (cdr loopBody))
)
(cond
((eval (= reps 0) (interaction-environment)) "")
(else (cons str (forLoop '(fun str) (- reps 1))))
)
)
)
The code below is how i am calling the function
(define (printermsg)
(display msg)
)
(forLoop '(printer "text ") 4)
The expected output for the above code:
text text text text
There are several issues with your code:
The way you pass the loopBody parameter to your function is incorrect, a list of symbols will not work: you want to pass along a list with the actual function and its argument.
You are not obtaining the second element in the list, cdr won't work because it returns the rest of the list, you need to use cadr instead.
Avoid using eval, it's not necessary at all for what you want, and in general is a bad idea.
Why are you building a list? cons is not required here.
When calling the recursion, you are again passing a list of symbols instead of the proper argument.
You're not actually calling the function!
This should work:
(define (forLoop loopBody reps)
(let ((fun (car loopBody))
(str (cadr loopBody)))
(cond
((= reps 0) (void)) ; don't do anything when the loop is done
(else
(fun str) ; actually call the function!
(forLoop loopBody (- reps 1))))))
(define (printer msg)
(display msg))
(forLoop (list printer "text ") 4) ; see how to build the loop body
=> text text text text
I found this wonderful script on github and used it successfully with GIMP on Windows 7. I recently upgraded to Windows 10, and now it will not work. I get the following error:
Error while executing script-fu-batch-smart-resizer:
Error: ( : 1) eval: unbound variable: strbreakup
Here is the code:
; https://github.com/per1234/batch-smart-resize
(define (script-fu-batch-smart-resize sourcePath destinationPath filenameModifier outputType outputQuality maxWidth maxHeight pad padColor . JPEGDCT)
(define (smart-resize fileCount sourceFiles)
(let*
(
(filename (car sourceFiles))
(image (car (gimp-file-load RUN-NONINTERACTIVE filename filename)))
)
(gimp-image-undo-disable image)
;crop to mask if one exists
(if (not (= (car (gimp-layer-get-mask (car (gimp-image-get-active-layer image)))) -1)) (plug-in-autocrop RUN-NONINTERACTIVE image (car (gimp-layer-get-mask (car (gimp-image-get-active-layer image))))))
;image manipulation
(let*
(
;get cropped source image dimensions
(sourceWidth (car (gimp-image-width image)))
(sourceHeight (car (gimp-image-height image)))
;don't resize image to larger than original dimensions
(outputMaxWidth (if (< sourceWidth maxWidth) sourceWidth maxWidth))
(outputMaxHeight (if (< sourceHeight maxHeight) sourceHeight maxHeight))
(outputWidth (if (< (/ sourceWidth sourceHeight) (/ outputMaxWidth outputMaxHeight)) (* (/ outputMaxHeight sourceHeight) sourceWidth) outputMaxWidth))
(outputHeight (if (> (/ sourceWidth sourceHeight) (/ outputMaxWidth outputMaxHeight)) (* (/ outputMaxWidth sourceWidth) sourceHeight) outputMaxHeight))
)
(gimp-image-scale image outputWidth outputHeight) ;scale image to the output dimensions
;pad
(if (= pad TRUE)
(begin
(gimp-image-resize image maxWidth maxHeight (/ (- maxWidth outputWidth) 2) (/ (- maxHeight outputHeight) 2)) ;resize canvas to to maximum dimensions and center the image
;add background layer
(let*
(
(backgroundLayer (car (gimp-layer-new image maxWidth maxHeight RGB-IMAGE "Background Layer" 100 NORMAL-MODE))) ;create background layer
)
(let*
(
(backgroundColor (car (gimp-context-get-background))) ;save the current background color so it can be reset after the padding is finished
)
(gimp-context-set-background padColor) ;set background color to the padColor
(gimp-drawable-fill backgroundLayer 1) ;Fill the background layer with the background color. I have to use 1 instead of FILL-BACKGROUND because GIMP 2.8 uses BACKGROUND-FILL.
(gimp-context-set-background backgroundColor) ;reset the background color to the previous value
)
(gimp-image-insert-layer image backgroundLayer 0 1) ;add background layer to image
)
)
)
)
(gimp-image-flatten image) ;flatten the layers
(let*
(
;format filename - strip source extension(from http://stackoverflow.com/questions/1386293/how-to-parse-out-base-file-name-using-script-fu), add filename modifier and destination path
(outputFilenameNoExtension
(string-append
(string-append destinationPath "/")
(unbreakupstr
(reverse
(cdr
(reverse
(strbreakup
(car
(reverse
(strbreakup filename (if isLinux "/" "\\"))
)
)
"."
)
)
)
)
"."
)
filenameModifier
)
)
)
;save file
(cond
((= outputType 0)
(let*
(
(outputFilename (string-append outputFilenameNoExtension ".png")) ;add the new extension
)
(file-png-save RUN-NONINTERACTIVE image (car (gimp-image-get-active-drawable image)) outputFilename outputFilename FALSE 9 TRUE FALSE FALSE TRUE TRUE)
)
)
((= outputType 1)
(let*
(
(outputFilename (string-append outputFilenameNoExtension ".jpg")) ;add the new extension
)
(file-jpeg-save RUN-NONINTERACTIVE image (car (gimp-image-get-active-drawable image)) outputFilename outputFilename (/ outputQuality 100) 0 TRUE TRUE "" 2 TRUE 0 (if (null? JPEGDCT) 0 (car JPEGDCT)))
)
)
(else
(let*
(
(outputFilename (string-append outputFilenameNoExtension ".gif")) ;add the new extension
)
(gimp-image-convert-indexed image 1 0 256 TRUE TRUE "")
(file-gif-save RUN-NONINTERACTIVE image (car (gimp-image-get-active-drawable image)) outputFilename outputFilename FALSE FALSE 0 0)
)
)
)
)
(gimp-image-delete image)
)
(if (= fileCount 1) 1 (smart-resize (- fileCount 1) (cdr sourceFiles))) ;determine whether to continue the loop
)
;detect OS type(from http://www.gimp.org/tutorials/AutomatedJpgToXcf/)
(define isLinux
(>
(length (strbreakup sourcePath "/" ) ) ;returns the number of pieces the string is broken into
(length (strbreakup sourcePath "\\" ) )
)
)
(define sourceFilesGlob (file-glob (if isLinux (string-append sourcePath "/*.*") (string-append sourcePath "\\*.*")) 0))
(if (pair? (car (cdr sourceFilesGlob))) ;check for valid source folder(if this script is called from another script they may have passed an invalid path and it's much more helpful to return a meaningful error message)
(smart-resize (car sourceFilesGlob) (car (cdr sourceFilesGlob)))
(error (string-append "Invalid Source Folder " sourcePath))
)
)
;dialog
(script-fu-register
"script-fu-batch-smart-resize" ;function name
"batch-smart-resize" ;menu label
"Crop to layer mask, resize within maximum dimensions, and pad to max dimensions(optional)" ;description
"per1234" ;author
"" ;copyright notice
"2015-10-02" ;date created
"" ;image type
SF-DIRNAME "Source Folder" "" ;sourcePath
SF-DIRNAME "Destination Folder" "" ;destinationPath
SF-STRING "Output Filename Modifier(appended)" "" ;filenameModifier
SF-OPTION "Output Type" '("PNG" "JPEG" "GIF") ;outputType
SF-VALUE "Output Quality(JPEG only) 0-100" "90" ;outputQuality
SF-VALUE "Max Width" "1500" ;maxWidth
SF-VALUE "Max Height" "1500" ;maxHeight
SF-TOGGLE "Pad" TRUE ;pad
SF-COLOR "Padding Color" "white" ;padColor
)
(script-fu-menu-register "script-fu-batch-smart-resize"
"<Image>/Tools") ;menu location
I have tried just about everything I could find online, and this is my last resort. Am I missing syntax that was acceptable on the Windows 7 version, that is not so in the Windows 10 version?
Thanks!
strbreakup is defined in script-fu-compat.init in /usr/share/gimp/2.0/scripts (or C:\Program Files\GIMP 2\share\gimp\2.0\scripts for Windows). Is this file present and complete (372 lines in my working version)?
Edit: summary from comments: Gimp didn't look in its standard scripts directory. The directory above should be listed in Edit>Preferences>Folders>Scripts.
I have long been trying to find the error, I'm doing a programming language and have the next code, using ragg, I have a syntax-object(resto ...) what has a bracket as data, I transform this syntax-object to a datum:
(let ([i (syntax->datum #'(resto ...))])
(display "Content i:")
(display i)
(if (eq? i (string->symbol "(})"))
(display "true")
(display "false")
)
)
and the output is:
Content: (})
false
But if I do this
(for ([i (syntax->datum #'(resto ...))])
(displayln "Content:")
(displayln i)
(if (eq? i (string->symbol "}"))
(display "true")
(display "false")
)
)
and the output is:
Content: }
true
MY QUESTION:
¿WHY THE IF OF CLAUSE LET IS FALSE?
¿AS I CAN COMPARE THESE TWO TYPES AND THAT THE RESULT IS TRUE WITHOUT THE FOR?
Documentation about functions:
syntax->datum
Each piece of code is doing a very different thing, I'll show you how to make each one work. The first one uses let to assign into a variable the whole list returned by syntax->datum, and afterwards you compare it against another list (better use equal? for testing equality, it's more general):
(let ([i (syntax->datum #'(|}|))]) ; `i` contains `(})`
(display "Content i: ")
(displayln i)
(if (equal? i '(|}|)) ; a list with a single element, the symbol `}`
(displayln "true")
(displayln "false")))
The second piece of code is using for to iterate over each element in a list, until it finds the symbol }:
(for ([i (syntax->datum #'(|}|))]) ; `i` contains `}`
(display "Content i: ")
(displayln i)
(if (equal? i '|}|) ; the symbol `}`
(displayln "true")
(displayln "false")))
As a side note, you have to be very careful with the way you're going to process all those curly brackets {} in your language, they're interpreted as normal parentheses () in Racket and they'll be tricky to handle, notice how I had to escape them by surrounding them with vertical bars.
I've been working on a project for school that takes functions from a class file and turns them into object/classes. The assignment is all about object oriented programming in scheme.
My problem however is that my code doesn't format right.
The output it gives me whenever I give it a file to pass in wraps the methods of the class in a list, making it so that the class never really gets declared. I can't for the life of me figure out how to get the parenthesis wrapping the method list to remove.
I would really appreciate any help.
Below is the output, the class file and the code,.
(define pointInstance
(let ((myx 1) (myy 2))
(lambda msg
(cond
(((eq? (car msg) getx) myx)
((eq? (car msg) gety) myy)
((eq? (car msg) setx) (set! myx x))
((eq? (car msg) show) (begin (display "[") (display myx) (display ",") (display myy) (display "]"))))))))
If you look at just after the cond you'll see how all those eq statements are contained in a list. I can't get this to work right unless they're not wrapped by that top level list.
;;;; PART1 --- A super-easy set of classes. Just models points and lines. Tests all of >the
;; basics of class behavior without touching on anything particularly complex.
(class pointInstance (parent:) (constructor_args:)
(ivars: (myx 1) (myy 2))
(methods:
(getx () myx)
(gety () myy)
(setx (x) (set! myx x))
(show () (begin (display "[") (display myx) (display ",") (display myy) (display "]")))
))
(require (lib "trace.ss"))
;; Continue reading until you hit the end of the file, all the while
;; building a list with the contents
(define load-file
(lambda (port)
(let ((rec (read port)))
(if (eof-object? rec)
'()
(cons rec (load-file port))))))
;; Open a port based on a file name using open-input-file
(define (load fname)
(let ((fport (open-input-file fname)))
(load-file fport)))
;(define lis (load "C:\\Users\\Logan\\Desktop\\simpletest.txt"))
;(define lis (load "C:\\Users\\Logan\\Desktop\\complextest.txt"))
(define lis (load "C:\\Users\\Logan\\Desktop\\pointinstance.txt"))
;(display (cdaddr (cdddar lis)))
(define makeMethodList
(lambda (listToMake retList)
;(display listToMake)
(cond
[(null? listToMake)
retList
;(display "The list passed in to parse was null")
]
[else
(makeMethodList (cdr listToMake) (append retList (list (getMethodLine listToMake))))
]
)
))
;(trace makeMethodList)
;this works provided you just pass in the function line
(define getMethodLine
(lambda (functionList)
`((eq? (car msg) ,(caar functionList)) ,(caddar functionList))))
(define load-classes
(lambda paramList
(cond
[(null? paramList) (display "Your parameters are null, man.")]
[(null? (car paramList))(display "Done creating class definitions.")]
[(not (null? (car paramList)))
(begin
(let* ((className (cadaar paramList))
(classInstanceVars (cdaddr (cddaar paramList)))
(classMethodList (cdr (cadddr (cddaar paramList))))
(desiredMethodList (makeMethodList classMethodList '()))
)
;(display "Classname: ")
;(display className)
;(newline)(newline)
;(display "Class Instance Vars: ")
;(display classInstanceVars)
;(newline)(newline)
;(display "Class Method List: ")
;(display classMethodList)
;(newline)
;(display "Desired Method List: ")
;(display desiredMethodList))
;(newline)(newline)
;----------------------------------------------------
;do not delete the below code!`
`(define ,className
(let ,classInstanceVars
(lambda msg
;return the function list here
(cond ,(makeMethodList classMethodList '())))
))
;---------------------------------------------------
))]
)
))
(load-classes lis)
;(load-classes lis)
;(load-classes-helper lis)
;(load-classes "simpletest.txt")
;(load-classes "complextest.txt")
;method list
;(display (cdr (cadddr (cddaar <class>))))
You have too many opening parenthesis in the 1st clause of the cond.
IE:
(((eq? (car msg) getx) myx)
^
Updated:
Are you looking for this?
(cond ,#(makeMethodList classMethodList '())
^^
Or you can do:
(cond . ,(makeMethodList classMethodList '())
Using Gimp 2.6.6 for MAC OS X (under X11) as downloaded from gimp.org.
I'm trying to automate a boring manual process with Script-Fu. I needed to parse the image file name to save off various layers as new files using a suffix on the original file name.
My original attempts went like this but failed because (string-search ...) doesn't seem to be available under 2.6 (a change to the scripting engine?).
(set! basefilename (substring filename 0 (string-search "." filename)))
Then I tried to use this information to parse out the base file name using regex but (re-match-nth ...) is not recognized either.
(if (re-match "^(.*)[.]([^.]+)$" filename buffer)
(set! basefilename (re-match-nth orig-name buffer 1))
)
And while pulling the value out of the vector ran without error, the resulting value is not considered a string when it is passed into (string-append ...).
(if (re-match "^(.*)[.]([^.]+)$" filename buffer)
(set! basefilename (vector-ref buffer 1))
)
So I guess my question is, how would I parse out the base file name?
Not really a correct solution:
> (filename-basename "this.is.a.long.filename.jpg")
"this"
A better implementation:
(define (morph-filename orig-name new-extension)
(let* ((buffer (vector "" "" "")))
(if (re-match "^(.*)[.]([^.]+)$" orig-name buffer)
(string-append (substring orig-name 0 (car (vector-ref buffer 2))) new-extension)
)
)
)
Context
GIMP 2.6.6 Windows Vista SP2
Goal
Extract the basename of the original filename without its extension.
Symptom
Error: eval: unbound variable:
re-match-nth
Possible suggestion
GIMP menu "Filters" > "Script-Fu" > "Console"
In the input box, paste the following Script-Fu definition of function
then hit the ENTER key:
(define (filename-basename orig-name)
(car (strbreakup orig-name "."))
; Nimmzo 09/09/30: the string split function strbreakup is defined
; in the compatibility file from SIOD to TinyScheme:
; C:\Program Files\GIMP\share\gimp\2.0\scripts\script-fu-compat.init
) ; end filename-basename
To test the function, enter:
(filename-basename "screen.xcf")
The Script-Fu Console answers:
"screen"
My version splits the filename (f) into parts delimited by separator ("." in this case); drops last part; and re-combines them with separator again
(define (pc-drop-extension f)
(unbreakupstr (butlast (strbreakup f ".")) ".") )
so
(pc-drop-extension "ab.cd.efi") -> "ab.cd"
and
(pc-drop-extension "ab/cd.ef/ghi.jkl.mno") -> "ab/cd.ef/ghi.jkl"
Many thanks philcolbourn for pointing out a "simple" way to do this.
Unfortunately, the butlast function is deprecated:
http://www.gimp.org/docs/script-fu-update.html#deprecated
Here is philcolbourn's version with the suggested replacement:
(define (drop-extension filename)
(unbreakupstr (reverse (cdr (reverse (strbreakup filename ".")))) ".")
)
As in Gimp 2.8 "gimp-image-get-uri" has to be used to get the filename of a JPG file, but gimp-image-get-uri delivers the complete path, I used this function to extract just the name of the pic (without the suffix ".jpg"):
(let* (
(uriname (car (gimp-image-get-uri IMAGE)))
(basename (car (reverse (strbreakup (car (strbreakup uriname ".")) "/"))))
...
)
...
)
For those looking for a true string-replace functionality, here is a function I wrote for use in Script Fu
(define (string-replace strIn strReplace strReplaceWith)
(let*
(
(curIndex 0)
(replaceLen (string-length strReplace))
(replaceWithLen (string-length strReplaceWith))
(inLen (string-length strIn))
(result strIn)
)
;loop through the main string searching for the substring
(while (<= (+ curIndex replaceLen) inLen)
;check to see if the substring is a match
(if (substring-equal? strReplace result curIndex (+ curIndex replaceLen))
(begin
;create the result string
(set! result (string-append (substring result 0 curIndex) strReplaceWith (substring result (+ curIndex replaceLen) inLen)))
;now set the current index to the end of the replacement. it will get incremented below so take 1 away so we don't miss anything
(set! curIndex (-(+ curIndex replaceWithLen) 1))
;set new length for inLen so we can accurately grab what we need
(set! inLen (string-length result))
)
)
(set! curIndex (+ curIndex 1))
)
(string-append result "")
)
)