;;; Sly
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;;
;;; Sly is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Sly is distributed in the hope that it will be useful, but WITHOUT
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;;; License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Purely functional game object scripting.
;;
;; Inspired by https://github.com/brandonbloom/bulletcombinators/
;;
;;; Code:

(define-module (sly actor)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:export (make-actor
            actor?
            actor-ref
            actor-action
            update-actor
            actor-filter-update
            call-with-actor

            action-lift
            action-effect-lift
            idle
            both
            then
            forever
            repeat
            wait
            ifa
            whena
            sequence
            together))


;;;
;;; Actors
;;;

(define-record-type <actor>
  (make-actor object action)
  actor?
  (object actor-ref)
  (action actor-action))

(define (update-actor world effects actor)
  "Apply the action for ACTOR with the given WORLD, the game world
object, and EFFECTS, the effects list."
  (match actor
    (($ <actor> _ #f)
     (values effects actor))
    (($ <actor> object action)
     (let-values (((new-action new-effects new-object)
                   (action world effects object)))
       (values new-effects (make-actor new-object new-action))))))

(define (actor-filter-update predicate world actors)
  "Update each actor in the list ACTORS with respect to WORLD and
return a new list of actors whose objects satisfy PREDICATE."
  (let loop ((actors actors)
             (effects '())
             (results '()))
    (match actors
      (() (values (reverse effects)
                  (reverse results)))
      ((actor . rest)
       (let-values (((effects actor) (update-actor world effects actor)))
         (if (predicate (actor-ref actor))
             (loop rest effects (cons actor results))
             (loop rest effects results)))))))

(define (call-with-actor actor proc)
  "Apply PROC with the object stored in ACTOR and return a new actor
containing the value returned from PROC."
  (let ((new (proc (actor-ref actor))))
    (make-actor new (actor-action actor))))


;;;
;;; Actions
;;;

(define (action-lift proc)
  "Create an action constructor from PROC, a procedure of any number
of arguments whose first argument is the game object being
transformed."
  (lambda args
    (lambda (world effects object)
      (values #f
              effects
              (apply proc object args)))))

(define (action-effect-lift proc)
  "Create an action constructor from PROC, a procedure of any number
of arguments, whose first two arguments are the world being
transformed and the game object being acted upon.  The actions
returned from this new procedure specify that PROC should be performed
as an effect on the world, and do not change the actor itself."
  (lambda args
    (lambda (world effects object)
      (values #f
              (list (lambda (world) (apply proc world object args)))
              object))))

(define (idle world effects object)
  "Do nothing.  Do not change OBJECT nor add anything to EFFECTS."
  (values #f effects object))

(define (both a b)
  "Peform action A immediately followed by action B.  When the action
is run, the remainder of both A and B are returned as the next action
to perform."
  (lambda (world effects object)
    (let-values (((next new-effects new-object)
                  (a world effects object)))
      (if next
          (let-values (((next* new-effects* new-object*)
                        (b world new-effects new-object)))
            (values (if next* (both next next*) next)
                    new-effects*
                    new-object*))
          (b world new-effects new-object)))))

(define (then a b)
  "Perform action A followed by action B.  Unlike 'both', action B is
not performed immediately after A finishes, but rather requires
another tick."
  (lambda (world effects object)
    (let-values (((next new-effects new-object)
                  (a world effects object)))
      (values (if next (then next b) b)
              new-effects
              new-object))))

(define (forever action)
  "Perform ACTION in an infinite loop."
  (define (forever world effects object)
    (let-values (((next new-effects new-object)
                  (action world effects object)))
      (values (if next (then next forever) forever) ; memoize?
              new-effects
              new-object)))
  forever)

(define (repeat times action)
  "Perform ACTION TIMES times in a row."
  (cond ((zero? times) idle)
        ((= times 1) action)
        (else (then action (repeat (1- times) action)))))

(define (wait duration)
  "Do nothing DURATION times."
  (repeat duration idle))

(define (ifa predicate consequent alternate)
  "Create an action that performs CONSEQUENT if PREDICATE is
satisfied, or ALTERNATE otherwise.  PREDICATE is a procedure that
accepts a single argument: The game object stored within the actor
that is performing the action."
  (lambda (world effects object)
    (let ((action (if (predicate object) consequent alternate)))
      (action world effects object))))

(define (whena predicate consequent)
  "Create an action that performs CONSEQUENT when PREDICATE is
satisfied, otherwise nothing is done."
  (ifa predicate consequent idle))

(define (unlessa predicate alternate)
  "Create an action that performs ALTERNATE unless PREDICATE is
satisfied, otherwise nothing is done."
  (ifa predicate idle alternate))

(define (sequence . actions)
  "Create an action that sequentially performs each action in
ACTIONS."
  (let loop ((actions actions))
    (match actions
      (() idle)
      ((action) action)
      ((action . rest)
       (then action (loop rest))))))

(define (together . actions)
  "Create an action that concurrently performs each action in
ACTIONS."
  (let loop ((actions actions))
    (match actions
      (() idle)
      ((action) action)
      ((action . rest)
       (both action (loop rest))))))