162 lines
6.0 KiB
Scheme
162 lines
6.0 KiB
Scheme
#!/usr/bin/env pika-script-fu-interpreter-3.0
|
|
|
|
; A script that tests resource classes in PIKA
|
|
; Tests the marshalling of parameters and return values in ScriptFu
|
|
;
|
|
; Setup: copy this file w/ executable permission, and its parent dir to /plug-ins
|
|
; Example: to ~/.pika-2.99/plug-ins/always-fail/always-fail.scm
|
|
|
|
; Delete .config/PIKA so that resources are in a standard state.
|
|
|
|
; Expect various resource names in the console
|
|
; Expect no "Fail" in the console
|
|
|
|
|
|
(define (script-fu-test-resource-class)
|
|
|
|
(define (expect expression
|
|
expected-value )
|
|
; use equal?, don't use eq?
|
|
(if (equal? expression expected-value)
|
|
#t
|
|
(pika-message "Fail")
|
|
)
|
|
)
|
|
|
|
; redirect messages to the console
|
|
(pika-message-set-handler 1)
|
|
|
|
(let* (
|
|
; Test as a return value
|
|
; These calls return a list with one element, use car
|
|
(brush (car (pika-context-get-brush)))
|
|
(font (car (pika-context-get-font)))
|
|
(gradient (car (pika-context-get-gradient)))
|
|
(palette (car (pika-context-get-palette)))
|
|
(pattern (car (pika-context-get-pattern)))
|
|
|
|
; font and pattern cannot be new(), duplicate(), delete()
|
|
|
|
; new() methods
|
|
(brushnew (car (pika-brush-new "Brush New")))
|
|
(gradientnew (car (pika-gradient-new "Gradient New")))
|
|
(palettenew (car (pika-palette-new "Palette New")))
|
|
|
|
; copy() methods
|
|
; copy method is named "duplicate"
|
|
; Takes an existing brush and a desired name
|
|
(brushcopy (car (pika-brush-duplicate brushnew "brushcopy")))
|
|
(gradientcopy (car (pika-gradient-duplicate gradientnew "gradientcopy")))
|
|
(palettecopy (car (pika-palette-duplicate palettenew "palettecopy")))
|
|
|
|
; See below, we test rename later
|
|
)
|
|
|
|
; write names to console
|
|
(pika-message brush)
|
|
(pika-message font)
|
|
(pika-message gradient)
|
|
(pika-message palette)
|
|
(pika-message pattern)
|
|
|
|
(pika-message brushnew)
|
|
(pika-message gradientnew)
|
|
(pika-message palettenew)
|
|
|
|
(pika-message brushcopy)
|
|
(pika-message gradientcopy)
|
|
(pika-message palettecopy)
|
|
|
|
; Note equal? works for strings, but eq? and eqv? do not
|
|
(pika-message "Expect resources from context have de novo installed PIKA names")
|
|
(expect (equal? brush "2. Hardness 050") #t)
|
|
(expect (equal? font "Sans-serif") #t)
|
|
(expect (equal? gradient "FG to BG (RGB)") #t)
|
|
(expect (equal? palette "Color History") #t)
|
|
(expect (equal? pattern "Pine") #t)
|
|
|
|
(pika-message "Expect new resource names are the names given when created")
|
|
(expect (equal? brushnew "Brush New") #t)
|
|
(expect (equal? gradientnew "Gradient New") #t)
|
|
(expect (equal? palettenew "Palette New") #t)
|
|
|
|
(pika-message "Expect copied resources have names given when created")
|
|
; !!! TODO PIKA appends " copy" and does not use the given name
|
|
; which contradicts the docs for the procedure
|
|
(expect (equal? brushcopy "Brush New copy") #t)
|
|
(expect (equal? gradientcopy "Gradient New copy") #t)
|
|
(expect (equal? palettecopy "Palette New copy") #t)
|
|
|
|
; rename() methods
|
|
; Returns new resource proxy, having possibly different name than requested
|
|
; ScriptFu marshals to a string
|
|
; !!! Must assign it to the same var,
|
|
; else the var becomes an invalid reference since it has the old name
|
|
(set! brushcopy (car (pika-brush-rename brushcopy "Brush Copy Renamed")))
|
|
(set! gradientcopy (car (pika-gradient-rename gradientcopy "Gradient Copy Renamed")))
|
|
(set! palettecopy (car (pika-palette-rename palettecopy "Palette Copy Renamed")))
|
|
|
|
; write renames to console
|
|
(pika-message brushcopy)
|
|
(pika-message gradientcopy)
|
|
(pika-message palettecopy)
|
|
|
|
(pika-message "Expect renamed have new names")
|
|
(expect (equal? brushcopy "Brush Copy Renamed") #t)
|
|
(expect (equal? gradientcopy "Gradient Copy Renamed") #t)
|
|
(expect (equal? palettecopy "Palette Copy Renamed") #t)
|
|
|
|
(pika-message "Expect class method id_is_valid of the PikaResource class")
|
|
; the class method takes a string.
|
|
; ScriptFu already has a string var, and marshalling is trivial
|
|
; For now, returns (1), not #t
|
|
(expect (car (pika-brush-id-is-valid brush)) 1)
|
|
(expect (car (pika-font-id-is-valid font)) 1)
|
|
(expect (car (pika-gradient-id-is-valid gradient)) 1)
|
|
(expect (car (pika-palette-id-is-valid palette)) 1)
|
|
(expect (car (pika-pattern-id-is-valid pattern)) 1)
|
|
|
|
(pika-message "Expect class method id_is_valid for invalid name")
|
|
; Expect false, but no error dialog from PIKA
|
|
; Returns (0), not #f
|
|
(expect (car (pika-brush-id-is-valid "invalid_name")) 0)
|
|
(expect (car (pika-font-id-is-valid "invalid_name")) 0)
|
|
(expect (car (pika-gradient-id-is-valid "invalid_name")) 0)
|
|
(expect (car (pika-palette-id-is-valid "invalid_name")) 0)
|
|
(expect (car (pika-pattern-id-is-valid "invalid_name")) 0)
|
|
|
|
(pika-message "Expect as a parameter to context works")
|
|
; Pass each resource class instance back to Gimp
|
|
(pika-context-set-brush brush)
|
|
(pika-context-set-font font)
|
|
(pika-context-set-gradient gradient)
|
|
(pika-context-set-palette palette)
|
|
(pika-context-set-pattern pattern)
|
|
|
|
(pika-message "Expect delete methods work without error")
|
|
(pika-brush-delete brushnew)
|
|
(pika-gradient-delete gradientnew)
|
|
(pika-palette-delete palettenew)
|
|
|
|
(pika-message "Expect var holding deleted resource is still defined, but is invalid reference")
|
|
; Returns (0), not #f
|
|
(expect (car (pika-brush-id-is-valid brushnew)) 0)
|
|
(expect (car (pika-gradient-id-is-valid gradientnew)) 0)
|
|
(expect (car (pika-palette-id-is-valid palettenew)) 0)
|
|
|
|
; We don't test the specialized methods of the classes here, see elsewhere
|
|
)
|
|
)
|
|
|
|
(script-fu-register "script-fu-test-resource-class"
|
|
"Test resource classes of Pika"
|
|
"Expect no errors in the console"
|
|
"lkk"
|
|
"lkk"
|
|
"2022"
|
|
"" ; requires no image
|
|
; no arguments or dialog
|
|
)
|
|
|
|
(script-fu-menu-register "script-fu-test-resource-class" "<Image>/Test")
|
