Initial checkin of Pika from heckimp

plug-ins/script-fu/scripts/test/resource-class/resource-class.scm

@@ -0,0 +1,161 @@
+#!/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")