Initial checkin of Pika from heckimp

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