Initial checkin of Pika from heckimp

plug-ins/script-fu/test/tests/PDB/bind-args.scm

@@ -0,0 +1,87 @@
+
+; Test ScriptFu's binding to all Pika C arg types of the PDB
+
+
+; The PDB procedures called are arbitrary, chosen for the type of their args.
+
+; The test is only that no error is thrown, not necessarily that the call is effective.
+
+; Test binding in both directions: args passed and args returned.
+
+; Testing is not complete, but illustrative of special cases.
+
+; Testing is not blindly exhaustive of every type declarable for PDB procedures.
+; Testing is with knowledge of the code.
+; Only testing representatives for cases in switch statement of scheme-wrapper.c.
+; For example, the code has a case for GObject that covers most subclasses
+; of PikaItem, so we only test once, say for PikaLayer.
+
+; Also, we don't test all primitive types.
+; We know they are tested drive-by in other tests,
+; so we don't necessarily test them here.
+; Int, String, Double, UInt
+
+; Note that no PDB procedure takes or returns:
+;    gchar (the type for a single character.)
+;    GParam or PikaParam
+; There is no case in scheme-wrapper.c.
+
+
+
+; int
+; float
+
+; PikaRGB is tested e.g. with Palette
+; PikaRGBArray is tested e.g.
+; from palette-get-colormap
+; to is not tested: not an arg to any PDB proc
+
+; GStrv string array
+; from brushes-get-list
+; to file-gih-save or extension-pika-help
+; TODO test GStrv to file-gih-save
+
+; GBytes
+; from image-get-colormap
+; to image-set-colormap
+
+; FloatArray
+; from pika-context-get-line-dash-pattern
+; to pika-context-set-line-dash-pattern
+
+
+;                 PikaResource
+; see resource.scm and context.scm
+
+
+;                 GFile
+
+;                 PikaParasite
+
+; ScriptFu takes and returns a list of attributes of a PikaParasite
+; A PikaParasite is a named string having a flags attribute ?
+; Also tested elsewhere, many objects can have parasites.
+; This tests the global parasites, on the pika instance.
+
+; to
+(assert '(pika-attach-parasite (list "foo" 1 "zed")))
+; from
+(assert `(equal? (car (pika-get-parasite "foo"))
+                 '("foo" 1 "zed")))
+
+
+;                 PikaUnit
+
+; A PikaUnit is both an enum and an object???
+; ScriptFu converts to int.  More or less an ID.
+
+; to
+; unit index 0 is px
+(assert '(string=? (car (pika-unit-get-abbreviation 0))
+                   "px"))
+
+; from
+; default line width unit is px
+(assert '(= (car (pika-context-get-line-width-unit))
+            0))
+

plug-ins/script-fu/test/tests/PDB/buffer.scm

@@ -0,0 +1,93 @@
+; Test methods of Buffer class of the PDB
+
+; aka NamedBuffer i.e. the clipboard saved with a name.
+
+; Edit methods that create buffers is tested elsewhere.
+; The names of those methods is hard to understand:
+; because they used "named" to mean "buffer"
+; E.G. pika-edit-named-copy might be better named:
+; pika-edit-copy-to-named-buffer
+
+
+
+; Prereq:  no buffer exists yet.
+
+
+
+; setup
+; Load test image that already has drawable
+(define testImage (testing:load-test-image "wilber.png"))
+
+; the layer is the zeroeth element in the vector which is the second element
+; but cadr returns the second element!!
+; TODO make this a library routine: get-first-layer
+; (1 #(<layerID>))
+(define testDrawable (vector-ref (cadr (pika-image-get-layers testImage ))
+                                  0))
+
+; Create new named buffer
+; There is no pika-buffer-new method,
+; instead it is a method of the Edit class so-to-speak
+; You can't: #(testDrawable)
+(define testBuffer (car (pika-edit-named-copy
+                              1
+                              (make-vector 1 testDrawable)
+                              "bufferName")))
+; Since no selection, the buffer is same size as image
+
+; Creation was effective: pika knows the buffer
+; get-list takes a regex, here empty ""
+; get-list returns  (("bufferName")) : a list of strings
+; and the first string is "bufferName"
+(assert `(string=? (caar (pika-buffers-get-list ""))
+                    "bufferName"))
+
+; buffer has same size as image when created with no selection
+; test image is 256x256
+(assert `(= (car (pika-buffer-get-width "bufferName"))
+            256))
+(assert `(= (car (pika-buffer-get-height "bufferName"))
+            256))
+
+; new buffer has alpha: the image is RGB but the buffer has bpp 4
+; This is not well documented.
+; FIXME the docs and the method name should say "bpp"
+; or "bytes per pixel" instead of "bytes"
+(assert `(= (car (pika-buffer-get-bytes "bufferName"))
+            4))
+
+; image type is RGBA
+; FIXME: the docs erroneously say "ImageBaseType" => "ImageType"
+(assert `(= (car (pika-buffer-get-image-type "bufferName"))
+            RGBA-IMAGE))
+
+
+
+;                 renaming
+
+; Renaming returns the given name if it doesn't clash with existing name.
+(assert `(string=? (car (pika-buffer-rename "bufferName" "renamedName"))
+                  "renamedName"))
+
+; Effect renaming: pika knows the renamed name
+(assert `(string=? (caar (pika-buffers-get-list ""))
+                    "renamedName"))
+
+; Renaming does not add another buffer
+
+; TODO list-length 1
+
+
+;                deleting
+
+; Delete evaluates but is void
+(assert `(pika-buffer-delete "renamedName"))
+
+; Delete was effective: pika no longer knows
+; and returns nil i.e. empty list (())
+(assert `(null? (car (pika-buffers-get-list ""))))
+
+
+; TODO test two buffers
+
+; TODO test renaming when name already in use

plug-ins/script-fu/test/tests/PDB/channel/channel-new.scm

@@ -0,0 +1,57 @@
+; Test methods of Channel class of the PDB
+
+
+
+; setup
+; new, empty image
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+
+; new image has no custom channels
+(assert `(= (car (pika-image-get-channels ,testImage))
+            0))
+
+; setup (not in an assert and not quoted)
+; vectors-new succeeds
+(define testChannel (car (pika-channel-new
+            testImage    ; image
+            23 24          ; width, height
+            "Test Channel" ; name
+            50.0           ; opacity
+            "red" )))      ; compositing color
+
+; new channel is not in image until inserted
+; get-channels yields (0 #())
+(assert `(= (car (pika-image-get-channels ,testImage))
+            0))
+
+; channel ID is valid
+(assert `(= (car (pika-item-id-is-channel ,testChannel))
+            1))  ; #t
+
+
+;               attributes
+
+; get-color
+; FIXME: this passes but should test return red ???
+(assert `(equal?
+            (car (pika-channel-get-color ,testChannel))
+            '(0 0 0)))
+
+
+
+
+;               insert
+
+; insert succeeds
+(assert `(pika-image-insert-channel
+            ,testImage
+            ,testChannel
+            0            ; parent, moot since channel groups not supported
+            0))          ; position in stack
+
+; insert was effective
+; testImage now has one channel
+(assert `(= (car (pika-image-get-channels ,testImage))
+            1))
+

plug-ins/script-fu/test/tests/PDB/context/context-get-set.scm

@@ -0,0 +1,42 @@
+; test getters and setters of PikaContext
+; (sic its not an object or class)
+
+
+
+;                        set-line-dash-pattern
+
+; tests binding of FloatArray
+
+; Default is no pattern
+; Even if user has stroked already and chosen a stroke>line>pattern
+(assert `(= (car (pika-context-get-line-dash-pattern))
+            0))
+
+; setter succeeds
+(assert `(pika-context-set-line-dash-pattern 2 #(5.0 11.0)))
+
+; setter effective
+(assert `(= (car (pika-context-get-line-dash-pattern))
+            2))
+(assert `(equal? (cadr (pika-context-get-line-dash-pattern))
+                  #(5.0 11.0)))
+
+
+;                        get-line-dash-offset
+
+;tests binding of float i.e. gdouble
+
+; defaults to 0.0 until set
+; FIXME why doesn't it persist in settings?
+(assert `(= (car (pika-context-get-line-dash-offset))
+            0.0))
+
+; setter succeeds
+(assert `(pika-context-set-line-dash-offset 3.3 ))
+; setter effective
+(assert `(= (car (pika-context-get-line-dash-offset))
+            3.3))
+
+
+
+

plug-ins/script-fu/test/tests/PDB/context/context-resource.scm

@@ -0,0 +1,113 @@
+; test resource methods of Context
+
+
+
+; function to test methods on Resource
+; for a valid Resource ID
+(define (test-resource-methods resource)
+
+  ; a resource is an int ID in ScriptFu
+  (assert `(integer? ,resource))
+
+  ; get-name returns a string
+  (assert `(string? (car (pika-resource-get-name ,resource))))
+
+  ; id-is-valid returns truth
+  ; (1) FUTURE #t
+  (assert `(car (pika-resource-id-is-valid ,resource)))
+
+  ; pika-resource-get-identifiers succeeds
+  ; it returns a triplet
+  (assert `(pika-resource-get-identifiers ,resource))
+
+  ; pika-resource-get-identifiers returns numeric for is-internal
+  ; Some of the fresh pika active resource are internal, some not !!!
+  (assert `(number? (car (pika-resource-get-identifiers ,resource))))
+
+  ; name from get-identifiers is same as from pika-resource-get-name
+  ; name is second field of triplet i.e. cadr
+  (assert `(string=? (cadr (pika-resource-get-identifiers ,resource))
+                     (car (pika-resource-get-name ,resource))))
+
+  ; pika-resource-is-editable succeeds
+  ; Returns a wrapped boolean
+  (assert `(pika-resource-is-editable ,resource))
+
+  ; The fresh pika active resources are all system resources i.e. not editable
+  ; returns 0 for #f
+  (assert `(= (car(pika-resource-is-editable ,resource))
+              0))
+)
+
+;                  "Test Parasite") ; name
+;               "Procedure execution of pika-resource-get-parasite failed")
+
+
+
+; test context-get-resource returns active resource of given className
+; Setup. Not assert.
+
+(define testBrush    (car (pika-context-get-resource "PikaBrush")))
+(define testFont     (car (pika-context-get-resource "PikaFont")))
+(define testGradient (car (pika-context-get-resource "PikaGradient")))
+(define testPalette  (car (pika-context-get-resource "PikaPalette")))
+(define testPattern  (car (pika-context-get-resource "PikaPattern")))
+; FUTURE Dynamics and other Resource subclasses
+
+
+;              test methods on active resource ID's
+
+(test-resource-methods testBrush)
+(test-resource-methods testFont)
+(test-resource-methods testGradient)
+(test-resource-methods testPalette)
+(test-resource-methods testPattern)
+
+
+;             test more specific context methods return same result
+;             as the general context-get-resource
+
+; test equality of numeric IDs
+(assert `(= (car(pika-context-get-brush))
+            ,testBrush))
+(assert `(= (car(pika-context-get-font))
+            ,testFont))
+(assert `(= (car(pika-context-get-gradient))
+            ,testGradient))
+(assert `(= (car(pika-context-get-palette))
+            ,testPalette))
+(assert `(= (car(pika-context-get-pattern))
+            ,testPattern))
+
+
+;              test resource-id-is-foo methods
+
+; the resource IDs from setup work with the specific id-is-foo methods
+
+(assert `(= (car(pika-resource-id-is-brush ,testBrush))
+            1))
+(assert `(= (car(pika-resource-id-is-font ,testFont))
+            1))
+(assert `(= (car(pika-resource-id-is-gradient ,testGradient))
+            1))
+(assert `(= (car(pika-resource-id-is-palette ,testPalette))
+            1))
+(assert `(= (car(pika-resource-id-is-pattern ,testPattern))
+            1))
+
+
+;             test errors
+
+
+; invalid type name
+(assert-error `(pika-context-get-resource "InvalidTypeName")
+              "Procedure execution of pika-context-get-resource failed")
+
+; invalid numeric ID
+; -1 is out of range
+(assert-error `(pika-resource-get-name -1)
+              "Procedure execution of pika-resource-get-name failed on invalid input arguments:")
+; 12345678 is in range but invalid
+(assert-error `(pika-resource-get-name 12345678)
+              "Procedure execution of pika-resource-get-name failed on invalid input arguments:")
+

plug-ins/script-fu/test/tests/PDB/enums.scm

@@ -0,0 +1,19 @@
+
+; Test enums of the PDB
+
+; These test and illustrate enums
+
+
+; ImageBaseType
+(assert '(= RGB     0))
+(assert '(= GRAY    1))
+(assert '(= INDEXED 2))
+
+; ImageType is not same as ImageBaseType
+(assert '(= RGB-IMAGE      0))
+(assert '(= RGBA-IMAGE     1))
+(assert '(= GRAY-IMAGE     2))
+(assert '(= GRAYA-IMAGE    3))
+(assert '(= INDEXED-IMAGE  4))
+(assert '(= INDEXEDA-IMAGE 5))
+

plug-ins/script-fu/test/tests/PDB/image/image-grayscale.scm

@@ -0,0 +1,54 @@
+; test Image of mode grayscale methods of PDB
+
+; !!! Note inconsistent use in PIKA of GRAY versus GRAYSCALE
+
+
+
+;              Basic grayscale tests
+
+
+;              setup
+
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+
+
+
+; method pika-image-convert-grayscale does not error
+(assert `(pika-image-convert-grayscale ,testImage))
+
+; conversion was effective:
+; basetype of grayscale is GRAY
+(assert `(=
+            (car (pika-image-get-base-type ,testImage))
+            GRAY))
+
+; conversion was effective:
+; grayscale image has-a colormap
+; colormap is-a vector of length zero, when image has no drawable.
+; FIXME doc says num-bytes is returned, obsolete since GBytes
+(assert `(=
+            (vector-length
+              (car (pika-image-get-colormap ,testImage)))
+            0))
+
+; grayscale images have precision PRECISION-U8-NON-LINEAR
+; FIXME annotation of PDB procedure says PIKA_PRECISION_U8
+(assert `(=
+           (car (pika-image-get-precision ,testImage))
+           PRECISION-U8-NON-LINEAR ))
+
+; TODO
+; drawable of grayscale image is also grayscale
+;(assert `(car (pika-drawable-is-grayscale
+;                 ()
+;               ,testImage)
+
+; convert precision of grayscale image succeeds
+(assert `(pika-image-convert-precision
+            ,testImage
+            PRECISION-DOUBLE-GAMMA))
+
+
+
+

plug-ins/script-fu/test/tests/PDB/image/image-indexed.scm

@@ -0,0 +1,128 @@
+; test Image of mode indexed methods of PDB
+
+; Now independent of image ID
+
+
+;              Basic indexed tests
+
+
+; an empty image for testing
+(define newTestImage (car (pika-image-new 21 22 RGB)))
+
+; Load test image that already has drawable
+(define testImage (testing:load-test-image "wilber.png"))
+
+
+
+
+
+; testImage is mode RGB
+(assert `(=
+            (car (pika-image-get-base-type ,testImage))
+            RGB))
+
+
+; method pika-image-convert-indexed yields truthy (now yields (#t) )
+(assert `(pika-image-convert-indexed
+                  ,testImage
+                  CONVERT-DITHER-NONE
+                  CONVERT-PALETTE-GENERATE
+                  2  ; color count
+                  1  ; alpha-dither.  FUTURE: #t
+                  1  ; remove-unused. FUTURE: #t
+                  "myPalette" ; ignored
+                  ))
+
+; method pika-image-convert-indexed works even on empty image
+(assert `(pika-image-convert-indexed
+                  ,newTestImage
+                  CONVERT-DITHER-NONE
+                  CONVERT-PALETTE-GENERATE
+                  25  ; color count
+                  1  ; alpha-dither.  FUTURE: #t
+                  1  ; remove-unused. FUTURE: #t
+                  "myPalette" ; ignored
+                  ))
+
+; conversion was effective:
+; basetype of indexed image is INDEXED
+(assert `(=
+            (car (pika-image-get-base-type ,testImage))
+            INDEXED))
+
+; conversion was effective:
+; basetype of indexed image is INDEXED
+(assert `(=
+            (car (pika-image-get-base-type ,newTestImage))
+            INDEXED))
+
+
+; testImage has a layer named same as file "wilber.png"
+; TODO Why does "Background" work but app shows "wilber.png"
+
+; drawable of indexed image is also indexed
+(assert `(= (car (pika-drawable-is-indexed
+                    ; unwrap the drawable ID
+                    (car (pika-image-get-layer-by-name ,testImage "Background"))))
+            1)) ; FUTURE #t
+
+
+
+;                     colormaps of indexed images
+
+; conversion was effective:
+; indexed image has-a colormap
+
+; colormap is-a vector of length zero, when image has no drawable.
+; get-colormap returns (#( <bytes of color>))
+; FIXME doc says num-bytes is returned, obsolete since GBytes
+(assert `(=
+            (vector-length
+              (car (pika-image-get-colormap ,newTestImage)))
+            0))
+
+; colormap is-a vector of length 3*<color count given during conversion>,
+; when image has a drawable.
+; 3*2=6
+; FIXME doc says num-bytes is returned, obsolete since GBytes
+(assert `(=
+            (vector-length
+              (car (pika-image-get-colormap ,testImage)))
+            (* 3 2)))
+
+; set-colormap succeeds
+; This tests marshalling of GBytes to PDB
+(assert `(pika-image-set-colormap ,testImage #(1 1 1 9 9 9)))
+
+; TODO set-colormap effective
+; colormap vector is same as given
+(assert `(equal?
+              (car (pika-image-get-colormap ,testImage))
+              #(1 1 1 9 9 9)))
+
+
+
+
+
+;                  precision of indexed images
+
+; indexed images have precision PRECISION-U8-NON-LINEAR
+; FIXME annotation of PDB procedure says PIKA_PRECISION_U8
+(assert `(=
+           (car (pika-image-get-precision ,testImage))
+           PRECISION-U8-NON-LINEAR ))
+
+
+
+
+; !!! This depends on ID 4 for image
+
+; convert precision of indexed images yields error
+(assert-error `(car (pika-image-convert-precision
+                  ,newTestImage
+                  PRECISION-DOUBLE-GAMMA))
+               "Procedure execution of pika-image-convert-precision failed on invalid input arguments: ")
+               ; "Image '[Untitled]' (4) must not be of type 'indexed'"
+
+
+

plug-ins/script-fu/test/tests/PDB/image/image-layers.scm

@@ -0,0 +1,58 @@
+; test Image methods of PDB
+; where methods deal with layers owned by image.
+
+
+; setup
+; Load test image that already has drawable
+(define testImage (testing:load-test-image "wilber.png"))
+
+
+
+;                 get-layers
+; procedure returns (1 #(<layerID>)) ....in the REPL
+
+
+; the testImage has one layer
+(assert `(= (car (pika-image-get-layers ,testImage ))
+            1))
+
+; get-layers returns second result a vector of ID's
+; !!! use cadr to get second result
+(assert `(vector? (cadr (pika-image-get-layers ,testImage ))))
+
+; the vector also has one element
+(assert `(= (vector-length (cadr (pika-image-get-layers ,testImage )))
+            1))
+
+; the vector can be indexed at first element
+; and is a numeric ID
+(assert `(number?
+            (vector-ref (cadr (pika-image-get-layers ,testImage ))
+                        0)))
+
+; store the layer ID
+(define testLayer (vector-ref (cadr (pika-image-get-layers testImage ))
+                              0))
+
+; FIXME seems to fail??? because name is actually "Background"
+
+; the same layer can be got by name
+; FIXME app shows layer name is "wilber.png" same as image name
+(assert `(= (car (pika-image-get-layer-by-name ,testImage "Background"))
+            ,testLayer))
+
+; the single layer's position is zero
+; pika-image-get-layer-position is deprecated
+(assert `(= (car (pika-image-get-item-position ,testImage ,testLayer))
+            0))
+
+
+; TODO pika-image-get-layer-by-tattoo
+
+; the single layer is selected  in freshly opened image
+(assert `(= (car (pika-image-get-selected-layers ,testImage ))
+            1))
+
+; TODO test selected layer is same layer
+
+

plug-ins/script-fu/test/tests/PDB/image/image-new.scm

@@ -0,0 +1,148 @@
+; test Image methods of PDB
+
+; loading this file changes testing state
+
+; Using numeric equality operator '=' on numeric ID's
+
+
+;            setup
+
+; method new from fresh PIKA state returns ID 1
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+
+
+
+; FUTURE method is_valid on new image yields #t
+; method is_valid on new image yields 1 i.e. true
+(assert `(=
+           (car (pika-image-id-is-valid ,testImage))
+           1))
+
+; Ensure attributes of new image are correct
+
+; method is_dirty on new image is true
+(assert `(=
+            (car (pika-image-is-dirty ,testImage))
+            1))
+
+; method get_width on new image yields same width given when created
+(assert `(=
+            (car (pika-image-get-width ,testImage))
+            21))
+
+; method get_height on new image yields same height given when created
+(assert `(=
+            (car (pika-image-get-height ,testImage))
+            22))
+
+; method get-base-type yields same image type given when created
+(assert `(=
+            (car (pika-image-get-base-type ,testImage))
+            RGB))
+
+; new image is known to pika
+; Returns (<length> #(1))
+(assert `(= (car (pika-get-images))
+            ,testImage))
+
+
+;        new image has no components
+
+; new image has zero layers
+(assert `(= (car (pika-image-get-layers ,testImage))
+            0))
+
+; new image has zero vectors
+(assert `(= (car (pika-image-get-vectors ,testImage))
+            0))
+
+; new image has no parasites
+(assert `(= (length
+              (car (pika-image-get-parasite-list ,testImage)))
+            0))
+
+
+
+
+
+; new image has-a selection
+(assert `(pika-image-get-selection ,testImage))
+
+; new image has no floating selection
+(assert `(=
+          (car (pika-image-get-floating-sel ,testImage))
+          -1))
+
+; TODO floating-sel-attached-to
+
+
+
+; new image has unit having ID 1
+(assert `(=
+            (car (pika-image-get-unit ,testImage))
+            1))
+
+; new image has name
+(assert `(string=?
+            (car (pika-image-get-name ,testImage))
+            "[Untitled]"))
+
+; new image has empty metadata string
+(assert `(string=?
+            (car (pika-image-get-metadata ,testImage))
+            ""))
+
+; has an effective color profile
+(assert `(pika-image-get-effective-color-profile ,testImage))
+
+
+
+;        new image has no associated files
+
+; GFile is string in ScriptFu
+
+; no file, xcf file, imported file, or exported file
+(assert `(string=? (car (pika-image-get-file     ,testImage)) ""))
+(assert `(string=? (car (pika-image-get-xcf-file ,testImage)) ""))
+(assert `(string=? (car (pika-image-get-imported-file ,testImage)) ""))
+(assert `(string=? (car (pika-image-get-exported-file ,testImage)) ""))
+
+
+
+; Test delete method.
+; !!! ID 1 is no longer valid
+
+; method delete succeeds on new image
+; returns 1 for true.  FUTURE returns #t
+(assert `(car (pika-image-delete ,testImage)))
+
+; ensure id invalid for deleted image
+; returns 0 for false.  FUTURE returns #f
+(assert `(=
+            (car (pika-image-id-is-valid ,testImage))
+            0))
+
+; deleted image is not in pika
+; Returns (<length> #())
+; FUTURE Returns empty list `()
+(assert `(=
+            (car (pika-get-images))
+            0))
+; !!! This only passes when testing is from fresh Pika restart
+
+
+; Test abnormal args to image-new
+
+
+; Dimension zero yields error
+; It does NOT yield invalid ID -1
+(assert-error `(pika-image-new 0 0 RGB)
+              (string-append
+                "Procedure execution of pika-image-new failed on invalid input arguments: "
+                "Procedure 'pika-image-new' has been called with value '0' for argument 'width' (#1, type gint)."))
+              ; " This value is out of range."
+
+
+
+

plug-ins/script-fu/test/tests/PDB/image/image-ops.scm

@@ -0,0 +1,83 @@
+; Test various operations on image
+
+
+;              setup
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+
+;           transformations
+
+; flip
+(assert `(pika-image-flip ,testImage ORIENTATION-HORIZONTAL))
+(assert `(pika-image-flip ,testImage ORIENTATION-VERTICAL))
+; TODO rotate scale resize policy
+
+(assert-error `(pika-image-flip ,testImage ORIENTATION-UNKNOWN)
+    (string-append
+      "Procedure execution of pika-image-flip failed on invalid input arguments: "
+      "Procedure 'pika-image-flip' has been called with value 'PIKA_ORIENTATION_UNKNOWN'"
+      " for argument 'flip-type' (#2, type PikaOrientationType). This value is out of range."))
+
+; rotate
+(assert `(pika-image-rotate ,testImage ROTATE-90))
+(assert `(pika-image-rotate ,testImage ROTATE-180))
+(assert `(pika-image-rotate ,testImage ROTATE-270))
+
+; scale
+; up
+(assert `(pika-image-scale ,testImage 100 100))
+
+; down to min
+(assert `(pika-image-scale ,testImage 1 1))
+
+; up to max
+; Performance:
+; This seems to work fast when previous scaled to 1,1
+; but then seems to slow down testing
+; unless we scale down afterwards.
+; This seems glacial if not scaled to 1,1 prior.
+(assert `(pika-image-scale ,testImage 524288 524288))
+
+; down to min
+(assert `(pika-image-scale ,testImage 1 1))
+
+
+;          policy ops
+
+; 0 means non-interactive
+(assert `(pika-image-policy-color-profile ,testImage 0))
+(assert `(pika-image-policy-rotate ,testImage 0))
+
+
+
+; freezing and unfreezing (avoid updates to dialogs)
+; Used for performance.
+(assert `(pika-image-freeze-channels ,testImage))
+(assert `(pika-image-freeze-layers ,testImage))
+(assert `(pika-image-freeze-vectors ,testImage))
+(assert `(pika-image-thaw-channels ,testImage))
+(assert `(pika-image-thaw-layers ,testImage))
+(assert `(pika-image-thaw-vectors ,testImage))
+
+; clean-all makes image not dirty
+(assert `(pika-image-clean-all ,testImage))
+(assert `(=
+            (car (pika-image-is-dirty ,testImage))
+            0))
+
+; TODO test flatten is effective
+; crop
+
+
+;                painting ops
+; TODO
+; heal
+; erase
+; smudge
+; pencil
+; clone
+; airbrush
+
+; cannot flatten empty image
+(assert-error `(pika-image-flatten ,testImage)
+  "Procedure execution of pika-image-flatten failed: Cannot flatten an image without any visible layer.")

plug-ins/script-fu/test/tests/PDB/image/image-precision.scm

@@ -0,0 +1,55 @@
+; test Image precision methods of PDB
+
+; Using numeric equality operator '=' on numeric ID's
+
+
+;             setup
+
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+
+;              Basic precision tests
+
+; method get_precision on new image yields PRECISION-U8-NON-LINEAR  150
+(assert `(=
+           (car (pika-image-get-precision ,testImage))
+           PRECISION-U8-NON-LINEAR ))
+
+
+
+;            Convert precision
+
+; method convert-precision yields true, with side effect on image
+(assert `(car (pika-image-convert-precision
+                ,testImage
+                PRECISION-U8-LINEAR)))
+
+
+; converted image is the precision
+(assert `(=
+           (car (pika-image-get-precision ,testImage))
+           PRECISION-U8-LINEAR ))
+
+; converting to the same precision yields error message
+(assert-error `(pika-image-convert-precision
+                  ,testImage
+                  PRECISION-U8-LINEAR)
+              "Procedure execution of pika-image-convert-precision failed on invalid input arguments: ")
+              ; "Image '[Untitled]' (2) must not be of precision 'u8-linear'"
+
+
+
+;       Indexed images precision tested elsewhere
+
+
+
+;       New with precision
+
+;         setup
+(define testImageWithPrecision (car (pika-image-new-with-precision 21 22 RGB PRECISION-DOUBLE-GAMMA)))
+
+
+; image has given precision
+(assert `(=
+           (car (pika-image-get-precision ,testImageWithPrecision))
+           PRECISION-DOUBLE-GAMMA ))

plug-ins/script-fu/test/tests/PDB/item/item.scm

@@ -0,0 +1,218 @@
+; test item methods of PDB
+
+; Define function that is a sequence of tests.
+; Iterate over items of different types, applying test function.
+;    1. test attributes of a minimal item
+;    2. test transformations of item
+
+; Test of pika-item-is-<ItemType> are elsewhere
+
+; Test of tree/group (raise/lower, reorder) are elsewhere
+
+
+
+
+; Implementation of test:
+; function using assert must backquote ` and unquote , item.
+
+
+
+; Test methods of bare, minimal item.
+(define (test-bare-item item)
+  ; item is a numeric ID is valid
+  (assert `(pika-item-id-is-valid ,item))
+
+  ; item is not a group (can have no children)
+  (assert `(= (car (pika-item-is-group ,item))
+              0))
+
+  ; item has no color tag
+  (assert `(= (car (pika-item-get-color-tag ,item))
+              COLOR-TAG-NONE))
+
+  ; item is not expanded
+  (assert `(= (car (pika-item-get-expanded ,item))
+              0))
+
+  ; item has name, tattoo
+  ; Test does not check returned value
+  (assert `(pika-item-get-name ,item))
+  (assert `(pika-item-get-tattoo ,item))
+
+  ; item has no parasites, yields no list of string
+  ; !!! C GStrv marshaled to empty list
+  ; Scheme null? tests for empty list
+  (assert `(null? (car (pika-item-get-parasite-list ,item))))
+
+  ; item has no parent
+  ; yields -1 for NULL ID
+  (assert `(= (car (pika-item-get-parent ,item))
+              -1))
+
+  ; item has-a image
+  ; Test does not compare item ID
+  (assert `(pika-item-get-image ,item))
+
+  ; item's content, position, visibility is not locked
+  (assert `(= (car (pika-item-get-lock-content ,item))
+              0))
+  (assert `(= (car (pika-item-get-lock-position ,item))
+              0))
+  (assert `(= (car (pika-item-get-lock-visibility ,item))
+              0))
+)
+
+
+; Test methods of image,item
+(define (test-item-in-image image item)
+  ; item can produce a selection
+  (assert `(pika-image-select-item
+              ,image
+              CHANNEL-OP-ADD
+              ,item))
+)
+
+
+
+; !!! PikaParasite does not have method new in PDB.
+; But you can create one in ScriptFu as (list "name" <flags> "data")
+; <flags>
+; 0 - Not persistent and not UNDOable
+; 1 - Persistent and not UNDOable
+; 2 - Not persistent and UNDOable
+; 3 - Persistent and UNDOable
+
+; https://www.pikausers.com/forums/pika-user/12970-how-are-parasites-represented-in-script-fu
+; https://www.mail-archive.com/pika-user@lists.xcf.berkeley.edu/msg20099.html
+
+; A returned parasite in ScriptFu is-a list (list "name" <flags> "data")
+
+; You can use this in testing but requires (quote ,testParasite) ???
+;(define testParasite (list "Parasite New" 1 "Parasite Data"))
+
+(define (test-item-parasite item)
+
+  ; not has-a parasite
+  ; !!! procedure expected to fail when no parasite
+  (assert-error `(pika-item-get-parasite
+                  ,item
+                  "Test Parasite") ; name
+                "Procedure execution of pika-item-get-parasite failed")
+
+  ; can attach parasite
+  (assert `(pika-item-attach-parasite
+              ,item
+              (list "Parasite New" 1 "Parasite Data")))
+  ; attach was effective: now item has parasite
+  ; and its name is as previously given
+  (assert `(string=?
+              ; !!! Parasite is list in list, and first element is name
+              (caar (pika-item-get-parasite
+                        ,item
+                        "Parasite New")) ; name
+              "Parasite New"))
+
+  ; can detach parasite
+  (assert `(pika-item-detach-parasite
+              ,item
+              "Parasite New"))
+  ; detach was effective
+  (assert-error `(pika-item-get-parasite
+                  ,item
+                  "Test Parasite") ; name
+                "Procedure execution of pika-item-get-parasite failed")
+)
+
+
+; OLD use image,item instance extant from previous tests.
+
+;        setup
+
+; All the items in the same testImage
+; See earlier tests, where setup is lifted from
+
+(define testImage (testing:load-test-image "wilber.png"))
+(define testLayer (vector-ref (cadr (pika-image-get-layers testImage ))
+                                  0))
+(define testSelection (car (pika-image-get-selection testImage)))
+(define
+  testTextLayer
+   (car (pika-text-fontname
+              testImage
+              -1     ; drawable.  -1 means NULL means create new text layer
+              0 0   ; coords
+              "bar" ; text
+              1     ; border size
+              1     ; antialias true
+              31    ; fontsize
+              PIXELS  ; size units.  !!! See UNIT-PIXEL
+              "fontName" )))
+(define testChannel (car (pika-channel-new
+            testImage    ; image
+            23 24          ; width, height
+            "Test Channel" ; name
+            50.0           ; opacity
+            "red" )))      ; compositing color
+; must add to image
+(pika-image-insert-channel
+            testImage
+            testChannel
+            0            ; parent, moot since channel groups not supported
+            0)
+(define
+  testLayerMask
+    (car (pika-layer-create-mask
+                    testLayer
+                    ADD-MASK-WHITE)))
+; must add to layer
+(pika-layer-add-mask
+            testLayer
+            testLayerMask)
+(define testPath (car (pika-vectors-new testImage "Test Path")))
+; must add to image
+(pika-image-insert-vectors
+                  testImage
+                  testPath
+                  0 0) ; parent=0 position=0
+
+
+
+;                 tests start here
+
+; layer
+(test-bare-item testLayer)
+(test-item-in-image testImage testLayer)
+(test-item-parasite testLayer)
+
+; text layer
+(test-bare-item testTextLayer)
+(test-item-in-image testImage testTextLayer)
+(test-item-parasite testTextLayer)
+
+; layerMask
+(test-bare-item testLayerMask)
+(test-item-in-image testImage testLayerMask)
+(test-item-parasite testLayerMask)
+
+; vectors
+(test-bare-item testPath)
+(test-item-in-image testImage testPath)
+(test-item-parasite testPath)
+
+; channel
+(test-bare-item testChannel)
+(test-item-in-image testImage testChannel)
+(test-item-parasite testChannel)
+
+; selection
+(test-bare-item testSelection)
+(test-item-in-image testImage testSelection)
+(test-item-parasite testSelection)
+
+; TODO other item types e.g. ?
+
+; pika-image-get-item-position
+; pika-image-raise-item
+; pika-image-raise-item-to-top
+; lower
+; reorder

plug-ins/script-fu/test/tests/PDB/layer/layer-mask.scm

@@ -0,0 +1,110 @@
+; tests of methods re masks on layers
+
+; masks are a separate class in Pika PikaLayerMask
+; but the methods are named strangely,
+; e.g. there is no pika-layer-mask-get-layer
+
+
+;        setup
+;
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+(define
+  testLayer (car (pika-layer-new
+                    testImage
+                    21
+                    22
+                    RGB-IMAGE
+                    "LayerNew"
+                    50.0
+                    LAYER-MODE-NORMAL)))
+; assert layer is not inserted in image
+
+; assert layerMask not on the layer yet!!!
+(define
+  testLayerMask (car (pika-layer-create-mask
+                    testLayer
+                    ADD-MASK-WHITE)))
+
+
+; mask is not on layer until added.
+; Getting the mask for the layer yields -1.
+(assert `(= (car (pika-layer-mask ,testLayer))
+            -1))
+
+; add layerMask created on a layer to that layer succeeds
+(assert `(pika-layer-add-mask
+            ,testLayer
+            ,testLayerMask))
+
+; add layerMask to layer was effective:
+; Getting the mask for the layer yields layerMask ID
+(assert `(= (car (pika-layer-mask ,testLayer))
+            ,testLayerMask))
+
+; and vice versa
+(assert `(= (car (pika-layer-from-mask ,testLayerMask))
+            ,testLayer))
+
+
+
+;           creating and adding second mask
+
+; creating a second mask from layer succeeds
+(define
+  testLayerMask2
+    (car (pika-layer-create-mask
+                  testLayer
+                  ADD-MASK-WHITE)))
+
+
+; adding a second layerMask fails
+(assert-error `(pika-layer-add-mask
+                 ,testLayer
+                 ,testLayerMask2)
+              (string-append
+                "Procedure execution of pika-layer-add-mask failed: "
+                "Unable to add a layer mask since the layer already has one."))
+
+
+
+;            mask removal
+
+; remove-mask fails if the layer is not on image
+(assert-error `(pika-layer-remove-mask
+                ,testLayer
+                MASK-APPLY)   ; removal mode
+              "Procedure execution of pika-layer-remove-mask failed on invalid input arguments: ")
+              ;  "Item 'LayerNew' (12) cannot be used because it has not been added to an image"))
+
+; adding layer to image succeeds
+(assert `(pika-image-insert-layer
+            ,testImage
+            ,testLayer
+            0  ; parent
+            0  ))  ; position within parent
+
+; remove-mask succeeds
+; when layer is in image
+(assert `(pika-layer-remove-mask
+            ,testLayer
+            MASK-APPLY))  ; removal mode
+
+; and is effective
+; layer no longer has a mask
+(assert `(= (car (pika-layer-mask ,testLayer))
+            -1))
+
+; and now we can add the second mask
+(assert `(pika-layer-add-mask
+                 ,testLayer
+                 ,testLayerMask2))
+
+
+; fails when mask different size from layer?
+
+; fails create layerMask when ADD-CHANNEL-MASK and no active channel
+
+; create layerMask ADD-ALPHA-MASK works even when no alpha channel
+
+; TODO many variations of create

plug-ins/script-fu/test/tests/PDB/layer/layer-new.scm

@@ -0,0 +1,120 @@
+; test Layer methods of PDB
+
+
+;        setup
+
+
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+(define testLayer
+         (car (pika-layer-new
+                    testImage
+                    21
+                    22
+                    RGB-IMAGE
+                    "LayerNew"
+                    50.0
+                    LAYER-MODE-NORMAL)))
+
+
+
+
+; new layer is not in the image until inserted
+(assert `(= (car (pika-image-get-layers ,testImage))
+            0))
+
+
+
+;        attributes of new layer
+
+;        defaulted attributes
+
+; apply-mask default false
+(assert `(=
+            (car (pika-layer-get-apply-mask ,testLayer))
+            0))
+
+; blend-space default LAYER-COLOR-SPACE-AUTO
+(assert `(=
+            (car (pika-layer-get-blend-space ,testLayer))
+            LAYER-COLOR-SPACE-AUTO))
+
+; composite-mode default LAYER-COMPOSITE-AUTO
+(assert `(=
+            (car (pika-layer-get-composite-mode ,testLayer))
+            LAYER-COMPOSITE-AUTO))
+
+; composite-space default LAYER-COLOR-SPACE-AUTO
+(assert `(=
+            (car (pika-layer-get-composite-space ,testLayer))
+            LAYER-COLOR-SPACE-AUTO))
+
+; edit-mask default false
+(assert `(=
+            (car (pika-layer-get-edit-mask ,testLayer))
+            0))
+
+; lock-alpha default false
+; deprecated? pika-layer-get-preserve-trans
+(assert `(=
+            (car (pika-layer-get-lock-alpha ,testLayer))
+            0))
+
+; mask not exist, ID -1
+; deprecated? pika-layer-mask
+(assert `(=
+            (car (pika-layer-get-mask ,testLayer))
+            -1))
+
+; mode default LAYER-MODE-NORMAL
+(assert `(=
+            (car (pika-layer-get-mode ,testLayer))
+            LAYER-MODE-NORMAL))
+
+; show-mask default false
+(assert `(=
+            (car (pika-layer-get-show-mask ,testLayer))
+            0))
+
+; visible default true
+; FIXME doc says default false
+(assert `(=
+            (car (pika-layer-get-visible ,testLayer))
+            1))
+
+; is-floating-sel default false
+(assert `(=
+            (car (pika-layer-is-floating-sel ,testLayer))
+            0))
+
+; !!! No get-offsets
+
+
+
+
+;         attributes are as given when created
+
+; name is as given
+(assert `(string=? (car (pika-layer-get-name ,testLayer))
+                  "LayerNew"))
+
+; opacity is as given
+(assert `(=
+            (car (pika-layer-get-opacity ,testLayer))
+            50.0))
+
+
+;          generated attributes
+
+; tattoo
+; tattoo is generated unique within image?
+(assert `(=
+            (car (pika-layer-get-tattoo ,testLayer))
+            2))
+
+
+
+
+
+
+

plug-ins/script-fu/test/tests/PDB/layer/layer-ops.scm

@@ -0,0 +1,88 @@
+; test Layer methods of PDB
+; where methods are operations
+
+
+;        setup
+
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+(define
+  testLayer (car (pika-layer-new
+                    testImage
+                    21
+                    22
+                    RGB-IMAGE
+                    "LayerNew#2"
+                    50.0
+                    LAYER-MODE-NORMAL)))
+; assert layer is not inserted in image
+
+
+;               errors when layer not in image
+
+; resize fails
+(assert-error `(pika-layer-resize ,testLayer 23 24 0 0)
+              (string-append
+                "Procedure execution of pika-layer-resize failed on invalid input arguments: "))
+                ;"Item 'LayerNew#2' (10) cannot be used because it has not been added to an image"))
+
+; scale fails
+(assert-error `(pika-layer-scale ,testLayer
+                  23 24 ; width height
+                  0)    ; is local origin?
+              (string-append
+                "Procedure execution of pika-layer-scale failed on invalid input arguments: "))
+                ;"Item 'LayerNew#2' (10) cannot be used because it has not been added to an image"))
+
+; pika-layer-resize-to-image-size fails
+; TODO
+
+; pika-layer-remove-mask fails when layer has no mask
+(assert-error `(pika-layer-remove-mask
+                  ,testLayer
+                  MASK-APPLY)
+              (string-append
+                "Procedure execution of pika-layer-remove-mask failed on invalid input arguments: "))
+                ; "Item 'LayerNew#2' (10) cannot be used because it has not been added to an image"))
+
+
+
+;              alpha operations
+
+; add-alpha succeeds
+(assert `(pika-layer-add-alpha ,testLayer))
+
+; and is effective
+; Note method on superclass Drawable
+(assert `(= (car (pika-drawable-has-alpha ,testLayer))
+            1))
+
+; flatten succeeds
+(assert `(pika-layer-flatten ,testLayer))
+
+; flatten was effective: no longer has alpha
+; flatten a layer means "remove alpha"
+(assert `(= (car (pika-drawable-has-alpha ,testLayer))
+            0))
+
+
+
+
+;              delete
+
+; delete succeeds
+(assert `(pika-layer-delete ,testLayer))
+
+; delete second time fails
+(assert-error `(pika-layer-delete ,testLayer)
+              "runtime: invalid item ID")
+
+; Error for flatten:
+; "Procedure execution of pika-layer-delete failed on invalid input arguments: "
+; "Procedure 'pika-layer-delete' has been called with an invalid ID for argument 'layer'. "
+; "Most likely a plug-in is trying to work on a layer that doesn't exist any longer."))
+
+; delete layer when image already deleted fails
+; TODO
+
+

plug-ins/script-fu/test/tests/PDB/misc.scm

@@ -0,0 +1,13 @@
+
+; Miscellaneous tests of the PDB
+; These are not associated with an object class
+
+
+; 0 is an invalid item id
+; FUTURE pika returns #f instead of 0
+; FUTURE pika doesn't wrap in extra list
+(assert '(= (car (pika-item-id-is-vectors 0)) 0))
+
+; -1 is an invalid item id
+; FUTURE: '(not (pika-item-id-is-valid -1))
+(assert '(= (car (pika-item-id-is-valid -1)) 0))

plug-ins/script-fu/test/tests/PDB/pdb.scm

@@ -0,0 +1,83 @@
+; Complete test of PDB
+
+; to run in SF Console:
+; (testing:load-test "pdb.scm")
+; Expect a report of passed and failed
+
+; This knows the set of files which are tests.
+; The test files might be organized in directories in the repo,
+; but all flattened into the /tests directory when installed.
+
+; images
+(testing:load-test "image-new.scm")
+(testing:load-test "image-precision.scm")
+(testing:load-test "image-indexed.scm")
+(testing:load-test "image-grayscale.scm")
+(testing:load-test "image-ops.scm")
+(testing:load-test "image-layers.scm")
+
+(testing:load-test "layer-new.scm")
+(testing:load-test "layer-ops.scm")
+(testing:load-test "layer-mask.scm")
+; TODO layer stack ops
+
+; Commented out until PDB is fixed
+; Known to crash PIKA
+;(testing:load-test "text-layer-new.scm")
+
+(testing:load-test "vectors-new.scm")
+(testing:load-test "channel-new.scm")
+; TODO channel-ops.scm
+
+(testing:load-test "selection.scm")
+(testing:load-test "selection-from.scm")
+
+; Test superclass methods.
+; Drawable and Item are superclasses
+; Testing Drawable and Item uses extant instances;
+; must be after instances of subclasses are created.
+; commented out until text-get-fontname is fixed
+; Known to crash PIKA
+;(testing:load-test "item.scm")
+; todo item ordering operations
+
+; TODO drawable
+
+; context
+(testing:load-test "context-get-set.scm")
+
+; Temporarily commented out until pikagpparam-body.c is fixed for PikaParamResource
+; If you uncomment it, see warnings in stderr
+;(testing:load-test "context-resource.scm")
+
+(testing:load-test "resource.scm")
+(testing:load-test "brush.scm")
+(testing:load-test "palette.scm")
+; TODO other resources gradient, etc
+(testing:load-test "resource-ops.scm")
+
+(testing:load-test "buffer.scm")
+
+; TODO edit ops
+; TODO undo
+; TODO progress
+
+; tested in bind-args.scm:
+;   unit
+;   parasite
+
+; pdb the object
+; pika the class, pika-get, pika-parasite
+
+
+(testing:load-test "misc.scm")
+(testing:load-test "enums.scm")
+(testing:load-test "refresh.scm")
+(testing:load-test "bind-args.scm")
+
+; report the result
+(testing:report)
+
+; yield the session overall result
+(testing:all-passed?)
+

plug-ins/script-fu/test/tests/PDB/refresh.scm

@@ -0,0 +1,69 @@
+; test refresh methods
+
+; make the app read resources from configuration files
+
+; methods of the app
+; the app manages collections of resources
+; app can refresh and list the resources.
+
+; A collection is named by the plural of the singular element,
+; i.e. brushes is a collection of brush.
+
+
+
+
+; Deprecations:
+; pika-palette-refresh
+; pika-brushes-list => pika-brushes-get-list etc.
+; pika-parasite-list => pika-get-parasite-list
+
+
+;                      refresh
+
+; always succeeds
+; FIXME but wraps result in list (#t)
+(assert `(car (pika-brushes-refresh)))
+(assert `(car (pika-dynamics-refresh)))
+(assert `(car (pika-fonts-refresh)))
+(assert `(car (pika-gradients-refresh)))
+(assert `(car (pika-palettes-refresh)))
+(assert `(car (pika-patterns-refresh)))
+
+
+;                      list
+
+; always succeeds
+; take an optional regex string
+(assert `(list? (car (pika-brushes-get-list ""))))
+(assert `(list? (car (pika-dynamics-get-list ""))))
+(assert `(list? (car (pika-fonts-get-list ""))))
+(assert `(list? (car (pika-gradients-get-list ""))))
+(assert `(list? (car (pika-palettes-get-list ""))))
+(assert `(list? (car (pika-patterns-get-list ""))))
+
+
+;            listing app's collection of things not resources
+; But taking a regex
+
+(assert `(list? (car (pika-buffers-get-list ""))))
+
+
+;           listing app's other collections not resources
+; Not taking a regex
+
+; FIXME the naming does not follow the pattern, should be plural parasites
+; Not: (pika-parasites-get-list "")
+(assert `(list? (car (pika-get-parasite-list))))
+
+; the app, images, vectors, drawables, items
+; can all have parasites.
+; Tested elsewhere.
+
+
+; pika-get-images does not follow the pattern:
+; it doesn't take a regex
+; and it returns a vector of image objects (0 #())
+(assert `(vector? (cadr (pika-get-images))))
+
+
+

plug-ins/script-fu/test/tests/PDB/resource/brush.scm

@@ -0,0 +1,151 @@
+; Test methods of Brush subclass of Resource class
+
+; !!! See also resource.scm
+
+; !!! Testing depends on a fresh install of PIKA.
+; A prior testing failure may leave brushes in PIKA.
+; The existing brush may have the same name as hard coded in tests.
+; In future, will be possible to create new brush with same name as existing?
+
+
+;      new
+
+
+; new succeeds
+; setup, not an assert
+(define testNewBrush (car (pika-brush-new "TestBrushNew")))
+
+; a resource is an int ID  in ScriptFu
+(assert `(number? ,testNewBrush))
+
+; new returns brush of given name
+; note call superclass method
+(assert `(string=?
+            (car (pika-resource-get-name ,testNewBrush))
+            "TestBrushNew"))
+
+
+
+;               attributes of new brush
+
+; new brush is kind generated versus raster
+(assert `(= (car (pika-brush-is-generated ,testNewBrush))
+            1))
+
+; angle     default is 0
+(assert `(=
+            (car (pika-brush-get-angle ,testNewBrush))
+            0))
+
+; aspect-ratio   default  is 1.0
+; FIXME: the doc says 0.0
+(assert `(=
+            (car (pika-brush-get-aspect-ratio ,testNewBrush))
+            1.0))
+
+; hardness   default is 0.5
+; FIXME: the doc says 0
+(assert `(=
+            (car (pika-brush-get-hardness ,testNewBrush))
+            0.5))
+
+; shape default is GENERATED-CIRCLE
+(assert `(=
+            (car (pika-brush-get-shape ,testNewBrush))
+            BRUSH-GENERATED-CIRCLE))
+
+; spikes default is 2
+; FIXME: docs says 0
+(assert `(=
+            (car (pika-brush-get-spikes ,testNewBrush))
+            2))
+
+; get-radius    default 5.0
+; FIXME: docs says 0
+(assert `(=
+            (car (pika-brush-get-radius ,testNewBrush))
+            5.0))
+
+
+; spacing default 20
+; FIXME: docs says 0
+(assert `(=
+            (car (pika-brush-get-spacing ,testNewBrush))
+            20))
+
+; get-info returns a list of attributes
+; For generated, color bytes is zero
+(assert `(equal? (pika-brush-get-info ,testNewBrush)
+                `(11 11 1 0)))
+
+; get-pixels returns a list of attributes
+; It is is long so we don't compare.
+; This test is just that it doesn't crash or return #f.
+(assert `(pika-brush-get-pixels ,testNewBrush))
+
+
+
+;              delete
+
+; can delete a new brush
+; PDB returns void, ScriptFu returns wrapped truth i.e. (#t)
+(assert `(car (pika-resource-delete ,testNewBrush)))
+
+; delete was effective
+; ID is now invalid
+(assert `(= (car (pika-resource-id-is-valid ,testNewBrush))
+            0))
+
+
+
+;       Kind non-generated brush
+
+; Brush named "z Pepper" is non-generated and is a system brush always installed
+
+; setup, not an assert
+(define testNongenBrush (car (pika-resource-get-by-name "PikaBrush" "z Pepper")))
+
+; brush says itself is not generated
+
+
+
+;       Certain attributes of non-generated brush yield errors
+; angle, aspect-ratio, hardness, shape, spikes, radius
+
+
+; angle is not an attribute of non-generated brush
+(assert-error
+  `(pika-brush-get-angle ,testNongenBrush)
+  "Procedure execution of pika-brush-get-angle failed")
+
+; TODO all the other attributes
+
+
+;        Non-generated brush attributes
+
+; is not generated
+(assert `(=
+            (car (pika-brush-is-generated ,testNongenBrush))
+            0))
+
+; spacing
+(assert `(=
+            (car (pika-brush-get-spacing ,testNongenBrush))
+            100))
+
+; pixels returns a list of attributes
+; FAIL: CRASH Inconsistency detected by ld.so: dl-runtime.c: 63: _dl_fixup: Assertion `ELFW(R_TYPE)(reloc->r_info) == ELF_MACHINE_JMP_SLOT' failed!
+; Known to fail because TS allocation of 120k byte contiguous cells for vector fails.
+; (assert `(pika-brush-get-pixels ,testNongenBrush))
+
+; get-info returns a list of attributes
+(assert `(equal? (pika-brush-get-info ,testNongenBrush)
+                `(180 220 1 3)))
+
+
+
+;                miscellaneous
+
+; pika-brush-get-by-name returns error, when brush of that name not exists
+(assert-error '(pika-brush-get-by-name "foo")
+              "Procedure execution of pika-brush-get-by-name failed on invalid input arguments: Brush 'foo' not found")

plug-ins/script-fu/test/tests/PDB/resource/palette.scm

@@ -0,0 +1,201 @@
+; Test methods of palette subclass of Resource class
+
+; !!! See also resource.scm
+
+; !!! Testing depends on a fresh install of PIKA.
+; A prior testing failure may leave palettees in PIKA.
+; The existing palette may have the same name as hard coded in tests.
+; In future, will be possible to create new palette with same name as existing.
+
+
+
+
+; setup, not assert
+; but tests the -new method
+(define testNewPalette (car (pika-palette-new "testNewPalette")))
+
+
+
+
+
+
+
+
+;                 attributes of new palette
+
+
+; pika-palette-get-background deprecated => pika-context-get-background
+; ditto foreground
+
+; new palette has given name
+; !!! Fails if not a fresh install, then name is like "testNewPalette #2"
+(assert `(string=?
+            (car (pika-resource-get-name ,testNewPalette))
+            "testNewPalette"))
+
+; new palette has zero colors
+(assert `(= (car (pika-palette-get-color-count ,testNewPalette))
+            0))
+
+; new palette has empty colormap
+; (0 #())
+(assert `(= (car (pika-palette-get-colors ,testNewPalette))
+            0))
+
+; new palette has zero columns
+; (0 #())
+(assert `(= (car (pika-palette-get-columns ,testNewPalette))
+            0))
+
+; new palette is-editable
+; method on Resource class
+(assert `(= (car (pika-resource-is-editable ,testNewPalette))
+            1))
+
+; can set new palette in context
+; Despite having empty colormap
+(assert `(pika-context-set-palette ,testNewPalette))
+
+
+
+;             attributes of existing palette
+
+; setup
+(define testBearsPalette (car (pika-palette-get-by-name "Bears")))
+
+
+; Max size palette is 256
+
+; Bears palette has 256 colors
+(assert `(= (car (pika-palette-get-color-count ,testBearsPalette))
+            256))
+
+; Bears palette colormap is size 256
+; (256)
+(assert `(= (car (pika-palette-get-color-count ,testBearsPalette))
+            256))
+
+; Bears palette colormap array is size 256 vector of 3-tuple lists
+; (256 #((8 8 8) ... ))
+(assert `(= (vector-length (cadr (pika-palette-get-colors ,testBearsPalette)))
+            256))
+
+; Bears palette has zero columns
+; (0 #())
+(assert `(= (car (pika-palette-get-columns ,testBearsPalette))
+            0))
+
+; system palette is not editable
+(assert `(= (car (pika-resource-is-editable ,testBearsPalette))
+            0))
+
+
+
+;              setting attributes of existing palette
+
+; Can not change column count on system palette
+(assert-error `(pika-palette-set-columns ,testBearsPalette 1)
+              "Procedure execution of pika-palette-set-columns failed")
+
+
+;              add entry to full system palette
+
+; error to add entry to palette which is non-editable and has full colormap
+(assert-error `(pika-palette-add-entry ,testBearsPalette "fooEntryName" "red")
+                "Procedure execution of pika-palette-add-entry failed ")
+
+
+
+ ;             setting attributes of new palette
+
+; succeeds
+(assert `(pika-palette-set-columns ,testNewPalette 1))
+
+; effective
+(assert `(= (car (pika-palette-get-columns ,testNewPalette))
+            1))
+
+
+;               adding color "entry" to new palette
+
+; add first entry returns index 0
+; result is wrapped (0)
+(assert `(= (car (pika-palette-add-entry ,testNewPalette "fooEntryName" "red"))
+            0))
+
+; was effective on color
+; FIXME returns ((0 0 0)) which is not "red"
+(assert `(equal? (car (pika-palette-entry-get-color ,testNewPalette 0))
+                  (list 0 0 0)))
+
+; was effective on name
+(assert `(equal? (car (pika-palette-entry-get-name ,testNewPalette 0))
+                  "fooEntryName"))
+
+
+
+;                delete colormap entry
+
+; succeeds
+; FIXME: the name seems backward, could be entry-delete
+(assert `(pika-palette-delete-entry  ,testNewPalette 0))
+; effective, color count is back to 0
+(assert `(= (car (pika-palette-get-color-count ,testNewPalette))
+            0))
+
+
+;               adding color "entry" to new palette which is full
+
+
+; TODO locked palette?  See issue about locking palette?
+
+
+
+
+
+;            delete palette
+
+; can delete a new palette
+(assert `(pika-resource-delete ,testNewPalette))
+
+; delete was effective
+; ID is now invalid
+(assert `(= (car(pika-resource-id-is-palette ,testNewPalette))
+            0))
+
+; delete was effective
+; not findable by name anymore
+; If the name DOES exist (because not started fresh) yields "substring out of bounds"
+(assert-error `(pika-palette-get-by-name "testNewPalette")
+              "Procedure execution of pika-palette-get-by-name failed on invalid input arguments: Palette 'testNewPalette' not found")
+
+
+
+
+; see context.scm
+
+
+
+
+;                   test deprecated methods
+
+; These should give warnings in Pika Error Console.
+; Now they are methods on Context, not Palette.
+
+(pika-palettes-set-palette testBearsPalette)
+
+(pika-palette-swap-colors)
+(pika-palette-set-foreground "pink")
+(pika-palette-set-background "purple")
+
+
+
+
+
+
+
+
+
+
+
+

plug-ins/script-fu/test/tests/PDB/resource/readme.md

@@ -0,0 +1 @@
+See also a plugin in scripts/test/resource-class/

plug-ins/script-fu/test/tests/PDB/resource/resource-ops.scm

@@ -0,0 +1,8 @@
+; test operations on resource pool
+
+; TODO
+
+; pika-resource-rename
+; pika-resource-duplicate
+; pika-resource-delete
+; pika-resource-rename

plug-ins/script-fu/test/tests/PDB/resource/resource.scm

@@ -0,0 +1,12 @@
+; Test methods of Resource class
+
+; This is currently empty of tests
+
+; See brush.scm, palette.scm etc. for test of subclasses of Resource
+
+; See resource-ops.scm for tests of:
+;pika-resource-delete  -duplicate  -rename
+
+; See context/context-resource.scm
+; for tests of generic methods
+; e.g. pika-resource-get-name   -id-is-valid  -is-editable

plug-ins/script-fu/test/tests/PDB/selection/selection-from.scm

@@ -0,0 +1,107 @@
+; test PDB methods that change selection from existing selection
+
+
+; setup
+; Reusing image 10
+(define testImage 10)
+
+
+; Test a selection-changing function
+; starting from selection None.
+;
+; The testFunction takes a "step" arg
+; and does not change the selection bounds.
+
+; {none <func> is-empty} yields true
+; {none <func>} is not an error
+
+(define (test-selection-change-from-none testFunction testImage)
+  ; Starting state: selection none
+  (assert `(pika-selection-none ,testImage))
+  ; test the testFunction
+  (assert `(,testFunction
+            ,testImage
+            4 )) ; radius or step
+  ; expect selection is still empty
+  (assert `(= (car (pika-selection-is-empty ,testImage))
+            1))
+  ; expect since there is no selection, the bounds are the entire image
+  (assert `(equal? (cdr (pika-selection-bounds ,testImage))
+                  '(0 0 21 22)))
+)
+
+(define (test-selection-change-from-all testFunction testImage isIdempotent)
+  ; Starting state: selection all
+  (assert `(pika-selection-all ,testImage))
+  ; test the testFunction
+  (assert `(,testFunction
+            ,testImage
+            4 )) ; radius or step
+
+  (if isIdempotent
+    (begin
+      ; expect selection is still not empty
+      (assert `(= (car (pika-selection-is-empty ,testImage))
+                  0))
+      ; expect selection bounds are still entire image
+      (assert `(equal? (cdr (pika-selection-bounds ,testImage))
+                        '(0 0 21 22)))))
+)
+
+
+
+
+
+; test selection methods that change by a pixel amount
+(test-selection-change-from-none pika-selection-feather testImage)
+(test-selection-change-from-none pika-selection-grow    testImage)
+(test-selection-change-from-none pika-selection-shrink  testImage)
+(test-selection-change-from-none pika-selection-border  testImage)
+
+; feather and grow from all are idempotent
+(test-selection-change-from-all pika-selection-feather testImage #t)
+(test-selection-change-from-all pika-selection-grow    testImage #t)
+
+(test-selection-change-from-all pika-selection-shrink  testImage #f)
+; shrink from all changes bounds
+(assert `(equal? (cdr (pika-selection-bounds ,testImage))
+                 '(4 4 17 18)))
+(test-selection-change-from-all pika-selection-border  testImage #f)
+; border from all empties the selection
+(assert `(= (car (pika-selection-is-empty ,testImage))
+                  1))
+
+
+
+
+;                 Effectiveness
+; When starting from a typical selection (not empty, not all)
+
+; TODO feather effective?
+; Might feather change bounds?
+
+; grow is effective
+; bounds are larger
+; TODO
+(assert `(equal? (cdr (pika-selection-bounds ,testImage))
+                 '(0 0 21 22)))
+
+; TODO test flood effective: holes were filled
+; Can't do it without knowing how many pixels are selected?
+; Knowing bounds is not adequate.
+
+; Simple tests of success
+(assert `(pika-selection-flood ,testImage))
+(assert `(pika-selection-invert ,testImage))
+(assert `(pika-selection-sharpen ,testImage))
+(assert `(pika-selection-translate
+            ,testImage
+            4 4))
+
+; TODO invert none is all and vice versa
+
+; TODO translate effective
+; TODO translate by large offset is empty selection
+; TODO sharpen is effective at removing antialiasing
+
+; save creates a new channel

plug-ins/script-fu/test/tests/PDB/selection/selection.scm

@@ -0,0 +1,111 @@
+; Test methods of selection class of the PDB
+
+
+
+;             setup
+
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+
+; get-selection yields an ID.
+; Image always yields a selection object.
+; It is a singleton.
+(define testSelection (car (pika-image-get-selection testImage)))
+
+
+
+
+; The returned ID is-a Selection
+(assert `(= (car (pika-item-id-is-selection ,testSelection))
+            1))
+
+; !!! Note there is little use for a Selection instance.
+; There are no methods on the class per se i.e. taking the instance ID.
+; Except for methods on the superclass Item of subclass Selection.
+;
+; Instead the methods seem to be on an image.
+; Its not clear whether changing the selection in an image
+; also changes the singleton Selection instance,
+; and there is no way of knowing, since the Selection instance
+; has no methods.
+
+; selection on new image is empty
+; !!! Requre no prior test on this image selected
+; !!! Arg is the image, not the selection object instance.
+(assert `(= (car (pika-selection-is-empty ,testImage))
+            1))
+
+; selection bounds yields (1 0 0 21 22)
+; First element of tuple is 0 (false)
+; indicates user or program has not made selection
+(assert `(= (car (pika-selection-bounds ,testImage))
+            0))
+; selection bounds equal bounds of image
+(assert `(equal? (cdr (pika-selection-bounds ,testImage))
+                 '(0 0 21 22)))
+
+
+
+
+
+;            select all and none
+
+; select all succeeds
+(assert `(pika-selection-all ,testImage))
+; !!! A selection operation does not create a new selection object
+; i.e. ID is the same.
+; get-selection yields same singleton on image
+(assert `(= (car (pika-image-get-selection ,testImage))
+            ,testSelection))
+; after select all, selection bound indicates selection created
+(assert `(= (car (pika-selection-bounds ,testImage))
+            1))
+; and now is-empty is false
+(assert `(= (car (pika-selection-is-empty ,testImage))
+            0))
+
+
+; clear and none are the synonyms
+
+; clear does not invalidate a prior selection object
+; i.e. get-selection returns same ID
+
+; clear makes selection bounds equal entire image
+; TODO
+
+; select none succeeds
+(assert `(pika-selection-none ,testImage))
+; effective: is-empty is true
+(assert `(= (car (pika-selection-is-empty ,testImage))
+            1))
+; same singleton on image exists
+(assert `(= (car (pika-image-get-selection ,testImage))
+            ,testSelection))
+
+
+;                misc selection operations
+
+; pika-selection-value
+
+
+;              change selection to totally new selection
+; Not a function of existing selection, by color or shape.
+
+;pika-image-select-color
+;  ,testImage
+ ; CHANNEL-OP-ADD
+;  drawable
+;  "red")
+
+; pika-image-select-contiguous-color
+; ellipse
+; polygon
+; rectangle
+; round-rectangle
+
+
+
+
+; pika-selection-float is tested elsewhere
+; It is not an op on the selection, but an op on the image that uses the selection.
+; See pika-image-floating-selection

plug-ins/script-fu/test/tests/PDB/text-layer/text-layer-new.scm

@@ -0,0 +1,150 @@
+; tests of TextLayer class
+
+; !!! Some methods tested here are named strangely:
+; text-fontname returns a new TextLayer
+
+
+
+
+;                  setup
+
+; Require image has no layer
+(define testImage (car (pika-image-new 21 22 RGB)))
+
+; setup (not an assert )
+(define
+    testTextLayer
+       (car (pika-text-layer-new
+              testImage
+              "textOfTestTextLayer" ; text
+              "fontName" ; fontname
+              30 ; fontsize
+              UNIT-PIXEL)))
+
+
+; !!!! fontName is not valid
+; The text displays anyway, using some font family, without error.
+; The docs don't seem to say which font family is used.
+; TODO better documentation
+; The text layer still says it is using the given font family.
+; TODO yield actual font family used.
+
+; !!! UNIT-PIXEL PikaUnitsType is distinct from PIXELS PikaSizeType
+
+
+; TODO test UNIT-POINT
+
+
+; is-a TextLayer
+(assert `(= (car (pika-item-id-is-text-layer ,testTextLayer))
+            1))
+
+; text layer is not in image yet
+(assert `(= (car (pika-image-get-layers ,testImage))
+            0))
+
+; adding layer to image succeeds
+(assert `(pika-image-insert-layer
+            ,testImage
+            ,testTextLayer ; layer
+            0  ; parent
+            0  ))  ; position within parent
+
+
+
+
+;             attributes
+
+; antialias default true
+; FIXME doc says false
+(assert `(= (car (pika-text-layer-get-antialias ,testTextLayer))
+            1))
+
+; base-direction default TEXT-DIRECTION-LTR
+(assert `(= (car (pika-text-layer-get-base-direction ,testTextLayer))
+            TEXT-DIRECTION-LTR))
+
+; language default "C"
+(assert `(string=? (car (pika-text-layer-get-language ,testTextLayer))
+                    "C"))
+
+; TODO other attributes
+
+; TODO setters effective
+
+;            attributes as given
+
+; text
+(assert `(string=? (car (pika-text-layer-get-text ,testTextLayer))
+                        "textOfTestTextLayer"))
+; font
+(assert `(string=? (car (pika-text-layer-get-font ,testTextLayer))
+                        "fontName"))
+; font-size
+(assert `(= (car (pika-text-layer-get-font-size ,testTextLayer))
+            30))
+
+; is no method to get fontSize unit
+
+
+;              misc ops
+
+; vectors from text succeeds
+(assert `(pika-vectors-new-from-text-layer
+              ,testImage
+              ,testTextLayer))
+; not capturing returned ID of vectors
+
+
+
+
+;                  misc method
+
+; pika-text-get-extents-fontname
+; Yields extent of rendered text, independent of image or layer.
+; Extent is (width, height, ascent, descent) in unstated units, pixels?
+; Does not affect image.
+(assert `(= (car (pika-text-get-extents-fontname
+              "zed" ; text
+              32    ; fontsize
+              POINTS  ; size units.  !!! See UNIT-PIXEL
+              "fontName" )) ; fontname
+            57))
+; usual result is (57 38 30 -8)
+
+
+
+;           alternate method for creating text layer
+
+
+; pika-text-fontname creates text layer AND inserts it into image
+; setup, not assert
+(define
+  testTextLayer2
+   (car (pika-text-fontname
+              testImage
+              -1     ; drawable.  -1 means NULL means create new text layer
+              0 0   ; coords
+              "bar" ; text
+              1     ; border size
+              1     ; antialias true
+              31    ; fontsize
+              PIXELS  ; size units.  !!! See UNIT-PIXEL
+              "fontName" )))
+
+
+; error to insert layer created by pika-text-fontname
+; TODO make the error message matching by prefix only
+(assert-error `(pika-image-insert-layer
+                  ,testImage
+                  ,testTextLayer2
+                  0  ; parent
+                  0  )  ; position within parent
+              "Procedure execution of pika-image-insert-layer failed on invalid input arguments: ")
+              ;  "Item 'bar' (17) has already been added to an image"
+
+
+
+; for debugging: display
+(assert `(= (car (pika-display-new ,testImage))
+            1))

plug-ins/script-fu/test/tests/PDB/vectors-new.scm

@@ -0,0 +1,86 @@
+
+; Test methods of vector class of the PDB
+
+; aka Path.  Image has set of Paths.  Path has strokes.
+
+
+;            setup
+
+(define testImage (car (pika-image-new 21 22 RGB)))
+(pika-message "testImage is:" (number->string testImage))
+
+
+
+
+
+;      ID methods
+
+; ensure ID 0 and negative are not vectors
+; FIXME #f/#t
+(assert '(= (car (pika-item-id-is-vectors 0))
+            0))  ; FUTURE #f
+
+; Test valid ID is tested drive-by
+
+
+
+;         image get/set vectors methods
+; This sequence of tests requires image 6 has no vectors yet
+
+; ensure get-vectors from image having no vectors yields zero vectors
+; FUTURE: returns just #(), not (0 #())
+(assert `(= (car (pika-image-get-vectors ,testImage))
+            0))
+
+
+; setup, not an assert
+; vectors-new succeeds
+(define testPath (car (pika-vectors-new
+                        testImage
+                        "Test Path")))
+
+
+; !!! id is valid even though vectors is not inserted in image
+(assert `(= (car (pika-item-id-is-vectors ,testPath))
+            1))  ; #t
+
+; new path name is as given
+(assert `(string=?
+            (car (pika-item-get-name ,testPath))
+            "Test Path"))
+
+; new vectors is not in image yet
+; image still has count of vectors == 0
+(assert `(= (car (pika-image-get-vectors ,testImage))
+            0))
+
+; new path has no strokes
+; path has stroke count == 0
+(assert `(= (car (pika-vectors-get-strokes ,testPath))
+            0))
+
+
+; insert vector in image yields (#t)
+(assert  `(car (pika-image-insert-vectors
+                  ,testImage
+                  ,testPath
+                  0 0))) ; parent=0 position=0
+
+; image with inserted vectors now has count of vectors == 1
+(assert `(= (car (pika-image-get-vectors ,testImage))
+            1))
+
+; FIXME: crashes in pikavectors-export.c line 234
+; possibly because path has no strokes?
+; export to string succeeds
+;(assert `(pika-vectors-export-to-string
+;            ,testImage
+;            ,testPath))
+
+; export-to-string all
+; FAIL: crashes
+; PDB doc says 0 should work, and ScriptFu is marshalling to a null PikaVectors*
+; so the PDB function in C is at fault?
+;(assert `(pika-vectors-export-to-string
+;            ,testImage
+;            0))