\version "2.24.0"
%-----------------------------------------------------------------
% Pippo è un oggetto post evento che, una volta chiamato (\pippo), stampa la stringa "pippo" di un proprio colore
% (rosso di default) e rende la testa della nota relativa dello stesso colore.
% Di seguito:
% - le dichiarazioni delle funzioni di base per definire un grob e un evento (grazie a Jean Abou Samra!);
% - definizione di una nuova interfaccia, un nuovo stencil, un nuovo grob (con relativa dichiarazione #all-grob-descriptions);
% - definizione della classe di eventi, dell'evento stesso, di una funzione di creazione e di un comando Lilypond;
% - definizione dell'engraver, con relativo inserimento nel contesto Voice.
% Infine un esempio.
% [le intestazioni delle varie sezioni sono in italiano]
% Questo script è a puro scopo di studio e chiaramente non serve a nulla!
% Può essere uno spunto per costruire degli oggetti personalizzati ed estendere le funzionalità di Lilypond
%-----------------------------------------------------------------
% Pippo (Foo) is a post-event object which, once called (\pippo), prints the string "pippo" in its own color (red by default)
% and makes the relative note head of the same color.
% Right away:
% - the basic function declarations to define a grob and an event (thanks to Jean Abou Samra!);
% - definition of a new interface, a new stencil, a new grob (with relative declaration #all-grob-descriptions);
% - definition of the event class, the event itself, a create function and a Lilypond command;
% - definition of the engraver, with relative insertion in the Voice context.
% Finally an example.
% [the headings of the various sections are in Italian]
% This script is for study purposes only and is clearly useless!
% It can be a starting point for building custom objects and extending the functionality of Lilypond
%-----------------------------------------------------------------
%--------------FUNZIONI DI BASE-----------------------------------

#(define (define-grob! grob-name grob-entry)
   (set! all-grob-descriptions
         (cons ((@@ (lily) completize-grob-entry)
                (cons grob-name grob-entry))
           all-grob-descriptions)))

#(define (define-event! type properties)
   (set-object-property! type
     'music-description
     (cdr (assq 'description properties)))
   (set! properties (assoc-set! properties 'name type))
   (set! properties (assq-remove! properties 'description))
   (hashq-set! music-name-to-property-table type properties)
   (set! music-descriptions
         (sort (cons (cons type properties)
                 music-descriptions)
           alist<?)))

%--------------DEFINIZIONE DEL GROB--------------------------------

#(ly:add-interface
  'pippo-interface
  "Just a markup with pippo"
  '()
  )

#(define (pippo-stencil grob) (grob-interpret-markup grob (ly:grob-property grob 'text)))

#(define-grob!
  'PippoText
  `(
     (stencil . ,pippo-stencil)
     (X-extent . ,empty-interval)
     (Y-extent . ,empty-interval)
     ;(parent-alignment-X . 1)		;NOT WORKING
     ;(self-alignment-X . #f)		;NOT WORKING
     ;(padding . 0)			;NOT WORKING
     (text . "pippo")
     (color . ,red)
     (layer . 0)
     (font-size . 0)
     (font-series . bold)
     (transparent . #f)
     (outside-staff-priority . 100)
     (direction . ,UP)
     (meta . (
               (class . Item)
               (interfaces . (
                               pippo-interface
                               text-interface
                               text-script-interface
                               font-interface
                               self-alignment-interface
                               item-interface
                               grob-interface
                               )
                 )
               )
       )
     )
  )

\layout {
  \context {
    \Global
    \grobdescriptions #all-grob-descriptions
  }
}

%--------------DEFINIZIONE E CREAZIONE DEL NUOVO EVENTO------------
%------------------------------------------------------------------

#(define-event-class 'pippo-event 'music-event)

#(define-event!
  'PippoEvent
  '(
     (description . "Used to trigger pippo")
     (types . (post-event pippo-event event))
     )
  )

#(define (make-pippo-script)
   (make-music 'PippoEvent 'direction UP 'padding 100))

pippo = #(make-pippo-script)

%--------------DEFINIZIONE DELL'ENGRAVER---------------------------

#(define (Pippo_engraver context)
   (let
    (
      (pippo-event #f)
      (note-heads '())
      (glob-col '())
      )
    (make-engraver
     (listeners
      (
        (pippo-event engraver event)
        (set! pippo-event event)
        )
       )
     (
       (process-music engraver)
       (if pippo-event
           (let*
            (
              (grob (ly:engraver-make-grob engraver 'PippoText pippo-event))
              (t (ly:grob-property grob 'text))
              (stil (grob-interpret-markup grob t))
              (x-extent (ly:stencil-extent stil X))
              (y-extent (ly:stencil-extent stil Y))
              (y-offset (ly:grob-property grob 'Y-offset))
              (dir (ly:event-property pippo-event 'direction))
              (PCgrob (ly:context-property context 'currentMusicalColumn))
              )
            (set! glob-col (ly:grob-property grob 'color))
            (ly:grob-set-property! grob 'X-extent x-extent)
            (ly:grob-set-property! grob 'Y-extent y-extent)
            (ly:grob-set-property! grob 'direction (if dir dir UP))
            grob
            )
           )
       )
     (acknowledgers
      (
        (note-head-interface engraver grob source-engraver)
        (set! note-heads (cons grob note-heads))
        )
      )
     (
       (process-acknowledged engraver)
       (for-each
        (lambda (note-head)
          (if (and note-head pippo-event)
              (begin
               ;---
               (ly:grob-set-property! note-head 'color glob-col)
               )
              )
          )
        note-heads)
       (set! note-heads '())
       )
     (
       (stop-translation-timestep engraver)
       (set! pippo-event #f)
       (set! glob-col '())
       )
     )
    )
   )

\layout {
  \context {
    \Voice
    \consists #Pippo_engraver
  }
}

%----------------------------------------------------------------------------

\relative {
  \once \override PippoText.font-size = 3
  %\once \override PippoText.padding = 10  %NOT WORKING
  a8_\pippo b4 e8 f2 r
  \once \override PippoText.direction = #DOWN
  \once \override PippoText.color = #blue
  \once \override PippoText.whiteout = ##t
  \once \override PippoText.layer = 2
  \once \override PippoText.extra-offset = #'(0 . -2)
  <g, d' a'>8\pippo a r e' g2
  \once \override PippoText.parenthesized = ##t
  \once \override PippoText.show-vertical-skylines = ##t
  \once \override PippoText.show-horizontal-skylines = ##t
  a2_\pippo
}