1:- module(clippy, [clippy//1]).    2
    3
    4:- use_module(library(http/html_write)).    5:- use_module(library(http/html_head)).    6:- use_module(library(http/js_write)).    7:- use_module(library(quasi_quotations)).    8
    9:- meta_predicate clippy(1, ?, ?).   10
   11%!	clippy(+Generator:goal)// is nondet
   12%
   13%	Makes clippy appear on screen.
   14%
   15%	generator is an arity 1 goal queried with
   16%	an argument of form
   17%
   18%	* character(Char)   Character is one of Clippy, Merlin,
   19%	  Rover, or Links  (default clippy)
   20%
   21%       * id(ID) ID is the ID of the agent (default agent1236742)
   22%
   23%	this just brings the character up. You have to control them
   24%	yourself.
   25%
   26% @see Using `clippy-js` from https://www.smore.com/clippy-js
   27
   28clippy(Generator) -->
   29	{
   30             (	  call(Generator, character(Char)) ; Char = 'Clippy' ),
   31% @tbd The identifier cannot really be set.
   32%	     (	  call(Generator, id(ID)) ; ID = agent1236742),
   33	     member(Char , ['Clippy', 'Merlin', 'Rover', 'Links'])
   34        },
   35	html([
   36	    \html_requires(clippy),
   37	    \js_script({| javascript(Char)