Fixed the init around message handler in InteropObject

The around message handler will not call to-pointer if it turns out that a
pointer already exists or the number stored is zero. This prevents us from
working with the null pointer.

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; InteropObject.clp - An interface that exposes a pointer address. It does not
; inherit from Object
;------------------------------------------------------------------------------
(defclass core::InteropObject
  "Interface to an item outside of the CLIPS environment"
  (is-a USER)
  (slot pointer (type INTEGER EXTERNAL-ADDRESS) (visibility public)))

(defmessage-handler core::InteropObject init around ()
						  (call-next-handler)
						  (if (and (numberp ?self:pointer)
									  (not (= 0 ?self:pointer))) then
							 (bind ?self:pointer (to-pointer ?self:pointer))))

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; InteropObject.clp - An interface that exposes a pointer address. It does not
; inherit from Object
;------------------------------------------------------------------------------
(defclass core::InteropObject
  "Interface to an item outside of the CLIPS environment"
  (is-a USER)
  (slot pointer (type INTEGER EXTERNAL-ADDRESS) (visibility public)))

(defmessage-handler core::InteropObject init around ()
						  (call-next-handler)
						  (if (numberp ?self:pointer) then
							 (bind ?self:pointer (to-pointer ?self:pointer))))


init/DeclareLibraryFunctions.clp: Added a library-files function

This function is meant to make it really easy to define the library files to
load for a given library without having to remember complex paths

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; DeclareLibraryFunctions.clp - Defines a series of functions used to
; streamline the loading of libraries in the adventure engine
;
; Written by Joshua Scoggins
; Started on 3/11/2013
;------------------------------------------------------------------------------
(deffunction init::load-library
 "Loads an adventure engine library from the root of the src folder"
 (?name)
 (batch* (format nil "lib/%s/Library.clp" ?name)))
;------------------------------------------------------------------------------
(deffunction init::library-files
 "Loads the files that make up the target library"
 (?offset $?names)
 (bind ?coreOffset (format nil "lib/%s/%s" ?offset "%s"))
 (progn$ (?a $?names)
  (batch* (format nil ?coreOffset ?a))))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; DeclareLibraryFunctions.clp - Defines a series of functions used to
; streamline the loading of libraries in the adventure engine
;
; Written by Joshua Scoggins
; Started on 3/11/2013
;------------------------------------------------------------------------------
(deffunction load-library
 "Loads an adventure engine library from the root of the src folder"
 (?name)
 (batch* (format nil "lib/%s/Library.clp" ?name)))
;------------------------------------------------------------------------------


Fixed a bug with the assembler

Fixed a bug with the assembler

;------------------------------------------------------------------------------
;electron
;Copyright (c) 2012-2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of The Adventure Engine nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;-------------------------------------------------------------------------------
; Assembler.clp - An assembler for the theoretical processor.
;-------------------------------------------------------------------------------
(defglobal MAIN ; human readable form
           ?*symbol-label-instruction* = label
           ?*symbol-terminate-instruction* = terminate
           ?*symbol-nop-instruction* = nop
           ?*symbol-add-instruction* = add
           ?*symbol-subtract-instruction* = sub
           ?*symbol-multiply-instruction* = mul
           ?*symbol-divide-instruction* = div
           ?*symbol-right-shift-instruction* = right-shift
           ?*symbol-left-shift-instruction* = left-shift
           ?*symbol-equal-instruction* = eq
           ?*symbol-not-equal-instruction* = neq
           ?*symbol-less-than-instruction* = lt
           ?*symbol-greater-than-instruction* = gt
           ?*symbol-and-instruction* = and
           ?*symbol-or-instruction* = or
           ?*symbol-not-instruction* = not
           ?*symbol-branch-instruction* = branch
           ?*symbol-load-instruction* = load
           ?*symbol-store-instruction* = store
           ?*symbol-set-instruction* = set
           ?*symbol-interrupt-instruction* = interrupt)
;-------------------------------------------------------------------------------
(deftemplate input-line
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot original-input
                   (type STRING)
                   (default ?NONE))
             (multislot raw-input))
;-------------------------------------------------------------------------------
(deftemplate operation
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot operation
                   (type SYMBOL)
                   (default ?NONE))
             (multislot arguments))
;-------------------------------------------------------------------------------
(deftemplate instruction
             (slot tag
                   (type SYMBOL))
             (slot arg-count
                   (type INTEGER))
             (slot is-macro ; is it a convienience instruction/operation?
                   (type SYMBOL)
                   (allowed-symbols FALSE TRUE)))
;-------------------------------------------------------------------------------
(deffacts argument-conversion-counts
          (instruction (tag ?*symbol-terminate-instruction*)
                       (arg-count 0))
          (instruction (tag ?*symbol-nop-instruction*)
                       (arg-count 0))
          (instruction (tag ?*symbol-add-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-subtract-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-multiply-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-divide-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-right-shift-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-left-shift-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-equal-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-not-equal-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-less-than-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-greater-than-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-and-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-or-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-not-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-branch-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-load-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-store-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-set-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-interrupt-instruction*)
                       (arg-count 1))
          (instruction (tag ?*symbol-label-instruction*)
                       (arg-count 1)
                       (is-macro TRUE)))
;-------------------------------------------------------------------------------
(defgeneric to-char)
;-------------------------------------------------------------------------------
(defmethod to-char
  ((?i INTEGER (>= ?i 0)) ; no negative numbers
   (?stream SYMBOL))
  (format ?stream "%c" ?i))

(defmethod to-char
  ((?i INTEGER (>= ?i 0)))
  (to-char ?i nil))

;-------------------------------------------------------------------------------
; since we can't do "knowledge construction" in the standard sense we need to
; pull input from standard-in.
;-------------------------------------------------------------------------------
(defrule initialize-assembler
         (initial-fact)
         =>
         (assert (read-to-end 1)))

(defrule build-input-line
         ?f <- (read-to-end ?i)
         =>
         (retract ?f)
         (bind ?input (readline))
         (if (neq ?input EOF) then
           (assert (read-to-end (+ ?i 1))
                   (input-line (line-number ?i)
                               (original-input ?input)
                               (raw-input (explode$ ?input))))
           else
           (assert (translate-input))))

(defrule throw-out-empty-lines
         "remove lines that are completely comments or just plain empty"
         (declare (salience 2))
         ?f <- (input-line (raw-input))
         =>
         (retract ?f))
(defrule invalid-line-found
         (declare (salience 2))
         (input-line (line-number ?i)
                     (original-input ?line)
                     (raw-input $?input))
         (test (> (length$ $?input) 4))
         =>
         (printout werror "ERROR: line " ?i " is invalid" crlf
                   "     " ?line crlf)
         (halt))

(defrule is-invalid-instruction
         (declare (salience 2))
         (input-line (raw-input ?op $?)
                     (line-number ?l)
                     (original-input ?input))
         (not (exists (instruction (tag ?op))))
         =>
         (printout werror
                   (format nil "ERROR: Instruction %s on line %d is invalid%n" ?op ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))
(defrule invalid-argument-count-for-operation
         (declare (salience 2))
         (input-line (raw-input ?operation $?rest)
                     (line-number ?l)
                     (original-input ?input))
         (instruction (tag ?operation)
                      (arg-count ?ac&:(!= ?ac (length$ $?rest))))
         =>
         (printout werror
                   (format nil "ERROR: Invalid number of arguments for %s on line %d%n"
                           ?operation ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))

(defrule process-input-line
         (declare (salience 1)) ; evaluate each line as it goes through
         ?f <- (input-line (raw-input ?operation $?rest)
                           (line-number ?l))
         (instruction (tag ?operation)
                      (arg-count =(length$ $?rest)))

         =>
         (retract ?f)
         (assert (operation (line-number ?l)
                            (operation ?operation)
                            (arguments $?rest))))
;-------------------------------------------------------------------------------
; this becomes a script that reads from standard input
;-------------------------------------------------------------------------------
(reset) ; load the instruction information for our purposes
(run)
(exit)

;------------------------------------------------------------------------------
;electron
;Copyright (c) 2012-2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of The Adventure Engine nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;-------------------------------------------------------------------------------
; Assembler.clp - An assembler for the theoretical processor.
;-------------------------------------------------------------------------------
(defglobal MAIN ; human readable form
           ?*symbol-label-instruction* = label
           ?*symbol-terminate-instruction* = terminate
           ?*symbol-nop-instruction* = nop
           ?*symbol-add-instruction* = add
           ?*symbol-subtract-instruction* = sub
           ?*symbol-multiply-instruction* = mul
           ?*symbol-divide-instruction* = div
           ?*symbol-right-shift-instruction* = right-shift
           ?*symbol-left-shift-instruction* = left-shift
           ?*symbol-equal-instruction* = eq
           ?*symbol-not-equal-instruction* = neq
           ?*symbol-less-than-instruction* = lt
           ?*symbol-greater-than-instruction* = gt
           ?*symbol-and-instruction* = and
           ?*symbol-or-instruction* = or
           ?*symbol-not-instruction* = not
           ?*symbol-branch-instruction* = branch
           ?*symbol-load-instruction* = load
           ?*symbol-store-instruction* = store
           ?*symbol-set-instruction* = set
           ?*symbol-interrupt-instruction* = interrupt)
;-------------------------------------------------------------------------------
(deftemplate input-line
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot original-input
                   (type STRING)
                   (default ?NONE))
             (multislot raw-input))
;-------------------------------------------------------------------------------
(deftemplate operation
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot operation
                   (type SYMBOL)
                   (default ?NONE))
             (multislot arguments))
;-------------------------------------------------------------------------------
(deftemplate instruction
             (slot tag
                   (type SYMBOL))
             (slot arg-count
                   (type INTEGER))
             (slot is-macro ; is it a convienience instruction/operation?
                   (type SYMBOL)
                   (allowed-symbols FALSE TRUE)))
;-------------------------------------------------------------------------------
(deffacts argument-conversion-counts
          (instruction (tag ?*symbol-terminate-instruction*)
                       (arg-count 0))
          (instruction (tag ?*symbol-nop-instruction*)
                       (arg-count 0))
          (instruction (tag ?*symbol-add-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-subtract-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-multiply-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-divide-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-right-shift-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-left-shift-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-equal-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-not-equal-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-less-than-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-greater-than-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-and-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-or-instruction*)
                       (arg-count 3))
          (instruction (tag ?*symbol-not-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-branch-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-load-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-store-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-set-instruction*)
                       (arg-count 2))
          (instruction (tag ?*symbol-interrupt-instruction*)
                       (arg-count 1))
          (instruction (tag ?*symbol-label-instruction*)
                       (arg-count 1)
                       (is-macro TRUE)))
;-------------------------------------------------------------------------------
(defgeneric to-char)
;-------------------------------------------------------------------------------
(defmethod to-char
  ((?i INTEGER (>= ?i 0)) ; no negative numbers
   (?stream SYMBOL))
  (format ?stream "%c" ?i))

(defmethod to-char
  ((?i INTEGER (>= ?i 0)))
  (to-char ?i nil))

;-------------------------------------------------------------------------------
; since we can't do "knowledge construction" in the standard sense we need to
; pull input from standard-in.
;-------------------------------------------------------------------------------
(defrule initialize-assembler
         (initial-fact)
         =>
         (assert (read-to-end 1)))

(defrule build-input-line
         ?f <- (read-to-end ?i)
         =>
         (retract ?f)
         (bind ?input (readline))
         (if (neq ?input EOF) then
           (assert (read-to-end (+ ?i 1))
                   (input-line (line-number ?i)
                               (original-input ?input)
                               (raw-input (explode$ ?input))))
           else
           (assert (translate-input))))

(defrule throw-out-empty-lines
         "remove lines that are completely comments or just plain empty"
         (declare (salience 2))
         ?f <- (input-line (raw-input))
         =>
         (retract ?f))
(defrule invalid-line-found
         (declare (salience 2))
         (input-line (line-number ?i)
                     (original-input ?line)
                     (raw-input $?input))
         (test (or (> (length$ $?input) 4)))
         =>
         (printout werror "ERROR: line " ?i " is invalid" crlf
                   "     " ?line crlf)
         (halt))

(defrule is-invalid-instruction
         (declare (salience 2))
         (input-line (raw-input ?op $?)
                     (line-number ?l)
                     (original-input ?input))
         (not (exists (instruction (tag ?op))))
         =>
         (printout werror
                   (format nil "ERROR: Instruction %s on line %d is invalid%n" ?op ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))
(defrule invalid-argument-count-for-operation
         (declare (salience 2))
         (input-line (raw-input ?operation $?rest)
                     (line-number ?l)
                     (original-input ?input))
         (instruction (tag ?operation)
                      (arg-count ?ac&:(!= ?ac (length$ $?rest))))
         =>
         (printout werror
                   (format nil "ERROR: Invalid number of arguments for %s on line %d%n"
                           ?operation ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))

(defrule process-input-line
         (declare (salience 1)) ; evaluate each line as it goes through
         ?f <- (input-line (raw-input ?operation $?rest)
                           (line-number ?l))
         (instruction (tag ?operation)
                      (arg-count =(length$ $?rest)))

         =>
         (retract ?f)
         (assert (operation (line-number ?l)
                            (operation ?operation)
                            (arguments $?rest))))
;-------------------------------------------------------------------------------
; this becomes a script that reads from standard input
;-------------------------------------------------------------------------------
(reset) ; load the instruction information for our purposes
(run)
(exit)


Added LoadEngine.clp

Added LoadEngine.clp

This file loads the standard engine library.

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; LoadEngine.clp - Runs the GLConstantConversion expert system
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
(clear)
;relative to the root of the source directory
(batch* "lib/cortex/Library.clp")

error: pathspec 'src/LoadEngine.clp' did not match any file(s) known to git


Added the license to chicanery.clp

Added the license to chicanery.clp

;------------------------------------------------------------------------------
;electron-platform
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
;ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(defclass native-pointer
  (is-a USER)
  (role abstract)
  (slot pointer-class
        (type LEXEME)
        (visibility public)
        (access read-only)
        (default nil))
  (slot pointer
        (type EXTERNAL-ADDRESS)
        (storage local)
        (visibility public))
  (message-handler init around)
  (message-handler build-pointer primary)
  (message-handler get-native-arguments primary))

(defmessage-handler native-pointer init around
                    ()
                    (call-next-handler)
                    (send ?self build-pointer))

(defmessage-handler native-pointer build-pointer primary
                    ()
                    (bind ?self:pointer
                          (new (dynamic-get pointer-class)
                               (expand$ (send ?self get-native-arguments)))))
(defgeneric quickpoint)
(defgeneric to-point)
(defclass point
  (is-a native-pointer)
  (role concrete)
  (pattern-match reactive)
  (slot pointer-class
        (source composite)
        (default Point))
  (slot x
        (type INTEGER)
        (range 0 ?VARIABLE)
        (visibility public)
        (storage local)
        (default ?NONE))
  (slot y
        (type INTEGER)
        (range 0 ?VARIABLE)
        (visibility public)
        (storage local)
        (default ?NONE))
  (message-handler get-native-arguments primary))

(defmessage-handler point get-native-arguments primary ()
                    (create$ ?self:x ?self:y))

(defmethod quickpoint
  ((?x INTEGER)
   (?y INTEGER))
  (new Point ?x ?y))

(defmethod to-point
  ((?mf INTEGER MULTIFIELD (= (length$ ?mf) 2)))
  (quickpoint (expand$ ?mf)))

(defmethod to-point
  ((?mf INTEGER MULTIFIELD (> (length$ ?mf) 2)))
  (quickpoint (nth$ 1 ?mf)
              (nth$ 2 ?mf)))
(defmethod to-point
  (($?mf INTEGER (>= (length$ ?mf) 2)))
  (to-point ?mf))
(definstances default-points
              (ZP of point
                  (x 0)
                  (y 0)))

(defgeneric quickrect)
(defclass rectangle
  (is-a native-pointer)
  (role concrete)
  (pattern-match reactive)
  (slot pointer-class
        (source composite)
        (default Rectangle))
  (slot x
        (type INTEGER)
        (range 0 ?VARIABLE)
        (visibility public)
        (storage local)
        (default ?NONE))
  (slot y
        (type INTEGER)
        (range 0 ?VARIABLE)
        (visibility public)
        (storage local)
        (default ?NONE))
  (slot bx
        (type INTEGER)
        (range 0 ?VARIABLE)
        (visibility public)
        (storage local)
        (default ?NONE))
  (slot by
        (type INTEGER)
        (range 0 ?VARIABLE)
        (visibility public)
        (storage local)
        (default ?NONE))
  (message-handler get-native-arguments primary))

(defmessage-handler rectangle get-native-arguments primary
                    ()
                    (create$ ?self:x ?self:y ?self:bx ?self:by))

(defmethod quickrect
  ((?x INTEGER)
   (?y INTEGER)
   (?bx INTEGER)
   (?by INTEGER))
  (new Rectangle ?x ?y ?bx ?by))

(defmethod quickrect
  ((?mf MULTIFIELD INTEGER (>= (length$ ?mf) 4)))
  (quickrect (expand$ (subseq$ ?mf 1 4))))

(defmethod quickrect
  (($?mf MULTIFIELD INTEGER (>= (length$ ?mf) 4)))
  (quickrect ?mf))

(definstances default-rectangle-types
              (pixel of rectangle
                     (x 0)
                     (y 0)
                     (bx 1)
                     (by 1)))

(defgeneric translate/standard-color)
(defgeneric intensity-to-cmap)
(defclass color
  (is-a USER)
  (slot red
        (type INTEGER)
        (range 0 255)
        (visibility public))
  (slot green
        (type INTEGER)
        (range 0 255)
        (visibility public))
  (slot blue
        (type INTEGER)
        (range 0 255)
        (visibility public))
  (message-handler to-native-color primary))

(defmessage-handler color to-native-color primary
                    ()
                    (rgb-to-cmap ?self:red
                                 ?self:green
                                 ?self:blue))
(defmethod translate/standard-color
  ((?color LEXEME))
  (switch (lowcase (string-to-field ?color))
          (case opaque then 0)
          (case transparent then 1)
          (case black then 2)
          (case white then 3)
          (case red then 4)
          (case green then 5)
          (case blue then 6)
          (case cyan then 7)
          (case magenta then 8)
          (case yellow then 9)
          (case paleyellow then 10)
          (case darkyellow then 11)
          (case darkgreen then 12)
          (case palegreen then 13)
          (case medgreen then 14)
          (case darkblue then 15)
          (case palebluegreen then 16)
          (case paleblue then 17)
          (case bluegreen then 18)
          (case greygreen then 19)
          (case palegreygreen then 20)
          (case yellowgreen then 21)
          (case medblue then 22)
          (case greyblue then 23)
          (case palegreyblue then 24)
          (case purpleblue then 25)
          (case notacolor then 26)
          (case nofill then 27)
          (default 28)))

(defmethod get-standard-color
  ((?color LEXEME INSTANCE-NAME))
  (get-standard-color
    (translate/standard-color ?color)))

(defmethod intensity-to-cmap
  "Converts an intensity value to a greyscale color"
  ((?intensity INTEGER (<= 0 ?intensity 255)))
  (rgb-to-cmap ?intensity
               ?intensity
               ?intensity))

(defmethod rgb-to-cmap
  ((?tuple INTEGER MULTIFIELD (>= (length$ ?tuple) 3)))
  (rgb-to-cmap (nth$ 1 ?tuple)
               (nth$ 2 ?tuple)
               (nth$ 3 ?tuple)))

(defclass image
  (is-a native-pointer)
  (role concrete)
  (pattern-match reactive)
  (slot pointer-class
        (source composite)
        (default Image))
  (slot rectangle
        (type INSTANCE)
        (allowed-classes rectangle)
        (storage local)
        (visibility public)
        (default ?NONE))
  (slot replicate
        (type SYMBOL)
        (allowed-symbols FALSE TRUE)
        (visibility public))
  (slot color
        (type INSTANCE INTEGER)
        (allowed-classes color)
        (storage local)
        (default-dynamic 0))
  (message-handler get-native-arguments primary))

(defmessage-handler image get-native-arguments primary
                    ()
                    (create$ (send ?self:rectangle get-pointer)
                             (if ?self:replicate then 1 else 0)
                             (if (instancep ?self:color) then
                               (send ?self:color to-native-color)
                               else
                               ?self:color)))
(defmethod screen/draw
  ((?r INSTANCE-NAME)
   (?src INSTANCE-NAME)
   (?mask INSTANCE-NAME)
   (?p INSTANCE-NAME))
  (screen/draw (instance-address ?r)
               (instance-address ?src)
               (instance-address ?mask)
               (instance-address ?p)))

(defmethod screen/draw
  ((?r INSTANCE-NAME)
   (?src INSTANCE-NAME)
   (?p INSTANCE-NAME))
  (screen/draw (instance-address ?r)
               (instance-address ?src)
               (instance-address ?p)))

(defmethod screen/draw
  ((?r rectangle)
   (?src image)
   (?mask image)
   (?p point))
  (screen/draw (send ?r get-pointer)
               (send ?src get-pointer)
               (send ?mask get-pointer)
               (send ?p get-pointer)))

(defmethod screen/draw
  ((?r rectangle)
   (?src image)
   (?p point))
  (screen/draw (send ?r get-pointer)
               (send ?src get-pointer)
               (new Image)
               (send ?p get-pointer)))

(defglobal MAIN
           ?*default-screen-flush-behavior* = TRUE)
(defmethod screen/flush
  ((?vis SYMBOL (not (neq ?vis TRUE FALSE))))
  (screen/flush (if ?vis then 1 else 0)))

(defmethod screen/flush
  ()
  (screen/flush ?*default-screen-flush-behavior*))

(defmethod screen/draw-text
  ((?p point)
   (?src image)
   (?sp point)
   (?str LEXEME))
  (screen/draw-text (send ?p get-pointer)
                    (send ?src get-pointer)
                    (send ?sp get-pointer)
                    ?str))

(defgeneric translate/kbd/query)
(defgeneric translate/mouse/buttons)
(defgeneric bool)
(defmethod bool ((?number INTEGER)) (if (= ?number 0) then FALSE else TRUE))

(defmethod translate/mouse/buttons
  ()
  ; Mouse combinations
  ; m.buttons & 1 => left-click
  ; m.buttons & 2 => middle-click
  ; m.buttons & 3 => left + middle
  ; m.buttons & 4 => right-click
  ; m.buttons & 5 => left + right
  ; m.buttons & 6 => middle + right
  ; m.buttons & 7 => left + middle + right
  (bind ?z (mouse/buttons))
  (return (create$
            (if (bool (binary-and ?z 1)) then button1 else (create$))
            (if (bool (binary-and ?z 2)) then button2 else (create$))
            (if (bool (binary-and ?z 4)) then button3 else (create$)))))

(defmethod translate/kbd/query
  ()
  ; This method has to be defined by the programmer because it is application
  ; specific. By default, if we don't know what the value is then just return
  ; the original rune value.
  (bind ?rune (kbd/query))
  (return (switch ?rune
                  (case -1 then NIL)
                  (case 0 then NIL)
                  (case 27 then ESC)
                  (case 61454 then UP)
                  (case 63488 then DOWN) ; Plan9's down :/
                  (case 128 then DOWN) ; this is the value I get for down
                  (case 61457 then LEFT)
                  (case 61458 then RIGHT)
                  (default ?rune))))
(defclass mouse
  (is-a USER)
  (multislot position
             (create-accessor read))
  (multislot buttons
             (create-accessor read))
  (slot timestamp
             (type INTEGER)
             (create-accessor read))
  (message-handler clear primary)
  (message-handler query primary))

(defmessage-handler mouse clear primary
                    ()
                    (bind ?self:position (create$))
                    (bind ?self:buttons (create$))
                    (bind ?self:timestamp 0))

(defmessage-handler mouse query primary
                    ()
                    (bind ?out (mouse/query))
                    (if ?out then
                      (bind ?self:position (bind ?tmp (mouse/position)))
                      (bind ?self:buttons (translate/mouse/buttons))
                      (bind ?self:timestamp (mouse/timestamp)))
                    (return ?out))

(definstances mouse-object
              (mouse of mouse))

(defclass keyboard
  (is-a USER)
  (multislot keys
             (type SYMBOL INTEGER)
             (create-accessor read))
  (slot length
        (type INTEGER)
        (create-accessor read))
  ; behavior slots
  ; should we append to the list of keys?
  (slot append-on-query
        (type SYMBOL)
        (allowed-symbols FALSE TRUE))
  ; Should we attempt to convert from raw codes to symbols?
  (slot raw-keycodes
        (type SYMBOL)
        (allowed-symbols FALSE TRUE))
  (message-handler clear primary)
  (message-handler query primary))

(defmessage-handler keyboard clear primary
                    ()
                    (slot-direct-delete$ keys 1 ?self:length)
                    (bind ?self:length 0))

(defmessage-handler keyboard query primary
                    "Get a key from the native runtime queue"
                    ()
                    (bind ?key (if ?self:raw-keycodes then
                                 (kbd/query)
                                 else
                                 (translate/kbd/query)))

                    (if ?self:append-on-query then
                      (slot-direct-insert$ keys
                                           (+ ?self:length 1)
                                           ?key)
                      (bind ?self:length (+ ?self:length 1))
                      else
                      (bind ?self:keys ?key)
                      (bind ?self:length 1))
                    (return ?key))

(definstances keyboard-interface
              (keyboard of keyboard))

(defgeneric quickmenu)
(defgeneric quickmenu/show)
(defgeneric translate-menu-id)
(defclass menu
  (is-a native-pointer)
  (role concrete)
  (pattern-match reactive)
  (slot pointer-class
        (source composite)
        (default menu))
  (multislot menu-entries
             (type LEXEME)
             (storage local)
             (visibility public)
             (default ?NONE))
  (message-handler get-native-arguments primary)
  (message-handler show-menu primary))

(defmessage-handler menu get-native-arguments primary
                    ()
                    ?self:menu-entries)
(defmessage-handler menu show-menu primary
                    "shows the target menu and translates it to the corresponding symbolic
                    representation"
                    (?button)
                    (translate-menu-id (menu/show ?self:pointer ?button)
                                       ?self:menu-entries))

(defmethod quickmenu/show
  "Construct a quick list and return a symbolic representation"
  ((?elements MULTIFIELD LEXEME)
   (?button INTEGER))
  (translate-menu-id (menu/show (quickmenu ?elements) ?button) ?elements))

(defmethod quickmenu
  "Defines a menu pointer without any associated object"
  (($?entries LEXEME))
  (quickmenu ?entries))

(defmethod quickmenu
  "Defines a menu pointer without any associated object"
  ((?entries MULTIFIELD LEXEME))
  (new menu (expand$ ?entries)))
(defmethod translate-menu-id
  "Handles the case when -1 is passed"
  ((?id INTEGER (= ?id -1))
   (?elements MULTIFIELD LEXEME))
  (return NIL))
(defmethod translate-menu-id
  "Translates numeric input from menu/show to symbolic representation"
  ((?id INTEGER (> ?id -1))
   (?elements MULTIFIELD LEXEME))
  ; We are one indexed while libevent is zero indexed
  (return (nth$ (+ ?id 1) ?elements)))

(defmethod translate-menu-id
  "Translates numeric input from menu/show to symbolic representation"
  ((?id INTEGER)
   ($?elements LEXEME))
  (translate-menu-id ?id ?elements))

; system initialization features
(defglobal MAIN
           ?*system-initialized* = FALSE)

(defrule initialize
         (declare (salience 10000))
         (initial-fact)
         =>
         (if (not ?*system-initialized*) then
           (eresized 0)
           (bind ?*system-initialized* TRUE)))

; on-resized handling

(defgeneric on-resized)

(defrule on-resized
         "library defined rule which calls the on-resized method"
         (declare (salience 10000))
         ?f <- (event resized new ?value)
         =>
         (retract ?f)
         (on-resized ?value))


Create task8.clp

Create task8.clp

(deffunction summ-iter (?n)
  (if (= ?n 1) then (return 1))
  (+ (/ 1 (* ?n ?n)) (summ-iter (- ?n 1)))
)

error: pathspec 'ssu-ai-level-2/chapter6/task8.clp' did not match any file(s) known to git


Deleted the player concept for the time being

;------------------------------------------------------------------------------
;The Adventure Engine
;Copyright (c) 2012-2016, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of The Adventure Engine nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; The state data relating to the player
;------------------------------------------------------------------------------
(defmodule player
           (import prompt defclass input-state)
           (export defclass item))
(defclass player::item
          (is-a USER)
          (slot title
           (type LEXEME)
           (storage local)
           (default ?NONE))
          (slot description
           (type STRING)
           (storage local)
           (default ?NONE)))


update BeerEX.clp

update BeerEX.clp

;;***********************
;;* BEER QUESTION RULES *
;;***********************

; random questions for user type and scenario recognition

(defrule determine-preferred-carbonation
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you generally prefer to drink low, medium or high carbonated drinks? 🍾")
                     (relation-asserted preferred-carbonation)
                     (valid-answers low medium high))))

(defrule determine-whether-he-is-a-regular-beer-drinker
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Are you a regular beer drinker? 🍺")
                     (relation-asserted regular-beer-drinker)
                     (valid-answers yes no))))

(defrule determine-preferred-color
   (declare (salience ?*very-high-priority*))
   (regular-beer-drinker yes)
   =>
   (assert (UI-state (display "Do you generally prefer pale, amber, brown or dark beer? 🍺")
                     (relation-asserted preferred-color)
                     (valid-answers pale amber brown dark))))

(defrule determine-preferred-fermentation
   (declare (salience ?*very-high-priority*))
   (regular-beer-drinker yes)
   =>
   (assert (UI-state (display "Do you generally prefer to drink top, bottom or wild fermented beer?")
                     (relation-asserted preferred-fermentation)
                     (valid-answers top bottom wild))))

(defrule determine-whether-he-eats-fermented-foods
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you generally eat fermented foods (probiotic yogurt, kefir, kombucha)? 🥛")
                     (relation-asserted fermented-foods-eater)
                     (valid-answers yes no))))

(defrule determine-whether-he-should-drive
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you have to drive? 🚘")
                     (relation-asserted driver)
                     (valid-answers yes no))))

(defrule determine-preferred-alcohol
   (declare (salience ?*very-high-priority*))
   (driver no)
   =>
   (assert (UI-state (display "Do you generally prefer to drink low, mild, high or very high alcoholic drinks? 🍹")
                     (relation-asserted preferred-alcohol)
                     (valid-answers low mild high "very high"))))

(defrule determine-whether-he-should-smoke-a-cigar
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you have to smoke a cigar? If yes, is the cigar claro, maduro or oscuro? 🚬")
                     (relation-asserted which-cigar)
                     (valid-answers claro maduro oscuro no))))

(defrule determine-preferred-flavor
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "What kind of flavor do you generally prefer?")
                     (relation-asserted preferred-flavor)
                     (valid-answers clean sweet bitter roasty fruity spicy sour "don't know"))))

; depth questions for meal type recognition

(defrule determine-whether-he-needs-to-pair-beer-with-a-meal
   (start)
   =>
   (assert (UI-state (display "Do you need to pair beer with a meal?")
                     (relation-asserted pair-beer-with-a-meal)
                     (valid-answers yes no)))
   (set-strategy depth))

(defrule determine-food-style
   (pair-beer-with-a-meal yes)
   =>
   (assert (UI-state (display "Are you vegetarian, vegan or omnivorous?")
                     (relation-asserted food-style)
                     (valid-answers vegetarian vegan omnivorous))))

(defrule determine-main-meal-for-omnivorous-or-vegetarian
   (pair-beer-with-a-meal yes)
   (or (food-style omnivorous)
       (food-style vegetarian))
   =>
   (assert (UI-state (display "Is the main meal pizza, entree, cheese or dessert? 🧀")
                     (relation-asserted main-meal-for-omnivorous-or-vegetarian)
                     (valid-answers pizza entree cheese dessert other))))

(defrule determine-main-meal-for-vegan
   (pair-beer-with-a-meal yes)
   (food-style vegan)
   =>
   (assert (UI-state (display "Is the main meal pizza, entree or dessert?")
                     (relation-asserted main-meal-for-vegan)
                     (valid-answers pizza entree dessert other))))

   ; ... if main meal is cheese

(defrule determine-which-cheese-style
   (main-meal-for-omnivorous-or-vegetarian cheese)
   =>
   (assert (UI-state (display (str-cat "Is the cheese style fresh (Mascarpone, Ricotta, Chèvre, Feta, Cream Cheese, "
                                       "Quark, Cottage), semi-soft (Colby, Fontina, Havarti, Monterey Jack), firm/hard "
                                       "(Gouda, Cheddar, Emmenthaler, Gruyère, Parmesan), blue (Roquefort, Gorgonzola), "
                                       "natural-rind (Brie, Camembert, Triple Crème, Mimolette, Stilton, Lancashire) "
                                       "or washed-rind (Epoisses, Livarot, Taleggio)? 🧀"))
                     (relation-asserted which-cheese-style)
                     (valid-answers fresh semi-soft firm/hard blue "natural rind" "washed rind" "don't know"))))

(defrule determine-which-fresh-cheese
   (which-cheese-style fresh)
   =>
   (assert (UI-state (display "Is the fresh cheese Mascarpone, Ricotta, Chèvre, Feta, Cream Cheese or other? 🧀")
                     (relation-asserted which-fresh-cheese)
                     (valid-answers Mascarpone Ricotta Chèvre Feta "Cream Cheese" other))))

(defrule determine-whether-he-should-eat-Mascarpone-with-fruit
   (which-fresh-cheese Mascarpone)
   =>
   (assert (UI-state (display "Do you have to eat Mascarpone with fruit?")
                     (relation-asserted mascarpone-with-fruit)
                     (valid-answers yes no))))

(defrule determine-which-semi-soft-cheese
   (which-cheese-style semi-sof)
   =>
   (assert (UI-state (display "Is the semi-soft cheese Colby, Havarti, Monterey Jack or other? 🧀")
                     (relation-asserted which-semi-soft-cheese)
                     (valid-answers Colby Havarti "Monterey Jack" other))))

(defrule determine-which-firm/hard-cheese
   (which-cheese-style firm/hard)
   =>
   (assert (UI-state (display "Is the firm/hard cheese Gouda, Cheddar, Emmenthaler, Gruyère, Parmesan or other? 🧀")
                     (relation-asserted which-firm/hard-cheese)
                     (valid-answers Gouda Cheddar Emmenthaler Gruyère Parmesan other))))

(defrule determine-which-type-of-Gouda
   (which-firm/hard-cheese Gouda)
   =>
   (assert (UI-state (display "Is the Gouda aged, smoked or other? 🧀")
                     (relation-asserted which-type-of-Gouda)
                     (valid-answers aged smoked other))))

(defrule determine-which-color-of-Cheddar
   (which-firm/hard-cheese Cheddar)
   =>
   (assert (UI-state (display "Is the Cheddar white or yellow? 🧀")
                     (relation-asserted which-color-of-Cheddar)
                     (valid-answers white yellow))))

(defrule determine-which-Cheddar-seasoning
   (which-firm/hard-cheese Cheddar)
   =>
   (assert (UI-state (display "Is the Cheddar seasoning mild, medium, aged or other? 🧀")
                     (relation-asserted which-Cheddar-seasoning)
                     (valid-answers mild medium aged other))))

(defrule determine-if-Cheddar-is-sharp
   (or (which-Cheddar-seasoning medium)
       (which-Cheddar-seasoning aged))
   =>
   (assert (UI-state (display "Is the Cheddar sharp? 🧀")
                     (relation-asserted Cheddar-is-sharp)
                     (valid-answers yes no "don't know"))))

(defrule determine-which-natural-rind-cheese
   (which-cheese-style "natural rind")
   =>
   (assert (UI-state (display (str-cat "Is the natural rind cheese Brie, Camembert, Triple Crème, Mimolette, Stilton, "
                                       "or other? 🧀"))
                     (relation-asserted which-natural-rind-cheese)
                     (valid-answers Brie Camembert "Triple Crème" Mimolette Stilton other))))

(defrule determine-which-washed-rind-cheese
   (which-cheese-style "washed rind")
   =>
   (assert (UI-state (display "Is the washed rind cheese Taleggio or other? 🧀")
                     (relation-asserted which-washed-rind-cheese)
                     (valid-answers Taleggio other))))

   ; ... if main meal is entree

(defrule determine-which-entree-omnivorous
   (food-style omnivorous)
   (main-meal-for-omnivorous-or-vegetarian entree)
   =>
   (assert (UI-state (display (str-cat "Is the main component of the entree grain (farro, arborio, wild rice, polenta), "
                                       "legumes (lentils, fava, chickpea, green beans), fish, meat, vegetables, fats "
                                       "or other?"))
                     (relation-asserted which-entree-omnivorous)
                     (valid-answers grain legumes fish meat vegetables fats other))))

(defrule determine-which-entree-vegetarian
   (food-style vegetarian)
   (main-meal-for-omnivorous-or-vegetarian entree)
   =>
   (assert (UI-state (display (str-cat "Is the main component of the entree grain (farro, arborio, wild rice, polenta), "
                                       "legumes (lentils, fava, chickpea, green beans), vegetables, vegetables fats "
                                       "(avocados, olive oil, peanut butter, nuts and seeds) or other?"))
                     (relation-asserted which-entree-vegetarian)
                     (valid-answers grain legumes vegetables "vegetables fats" other))))

(defrule determine-which-entree-vegan
   (main-meal-for-vegan entree)
   =>
   (assert (UI-state (display (str-cat "Is the main component of the entree grain (farro, arborio, wild rice, polenta), "
                                       "legumes (lentils, fava, chickpea, green beans), vegetables, vegetables fats "
                                       "(avocados, olive oil, peanut butter, nuts and seeds), or other?"))
                     (relation-asserted which-entree-vegan)
                     (valid-answers grain legumes vegetables "vegetables fats" other))))

(defrule determine-which-vegetables
   (or (which-entree-omnivorous vegetables)
       (which-entree-vegetarian vegetables)
       (which-entree-vegan vegetables))
   =>
   (assert (UI-state (display (str-cat "Does the vegetables are root (parsnips, carrots), grilled (peppers, onions, "
                                       "mushrooms) or other?"))
                     (relation-asserted which-vegetables)
                     (valid-answers root grilled other))))

(defrule determine-which-fish
   (which-entree-omnivorous fish)
   =>
   (assert (UI-state (display (str-cat "Does the fish is shellfish (clams, scallops, lobster, crab), bluefish (salmon, "
                                        "trout, tuna) or other? 🦐 🐟"))
                     (relation-asserted which-fish)
                     (valid-answers shellfish bluefish other))))

(defrule determine-which-fats
   (which-entree-omnivorous fats)
   =>
   (assert (UI-state (display (str-cat "Does the fats are vegetable (avocados, olive oil, peanut butter, nuts "
                                       "and seeds) or animal (duck/pork fat, dairy)?"))
                     (relation-asserted which-fats)
                     (valid-answers vegetable animal other))))

(defrule determine-which-meat
   (which-entree-omnivorous meat)
   =>
   (assert (UI-state (display (str-cat "Does the meat is rich meats (beef strip loin, lamb), game birds (duck, quail, "
                                       "quinoa), braised meats (beef short-rib, pork shoulder), pork or other?"))
                     (relation-asserted which-meat)
                     (valid-answers "rich meats" "game birds" "braised meats" pork other))))

(defrule determine-which-pork
   (which-meat pork)
   =>
   (assert (UI-state (display "Does the pork is prosciutto, speck, mortadella, sausage or other?")
                     (relation-asserted which-pork)
                     (valid-answers prosciutto speck mortadella sausage other))))

(defrule determine-which-sausage
   (which-pork sausage)
   =>
   (assert (UI-state (display "Does the sausage is capocollo, soppressata, salame piccante or other?")
                     (relation-asserted which-sausage)
                     (valid-answers capocollo soppressata "salame piccante" other))))

(defrule determine-which-dessert
   (or (which-entree-omnivorous dessert)
       (which-entree-vegetarian dessert))
   =>
   (assert (UI-state (display (str-cat "Does the dessert is creamy (cheesecake, ice cream, creme brûlée, mousse cake), "
                                       "chocolate or other? 🍫"))
                     (relation-asserted which-dessert)
                     (valid-answers creamy chocolate other))))

(defrule determine-which-chocolate
   (which-dessert chocolate)
   =>
   (assert (UI-state (display (str-cat "Does the chocolate is white, milk (35% cacao ca.), semisweet (55% cacao ca.), "
                                       "bittersweet (70% cacao ca.) or unsweetened/bitter (100% cacao)? 🍫"))
                     (relation-asserted which-chocolate)
                     (valid-answers white milk semisweet bittersweet unsweetened/bitter "don't know"))))

;(defrule determine-predominant-dish-taste
;   (start)
;   =>
;   (assert (UI-state (display "Which is the predominant taste of the dish?")
;                     (relation-asserted predominant-dish-taste)
;                     (valid-answers sweet acid spice umami "not tasted yet"))))

;(defrule determine-dish-cooking-method
;   (start)
;   =>
;   (assert (UI-state (display (str-cat "Does the dish cooking method is dry-heat (broiling, grilling, roasting, baking, "
;                                       "sautéing, pan-frying, deep-frying), moist-heat (poaching, simmering, boiling, "
;                                       "steaming) or it is a combination of both (braising, stewing)?"))
;                     (relation-asserted dish-cooking-method)
;                     (valid-answers dry-heat moist-heat combination "don't know"))))

;;***********************
;;* BEER QUESTION RULES *
;;***********************

; random questions for user type and scenario recognition

(defrule determine-preferred-carbonation
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you generally prefer to drink low, medium or high carbonated drinks? 🍾")
                     (help "help")
                     (why "why")
                     (relation-asserted preferred-carbonation)
                     (valid-answers low medium high))))

(defrule determine-whether-he-is-a-regular-beer-drinker
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Are you a regular beer drinker? 🍺")
                     (relation-asserted regular-beer-drinker)
                     (valid-answers yes no))))

(defrule determine-preferred-color
   (declare (salience ?*very-high-priority*))
   (regular-beer-drinker yes)
   =>
   (assert (UI-state (display "Do you generally prefer pale, amber, brown or dark beer? 🍺")
                     (relation-asserted preferred-color)
                     (valid-answers pale amber brown dark))))

(defrule determine-preferred-fermentation
   (declare (salience ?*very-high-priority*))
   (regular-beer-drinker yes)
   =>
   (assert (UI-state (display "Do you generally prefer to drink top, bottom or wild fermented beer?")
                     (relation-asserted preferred-fermentation)
                     (valid-answers top bottom wild))))

(defrule determine-whether-he-eats-fermented-foods
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you generally eat fermented foods (probiotic yogurt, kefir, kombucha)? 🥛")
                     (relation-asserted fermented-foods-eater)
                     (valid-answers yes no))))

(defrule determine-whether-he-should-drive
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you have to drive? 🚘")
                     (relation-asserted driver)
                     (valid-answers yes no))))

(defrule determine-preferred-alcohol
   (declare (salience ?*very-high-priority*))
   (driver no)
   =>
   (assert (UI-state (display "Do you generally prefer to drink low, mild, high or very high alcoholic drinks? 🍹")
                     (relation-asserted preferred-alcohol)
                     (valid-answers low mild high "very high"))))

(defrule determine-whether-he-should-smoke-a-cigar
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "Do you have to smoke a cigar? If yes, is the cigar claro, maduro or oscuro? 🚬")
                     (relation-asserted which-cigar)
                     (valid-answers claro maduro oscuro no))))

(defrule determine-preferred-flavor
   (declare (salience ?*very-high-priority*))
   (start)
   =>
   (assert (UI-state (display "What kind of flavor do you generally prefer?")
                     (relation-asserted preferred-flavor)
                     (valid-answers clean sweet bitter roasty fruity spicy sour "don't know"))))

; depth questions for meal type recognition

(defrule determine-whether-he-needs-to-pair-beer-with-a-meal
   (start)
   =>
   (assert (UI-state (display "Do you need to pair beer with a meal?")
                     (relation-asserted pair-beer-with-a-meal)
                     (valid-answers yes no)))
   (set-strategy depth))

(defrule determine-food-style
   (pair-beer-with-a-meal yes)
   =>
   (assert (UI-state (display "Are you vegetarian, vegan or omnivorous?")
                     (relation-asserted food-style)
                     (valid-answers vegetarian vegan omnivorous))))

(defrule determine-main-meal-for-omnivorous-or-vegetarian
   (pair-beer-with-a-meal yes)
   (or (food-style omnivorous)
       (food-style vegetarian))
   =>
   (assert (UI-state (display "Is the main meal pizza, entree, cheese or dessert? 🧀")
                     (relation-asserted main-meal-for-omnivorous-or-vegetarian)
                     (valid-answers pizza entree cheese dessert other))))

(defrule determine-main-meal-for-vegan
   (pair-beer-with-a-meal yes)
   (food-style vegan)
   =>
   (assert (UI-state (display "Is the main meal pizza, entree or dessert?")
                     (relation-asserted main-meal-for-vegan)
                     (valid-answers pizza entree dessert other))))

   ; ... if main meal is cheese

(defrule determine-which-cheese-style
   (main-meal-for-omnivorous-or-vegetarian cheese)
   =>
   (assert (UI-state (display (str-cat "Is the cheese style fresh (Mascarpone, Ricotta, Chèvre, Feta, Cream Cheese, "
                                       "Quark, Cottage), semi-soft (Colby, Fontina, Havarti, Monterey Jack), firm/hard "
                                       "(Gouda, Cheddar, Emmenthaler, Gruyère, Parmesan), blue (Roquefort, Gorgonzola), "
                                       "natural-rind (Brie, Camembert, Triple Crème, Mimolette, Stilton, Lancashire) "
                                       "or washed-rind (Epoisses, Livarot, Taleggio)? 🧀"))
                     (relation-asserted which-cheese-style)
                     (valid-answers fresh semi-soft firm/hard blue "natural rind" "washed rind" "don't know"))))

(defrule determine-which-fresh-cheese
   (which-cheese-style fresh)
   =>
   (assert (UI-state (display "Is the fresh cheese Mascarpone, Ricotta, Chèvre, Feta, Cream Cheese or other? 🧀")
                     (relation-asserted which-fresh-cheese)
                     (valid-answers Mascarpone Ricotta Chèvre Feta "Cream Cheese" other))))

(defrule determine-whether-he-should-eat-Mascarpone-with-fruit
   (which-fresh-cheese Mascarpone)
   =>
   (assert (UI-state (display "Do you have to eat Mascarpone with fruit?")
                     (relation-asserted mascarpone-with-fruit)
                     (valid-answers yes no))))

(defrule determine-which-semi-soft-cheese
   (which-cheese-style semi-sof)
   =>
   (assert (UI-state (display "Is the semi-soft cheese Colby, Havarti, Monterey Jack or other? 🧀")
                     (relation-asserted which-semi-soft-cheese)
                     (valid-answers Colby Havarti "Monterey Jack" other))))

(defrule determine-which-firm/hard-cheese
   (which-cheese-style firm/hard)
   =>
   (assert (UI-state (display "Is the firm/hard cheese Gouda, Cheddar, Emmenthaler, Gruyère, Parmesan or other? 🧀")
                     (relation-asserted which-firm/hard-cheese)
                     (valid-answers Gouda Cheddar Emmenthaler Gruyère Parmesan other))))

(defrule determine-which-type-of-Gouda
   (which-firm/hard-cheese Gouda)
   =>
   (assert (UI-state (display "Is the Gouda aged, smoked or other? 🧀")
                     (relation-asserted which-type-of-Gouda)
                     (valid-answers aged smoked other))))

(defrule determine-which-color-of-Cheddar
   (which-firm/hard-cheese Cheddar)
   =>
   (assert (UI-state (display "Is the Cheddar white or yellow? 🧀")
                     (relation-asserted which-color-of-Cheddar)
                     (valid-answers white yellow))))

(defrule determine-which-Cheddar-seasoning
   (which-firm/hard-cheese Cheddar)
   =>
   (assert (UI-state (display "Is the Cheddar seasoning mild, medium, aged or other? 🧀")
                     (relation-asserted which-Cheddar-seasoning)
                     (valid-answers mild medium aged other))))

(defrule determine-if-Cheddar-is-sharp
   (or (which-Cheddar-seasoning medium)
       (which-Cheddar-seasoning aged))
   =>
   (assert (UI-state (display "Is the Cheddar sharp? 🧀")
                     (relation-asserted Cheddar-is-sharp)
                     (valid-answers yes no "don't know"))))

(defrule determine-which-natural-rind-cheese
   (which-cheese-style "natural rind")
   =>
   (assert (UI-state (display (str-cat "Is the natural rind cheese Brie, Camembert, Triple Crème, Mimolette, Stilton, "
                                       "or other? 🧀"))
                     (relation-asserted which-natural-rind-cheese)
                     (valid-answers Brie Camembert "Triple Crème" Mimolette Stilton other))))

(defrule determine-which-washed-rind-cheese
   (which-cheese-style "washed rind")
   =>
   (assert (UI-state (display "Is the washed rind cheese Taleggio or other? 🧀")
                     (relation-asserted which-washed-rind-cheese)
                     (valid-answers Taleggio other))))

   ; ... if main meal is entree

(defrule determine-which-entree-omnivorous
   (food-style omnivorous)
   (main-meal-for-omnivorous-or-vegetarian entree)
   =>
   (assert (UI-state (display (str-cat "Is the main component of the entree grain (farro, arborio, wild rice, polenta), "
                                       "legumes (lentils, fava, chickpea, green beans), fish, meat, vegetables, fats "
                                       "or other?"))
                     (relation-asserted which-entree-omnivorous)
                     (valid-answers grain legumes fish meat vegetables fats other))))

(defrule determine-which-entree-vegetarian
   (food-style vegetarian)
   (main-meal-for-omnivorous-or-vegetarian entree)
   =>
   (assert (UI-state (display (str-cat "Is the main component of the entree grain (farro, arborio, wild rice, polenta), "
                                       "legumes (lentils, fava, chickpea, green beans), vegetables, vegetables fats "
                                       "(avocados, olive oil, peanut butter, nuts and seeds) or other?"))
                     (relation-asserted which-entree-vegetarian)
                     (valid-answers grain legumes vegetables "vegetables fats" other))))

(defrule determine-which-entree-vegan
   (main-meal-for-vegan entree)
   =>
   (assert (UI-state (display (str-cat "Is the main component of the entree grain (farro, arborio, wild rice, polenta), "
                                       "legumes (lentils, fava, chickpea, green beans), vegetables, vegetables fats "
                                       "(avocados, olive oil, peanut butter, nuts and seeds), or other?"))
                     (relation-asserted which-entree-vegan)
                     (valid-answers grain legumes vegetables "vegetables fats" other))))

(defrule determine-which-vegetables
   (or (which-entree-omnivorous vegetables)
       (which-entree-vegetarian vegetables)
       (which-entree-vegan vegetables))
   =>
   (assert (UI-state (display (str-cat "Does the vegetables are root (parsnips, carrots), grilled (peppers, onions, "
                                       "mushrooms) or other?"))
                     (relation-asserted which-vegetables)
                     (valid-answers root grilled other))))

(defrule determine-which-fish
   (which-entree-omnivorous fish)
   =>
   (assert (UI-state (display (str-cat "Does the fish is shellfish (clams, scallops, lobster, crab), bluefish (salmon, "
                                        "trout, tuna) or other? 🦐 🐟"))
                     (relation-asserted which-fish)
                     (valid-answers shellfish bluefish other))))

(defrule determine-which-fats
   (which-entree-omnivorous fats)
   =>
   (assert (UI-state (display (str-cat "Does the fats are vegetable (avocados, olive oil, peanut butter, nuts "
                                       "and seeds) or animal (duck/pork fat, dairy)?"))
                     (relation-asserted which-fats)
                     (valid-answers vegetable animal other))))

(defrule determine-which-meat
   (which-entree-omnivorous meat)
   =>
   (assert (UI-state (display (str-cat "Does the meat is rich meats (beef strip loin, lamb), game birds (duck, quail, "
                                       "quinoa), braised meats (beef short-rib, pork shoulder), pork or other?"))
                     (relation-asserted which-meat)
                     (valid-answers "rich meats" "game birds" "braised meats" pork other))))

(defrule determine-which-pork
   (which-meat pork)
   =>
   (assert (UI-state (display "Does the pork is prosciutto, speck, mortadella, sausage or other?")
                     (relation-asserted which-pork)
                     (valid-answers prosciutto speck mortadella sausage other))))

(defrule determine-which-sausage
   (which-pork sausage)
   =>
   (assert (UI-state (display "Does the sausage is capocollo, soppressata, salame piccante or other?")
                     (relation-asserted which-sausage)
                     (valid-answers capocollo soppressata "salame piccante" other))))

(defrule determine-which-dessert
   (or (which-entree-omnivorous dessert)
       (which-entree-vegetarian dessert))
   =>
   (assert (UI-state (display (str-cat "Does the dessert is creamy (cheesecake, ice cream, creme brûlée, mousse cake), "
                                       "chocolate or other? 🍫"))
                     (relation-asserted which-dessert)
                     (valid-answers creamy chocolate other))))

(defrule determine-which-chocolate
   (which-dessert chocolate)
   =>
   (assert (UI-state (display (str-cat "Does the chocolate is white, milk (35% cacao ca.), semisweet (55% cacao ca.), "
                                       "bittersweet (70% cacao ca.) or unsweetened/bitter (100% cacao)? 🍫"))
                     (relation-asserted which-chocolate)
                     (valid-answers white milk semisweet bittersweet unsweetened/bitter "don't know"))))

;(defrule determine-predominant-dish-taste
;   (start)
;   =>
;   (assert (UI-state (display "Which is the predominant taste of the dish?")
;                     (relation-asserted predominant-dish-taste)
;                     (valid-answers sweet acid spice umami "not tasted yet"))))

;(defrule determine-dish-cooking-method
;   (start)
;   =>
;   (assert (UI-state (display (str-cat "Does the dish cooking method is dry-heat (broiling, grilling, roasting, baking, "
;                                       "sautéing, pan-frying, deep-frying), moist-heat (poaching, simmering, boiling, "
;                                       "steaming) or it is a combination of both (braising, stewing)?"))
;                     (relation-asserted dish-cooking-method)
;                     (valid-answers dry-heat moist-heat combination "don't know"))))


src/tools/conv/gl/Types/FileRelated.clp: Removed the message template

This has been done because cortex already defines one.

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; FileRelated.clp - Defines file related objects and templates
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
(defclass types::opened-file
  (is-a Object)
  (slot file-id)
  (slot index (type INTEGER) (range 0 ?VARIABLE))
  (message-handler next-index)
  (message-handler read-line)
  (message-handler close-file))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file read-line ()
                    (readline ?self:file-id))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file close-file ()
                    (close ?self:file-id))
;------------------------------------------------------------------------------
(defclass types::file-line
  (is-a Object)
  (slot index)
  (slot type)
  (multislot contents))
;------------------------------------------------------------------------------
(defclass types::heading-span
  "Defines a span between two different headings"
  (is-a Object)
  (slot header-name)
  (slot from)
  (slot to)
  (multislot contents))
;------------------------------------------------------------------------------
(deftemplate types::message
             (slot from)
             (slot to)
             (slot action)
             (multislot arguments))
;------------------------------------------------------------------------------


Fixed a bug in define-header-spans

Fixed a bug in define-header-spans

I had marked the type of the file-line to be header when it should be heading.
This has been fixed.

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLConstantConversion.clp - an expert system that reads a define and generates
; conversion code for it.
;------------------------------------------------------------------------------
(defclass opened-file
  (is-a USER)
  (slot id)
  (slot index (type INTEGER) (range 0 ?VARIABLE))
  (message-handler next-index)
  (message-handler read-line)
  (message-handler close-file))
;------------------------------------------------------------------------------
(defmessage-handler opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler opened-file read-line ()
                    (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler opened-file close-file ()
                    (close ?self:id))
;------------------------------------------------------------------------------
(deftemplate file-line
             (slot index)
             (slot parent)
             (slot type)
             (multifield contents))
;------------------------------------------------------------------------------
(deftemplate heading-span
             "Defines a span between two different headings"
             (slot from)
             (slot to)
             (slot parent)
             (slot distance))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction get-input-form-factor ()
             (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule open-target-file
         "This rule takes a fact of the above INPUT FORM and attempts to open the file"
         ?fct <- (parse constant file ?path)
         =>
         (bind ?name (gensym*))
         (retract ?fct)
         (if (open ?path ?name "r") then
           (make-instance of opened-file (id ?name) (index 0))
           (assert (read file ?name))
           else
           (printout t "ERROR: target file at " ?path " does not exist!" crlf
                     "Halting!" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule build-file-line
         ?fct <- (read file ?fid)
         ?obj <- (object (is-a opened-file)
                         (id ?fid))
         =>
         (retract ?fct)
         (bind ?result (send ?obj read-line))
         (if (neq ?result EOF) then
           (assert (read file ?fid)
                   (file-line (index (send ?obj next-index))
                              (type UNKNOWN)
                              (parent ?fid)
                              (contents (explode$ ?result))))
           else
           (send ?obj close-file)
           (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule retract-unknowns
         (declare (salience -10))
         ?f <- (file-line (type UNKNOWN))
         =>
         (retract ?f))
;------------------------------------------------------------------------------
(defrule mark-heading-groups
         "Tags lines that consist of /* $? */ as group headings"
         ?f <- (file-line (type UNKNOWN)
                          (contents /* $? */))
         =>
         (modify ?f (type heading)))
;------------------------------------------------------------------------------
(defrule mark-entry-line
         "Tags lines that are defines and modifies the associated contents"
         ?f <- (file-line (type UNKNOWN)
                          (contents #define ?name ?))
         =>
         (modify ?f (type #define) (contents ?name)))
;------------------------------------------------------------------------------
(defrule merge-three-line-headers
         "Merges simple three line headings into one rule"
         ?f0 <- (file-line (index ?i)
                           (type UNKNOWN)
                           (contents /*))
         ?f1 <- (file-line (index ?i2&:(= ?i2 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents * $?c))
         ?f2 <- (file-line (index ?i3&:(= ?i3 (+ ?i 2)))
                           (type UNKNOWN)
                           (contents */))
         =>
         (retract ?f1 ?f2)
         (modify ?f0 (contents /* $?c */)))
;------------------------------------------------------------------------------
(defrule mark-glapi-calls
         "marks glapi calls"
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $? "(" $? ")"))
         =>
         (modify ?f (type GLAPI-DEF)))
;------------------------------------------------------------------------------
(defrule merge-potential-glapi-calls
         "Merges the next line of a GLAPI call if the line doesn't end with )"
         (declare (salience -1))
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $?vals "(" $?c)
                          (index ?i))
         (test (not (member$ ")" $?c)))
         ?f0 <- (file-line (index ?i0&:(= ?i0 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents $?contents))
         =>
         (retract ?f)
         (modify ?f0 (contents GLAPI $?vals "(" $?c $?contents)))
;------------------------------------------------------------------------------
(defrule define-header-spans
         "Defines spans between headers"
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i))
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i2&:(< ?i2 ?i)))
         =>
         (bind ?difference (- ?i ?i2))
         (if (> ?difference 0) then
         (assert (heading-span (from ?i)
                  (to ?i2)
                  (parent ?parent)
                  (distance ?difference)))))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLConstantConversion.clp - an expert system that reads a define and generates
; conversion code for it.
;------------------------------------------------------------------------------
(defclass opened-file
  (is-a USER)
  (slot id)
  (slot index (type INTEGER) (range 0 ?VARIABLE))
  (message-handler next-index)
  (message-handler read-line)
  (message-handler close-file))
;------------------------------------------------------------------------------
(defmessage-handler opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler opened-file read-line ()
                    (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler opened-file close-file ()
                    (close ?self:id))
;------------------------------------------------------------------------------
(deftemplate file-line
             (slot index)
             (slot parent)
             (slot type)
             (multifield contents))
;------------------------------------------------------------------------------
(deftemplate heading-span
             "Defines a span between two different headings"
             (slot from)
             (slot to)
             (slot parent)
             (slot distance))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction get-input-form-factor ()
             (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule open-target-file
         "This rule takes a fact of the above INPUT FORM and attempts to open the file"
         ?fct <- (parse constant file ?path)
         =>
         (bind ?name (gensym*))
         (retract ?fct)
         (if (open ?path ?name "r") then
           (make-instance of opened-file (id ?name) (index 0))
           (assert (read file ?name))
           else
           (printout t "ERROR: target file at " ?path " does not exist!" crlf
                     "Halting!" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule build-file-line
         ?fct <- (read file ?fid)
         ?obj <- (object (is-a opened-file)
                         (id ?fid))
         =>
         (retract ?fct)
         (bind ?result (send ?obj read-line))
         (if (neq ?result EOF) then
           (assert (read file ?fid)
                   (file-line (index (send ?obj next-index))
                              (type UNKNOWN)
                              (parent ?fid)
                              (contents (explode$ ?result))))
           else
           (send ?obj close-file)
           (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule retract-unknowns
         (declare (salience -10))
         ?f <- (file-line (type UNKNOWN))
         =>
         (retract ?f))
;------------------------------------------------------------------------------
(defrule mark-heading-groups
         "Tags lines that consist of /* $? */ as group headings"
         ?f <- (file-line (type UNKNOWN)
                          (contents /* $? */))
         =>
         (modify ?f (type heading)))
;------------------------------------------------------------------------------
(defrule mark-entry-line
         "Tags lines that are defines and modifies the associated contents"
         ?f <- (file-line (type UNKNOWN)
                          (contents #define ?name ?))
         =>
         (modify ?f (type #define) (contents ?name)))
;------------------------------------------------------------------------------
(defrule merge-three-line-headers
         "Merges simple three line headings into one rule"
         ?f0 <- (file-line (index ?i)
                           (type UNKNOWN)
                           (contents /*))
         ?f1 <- (file-line (index ?i2&:(= ?i2 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents * $?c))
         ?f2 <- (file-line (index ?i3&:(= ?i3 (+ ?i 2)))
                           (type UNKNOWN)
                           (contents */))
         =>
         (retract ?f1 ?f2)
         (modify ?f0 (contents /* $?c */)))
;------------------------------------------------------------------------------
(defrule mark-glapi-calls
         "marks glapi calls"
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $? "(" $? ")"))
         =>
         (modify ?f (type GLAPI-DEF)))
;------------------------------------------------------------------------------
(defrule merge-potential-glapi-calls
         "Merges the next line of a GLAPI call if the line doesn't end with )"
         (declare (salience -1))
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $?vals "(" $?c)
                          (index ?i))
         (test (not (member$ ")" $?c)))
         ?f0 <- (file-line (index ?i0&:(= ?i0 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents $?contents))
         =>
         (retract ?f)
         (modify ?f0 (contents GLAPI $?vals "(" $?c $?contents)))
;------------------------------------------------------------------------------
(defrule define-header-spans
         "Defines spans between headers"
         (file-line (type header)
                    (parent ?parent)
                    (index ?i))
         (file-line (type header)
                    (parent ?parent)
                    (index ?i2&:(< ?i2 ?i)))
         =>
         (bind ?difference (- ?i ?i2))
         (if (> ?difference 0) then
         (assert (heading-span (from ?i)
                  (to ?i2)
                  (parent ?parent)
                  (distance ?difference)))))
;------------------------------------------------------------------------------