;;;; -*- Mode:COMMON-LISP; Package:GBB-USER; Base:10 -*-
;;;; *-* File: lapis: /u7/gbb/v-400/dev/source/gbb/examples/getting-started.lisp *-*
;;;; *-* Edited-By: Cork *-*
;;;; *-* Last-Edit: Tuesday, September 22, 1998  10:55:43 *-*
;;;; *-* Machine: GRANITE (Explorer II, Microcode 489) *-*

;;;; **************************************************************************
;;;; **************************************************************************
;;;; *
;;;; *                        "RANDOM WALK" APPLICATION
;;;; *
;;;; **************************************************************************
;;;; **************************************************************************
;;;
;;; Copyright (c) 1998
;;; Knowledge Technologies International
;;; All rights reserved
;;;
;;; Copyright (c) 1989-1998
;;; Blackboard Technology Group, Inc., Amherst, MA 01002.
;;;
;;; From: ``Getting Started with GBB'' (Appendix)
;;;
;;; To run:
;;;   1. Startup GBB
;;;   2. Evaluate: (load-kti-module '(:gbb-user-package :agenda-shell))
;;;   3. Evaluate: (in-package "GBB-USER")
;;;   4. Compile and load this file
;;;   5. Evaluate: (take-a-walk)
;;;
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;;;
;;;  04-04-93 File created.
;;;  04-01-96 Updated to GBB V3.1.  (Cork)
;;;  05-08-97 Converted to GBB V3.2.  (Cork)
;;;  09-22-98 Converted to GBB V4.0.  (Cork)
;;;
;;; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

(in-package "GBB-USER")

;;; ------------------------------------------------------------------------
;;;   Module Definition
;;; ------------------------------------------------------------------------ 
;;
;;    (define-kti-module :getting-started-example
;;      (:modules :gbb :gbb-user-package :agenda-shell :gbb-graphics)
;;      (:package :gbb-user (:use :agenda-shell))
;;      (:directory gbb-root-open "examples") 
;;      (:files "getting-started"))

;;; ------------------------------------------------------------------------
;;;   Variables
;;; ------------------------------------------------------------------------

(defvar *THE-RANDOM-WALK* nil
  "Stores the random-walk unit instance.")

;;; ------------------------------------------------------------------------
;;;   Top level function: take-a-walk
;;; ------------------------------------------------------------------------

(defun take-a-walk ()

  "take-a-walk ()

Runs the ``random walk'' example application."
  
  (delete-blackboard-database)
  (instantiate-blackboard-database '(known-world))
  (start-control-shell))

;;; ------------------------------------------------------------------------
;;;   Space definitions
;;; ------------------------------------------------------------------------

(define-space known-world ()
  ((time :ordered (0 60))
   (x :ordered (0 100))
   (y :ordered (0 100))))

;;; ------------------------------------------------------------------------
;;;   Structure definitions
;;; ------------------------------------------------------------------------

(defstruct (time-point (:conc-name "TIME-POINT."))
  time x y)

;;; ------------------------------------------------------------------------
;;;   Dimension-value computations
;;; ------------------------------------------------------------------------

(define-dimension-value-computation time-point-list-dvc
  ((time :point location.time)
   (x    :point location.x)
   (y    :point location.y))
  (:dimension-value-computation-type :series time)
  (:element-type location))

;;; ------------------------------------------------------------------------

(define-dimension-value-computation time-point-dvc
  ((time :point time-point.time)
   (x    :point time-point.x)
   (y    :point time-point.y)))

;;; ------------------------------------------------------------------------
;;;   Unit class definitions
;;; ------------------------------------------------------------------------

(define-unit-class location ()
  ((time-point
     :type time-point-dvc)
   (previous-location
     :link (location next-location :singular) 
     :singular t)
   (next-location
     :link (location previous-location :singular) 
     :singular t)
   (random-path
     :link (random-path locations)
     :singular t))
  (:generate-initargs t)
  (:generate-accessors t)
  (:creation-event-functions add-location-to-random-path)
  (:dimensions
    (time time-point)
    (x time-point)
    (y time-point))
  (:paths '(known-world)))

;;; Creation-event function:

(defun add-location-to-random-path (event-name &key unit &allow-other-keys)
  (declare (ignore event-name))
  ;; Link the newly created location unit instance to the random-path
  ;; unit instance:
  (linkf (location.random-path unit) *the-random-walk*))

;;; Accessor methods for location x, y, and time values:

(defmethod location.x ((unit location))
  (time-point.x (location.time-point unit)))

(defmethod location.y ((unit location))
  (time-point.y (location.time-point unit)))

(defmethod location.time ((unit location))
  (time-point.time (location.time-point unit)))

;;; ------------------------------------------------------------------------

(define-unit-class random-path ()
  ((locations
     :link (location random-path :singular)
     :type time-point-list-dvc
     :sort-function #'<
     :sort-key #'location.time))
  (:generate-initargs t)
  (:generate-accessors t)
  (:dimensions
    (time locations)
    (x locations)
    (y locations))
  (:paths '(known-world)))

;;; ------------------------------------------------------------------------
;;;   Events
;;; ------------------------------------------------------------------------

(define-event-class initial-unit-event (single-unit-event)
  ())

(enable-event-printing 'initial-unit-event)

;;; ------------------------------------------------------------------------
;;;   Initial KS
;;; ------------------------------------------------------------------------

(define-ks initial-ks
  :trigger-events ((start-control-shell-event))
  :rating 100
  :ks-function 'initial-ks-function)

(defun initial-ks-function (ksa)
  (declare (ignore ksa))

  ;; Create the ``empty'' random-path unit instance:
  (setf *the-random-walk* (make-unit 'random-path))

  ;; Create the initial location unit instance at (50,50):
  (let ((initial-instance
          (make-unit 'location
                     :time-point (make-time-point :time 0 :x 50 :y 50))))
    (signal-event 'initial-unit-event :unit initial-instance)))

;;; ------------------------------------------------------------------------
;;;   Random walk KS
;;; ------------------------------------------------------------------------

(define-ks random-walk-ks
  :trigger-events ((creation-event location))
  :rating 100
  :ks-function 'random-walk-ks-function)

(defun random-walk-ks-function (ksa)
  (let* ((stimulus-unit (sole-stimulus-unit ksa))
         ;; The time of the new location unit instance is always one
         ;; greater than the time of the stimulus location unit instance:
         (time (+ 1 (location.time stimulus-unit)))
         ;; The x and y values of the new location unit instance are
         ;; randomly computed within +/- 20 of the x and y values of the
         ;; stimulus location unit instance:
         (x (+ (location.x stimulus-unit) (random 41) -20))
         (y (+ (location.y stimulus-unit) (random 41) -20)))

    ;; Check if the new x and y values are within the known-world
    ;; boundaries.  Create the new location unit instance if they are;
    ;; otherwise, tell the user we've walked away.
    (if (and (<= 0 x 100) (<= 0 y 100))
        ;; Check the new time value to ensure it is within the maximum
        ;; time value (60).  Create the new location unit instance if
        ;; the time is OK; otherwise, tell the user we've walked too
        ;; long.
        (if (<= 0 time 60)
            (make-unit 'location
                       :time-point (make-time-point :time time :x x :y y)
                       :previous-location stimulus-unit)
            (format t "~2%Walked too long.~2%"))
        (format t "~2%Walked off the world: (~d, ~d).~2%" x y))))

;;; ------------------------------------------------------------------------
;;;   Count stops KS
;;; ------------------------------------------------------------------------

(define-ks count-stops-ks
  :trigger-events ((start-control-shell-event))
  ;; The rating of this KS must be lower than the rating of the 
  ;; initial-ks and random-walk-ks:
  :rating 90
  :ks-function 'count-stops)

(defun count-stops (ksa)
  (declare (ignore ksa))
  
  ;; Find and count the location unit instances within the center
  ;; quadrant ((25,25)(75,75)):
  (let ((unit-instances (find-units 'location '(known-world)
                                    '(:and (x :within (25 . 75))
                                           (y :within (25 . 75))))))
    (format t "~2%~d stops in the center quadrant. ~2%"
            (length unit-instances))))

;;; ------------------------------------------------------------------------
;;;   Print path KS
;;; ------------------------------------------------------------------------

(define-ks print-path-ks
  :trigger-events ((initial-unit-event location))
  :rating 80
  :ks-function 'print-path-ks-function)

(defun print-path-ks-function (ksa)
  (format t "~2&The random path:")
  (let ((instance (sole-stimulus-unit ksa)))

    ;; Starting with the initial location unit instance, print the
    ;; unit instance name and location, and follow the next-location
    ;; link (printing each unit instance) as long as there is a
    ;; next-location link:
    (loop 
      (unless (unit-instance-p instance)
        (return))
      (format t "~&~5T~A (~S ~S)"
              (unit-name instance)
              (location.x instance)
              (location.y instance))
      (setf instance (location.next-location instance)))
    (format t "~2&")))

;;; ------------------------------------------------------------------------
;;; Enable printing of all control shell events:

(enable-event-printing 'control-shell-event)

;;; ------------------------------------------------------------------------
;;;   End of File
;;; ------------------------------------------------------------------------