#!/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")
