test: add tests of paint ops.

This commit is contained in:
bootchk 2024-01-23 13:27:43 -05:00 committed by Lloyd Konneker
parent 3f54d83bac
commit 25280ffdb1
6 changed files with 218 additions and 31 deletions

View File

@ -17,6 +17,9 @@ if not stable
'tests' / 'PDB' / 'image' / 'image-mode.scm',
'tests' / 'PDB' / 'image' / 'image-color-profile.scm',
'tests' / 'PDB' / 'paint' / 'paint.scm',
'tests' / 'PDB' / 'layer' / 'layer-new.scm',
'tests' / 'PDB' / 'layer' / 'layer-ops.scm',
'tests' / 'PDB' / 'layer' / 'layer-mask.scm',

View File

@ -38,10 +38,12 @@
(car (gimp-image-get-base-type ,testImage))
RGB))
; new image is known to gimp
; new image is known to gimp.
; Returns (<length> #(1))
; Test that the length is 1.
; !!! This is sensitive to retest, if a test leaves images.
(assert `(= (car (gimp-get-images))
,testImage))
1))
; new image has few components

View File

@ -1,5 +1,8 @@
; Test various operations on image
; The operand is the total image itself.
; For paint operations (changing a subset of the image) see paint.scm
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
@ -97,17 +100,6 @@
; TODO test flatten is effective
; painting ops
; TODO
; heal
; erase
; smudge
; pencil
; clone
; airbrush
; cannot flatten empty image
(assert-error `(gimp-image-flatten ,testImage)
"Procedure execution of gimp-image-flatten failed: Cannot flatten an image without any visible layer.")

View File

@ -20,6 +20,7 @@
; new layer is not in the image until inserted
; returns (length, list), check length is 0
(assert `(= (car (gimp-image-get-layers ,testImage))
0))
@ -30,9 +31,7 @@
; defaulted attributes
; apply-mask default false
(assert `(=
(car (gimp-layer-get-apply-mask ,testLayer))
0))
(assert-PDB-false `(gimp-layer-get-apply-mask ,testLayer))
; blend-space default LAYER-COLOR-SPACE-AUTO
(assert `(=
@ -50,15 +49,11 @@
LAYER-COLOR-SPACE-AUTO))
; edit-mask default false
(assert `(=
(car (gimp-layer-get-edit-mask ,testLayer))
0))
(assert-PDB-false `(gimp-layer-get-edit-mask ,testLayer))
; lock-alpha default false
; deprecated? gimp-layer-get-preserve-trans
(assert `(=
(car (gimp-layer-get-lock-alpha ,testLayer))
0))
(assert-PDB-false `(gimp-layer-get-lock-alpha ,testLayer))
; mask not exist, ID -1
; deprecated? gimp-layer-mask
@ -72,20 +67,14 @@
LAYER-MODE-NORMAL))
; show-mask default false
(assert `(=
(car (gimp-layer-get-show-mask ,testLayer))
0))
(assert-PDB-false `(gimp-layer-get-show-mask ,testLayer))
; visible default true
; FIXME doc says default false
(assert `(=
(car (gimp-layer-get-visible ,testLayer))
1))
(assert-PDB-true `(gimp-layer-get-visible ,testLayer))
; is-floating-sel default false
(assert `(=
(car (gimp-layer-is-floating-sel ,testLayer))
0))
(assert-PDB-false `(gimp-layer-is-floating-sel ,testLayer))
; !!! No get-offsets

View File

@ -0,0 +1,200 @@
; Test painting operations on drawable
; The operand is a subset of the drawable
; For operations on the total image, see image-ops.scm
; For operations on a total layer, see layer-ops.scm
; Not currently testing pixels were changed,
; only that the operations says it succeeded.
; Define an aux testing function
; that tests the "-default" kind of paint operation.
; Takes an operation (first-class function)
; The operation must have the signature (layer, num_strokes, stroke array).
; All the <paint-op>-default PDB procedures have that signature.
(define (test-paint-op-default paint-op)
; the PDB procedure paint-op succeeds
(assert `(,paint-op
,testLayer ; target
2 ; num-strokes
#(4.0 4.0)))) ; float array))
; setup
(define testImage (car (gimp-image-new 21 22 RGB)))
(define
testLayer (car (gimp-layer-new
testImage
21
22
RGB-IMAGE
"LayerNew"
50.0
LAYER-MODE-NORMAL)))
; assert layer is not inserted in image
; paint ops fail until layer is added to image
(assert-error `(gimp-airbrush ,testLayer 50.0 ; pressure
2 ; num-strokes
#(4.0 4.0)) ; float array
(string-append
"Procedure execution of gimp-airbrush failed on invalid input arguments: "))
; "Item 'LayerNew#2' (10) cannot be used because it has not been added to an image"))
; adding layer to image succeeds
(assert `(gimp-image-insert-layer
,testImage
,testLayer
0 ; parent
0 )) ; position within parent
; airbrush
(assert `(gimp-airbrush
,testLayer
50.0 ; pressure
2 ; num-strokes
#(4.0 4.0))) ; float array
; with two strokes
(assert `(gimp-airbrush
,testLayer
50.0 ; pressure
4 ; num-strokes
#(4.0 4.0 8.0 8.0))) ; float array
; with stroke out of bounds of image
(assert `(gimp-airbrush
,testLayer
50.0 ; pressure
4 ; num-strokes
#(4.0 4.0 800.0 800.0))) ; float array
; clone
; where source and target are same.
; stroke coords in the target.
; FIXME crashes
;(assert `(gimp-clone
; ,testLayer ; affected i.e. target
; ,testLayer ; source
; CLONE-IMAGE ; clone type
; 1.0 1.0 ; source coord x,y is not a vector
; 2 ; num-strokes
; #(4.0 4.0))) ; float array
; TODO CLONE-PATTERN
; eraser
(assert `(gimp-eraser
,testLayer ; target
4 ; num-strokes
#(4.0 4.0 800.0 800.0) ; float array
BRUSH-HARD ; hardness
PAINT-CONSTANT)) ; PaintApplicationMode
(assert `(gimp-eraser-default
,testLayer ; target
4 ; num-strokes
#(0.0 0.0 800.0 800.0) ; float array
))
; FIXME crashes
; heal
;(assert `(gimp-heal
; ,testLayer ; affected i.e. target
; ,testLayer ; source
; 1.0 1.0 ; source coord x,y is not a vector
; 2 ; num-strokes
; #(4.0 4.0))) ; float array
; convolve
(assert `(gimp-convolve
,testLayer ; affected i.e. target
99.9999999999 ; pressure
CONVOLVE-BLUR ; type
2 ; num-strokes
#(4.0 4.0))) ; float array
; dodgeburn
(assert `(gimp-dodgeburn
,testLayer ; affected i.e. target
66.0 ; exposure
DODGE-BURN-TYPE-DODGE ; type, BURN or DODGE
TRANSFER-MIDTONES ; transfer mode
2 ; num-strokes
#(4.0 4.0))) ; float array
; pencil
; See below, only tested in default kind.
; smudge
(assert `(gimp-smudge
,testLayer ; affected i.e. target
0.0 ; pressure
2 ; num-strokes
#(4.0 4.0))) ; float array
; Test the "-default" kinds of paint ops
; These are convenience methods, taking fewer args.
; The args default from the tool settings.
; In alphabetic order
(test-paint-op-default gimp-airbrush-default)
; FIXME crashes
;(test-paint-op-default gimp-clone-default)
(test-paint-op-default gimp-convolve-default)
(test-paint-op-default gimp-dodgeburn-default)
; FIXME crashes
;(test-paint-op-default gimp-heal-default)
(test-paint-op-default gimp-paintbrush-default)
; !!! gimp-pencil is not named gimp-pencil-default
; but has the same signature as other default paint ops.
(test-paint-op-default gimp-pencil)
(test-paint-op-default gimp-smudge-default)
; For any paint op,
; <2 control points is error
(assert-error `(gimp-airbrush
,testLayer
50.0 ; pressure
1 ; num-strokes
#(4.0)) ; float array
"Invalid value 1 for argument 2: expected value between 2 and 2147483647")
; The binding requires a Scheme vector for C float array,
; not a list, here a literal i.e. quoted.
(assert-error `(gimp-airbrush
,testLayer
50.0 ; pressure
2 ; num-strokes
`(4.0 49.0)) ; strokes
"in script, expected type: vector for argument 4 to gimp-airbrush")

View File

@ -19,6 +19,7 @@
(testing:load-test "image-mode.scm")
(testing:load-test "image-color-profile.scm")
(testing:load-test "paint.scm")
(testing:load-test "layer-new.scm")
(testing:load-test "layer-ops.scm")