├── README.md
├── branch.lisp
├── leaf.lisp
├── macros.lisp
├── message.lisp
├── parse.lisp
├── scripts
    ├── draw.lisp
    └── input.lisp
├── stage.lisp
├── tree-talk.lisp
├── tree.lisp
├── treepost.lisp
└── utilities.lisp


/README.md:
--------------------------------------------------------------------------------
  1 | ### A different take on the object model
  2 | 
  3 | ## What's the down and dirty?
  4 | 
  5 | I'm not a biologist, but I don't think cells operate by just reaching into
  6 | another cell with 'getters' and 'setters' and messing with information. They
  7 | communicate. They talk to each other. 
  8 | 
  9 | And objects just don't talk to each other in programming.
 10 | 
 11 | This project is my vision of what I understood 'object-oriented' and 'message
 12 | passing' to be before I learned object-oriented programming:
 13 | 
 14 | * An object acts alone and in an entirely insulated environment. 
 15 | * An object only acts by the messages it receives.
 16 | * An object may act on a message by sending a response (which is yet another message) or it may do 
 17 | everything internally without response.
 18 | 
 19 | Objects in Tree-Talk are put into a tree and operate purely on messages.
 20 | Having a tree allows for clearly defined ways of sending messages -- "say",
 21 | "broadcast", "think".  These procedures define who "hears" a message (its 
 22 | scope).
 23 | 
 24 | Each object's state is hidden from one another. There are no public, protected,
 25 | or private methods -- just a single entry-point for taking in a message.
 26 | 
 27 | I've been working on this problem for a long time and want to know if I'm hot
 28 | or cold and am open to help.
 29 | 
 30 | I tried doing [virtual methods and templates in C++](https://github.com/rlt3/Messaging/blob/master/src/messageable.hpp "c++ mess"). 
 31 | Before that (and before I realized I was ever trying to solve this problem) [I was
 32 | using PHP in a similar way.](https://github.com/rlt3/Stream "sphagetti php")
 33 | 
 34 | ## Why can't objects just talk to each other?
 35 | 
 36 | I was making a game and I wanted a monster to track the player through a
 37 | dungeon room. I kept having a bunch of circular dependency issues with the
 38 | player being an entity and the monster being and entity and blah blah blah. 
 39 | 
 40 | I knew the solution -- just use yet another class to interface between the two.
 41 | But why couldn't the monster just "hear" the player's movements? 
 42 | 
 43 | If I'm in the room with someone, I can hear and see them moving. That person is
 44 | communicating their movements to me without ever having to explicity say
 45 | anything to me personally. If they start to move too closely I can get out of
 46 | the way.
 47 | 
 48 | With Tree-Talk, the player and monster can just talk to each other and figure
 49 | all this out amongst themselves.
 50 | 
 51 | ## How do they talk?
 52 | 
 53 | Before I explain how they talk, I want to explain the structure of the project.
 54 | Right now, the core data structure is a tree. I am using a different definition
 55 | of leaves and nodes.
 56 | 
 57 | Each node on this tree represents an object. I call these nodes branches.
 58 | 
 59 | Each branch has any number of properties (like an entity-component system) that
 60 | define that branch. I call those properties leaves.
 61 | 
 62 | Each branch has any number of leaves which define it. And each branch also has
 63 | any number of children.
 64 | 
 65 | That means a tree is simply a collection of branches.
 66 | 
 67 | ## That's cool, but how do they talk?
 68 | 
 69 | Since this is an object system, a leaf is an object which has methods. The
 70 | methods it has are the messages it receives.
 71 | 
 72 | For example, the player mashes the up-arrow on their keyboard. It produces a
 73 | message that looks something like this:
 74 | 
 75 |     (message 'input 'up)
 76 | 
 77 | We might have a leaf that looks like this:
 78 | 
 79 |     (handle-message input (direction) input-leaf
 80 |         "Translate the player's input to our player object."
 81 |         (think 'move-towards (input->coordinates direction))
 82 | 
 83 | The "think" procedure tells Tree-Talk that we want that message to be internal
 84 | and messages the other leaves on that branch. In other words, it is talking to
 85 | itself.
 86 | 
 87 | Let's take this example further and look at another leaf:
 88 | 
 89 |     (handle-message move-towards (coordinates) movement-leaf
 90 |         "Set the destination."
 91 |         (property-set! 'destination coordinates))
 92 | 
 93 |     (handle-message update (dt) movement-leaf
 94 |         "Move with delta time and let everyone know our location every update."
 95 |         (move-delta dt)
 96 |         (say 'movement (property 'location)))
 97 | 
 98 | This leaf accepted the 'move-towards message and set its destination. Then at
 99 | every 'update it moves and then tells its current location to the other
100 | branches. That's how I might handle collision.
101 | 
102 | ## What are the ways you can send messages?
103 | 
104 | Right now there are just five ways:
105 | 
106 | * Say - Send a message to a branch's siblings.
107 | * Reply - Send a message directly to the author of the message.
108 | * Think - Send a message internally to the other leaves on a branch.
109 | * Command - Send a message to a branch's children.
110 | * Broadcast - Send a message to the entire tree.
111 | 
112 | ## How do I mess around with this?
113 | 
114 | I already have some toy scripts in the repo. I have a tree structure defined
115 | in `stage.lisp`. You can get started right away by loading that into your
116 | interpreter and calling `(tree-message *tree* 'update)`.
117 | 
118 | `(tree-message *tree* 'input 'up)` will return a message. The entire point of
119 | the tree is that you send messages in and receive responses, which are just
120 | messages you can put right back into the tree.
121 | 
122 |     > (tree-message *tree* 'update)
123 |     Drawing at (10, 15)
124 |     NIL
125 | 
126 |     > (tree-message *tree* 'input 'up)
127 |     (#<a TREE-TALK::MESSAGE>)
128 | 
129 |     > (tree-message-list *tree* (tree-message *tree* 'input 'up))
130 |     (NIL)
131 | 
132 |     > (tree-message *tree* 'update)
133 |     Drawing at (10, 16)
134 |     NIL
135 | 
136 | ## The future
137 | 
138 | Though I am using this for games, I think the general idea is bigger than
139 | games and the reason why I want to share it with everyone.
140 | 
141 | I am attempting to make a [C Library which can interface with objects
142 | written in many different languages](https://github.com/rlt3/tree-talk-c "tree-talk-c").
143 | 


--------------------------------------------------------------------------------
/branch.lisp:
--------------------------------------------------------------------------------
 1 | ;;; A branch is a collection of leaves.
 2 | ;;;
 3 | ;;; Branches are a traditional `node' of a tree. Branches have children, but
 4 | ;;; it is the leaves that define them. Thinking of a branch as an object, the
 5 | ;;; leaves are their properties.
 6 | 
 7 | (defclass branch ()
 8 |     ((  leaves :reader branch-leaves
 9 |                :initform ()
10 |                :initarg :leaves)
11 |      (children :reader branch-children
12 |                :initform ()
13 |                :initarg :children)))
14 | 
15 | (defmethod branch-each-side ((self branch) side procedure)
16 |     "Do the procedure for a deviant of the branch."
17 |     (mapcar procedure (funcall side self)))
18 | 
19 | (defmethod branch-each-child ((self branch) procedure)
20 |     "Do the procedure for each child of the branch."
21 |     (branch-each-side self #'branch-children procedure))
22 | 
23 | (defmethod branch-each-leaf ((self branch) procedure)
24 |     "Do the procedure for each leaf of the branch."
25 |     (branch-each-side self #'branch-leaves procedure))
26 | 
27 | (defmethod branch-add-leaf! ((self branch) leaf)
28 |     "Add a leaf to the branch. The leaf is appended to the end."
29 |     (setf (slot-value self 'leaves)
30 |           (append (branch-leaves self) (list leaf))))
31 | 
32 | (defmethod branch-load! ((self branch))
33 |     "Load the leaves of an branch."
34 |     (branch-each-leaf self #'leaf-load!))
35 | 
36 | (defun make-branch (leaves children)
37 |   (make-instance 'branch :leaves leaves :children children))
38 | 


--------------------------------------------------------------------------------
/leaf.lisp:
--------------------------------------------------------------------------------
 1 | ;;; Leaves are what makes a branch be different from another branch.
 2 | ;;;
 3 | ;;; A leaf holds and iteracts with state that is kept hidden from all other
 4 | ;;; leaves. The only way for any leaf root to interact with another is to have
 5 | ;;; some external system act upon it.
 6 | 
 7 | (defclass leaf ()
 8 |    ((filename  :reader leaf-filename 
 9 |                :initform "default"
10 |                :initarg :filename)
11 | 
12 |     (class-sym :reader leaf-class-sym
13 |                :initform 'default 
14 |                :initarg :class-sym)
15 | 
16 |     ( env-vars :reader leaf-env-vars
17 |                :initform '() 
18 |                :initarg :env-vars)
19 | 
20 |     (   object :reader leaf-root
21 |                :initform ())))
22 | 
23 | (defmethod leaf-load! ((self leaf))
24 |     "Load our script file if needed and then load the script with the 
25 |     environment vars. Not tied to constructor so that our object can get 
26 |     reloaded dynamically."
27 |     (load (concatenate 'string "scripts/" (leaf-filename self)))
28 |     (setf (slot-value self 'object) 
29 |           (apply #'make-instance 
30 |                 (leaf-class-sym self)
31 |                 (leaf-env-vars self))))
32 | 
33 | (defmethod leaf-serialize ((self leaf))
34 |     "Export lists and reload by applying those lists to make-leaf."
35 |     (list (leaf-filename self)
36 |           (leaf-class-sym self)
37 |           (leaf-env-vars self)))
38 | 
39 | (defun make-leaf (f c v)
40 |     "Make it easier to apply arg lists to make an instance."
41 |     (make-instance 'leaf :filename f :class-sym c :env-vars v))
42 | 


--------------------------------------------------------------------------------
/macros.lisp:
--------------------------------------------------------------------------------
 1 | (in-package :cl-user)
 2 | (use-package :tree-talk)
 3 | 
 4 | (defmacro handler (name super-list property-list)
 5 |     "A wrapper for classes so we can know the class name."
 6 |     `(defclass ,name ,super-list
 7 |         ,property-list))
 8 | 
 9 | (defmacro handle-message (name args handler &optional doc-string &rest body)
10 |     "Creates a message-handler as a method for the handler's class."
11 |     `(defmethod ,name ((self ,handler) (msg tree-talk::message) ,@args)
12 |         ,doc-string
13 |         (flet ((property (sym)
14 |                     (slot-value self sym))
15 |                (property-set! (sym value)
16 |                     (setf (slot-value self sym) value))
17 |                (think (title &rest data) 
18 |                     (tree-talk::make-response #'tree-talk::post-think msg title data))
19 |                (reply (title &rest data) 
20 |                     (tree-talk::make-response #'tree-talk::post-reply msg title data))
21 |                (broadcast (title &rest data) 
22 |                     (tree-talk::make-response #'tree-talk::post-broadcast msg title data))
23 |                (command (title &rest data) 
24 |                     (tree-talk::make-response #'tree-talk::post-command msg title data)))
25 |             ,@body)))
26 | 
27 | (defmacro helper (name args handler &optional doc-string &rest body)
28 |     "Used to signify a procedure that isn't meant to handle messages."
29 |     `(defmethod ,name ((self ,handler) ,@args)
30 |         ,doc-string
31 |         (flet ((property (sym)
32 |                     (slot-value self sym))
33 |                (property-set! (sym value)
34 |                     (setf (slot-value self sym) value)))
35 |             ,@body)))
36 | 


--------------------------------------------------------------------------------
/message.lisp:
--------------------------------------------------------------------------------
 1 | ;;; A message is sent to a method, not a node or set of nodes. This means that
 2 | ;;; the author of the message doesn't know the recipients.
 3 | ;;;
 4 | ;;; Messages are sent to different `post offices'. Each post office sends the
 5 | ;;; message in a different way. 
 6 | 
 7 | (defclass message ()
 8 |   ((  from :reader message-author 
 9 |            :initform ()       
10 |            :initarg :from)
11 |    (method :reader message-method 
12 |            :initform ()       
13 |            :initarg :method)
14 |    ( title :reader message-title  
15 |            :initform 'default 
16 |            :initarg :title)
17 |    (  body :reader message-body   
18 |            :initform ()       
19 |            :initarg :body)
20 |    ; stamps
21 |    (recipient :accessor message-recipient 
22 |               :initarg :recipient)))
23 | 
24 | (defmethod message-stamp! (property-sym (self message) value)
25 |     "Single entry for changing our message object."
26 |     (setf (slot-value self property-sym) value)
27 |     self)
28 | 
29 | (defun make-message (from title body method &rest stamps)
30 |     "Make message with standard options and optionally add stamps which has to
31 |     come in the form ':stamp-name stamp-value'"
32 |     (apply #'make-instance
33 |           (append (list 'message 
34 |                         :from from 
35 |                         :title title 
36 |                         :body body 
37 |                         :method method)
38 |                   stamps)))
39 | 


--------------------------------------------------------------------------------
/parse.lisp:
--------------------------------------------------------------------------------
 1 | ;;; The form of our data structure is ( () () ). So, it is a list that has
 2 | ;;; two lists inside. Knowing this, we can define how to get to each `side'
 3 | ;;; and use those definitions to define their meaning.
 4 | 
 5 | (defun parse-left (form)
 6 |     (car form))
 7 | 
 8 | (defun parse-right (form)
 9 |     (cadr form))
10 | 
11 | (defun parse-each-side (form side procedure)
12 |     "Call a procedure on every element on one side of the object."
13 |     (if (not (car (funcall side form)))
14 |         ()
15 |         (mapcar procedure (funcall side form))))
16 | 
17 | (defun parse-each-child (form procedure)
18 |     "For each of the children do a procedure."
19 |     (parse-each-side form #'parse-right procedure))
20 | 
21 | (defun parse-each-leaf (form procedure)
22 |     "For each of the leafs do a procedure."
23 |     (parse-each-side form #'parse-left procedure))
24 | 


--------------------------------------------------------------------------------
/scripts/draw.lisp:
--------------------------------------------------------------------------------
 1 | (handler draw ()
 2 |     ((x :initform 0 :initarg :x)
 3 |      (y :initform 0 :initarg :y)))
 4 | 
 5 | (handle-message update () draw
 6 |     "Output our coordinates."
 7 |     (format t "Drawing at (~D, ~D)~%" (property 'x) (property 'y)))
 8 | 
 9 | (handle-message location (coordinates) draw
10 |     "Have our internals keep up with the location."
11 |     (move self coordinates))
12 | 
13 | (helper move (coordinates) draw
14 |     "Move our ourselves."
15 |     (property-set! 'x (+ (property 'x) (car coordinates)))
16 |     (property-set! 'y (+ (property 'y) (cadr coordinates)))
17 |     self)
18 | 


--------------------------------------------------------------------------------
/scripts/input.lisp:
--------------------------------------------------------------------------------
 1 | (handler Input () ())
 2 | 
 3 | (defun input->coordinates (input)
 4 |     "Translate the input to the a direction."
 5 |     (case input
 6 |         (up    '(0 1))
 7 |         (down  '(0 -1))
 8 |         (right '(1 0))
 9 |         (left  '(-1 0))))
10 | 
11 | (handle-message input (direction) Input
12 |     "When we receive the start message, update this object's location."
13 |     (think 'location (input->coordinates direction)))
14 | 


--------------------------------------------------------------------------------
/stage.lisp:
--------------------------------------------------------------------------------
 1 | (load "tree-talk.lisp")
 2 | (load "macros.lisp")
 3 | 
 4 | (in-package :cl-user)
 5 | (use-package :tree-talk)
 6 | 
 7 | (defun reload ()
 8 |     (load "stage.lisp"))
 9 | 
10 | (defvar *tree-structure*
11 |     (list
12 |         (list ())
13 |         (list
14 |             (list
15 |                 (list 
16 |                       '("input.lisp" input ())
17 |                       '("draw.lisp" draw (:x 10 :y 15)))
18 |                 (list 
19 |                     (list 
20 |                         (list '("draw.lisp" draw (:x 800 :y 600)))
21 |                         (list ()))))
22 |             (list
23 |                 (list '("draw.lisp" draw (:x 40 :y 80)))
24 |                 (list ())))))
25 | 
26 | (defvar *tree* (make-tree *tree-structure*))
27 | (tree-load! *tree*)
28 | 


--------------------------------------------------------------------------------
/tree-talk.lisp:
--------------------------------------------------------------------------------
 1 | (defpackage :tree-talk
 2 |             (:use :common-lisp)
 3 |             (:export :make-tree :tree-load! :tree-message :tree-message-list))
 4 | 
 5 | (in-package :tree-talk)
 6 | 
 7 | (load "utilities.lisp")
 8 | (load "parse.lisp")
 9 | (load "leaf.lisp")
10 | (load "branch.lisp")
11 | (load "tree.lisp")
12 | (load "message.lisp")
13 | (load "treepost.lisp")
14 | 
15 | (defun tree-message (tree title &rest body)
16 |     "The entry point to message a tree."
17 |     (treepost tree (make-message tree title body #'post-broadcast)))
18 | 
19 | (defun tree-message-list (tree message-list)
20 |     "Send a list of messages to the tree."
21 |     (mapcar (lambda (msg) 
22 |                 (treepost tree msg)) 
23 |             message-list))
24 | 


--------------------------------------------------------------------------------
/tree.lisp:
--------------------------------------------------------------------------------
 1 | ;;; A tree is a collection of branches.
 2 | 
 3 | (defmethod tree-load! ((self branch))
 4 |     "Load the entire tree's leaves."
 5 |     (branch-load! self)
 6 |     (mapcar #'tree-load! (branch-children self)))
 7 | 
 8 | (defmethod tree-serialize ((self branch))
 9 |     "Serialize the branch and it's children if any."
10 |     (list (branch-each-leaf self #'leaf-serialize)
11 |           (branch-each-child self #'tree-serialize)))
12 | 
13 | (defun make-tree (serialized-tree)
14 |     "Create and return the head of a tree from a serialized tree."
15 |     (make-branch (parse-each-leaf serialized-tree 
16 |                                   (lambda (o) (apply #'make-leaf o)))
17 |                  (parse-each-child serialized-tree #'make-tree)))
18 | 
19 | 


--------------------------------------------------------------------------------
/treepost.lisp:
--------------------------------------------------------------------------------
 1 | ;;; The `post office' of the tree -- treepost.
 2 | 
 3 | (defmethod post-send ((self message) object)
 4 |     "Send the message to an object."
 5 |     (handler-case
 6 |         (apply #'funcall
 7 |             (append (list (message-title self) object self)
 8 |                     (message-body self)))
 9 |         (condition (e) ())))
10 | 
11 | (defun post-to-leaf (message leaf)
12 |     "Message the leaf."
13 |     (post-send message (leaf-root leaf)))
14 | 
15 | (defun post-to-branch (message branch)
16 |     "Message the leaves of this branch."
17 |     (message-stamp! 'recipient message branch)
18 |         (branch-each-leaf branch 
19 |                          (lambda (leaf) 
20 |                              (post-to-leaf message leaf))))
21 | 
22 | (defun post-to-tree (message branch)
23 |     "Send a message to a tree from a branch recursively."
24 |     (append (post-to-branch message branch)
25 |             (branch-each-child branch
26 |                               (lambda (child) 
27 |                                   (post-to-tree message child)))))
28 | 
29 | (defun treepost (tree msg)
30 |     "Dispatch the message via its method."
31 |     (remove-if #'not-messagep?
32 |               (flatten (funcall (message-method msg) tree msg))))
33 | 
34 | ;; Methods in which we send our messages.
35 | 
36 | (defun post-broadcast (tree message)
37 |     "Send a message to the entire tree."
38 |     (post-to-tree message tree))
39 | 
40 | (defun post-think (tree message)
41 |     "A leaf messages the other leaves on its branch."
42 |     (post-to-branch message (message-author message)))
43 | 
44 | (defun post-reply (tree message)
45 |     "A branch replies directly to another branch."
46 |     (post-to-branch message (message-recipient message)))
47 | 
48 | (defun post-command (tree message)
49 |     "A branch messages its children."
50 |     (branch-each-child (message-author message)
51 |                        (lambda (child) 
52 |                            (post-to-branch message child))))
53 | 
54 | ;; Create the responses, with stamps appended determined by its method
55 | 
56 | (defun make-response (method old-message title body)
57 |     "Create a response to the old message sent by a method."
58 |     (apply #'make-message
59 |            (append (list (message-recipient old-message) title body method)
60 |                    (cond ((eq method #'post-reply) 
61 |                              (list :recipient (message-author old-message))
62 |                          (t '()))))))
63 | 


--------------------------------------------------------------------------------
/utilities.lisp:
--------------------------------------------------------------------------------
 1 | (defun flatten (l)
 2 |     "Collect every element from a list of nested lists."
 3 |     (cond ((null l) nil)
 4 |           ((atom l) (list l))
 5 |           (t (loop for a in l appending (flatten a)))))
 6 | 
 7 | (defun not-messagep? (maybe-message)
 8 |     "Returns true if not a message. False if it is a message."
 9 |     (cond ((eq 'message (type-of maybe-message)) ())
10 |           (t t)))
11 | 


--------------------------------------------------------------------------------