Added documentation to CLIPS function send-response.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		DEFTEMPLATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftemplate waiting
	(slot cmd (type STRING))
	(slot id (type INTEGER))
	(slot args (type STRING))
	(slot timeout
		(type INTEGER)
		(range 0 ?VARIABLE)
	)
	(slot attempts
		(type INTEGER)
		(range 1 ?VARIABLE)
	)
	(slot symbol
		(type SYMBOL)
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		BB FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deffunction send-command
	; Receives: command, symbol identifier, cmd_params and optionally
	;timeout and number of attempts in case it times out or fails.
	; Symbol identifier is useful for tracking responses through rules.
	(?cmd ?sym ?args $?settings)
	(bind ?timeout ?*defaultTimeout*)
	(bind ?attempts ?*defaultAttempts*)
	(switch (length$ $?settings)
		(case 1 then
			(bind ?timeout (nth$ 1 $?settings))
		)
		(case 2 then
			(bind ?timeout (nth$ 1 $?settings))
			(bind ?attempts (nth$ 2 $?settings))
		)
	)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(if (> ?timeout 0) then
		(setCmdTimer ?timeout ?cmd ?id)
	)
	(assert
		(waiting (cmd ?cmd) (id ?id) (args ?args) (timeout ?timeout) (attempts ?attempts) (symbol ?sym) )
	)
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
	(return ?id)
)

(deffunction send-response
	; Receives: command, id, result and params
	(?cmd ?id ?result ?params)
	(python-call SendResponse ?cmd ?id ?result ?params)
	(log-message INFO "Sent response: '" ?cmd "' - id: " ?id " - result: " ?result "params: " ?params)
;	(halt)
)

(deffunction create-shared_var
	; Receives: type and name
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name)
	(bind ?resp (python-call CreateSharedVar ?type ?name))
	(if (eq ?resp 1) then
		(log-message INFO "Created SharedVar: " ?name)
	else
		(log-message WARNING "SharedVar: '" ?name "' could NOT be created!")
	)
	(return ?resp)
)

(deffunction write-shared_var
	; Receives: type, name and data
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name $?data)
	(bind ?resp (python-call WriteSharedVar ?type ?name $?data))
	(if (eq ?resp 1) then
		(log-message INFO "Written to SharedVar: '" ?name "' - " $?data)
	else
		(log-message WARNING "Could NOT write to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

(deffunction subscribe_to-shared_var
	; Receives: name and optionally subscription type and report type
	; Subscription type is one of: creation | writemodule | writeothers | writeany
	; report type is one of: content | notify
	(?name $?options)
	(bind ?resp (python-call SubscribeToSharedVar ?name $?options) )
	(if (eq ?resp 1) then
		(log-message INFO "Subscribed to SharedVar: '" ?name "'")
		(assert
			(BB_subscribed_to_var ?name)
		)
	else
		(log-message WARNING "Could NOT subscribe to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		RULES TO HANDLE BB (PYTHON) ASSERTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-waiting-timedout-without_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts 1) (args ?args) (timeout ?timeout&~0) (symbol ?sym) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(assert
		(BB_answer ?cmd ?sym 0 ?args)
	)
	(retract ?w ?BB)
	(log-message WARNING "Command timedout w/o attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms")
)

(defrule BB-waiting-timedout-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(retract ?BB)
	(log-message WARNING "Command timedout w/ attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(bind ?attempts (- ?attempts 1))
	(modify ?w (id ?id) (attempts ?attempts))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-failed-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_received ?cmd ?id 0 ?)
	=>
	(retract ?BB)
	(log-message WARNING "Command failed w/ attempts: '" ?cmd "' - id: " ?id " - attempts: " ?attempts)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(modify ?w (id ?id) (attempts (- ?attempts 1)))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-set_answer
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts ?attempts) (symbol ?sym))
	?BB <-(BB_received ?cmd ?id ?result ?params)
	(test (or (eq ?result 1) (eq ?attempts 1)))
	=>
	(retract ?w ?BB)
	(assert
		(BB_answer ?cmd ?sym ?result ?params)
	)
	(log-message INFO "Answer received: '" ?cmd "' - id: " ?id " - successful: " ?result " - response: " ?params)
)

(defrule BB-clear-timers
	(declare (salience -1000))
	?t <-(BB_timer ?cmd ?id)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?t)
	(log-message INFO "Clearing timer for command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_response
	(declare (salience -1000))
	?BB <-(BB_received ?cmd ?id $?)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?BB)
	(log-message WARNING "Clearing unhandled response from command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_answer
	(declare (salience -1000))
	?BB <-(BB_answer ?cmd ?sym ?result ?params)
	=>
	(retract ?BB)
	(log-message INFO "Clearing answer from command: '" ?cmd "' - sym: " ?sym "' - result: " ?result "' - params: " ?params)
)

;	HANDLE SHARED VAR UPDATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-set_sv_update
	?BB <-(BB_sv_updated ?var $?values)
	=>
	(retract ?BB)
	(log-message INFO "Shared var updated: " ?var "\t\t-\t\tvalue: " $?values)
	;(printout t "Shared var updated: " ?var crlf "value: " $?values crlf)
)

(defrule BB-clear_sv_update
	(declare (salience -10000))
	?BB <-(BB_sv_updated $?)
	=>
	(retract ?BB)
)

(defrule BB-unknown-command
	(declare (salience -10000))
	?BB <-(BB_cmd ?cmd ?id ?params)
	=>
	(retract ?BB)
	(send-response ?cmd ?id FALSE "unknown command")
	(log-message WARNING "Unhandled command received: " ?cmd)
;	(halt)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		DEFTEMPLATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftemplate waiting
	(slot cmd (type STRING))
	(slot id (type INTEGER))
	(slot args (type STRING))
	(slot timeout
		(type INTEGER)
		(range 0 ?VARIABLE)
	)
	(slot attempts
		(type INTEGER)
		(range 1 ?VARIABLE)
	)
	(slot symbol
		(type SYMBOL)
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		BB FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deffunction send-command
	; Receives: command, symbol identifier, cmd_params and optionally
	;timeout and number of attempts in case it times out or fails.
	; Symbol identifier is useful for tracking responses through rules.
	(?cmd ?sym ?args $?settings)
	(bind ?timeout ?*defaultTimeout*)
	(bind ?attempts ?*defaultAttempts*)
	(switch (length$ $?settings)
		(case 1 then
			(bind ?timeout (nth$ 1 $?settings))
		)
		(case 2 then
			(bind ?timeout (nth$ 1 $?settings))
			(bind ?attempts (nth$ 2 $?settings))
		)
	)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(if (> ?timeout 0) then
		(setCmdTimer ?timeout ?cmd ?id)
	)
	(assert
		(waiting (cmd ?cmd) (id ?id) (args ?args) (timeout ?timeout) (attempts ?attempts) (symbol ?sym) )
	)
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
	(return ?id)
)

(deffunction send-response
	(?cmd ?id ?result ?params)
	(python-call SendResponse ?cmd ?id ?result ?params)
	(log-message INFO "Sent response: '" ?cmd "' - id: " ?id " - result: " ?result "params: " ?params)
;	(halt)
)

(deffunction create-shared_var
	; Receives: type and name
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name)
	(bind ?resp (python-call CreateSharedVar ?type ?name))
	(if (eq ?resp 1) then
		(log-message INFO "Created SharedVar: " ?name)
	else
		(log-message WARNING "SharedVar: '" ?name "' could NOT be created!")
	)
	(return ?resp)
)

(deffunction write-shared_var
	; Receives: type, name and data
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name $?data)
	(bind ?resp (python-call WriteSharedVar ?type ?name $?data))
	(if (eq ?resp 1) then
		(log-message INFO "Written to SharedVar: '" ?name "' - " $?data)
	else
		(log-message WARNING "Could NOT write to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

(deffunction subscribe_to-shared_var
	; Receives: name and optionally subscription type and report type
	; Subscription type is one of: creation | writemodule | writeothers | writeany
	; report type is one of: content | notify
	(?name $?options)
	(bind ?resp (python-call SubscribeToSharedVar ?name $?options) )
	(if (eq ?resp 1) then
		(log-message INFO "Subscribed to SharedVar: '" ?name "'")
		(assert
			(BB_subscribed_to_var ?name)
		)
	else
		(log-message WARNING "Could NOT subscribe to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		RULES TO HANDLE BB (PYTHON) ASSERTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-waiting-timedout-without_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts 1) (args ?args) (timeout ?timeout&~0) (symbol ?sym) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(assert
		(BB_answer ?cmd ?sym 0 ?args)
	)
	(retract ?w ?BB)
	(log-message WARNING "Command timedout w/o attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms")
)

(defrule BB-waiting-timedout-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(retract ?BB)
	(log-message WARNING "Command timedout w/ attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(bind ?attempts (- ?attempts 1))
	(modify ?w (id ?id) (attempts ?attempts))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-failed-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_received ?cmd ?id 0 ?)
	=>
	(retract ?BB)
	(log-message WARNING "Command failed w/ attempts: '" ?cmd "' - id: " ?id " - attempts: " ?attempts)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(modify ?w (id ?id) (attempts (- ?attempts 1)))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-set_answer
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts ?attempts) (symbol ?sym))
	?BB <-(BB_received ?cmd ?id ?result ?params)
	(test (or (eq ?result 1) (eq ?attempts 1)))
	=>
	(retract ?w ?BB)
	(assert
		(BB_answer ?cmd ?sym ?result ?params)
	)
	(log-message INFO "Answer received: '" ?cmd "' - id: " ?id " - successful: " ?result " - response: " ?params)
)

(defrule BB-clear-timers
	(declare (salience -1000))
	?t <-(BB_timer ?cmd ?id)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?t)
	(log-message INFO "Clearing timer for command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_response
	(declare (salience -1000))
	?BB <-(BB_received ?cmd ?id $?)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?BB)
	(log-message WARNING "Clearing unhandled response from command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_answer
	(declare (salience -1000))
	?BB <-(BB_answer ?cmd ?sym ?result ?params)
	=>
	(retract ?BB)
	(log-message INFO "Clearing answer from command: '" ?cmd "' - sym: " ?sym "' - result: " ?result "' - params: " ?params)
)

;	HANDLE SHARED VAR UPDATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-set_sv_update
	?BB <-(BB_sv_updated ?var $?values)
	=>
	(retract ?BB)
	(log-message INFO "Shared var updated: " ?var "\t\t-\t\tvalue: " $?values)
	;(printout t "Shared var updated: " ?var crlf "value: " $?values crlf)
)

(defrule BB-clear_sv_update
	(declare (salience -10000))
	?BB <-(BB_sv_updated $?)
	=>
	(retract ?BB)
)

(defrule BB-unknown-command
	(declare (salience -10000))
	?BB <-(BB_cmd ?cmd ?id ?params)
	=>
	(retract ?BB)
	(send-response ?cmd ?id FALSE "unknown command")
	(log-message WARNING "Unhandled command received: " ?cmd)
;	(halt)
)


Added the file that contains the Message template definition

; Message.clp - a basic template type that is used to pass messages between
; different modules
; Written by Joshua Scoggins
(deftemplate engine::message
				 "A standardized way to pass facts between modules"
				 (slot from)
				 (slot to)
				 (slot action)
				 (multislot arguments))

error: pathspec 'src/clips/modules/engine/Message.clp' did not match any file(s) known to git


Objetivos

Objetivos

; Thu May 05 11:59:51 CEST 2016
;
;+ (version "3.5")
;+ (build "Build 663")

(defclass %3ACLIPS_TOP_LEVEL_SLOT_CLASS "Fake class to save top-level slot information"
	(is-a USER)
	(role abstract)
	(single-slot grado
;+		(comment "1 - 2")
		(type INTEGER)
		(range 1 2)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot consumo+de+fruta
;+		(comment "Piezas a la semana")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot jueves
;+		(comment "ejercicios jueves")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot tiempo+diario+disponible
;+		(comment "tiempo diario en minutos")
		(type INTEGER)
		(range 30 1440)
		(cardinality 7 7)
		(create-accessor read-write))
	(multislot zona
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write))
	(multislot problemas+fisicos
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(multislot problemas
		(type INSTANCE)
;+		(allowed-classes Problema)
		(cardinality 1 ?VARIABLE)
		(create-accessor read-write))
	(multislot objetivos
		(type INSTANCE)
;+		(allowed-classes Objetivo)
		(create-accessor read-write))
	(single-slot repeticiones+maximas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot viernes
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot peso
		(type FLOAT)
		(default 75.0)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot tipo
		(type INTEGER)
		(range 1 4)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot calorias+quemadas
;+		(comment "calorias quemadas por minuto")
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot grupo_muscular
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot imc
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot picar+entre+horas
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot duracion+minima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot cansancio
		(type SYMBOL)
		(allowed-values Mucho Poco Nada)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot duracion
;+		(comment "en minutos")
		(type INTEGER)
		(default 0)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot sabado
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot lunes
;+		(comment "ejercicios lunes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot salud
		(type INSTANCE)
;+		(allowed-classes Salud)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot ejercicios+combinan
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot tests
		(type INSTANCE)
;+		(allowed-classes Test)
		(create-accessor read-write))
	(single-slot ejercicio
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot problemas+aliviados
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot frequencia
		(type SYMBOL)
		(allowed-values Diaria Semanal Mensual None)
		(default None)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot dieta
		(type INSTANCE)
;+		(allowed-classes Dieta)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot abuso+de+sal
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot ppm
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot repeticiones+minimas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot actividades
		(type INSTANCE)
;+		(allowed-classes Actividad)
		(create-accessor read-write))
	(multislot martes
;+		(comment "ejercicios martes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot edad+maxima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot pMax
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot pMin
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot edad+minima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot problemas+contraindicados
;+		(comment "problemas del usuario contraindicados para este ejercicio")
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot tirantezMuscular
		(type SYMBOL)
		(allowed-values Poco Mucho Nada)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot miercoles
;+		(comment "ejercicios miercoles")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot duracion+maxima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot grupos+musculares
;+		(comment "grupos musculares ejercitados")
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write))
	(single-slot repeticiones
		(type INTEGER)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot altura
		(type FLOAT)
		(default 1.7)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot edad
		(type INTEGER)
		(default 25)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot dificultad
		(type SYMBOL)
		(allowed-values moderada normal dificil)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot domingo
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot value
;+		(type ANY)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Persona
	(is-a USER)
	(role concrete)
	(single-slot imc
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot actividades
		(type INSTANCE)
;+		(allowed-classes Actividad)
		(create-accessor read-write))
	(single-slot altura
		(type FLOAT)
		(default 1.7)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot peso
		(type FLOAT)
		(default 75.0)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot tests
		(type INSTANCE)
;+		(allowed-classes Test)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
		(default "Paco")
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot edad
		(type INTEGER)
		(default 25)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot pMax
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot problemas+fisicos
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot pMin
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot dieta
		(type INSTANCE)
;+		(allowed-classes Dieta)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Test
	(is-a USER)
	(role concrete)
	(single-slot ppm
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot cansancio
		(type SYMBOL)
		(allowed-values Mucho Poco Nada)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot tirantezMuscular
		(type SYMBOL)
		(allowed-values Poco Mucho Nada)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Actividad
	(is-a USER)
	(role concrete)
	(single-slot duracion
;+		(comment "en minutos")
		(type INTEGER)
		(default 0)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot frequencia
		(type SYMBOL)
		(allowed-values Diaria Semanal Mensual None)
		(default None)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Actividad+de+Trabajo
	(is-a Actividad)
	(role concrete))

(defclass Actividad+fuera+de+Trabajo
	(is-a Actividad)
	(role concrete))

(defclass Estatica
	(is-a Actividad+fuera+de+Trabajo)
	(role concrete))

(defclass Tarea+domestica
	(is-a Actividad+fuera+de+Trabajo)
	(role concrete))

(defclass Desplazamiento
	(is-a Actividad+fuera+de+Trabajo)
	(role concrete))

(defclass Salud
	(is-a USER)
	(role concrete)
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Dieta
	(is-a Salud)
	(role concrete)
	(single-slot picar+entre+horas
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot consumo+de+fruta
;+		(comment "Piezas a la semana")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot abuso+de+sal
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Problema
	(is-a Salud)
	(role concrete))

(defclass Problema+musculo-esqueletico
	(is-a Problema)
	(role concrete)
	(multislot zona
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write)))

(defclass Otros+problemas
	(is-a Problema)
	(role concrete))

(defclass Problema+IMC
	(is-a Problema)
	(role concrete))

(defclass Objetivo
	(is-a USER)
	(role concrete)
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Musculacion
	(is-a Objetivo)
	(role concrete)
	(single-slot grupo_muscular
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Programa
	(is-a USER)
	(role concrete)
	(multislot jueves
;+		(comment "ejercicios jueves")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot objetivos
		(type INSTANCE)
;+		(allowed-classes Objetivo)
		(create-accessor read-write))
	(multislot tiempo+diario+disponible
;+		(comment "tiempo diario en minutos")
		(type INTEGER)
		(range 30 1440)
		(cardinality 7 7)
		(create-accessor read-write))
	(multislot lunes
;+		(comment "ejercicios lunes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot martes
;+		(comment "ejercicios martes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot sabado
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot viernes
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot miercoles
;+		(comment "ejercicios miercoles")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot domingo
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write)))

(defclass Ejercicio
	(is-a USER)
	(role concrete)
	(single-slot duracion+maxima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot duracion+minima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot repeticiones+minimas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot grupos+musculares
;+		(comment "grupos musculares ejercitados")
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot edad+maxima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot ejercicios+combinan
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot edad+minima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot objetivos
		(type INSTANCE)
;+		(allowed-classes Objetivo)
		(create-accessor read-write))
	(multislot problemas+contraindicados
;+		(comment "problemas del usuario contraindicados para este ejercicio")
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot repeticiones+maximas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot problemas+aliviados
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot calorias+quemadas
;+		(comment "calorias quemadas por minuto")
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Ejercicio+con+aparatos
	(is-a Ejercicio)
	(role concrete))

(defclass Ejercicio+de+suelo
	(is-a Ejercicio)
	(role concrete))

(defclass Ejercicio+con+pesas
	(is-a Ejercicio)
	(role concrete))

(defclass Estiramientos
	(is-a Ejercicio)
	(role concrete))

(defclass Grupo+muscular
	(is-a USER)
	(role concrete)
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Ejercicio-Persona
	(is-a USER)
	(role concrete)
	(single-slot repeticiones
		(type INTEGER)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot salud
		(type INSTANCE)
;+		(allowed-classes Salud)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot ejercicio
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot dificultad
		(type SYMBOL)
		(allowed-values moderada normal dificil)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(definstances instances
; Thu May 05 11:59:52 CEST 2016
;
;+ (version "3.5")
;+ (build "Build 663")

([Articular] of  Problema+musculo-esqueletico

	(nombre "Articular"))

([Barrer] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Barrer"))

([Bicicleta+estatica] of  Ejercicio+con+aparatos

	(calorias+quemadas 6.4)
	(duracion+maxima 90)
	(duracion+minima 20)
	(edad+maxima 60)
	(edad+minima 12)
	(ejercicios+combinan
		[Cinta+de+correr]
		[Stepper])
	(grupos+musculares
		[Cuadriceps]
		[Gemelos]
		[Gluteos])
	(nombre "Bicicleta estatica")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Articular]
		[Rodillas]))

([Brazos] of  Problema+musculo-esqueletico

	(nombre "Brazos")
	(zona
		[B%C3%ADceps]
		[Deltoides]
		[Dorsal]
		[Tr%C3%ADceps]))

([B%C3%ADceps] of  Grupo+muscular

	(nombre "Biceps"))

([Carrera+sostenida] of  Test

	(nombre "Carrera sostenida"))

([Cinta+de+correr] of  Ejercicio+con+aparatos

	(duracion+minima 20)
	(edad+minima 12)
	(ejercicios+combinan
		[Bicicleta+estatica]
		[Stepper])
	(grupos+musculares
		[Gemelos]
		[Tr%C3%ADceps])
	(nombre "Cinta de correr")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Presion+alta]
		[Articular]
		[Rodillas]))

([Colada] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Colada"))

([Compra] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Compra"))

([CouchPotato_Class0] of  Ejercicio+con+aparatos

	(calorias+quemadas 4.0)
	(duracion+maxima 30)
	(duracion+minima 10)
	(edad+minima 12)
	(ejercicios+combinan [Pesos])
	(grupos+musculares
		[B%C3%ADceps]
		[Deltoides]
		[Trapecio]
		[Tr%C3%ADceps])
	(nombre "Pesos brazos")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Presion+alta]
		[Articular])
	(repeticiones+minimas 10))

([CouchPotato_Class2] of  Problema+IMC

	(nombre "Peso insuficiente"))

([CouchPotato_Class3] of  Problema+IMC

	(nombre "Obesidad tipo 1"))

([CouchPotato_Class4] of  Problema+IMC

	(nombre "Obesidad tipo 2"))

([CouchPotato_Class5] of  Problema+IMC

	(nombre "Obesidad tipo 3"))

([CouchPotato_Class6] of  Problema+IMC

	(nombre "Obesidad tipo 4"))

([CouchPotato_Class7] of  Problema+IMC

	(nombre "Sobrepeso grado 1"))

([CouchPotato_Class8] of  Problema+IMC

	(nombre "Sobrepeso grado 2"))

([CouchPotato_Class9] of  Ejercicio+de+suelo
)

([Cuadriceps] of  Grupo+muscular

	(nombre "Cuadriceps"))

([Cuello] of  Problema+musculo-esqueletico

	(nombre "Cuello")
	(zona [Trapecio]))

([Cuidar+del+jard%C3%ADn] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Cuidar del jardin"))

([De+pie] of  Actividad+de+Trabajo

	(nombre "De pie"))

([Deltoides] of  Grupo+muscular

	(nombre "Deltoides"))

([Desplazamiento+a+pie] of  Actividad+de+Trabajo

	(nombre "Desplazamientos a pie"))

([Dorsal] of  Grupo+muscular

	(nombre "Dorsal"))

([Equilibrio] of  Objetivo

	(nombre "Equilibrio"))

([Esfuerzos+musculares] of  Actividad+de+Trabajo

	(nombre "Esfuerzos musculares"))

([Espalda] of  Problema+musculo-esqueletico

	(nombre "Espalda")
	(zona
		[Dorsal]
		[Trapecio]))

([Flexibilidad] of  Objetivo

	(nombre "Flexibilidad"))

([Fregar] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Fregar"))

([Gemelos] of  Grupo+muscular

	(nombre "Gemelos"))

([Gluteos] of  Grupo+muscular

	(nombre "Gluteos"))

([Lectura] of  Estatica

	(duracion 0)
	(frequencia None)
	(nombre "Lectura"))

([Levantamiento+de+peso] of  Actividad+de+Trabajo

	(nombre "Levantamiento de peso"))

([Mantenimiento] of  Objetivo

	(nombre "Mantenimiento"))

([Movimientos+Repetitivos] of  Actividad+de+Trabajo

	(nombre "Movimientos repetitivos"))

([Paseo] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Paseo"))

([Paseo+mascota] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Paseo mascota"))

([Pesos] of  Ejercicio+con+aparatos

	(calorias+quemadas 5.0)
	(duracion+maxima 30)
	(duracion+minima 10)
	(edad+minima 12)
	(ejercicios+combinan [CouchPotato_Class0])
	(grupos+musculares
		[Cuadriceps]
		[Gemelos]
		[Gluteos])
	(nombre "Pesos piernas")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Presion+alta]
		[Articular]
		[Rodillas])
	(repeticiones+minimas 10))

([Planchar] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Planchar"))

([Ponerse+en+forma] of  Objetivo

	(nombre "Ponerse en forma"))

([Presion+alta] of  Otros+problemas

	(nombre "Presion alta"))

([Rebajar+Peso] of  Objetivo

	(nombre "Rebajar peso"))

([Remo] of  Ejercicio+con+aparatos

	(calorias+quemadas 10.0)
	(grupos+musculares
		[B%C3%ADceps]
		[Cuadriceps]
		[Dorsal]
		[Gemelos]
		[Tr%C3%ADceps]
		[Deltoides]
		[Gluteos])
	(nombre "Remo")
	(problemas+aliviados
		[Articular]
		[Rodillas])
	(repeticiones+minimas 20))

([Rodillas] of  Problema+musculo-esqueletico

	(nombre "Rodillas")
	(zona [Gemelos]))

([Salir+a+correr] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Salir a correr"))

([Sentado] of  Actividad+de+Trabajo

	(nombre "Sentado"))

([Sistema+Card%C3%ADaco] of  Objetivo

	(nombre "Sistema cardiaco"))

([Stepper] of  Ejercicio+con+aparatos

	(calorias+quemadas 6.1)
	(duracion+maxima 30)
	(duracion+minima 10)
	(edad+maxima 55)
	(ejercicios+combinan
		[Cinta+de+correr]
		[Bicicleta+estatica])
	(grupos+musculares
		[Cuadriceps]
		[Gemelos]
		[Gluteos])
	(nombre "Stepper")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Articular]
		[Rodillas])
	(repeticiones+maximas 200)
	(repeticiones+minimas 10))

([Subir+tramos+de+escalera] of  Test

	(nombre "Subir tramos escalera"))

([Television] of  Estatica

	(duracion 0)
	(frequencia None)
	(nombre "Television"))

([Trapecio] of  Grupo+muscular

	(nombre "Trapecio"))

([Tr%C3%ADceps] of  Grupo+muscular

	(nombre "Triceps"))

)

([Troll] of Persona
	(nombre "Inigo")
	(altura 1.9)
	(peso 75)
	(imc 20))

)
;;****************
;;* DEFFUNCTIONS *
;;****************

(deffunction ask-question (?question $?allowed-values)
   (printout t ?question)
   (bind ?answer (read))
   (while (not (member ?answer ?allowed-values)) do
      (printout t ?question)
      (bind ?answer (read))
      (if (lexemep ?answer)
          then (bind ?answer (lowcase ?answer))))
   ?answer)

(deffunction si-o-no-p (?question)
   (bind ?response (ask-question ?question si no s n))
   (if (or (eq ?response si) (eq ?response s))
       then TRUE
       else FALSE))

(deffunction pregunta-general (?pregunta)
	(format t "%s" ?pregunta)
	(bind ?respuesta (read))
	?respuesta
)

(deffunction pregunta-numerica (?pregunta ?rangini ?rangfi)
	(format t "%s [%d,%d] " ?pregunta ?rangini ?rangfi)
	(bind ?respuesta (read))
	(while (not(and(>= ?respuesta ?rangini)(<= ?respuesta ?rangfi))) do
		(format t "%s [%d,%d] " ?pregunta ?rangini ?rangfi)
		(bind ?respuesta (read))
	)
	?respuesta
)

;;****************
;;* REGLAS       *
;;****************

(defmodule MAIN (export ?ALL))

(defrule presentacion
    (declare (salience 10))
    =>
    (printout t "----------------------------" crlf)
    (printout t "--Sistema de recomendacion--" crlf)
    (printout t "-----de entrenamientos------" crlf)
    (printout t "----------------------------" crlf)
    (printout t "----I'm no couch potato-----" crlf)
    (printout t "----------------------------" crlf)
    (printout t crlf)
    (focus preguntas-persona)

)

(defmodule preguntas-persona "Modulo de preguntas sobnre la persona"
  (import MAIN ?ALL)
  (export ?ALL))

(defrule pregunta-nombre
    =>
    (bind ?nombre (pregunta-general "Nombre: "))
    (assert (nombre ?nombre))
)

(deffunction anadir-ProblemaIMC (?persona ?problema)
	(bind ?instancia (find-instance ((?p Problema+IMC)) (eq (str-compare ?p:nombre ?problema) 0)))
	(slot-insert$ ?persona problemas+fisicos 1 ?instancia)
)

(defrule crea-persona
    (nombre ?nombre)
    (test (not (any-instancep ((?persona Persona)) (eq (str-compare ?persona:nombre ?nombre) 0))))
    =>
    (bind ?persona (make-instance persona of Persona))
	(send ?persona put-nombre ?nombre)
	(bind ?edad (pregunta-numerica "Edad (anos): " 0.0 100.0))
    (send ?persona put-altura ?edad)
    (bind ?altura (pregunta-numerica "Altura (m): " 0.0 3.0))
    (send ?persona put-altura ?altura)
    (bind ?peso (pregunta-numerica "Peso (kg): " 0.0 600.0))
    (send ?persona put-peso ?peso)
	(bind ?imc (/ ?peso (* ?altura ?altura)))
    (send ?persona put-imc ?imc)
	(if (< ?imc 18.5) then (anadir-ProblemaIMC ?persona "Peso insuficiente") else
		(if (> ?imc 50) then (anadir-ProblemaIMC ?persona "Obesidad tipo 4") else
			(if (> ?imc 40) then (anadir-ProblemaIMC ?persona "Obesidad tipo 3") else
				(if (> ?imc 35) then (anadir-ProblemaIMC ?persona "Obesidad tipo 2") else
					(if (> ?imc 30) then (anadir-ProblemaIMC ?persona "Obesidad tipo 1") else
						(if (> ?imc 27) then (anadir-ProblemaIMC ?persona "Sobrepeso grado 2") else
							(if (> ?imc 25) then (anadir-ProblemaIMC ?persona "Sobrepeso grado 1"))
						)
					)
				)
			)
		)
	)
    (bind ?pMin (pregunta-numerica "Cual es tu presion sanguinea minima (diastolica)? " 0.0 200.0))
	(bind ?pMax (pregunta-numerica "Cual es tu presion sanguinea maxima (sistolica)? " 0.0 200.0))
    (send ?persona put-pMin ?pMin)
    (send ?persona put-pMax ?pMax)
	(if (or (>= ?pMin 90) (>= ?pMax 140)) then
		(bind ?instancia (find-instance ((?p Otros+problemas)) (eq (str-compare ?p:nombre "Presion alta") 0)))
		(slot-insert$ ?persona problemas+fisicos 1 ?instancia)
	)
)

(defrule pide-actividades
	(nombre ?nombre)
	?persona <-(object (is-a Persona)(nombre ?nombreA))
	(test (eq (str-compare  ?nombre ?nombreA) 0))
	=>
	(bind ?lista_actividades (find-all-instances ((?a Actividad)) TRUE))
	(printout t "0 : Deja de anadir" crlf)
	(loop-for-count (?i 1 (length$ ?lista_actividades)) do
		(bind ?aux (nth$ ?i ?lista_actividades))
		(printout t ?i " : " (class ?aux) " : " (send ?aux get-nombre) crlf)
	)
	(bind ?respuesta (pregunta-numerica "Que actividad quieres anadir? " 0 (length$ ?lista_actividades)))
	(while (> ?respuesta 0) do
		(bind ?actividad (nth$ ?respuesta ?lista_actividades))
		(send ?actividad put-duracion   (pregunta-numerica "Cuanto dura la actividad? (minutos)" 0 600))
		(send ?actividad put-frequencia (ask-question "Con que frequencia? [Diaria|Semanal|Mensual] " Diaria Semanal Mensual))
		(slot-insert$ ?persona actividades 1 ?actividad)
		(bind ?respuesta (pregunta-numerica "Que actividad mas quieres anadir? " 0 (length$ ?lista_actividades)))
	)
)

(defrule crea-dieta
	(nombre ?nombre)
	?persona <-(object (is-a Persona)(nombre ?nombreA))
	(test (eq (str-compare  ?nombre ?nombreA) 0))
	=>
	(bind ?dieta (make-instance dieta of Dieta))
	(send ?dieta put-nombre "Much WOW")
    (bind ?sal (pregunta-numerica "Consumo de sal: " 0.0 10.0))
    (send ?dieta put-abuso+de+sal ?sal)
	(bind ?picar (pregunta-numerica "Picoteo entre horas: " 0.0 10.0))
    (send ?dieta put-picar+entre+horas ?picar)
    (bind ?fruta (pregunta-numerica "Cuantas piezas de fruta tomas a la semana? " 0.0 500.0))
    (send ?dieta put-consumo+de+fruta ?fruta)

	(send ?persona put-dieta ?dieta)
)

(defrule pide-problema
	(nombre ?nombre)
	?persona <-(object (is-a Persona)(nombre ?nombreA))
	(test (eq (str-compare  ?nombre ?nombreA) 0))
	=>
	(printout t "Problemas musculo-esqueleticos: " crlf)
	(bind ?lista_problemas_musc (find-all-instances ((?p Problema+musculo-esqueletico)) TRUE))
	(printout t "0 : Deja de anadir" crlf)
	(loop-for-count (?i 1 (length$ ?lista_problemas_musc)) do
		(bind ?aux (nth$ ?i ?lista_problemas_musc))
		(printout t ?i " : " (send ?aux get-nombre) crlf)
	)
	(bind ?respuesta (pregunta-numerica "Que problema de estos tienes? " 0 (length$ ?lista_problemas_musc)))
	(while (> ?respuesta 0) do
		(slot-insert$ ?persona problemas+fisicos 1 (nth$ ?respuesta ?lista_problemas_musc))
		(bind ?respuesta (pregunta-numerica "Que problema mas de estos tienes? " 0 (length$ ?lista_problemas_musc)))
	)
)

(defrule pide-objetivo
	(nombre ?nombre)
	?persona <-(object (is-a Persona)(nombre ?nombreA))
	(test (eq (str-compare  ?nombre ?nombreA) 0))
	=>
	(bind ?lista_objetivos (find-all-instances ((?o Objetivo)) TRUE))
	(printout t "0 : Deja de anadir" crlf)
	(loop-for-count (?i 1 (length$ ?lista_objetivos)) do
		(bind ?aux (nth$ ?i ?lista_objetivos))
		(printout t ?i " : " (send ?aux get-nombre) crlf)
	)
	(bind ?respuesta (pregunta-numerica "Que objetivo tienes? " 0 (length$ ?lista_objetivos)))
	(while (> ?respuesta 0) do
		(slot-insert$ ?persona Persona:objetivos 1 (nth$ ?respuesta ?lista_objetivos))
		(bind ?respuesta (pregunta-numerica "Que objetivo mas tienes? " 0 (length$ ?lista_objetivos)))
	)
)

; Thu May 05 11:59:51 CEST 2016
;
;+ (version "3.5")
;+ (build "Build 663")

(defclass %3ACLIPS_TOP_LEVEL_SLOT_CLASS "Fake class to save top-level slot information"
	(is-a USER)
	(role abstract)
	(single-slot grado
;+		(comment "1 - 2")
		(type INTEGER)
		(range 1 2)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot consumo+de+fruta
;+		(comment "Piezas a la semana")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot jueves
;+		(comment "ejercicios jueves")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot tiempo+diario+disponible
;+		(comment "tiempo diario en minutos")
		(type INTEGER)
		(range 30 1440)
		(cardinality 7 7)
		(create-accessor read-write))
	(multislot zona
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write))
	(multislot problemas+fisicos
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(multislot problemas
		(type INSTANCE)
;+		(allowed-classes Problema)
		(cardinality 1 ?VARIABLE)
		(create-accessor read-write))
	(multislot objetivos
		(type INSTANCE)
;+		(allowed-classes Objetivo)
		(create-accessor read-write))
	(single-slot repeticiones+maximas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot viernes
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot peso
		(type FLOAT)
		(default 75.0)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot tipo
		(type INTEGER)
		(range 1 4)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot calorias+quemadas
;+		(comment "calorias quemadas por minuto")
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot grupo_muscular
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot imc
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot picar+entre+horas
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot duracion+minima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot cansancio
		(type SYMBOL)
		(allowed-values Mucho Poco Nada)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot duracion
;+		(comment "en minutos")
		(type INTEGER)
		(default 0)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot sabado
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot lunes
;+		(comment "ejercicios lunes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot salud
		(type INSTANCE)
;+		(allowed-classes Salud)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot ejercicios+combinan
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot tests
		(type INSTANCE)
;+		(allowed-classes Test)
		(create-accessor read-write))
	(single-slot ejercicio
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot problemas+aliviados
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot frequencia
		(type SYMBOL)
		(allowed-values Diaria Semanal Mensual None)
		(default None)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot dieta
		(type INSTANCE)
;+		(allowed-classes Dieta)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot abuso+de+sal
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot ppm
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot repeticiones+minimas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot actividades
		(type INSTANCE)
;+		(allowed-classes Actividad)
		(create-accessor read-write))
	(multislot martes
;+		(comment "ejercicios martes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot edad+maxima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot pMax
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot pMin
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot edad+minima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot problemas+contraindicados
;+		(comment "problemas del usuario contraindicados para este ejercicio")
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot tirantezMuscular
		(type SYMBOL)
		(allowed-values Poco Mucho Nada)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot miercoles
;+		(comment "ejercicios miercoles")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot duracion+maxima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot grupos+musculares
;+		(comment "grupos musculares ejercitados")
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write))
	(single-slot repeticiones
		(type INTEGER)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot altura
		(type FLOAT)
		(default 1.7)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot edad
		(type INTEGER)
		(default 25)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot dificultad
		(type SYMBOL)
		(allowed-values moderada normal dificil)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot domingo
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot value
;+		(type ANY)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Persona
	(is-a USER)
	(role concrete)
	(single-slot imc
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot actividades
		(type INSTANCE)
;+		(allowed-classes Actividad)
		(create-accessor read-write))
	(single-slot altura
		(type FLOAT)
		(default 1.7)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot peso
		(type FLOAT)
		(default 75.0)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(multislot tests
		(type INSTANCE)
;+		(allowed-classes Test)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
		(default "Paco")
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot edad
		(type INTEGER)
		(default 25)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot pMax
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot problemas+fisicos
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot pMin
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot dieta
		(type INSTANCE)
;+		(allowed-classes Dieta)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Test
	(is-a USER)
	(role concrete)
	(single-slot ppm
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot cansancio
		(type SYMBOL)
		(allowed-values Mucho Poco Nada)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot tirantezMuscular
		(type SYMBOL)
		(allowed-values Poco Mucho Nada)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Actividad
	(is-a USER)
	(role concrete)
	(single-slot duracion
;+		(comment "en minutos")
		(type INTEGER)
		(default 0)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot frequencia
		(type SYMBOL)
		(allowed-values Diaria Semanal Mensual None)
		(default None)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Actividad+de+Trabajo
	(is-a Actividad)
	(role concrete))

(defclass Actividad+fuera+de+Trabajo
	(is-a Actividad)
	(role concrete))

(defclass Estatica
	(is-a Actividad+fuera+de+Trabajo)
	(role concrete))

(defclass Tarea+domestica
	(is-a Actividad+fuera+de+Trabajo)
	(role concrete))

(defclass Desplazamiento
	(is-a Actividad+fuera+de+Trabajo)
	(role concrete))

(defclass Salud
	(is-a USER)
	(role concrete)
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Dieta
	(is-a Salud)
	(role concrete)
	(single-slot picar+entre+horas
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot consumo+de+fruta
;+		(comment "Piezas a la semana")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot abuso+de+sal
;+		(comment "de 0 (nada) a 10 (mucho)")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Problema
	(is-a Salud)
	(role concrete))

(defclass Problema+musculo-esqueletico
	(is-a Problema)
	(role concrete)
	(multislot zona
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write)))

(defclass Otros+problemas
	(is-a Problema)
	(role concrete))

(defclass Problema+IMC
	(is-a Problema)
	(role concrete))

(defclass Objetivo
	(is-a USER)
	(role concrete)
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Musculacion
	(is-a Objetivo)
	(role concrete)
	(single-slot grupo_muscular
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Programa
	(is-a USER)
	(role concrete)
	(multislot jueves
;+		(comment "ejercicios jueves")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot objetivos
		(type INSTANCE)
;+		(allowed-classes Objetivo)
		(create-accessor read-write))
	(multislot tiempo+diario+disponible
;+		(comment "tiempo diario en minutos")
		(type INTEGER)
		(range 30 1440)
		(cardinality 7 7)
		(create-accessor read-write))
	(multislot lunes
;+		(comment "ejercicios lunes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot martes
;+		(comment "ejercicios martes")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot sabado
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot viernes
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot miercoles
;+		(comment "ejercicios miercoles")
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(multislot domingo
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write)))

(defclass Ejercicio
	(is-a USER)
	(role concrete)
	(single-slot duracion+maxima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot duracion+minima
;+		(comment "en minutos")
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(single-slot repeticiones+minimas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot grupos+musculares
;+		(comment "grupos musculares ejercitados")
		(type INSTANCE)
;+		(allowed-classes Grupo+muscular)
		(create-accessor read-write))
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot edad+maxima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot ejercicios+combinan
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
		(create-accessor read-write))
	(single-slot edad+minima
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot objetivos
		(type INSTANCE)
;+		(allowed-classes Objetivo)
		(create-accessor read-write))
	(multislot problemas+contraindicados
;+		(comment "problemas del usuario contraindicados para este ejercicio")
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot repeticiones+maximas
		(type INTEGER)
;+		(cardinality 0 1)
		(create-accessor read-write))
	(multislot problemas+aliviados
		(type INSTANCE)
;+		(allowed-classes Problema)
		(create-accessor read-write))
	(single-slot calorias+quemadas
;+		(comment "calorias quemadas por minuto")
		(type FLOAT)
;+		(cardinality 0 1)
		(create-accessor read-write)))

(defclass Ejercicio+con+aparatos
	(is-a Ejercicio)
	(role concrete))

(defclass Ejercicio+de+suelo
	(is-a Ejercicio)
	(role concrete))

(defclass Ejercicio+con+pesas
	(is-a Ejercicio)
	(role concrete))

(defclass Estiramientos
	(is-a Ejercicio)
	(role concrete))

(defclass Grupo+muscular
	(is-a USER)
	(role concrete)
	(single-slot nombre
		(type STRING)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(defclass Ejercicio-Persona
	(is-a USER)
	(role concrete)
	(single-slot repeticiones
		(type INTEGER)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot salud
		(type INSTANCE)
;+		(allowed-classes Salud)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot ejercicio
		(type INSTANCE)
;+		(allowed-classes Ejercicio)
;+		(cardinality 1 1)
		(create-accessor read-write))
	(single-slot dificultad
		(type SYMBOL)
		(allowed-values moderada normal dificil)
;+		(cardinality 1 1)
		(create-accessor read-write)))

(definstances instances
; Thu May 05 11:59:52 CEST 2016
;
;+ (version "3.5")
;+ (build "Build 663")

([Articular] of  Problema+musculo-esqueletico

	(nombre "Articular"))

([Barrer] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Barrer"))

([Bicicleta+estatica] of  Ejercicio+con+aparatos

	(calorias+quemadas 6.4)
	(duracion+maxima 90)
	(duracion+minima 20)
	(edad+maxima 60)
	(edad+minima 12)
	(ejercicios+combinan
		[Cinta+de+correr]
		[Stepper])
	(grupos+musculares
		[Cuadriceps]
		[Gemelos]
		[Gluteos])
	(nombre "Bicicleta estatica")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Articular]
		[Rodillas]))

([Brazos] of  Problema+musculo-esqueletico

	(nombre "Brazos")
	(zona
		[B%C3%ADceps]
		[Deltoides]
		[Dorsal]
		[Tr%C3%ADceps]))

([B%C3%ADceps] of  Grupo+muscular

	(nombre "Biceps"))

([Carrera+sostenida] of  Test

	(nombre "Carrera sostenida"))

([Cinta+de+correr] of  Ejercicio+con+aparatos

	(duracion+minima 20)
	(edad+minima 12)
	(ejercicios+combinan
		[Bicicleta+estatica]
		[Stepper])
	(grupos+musculares
		[Gemelos]
		[Tr%C3%ADceps])
	(nombre "Cinta de correr")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Presion+alta]
		[Articular]
		[Rodillas]))

([Colada] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Colada"))

([Compra] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Compra"))

([CouchPotato_Class0] of  Ejercicio+con+aparatos

	(calorias+quemadas 4.0)
	(duracion+maxima 30)
	(duracion+minima 10)
	(edad+minima 12)
	(ejercicios+combinan [Pesos])
	(grupos+musculares
		[B%C3%ADceps]
		[Deltoides]
		[Trapecio]
		[Tr%C3%ADceps])
	(nombre "Pesos brazos")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Presion+alta]
		[Articular])
	(repeticiones+minimas 10))

([CouchPotato_Class2] of  Problema+IMC

	(nombre "Peso insuficiente"))

([CouchPotato_Class3] of  Problema+IMC

	(nombre "Obesidad tipo 1"))

([CouchPotato_Class4] of  Problema+IMC

	(nombre "Obesidad tipo 2"))

([CouchPotato_Class5] of  Problema+IMC

	(nombre "Obesidad tipo 3"))

([CouchPotato_Class6] of  Problema+IMC

	(nombre "Obesidad tipo 4"))

([CouchPotato_Class7] of  Problema+IMC

	(nombre "Sobrepeso grado 1"))

([CouchPotato_Class8] of  Problema+IMC

	(nombre "Sobrepeso grado 2"))

([CouchPotato_Class9] of  Ejercicio+de+suelo
)

([Cuadriceps] of  Grupo+muscular

	(nombre "Cuadriceps"))

([Cuello] of  Problema+musculo-esqueletico

	(nombre "Cuello")
	(zona [Trapecio]))

([Cuidar+del+jard%C3%ADn] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Cuidar del jardin"))

([De+pie] of  Actividad+de+Trabajo

	(nombre "De pie"))

([Deltoides] of  Grupo+muscular

	(nombre "Deltoides"))

([Desplazamiento+a+pie] of  Actividad+de+Trabajo

	(nombre "Desplazamientos a pie"))

([Dorsal] of  Grupo+muscular

	(nombre "Dorsal"))

([Equilibrio] of  Objetivo

	(nombre "Equilibrio"))

([Esfuerzos+musculares] of  Actividad+de+Trabajo

	(nombre "Esfuerzos musculares"))

([Espalda] of  Problema+musculo-esqueletico

	(nombre "Espalda")
	(zona
		[Dorsal]
		[Trapecio]))

([Flexibilidad] of  Objetivo

	(nombre "Flexibilidad"))

([Fregar] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Fregar"))

([Gemelos] of  Grupo+muscular

	(nombre "Gemelos"))

([Gluteos] of  Grupo+muscular

	(nombre "Gluteos"))

([Lectura] of  Estatica

	(duracion 0)
	(frequencia None)
	(nombre "Lectura"))

([Levantamiento+de+peso] of  Actividad+de+Trabajo

	(nombre "Levantamiento de peso"))

([Mantenimiento] of  Objetivo

	(nombre "Mantenimiento"))

([Movimientos+Repetitivos] of  Actividad+de+Trabajo

	(nombre "Movimientos repetitivos"))

([Paseo] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Paseo"))

([Paseo+mascota] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Paseo mascota"))

([Pesos] of  Ejercicio+con+aparatos

	(calorias+quemadas 5.0)
	(duracion+maxima 30)
	(duracion+minima 10)
	(edad+minima 12)
	(ejercicios+combinan [CouchPotato_Class0])
	(grupos+musculares
		[Cuadriceps]
		[Gemelos]
		[Gluteos])
	(nombre "Pesos piernas")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Presion+alta]
		[Articular]
		[Rodillas])
	(repeticiones+minimas 10))

([Planchar] of  Tarea+domestica

	(duracion 0)
	(frequencia None)
	(nombre "Planchar"))

([Ponerse+en+forma] of  Objetivo

	(nombre "Ponerse en forma"))

([Presion+alta] of  Otros+problemas

	(nombre "Presion alta"))

([Rebajar+Peso] of  Objetivo

	(nombre "Rebajar peso"))

([Remo] of  Ejercicio+con+aparatos

	(calorias+quemadas 10.0)
	(grupos+musculares
		[B%C3%ADceps]
		[Cuadriceps]
		[Dorsal]
		[Gemelos]
		[Tr%C3%ADceps]
		[Deltoides]
		[Gluteos])
	(nombre "Remo")
	(problemas+aliviados
		[Articular]
		[Rodillas])
	(repeticiones+minimas 20))

([Rodillas] of  Problema+musculo-esqueletico

	(nombre "Rodillas")
	(zona [Gemelos]))

([Salir+a+correr] of  Desplazamiento

	(duracion 0)
	(frequencia None)
	(nombre "Salir a correr"))

([Sentado] of  Actividad+de+Trabajo

	(nombre "Sentado"))

([Sistema+Card%C3%ADaco] of  Objetivo

	(nombre "Sistema cardiaco"))

([Stepper] of  Ejercicio+con+aparatos

	(calorias+quemadas 6.1)
	(duracion+maxima 30)
	(duracion+minima 10)
	(edad+maxima 55)
	(ejercicios+combinan
		[Cinta+de+correr]
		[Bicicleta+estatica])
	(grupos+musculares
		[Cuadriceps]
		[Gemelos]
		[Gluteos])
	(nombre "Stepper")
	(problemas+aliviados
		[CouchPotato_Class3]
		[CouchPotato_Class4]
		[CouchPotato_Class5]
		[CouchPotato_Class6]
		[CouchPotato_Class7]
		[CouchPotato_Class8])
	(problemas+contraindicados
		[Articular]
		[Rodillas])
	(repeticiones+maximas 200)
	(repeticiones+minimas 10))

([Subir+tramos+de+escalera] of  Test

	(nombre "Subir tramos escalera"))

([Television] of  Estatica

	(duracion 0)
	(frequencia None)
	(nombre "Television"))

([Trapecio] of  Grupo+muscular

	(nombre "Trapecio"))

([Tr%C3%ADceps] of  Grupo+muscular

	(nombre "Triceps"))

)

([Troll] of Persona
	(nombre "Inigo")
	(altura 1.9)
	(peso 75)
	(imc 20))

)
;;****************
;;* DEFFUNCTIONS *
;;****************

(deffunction ask-question (?question $?allowed-values)
   (printout t ?question)
   (bind ?answer (read))
   (while (not (member ?answer ?allowed-values)) do
      (printout t ?question)
      (bind ?answer (read))
      (if (lexemep ?answer)
          then (bind ?answer (lowcase ?answer))))
   ?answer)

(deffunction si-o-no-p (?question)
   (bind ?response (ask-question ?question si no s n))
   (if (or (eq ?response si) (eq ?response s))
       then TRUE
       else FALSE))

(deffunction pregunta-general (?pregunta)
	(format t "%s" ?pregunta)
	(bind ?respuesta (read))
	?respuesta
)

(deffunction pregunta-numerica (?pregunta ?rangini ?rangfi)
	(format t "%s [%d,%d] " ?pregunta ?rangini ?rangfi)
	(bind ?respuesta (read))
	(while (not(and(>= ?respuesta ?rangini)(<= ?respuesta ?rangfi))) do
		(format t "%s [%d,%d] " ?pregunta ?rangini ?rangfi)
		(bind ?respuesta (read))
	)
	?respuesta
)

;;****************
;;* REGLAS       *
;;****************

(defmodule MAIN (export ?ALL))

(defrule presentacion
    (declare (salience 10))
    =>
    (printout t "----------------------------" crlf)
    (printout t "--Sistema de recomendacion--" crlf)
    (printout t "-----de entrenamientos------" crlf)
    (printout t "----------------------------" crlf)
    (printout t "----I'm no couch potato-----" crlf)
    (printout t "----------------------------" crlf)
    (printout t crlf)
    (focus preguntas-persona)

)

(defmodule preguntas-persona "Modulo de preguntas sobnre la persona"
  (import MAIN ?ALL)
  (export ?ALL))

(defrule pregunta-nombre
    =>
    (bind ?nombre (pregunta-general "Nombre: "))
    (assert (nombre ?nombre))
)

(deffunction anadir-ProblemaIMC (?persona ?problema)
	(bind ?instancia (find-instance ((?p Problema+IMC)) (eq (str-compare ?p:nombre ?problema) 0)))
	(slot-insert$ ?persona problemas+fisicos 1 ?instancia)
)

(defrule crea-persona
    (nombre ?nombre)
    (test (not (any-instancep ((?persona Persona)) (eq (str-compare ?persona:nombre ?nombre) 0))))
    =>
    (bind ?persona (make-instance persona of Persona))
	(send ?persona put-nombre ?nombre)
	(bind ?edad (pregunta-numerica "Edad (anos): " 0.0 100.0))
    (send ?persona put-altura ?edad)
    (bind ?altura (pregunta-numerica "Altura (m): " 0.0 3.0))
    (send ?persona put-altura ?altura)
    (bind ?peso (pregunta-numerica "Peso (kg): " 0.0 600.0))
    (send ?persona put-peso ?peso)
	(bind ?imc (/ ?peso (* ?altura ?altura)))
    (send ?persona put-imc ?imc)
	(if (< ?imc 18.5) then (anadir-ProblemaIMC ?persona "Peso insuficiente") else
		(if (> ?imc 50) then (anadir-ProblemaIMC ?persona "Obesidad tipo 4") else
			(if (> ?imc 40) then (anadir-ProblemaIMC ?persona "Obesidad tipo 3") else
				(if (> ?imc 35) then (anadir-ProblemaIMC ?persona "Obesidad tipo 2") else
					(if (> ?imc 30) then (anadir-ProblemaIMC ?persona "Obesidad tipo 1") else
						(if (> ?imc 27) then (anadir-ProblemaIMC ?persona "Sobrepeso grado 2") else
							(if (> ?imc 25) then (anadir-ProblemaIMC ?persona "Sobrepeso grado 1"))
						)
					)
				)
			)
		)
	)
    (bind ?pMin (pregunta-numerica "Cual es tu presion sanguinea minima (diastolica)? " 0.0 200.0))
	(bind ?pMax (pregunta-numerica "Cual es tu presion sanguinea maxima (sistolica)? " 0.0 200.0))
    (send ?persona put-pMin ?pMin)
    (send ?persona put-pMax ?pMax)
	(if (or (>= ?pMin 90) (>= ?pMax 140)) then
		(bind ?instancia (find-instance ((?p Otros+problemas)) (eq (str-compare ?p:nombre "Presion alta") 0)))
		(slot-insert$ ?persona problemas+fisicos 1 ?instancia)
	)
)

(defrule pide-actividades
	(nombre ?nombre)
	?persona <-(object (is-a Persona)(nombre ?nombreA))
	(test (eq (str-compare  ?nombre ?nombreA) 0))
	=>
	(bind ?lista_actividades (find-all-instances ((?a Actividad)) TRUE))
	(printout t "0 : Deja de aadir" crlf)
	(loop-for-count (?i 1 (length$ ?lista_actividades)) do
		(bind ?aux (nth$ ?i ?lista_actividades))
		(printout t ?i " : " (class ?aux) " : " (send ?aux get-nombre) crlf)
	)
	(bind ?respuesta (pregunta-numerica "Que actividad quieres anadir? " 0 (length$ ?lista_actividades)))
	(while (> ?respuesta 0) do
		(bind ?actividad (nth$ ?respuesta ?lista_actividades))
		(send ?actividad put-duracion   (pregunta-numerica "Cuanto dura la actividad? (minutos)" 0 600))
		(send ?actividad put-frequencia (ask-question "Con que frequencia? [Diaria|Semanal|Mensual] " Diaria Semanal Mensual))
		(slot-insert$ ?persona actividades 1 ?actividad)
		(bind ?respuesta (pregunta-numerica "Que actividad quieres anadir? " 0 (length$ ?lista_actividades)))
	)
)

(defrule crea-dieta
	(nombre ?nombre)
	?persona <-(object (is-a Persona)(nombre ?nombreA))
	(test (eq (str-compare  ?nombre ?nombreA) 0))
	=>
	(bind ?dieta (make-instance dieta of Dieta))
	(send ?dieta put-nombre "Much WOW")
    (bind ?sal (pregunta-numerica "Consumo de sal: " 0.0 10.0))
    (send ?dieta put-abuso+de+sal ?sal)
	(bind ?picar (pregunta-numerica "Picoteo entre horas: " 0.0 10.0))
    (send ?dieta put-picar+entre+horas ?picar)
    (bind ?fruta (pregunta-numerica "Cuantas piezas de fruta tomas a la semana? " 0.0 500.0))
    (send ?dieta put-consumo+de+fruta ?fruta)

	(send ?persona put-dieta ?dieta)
)

(defrule pide-problema
	(nombre ?nombre)
	?persona <-(object (is-a Persona)(nombre ?nombreA))
	(test (eq (str-compare  ?nombre ?nombreA) 0))
	=>
	(printout t "Problemas musculo-esqueleticos: " crlf)
	(bind ?lista_problemas_musc (find-all-instances ((?p Problema+musculo-esqueletico)) TRUE))
	(printout t "0 : Deja de aadir" crlf)
	(loop-for-count (?i 1 (length$ ?lista_problemas_musc)) do
		(bind ?aux (nth$ ?i ?lista_problemas_musc))
		(printout t ?i " : " (send ?aux get-nombre) crlf)
	)
	(bind ?respuesta (pregunta-numerica "Que problema de estos tienes? " 0 (length$ ?lista_problemas_musc)))
	(while (> ?respuesta 0) do
		(slot-insert$ ?persona problemas+fisicos 1 (nth$ ?respuesta ?lista_problemas_musc))
		(bind ?respuesta (pregunta-numerica "Que problema de estos tienes? " 0 (length$ ?lista_problemas_musc)))
	)
)


Added example product for catharsis

Added example product for catharsis

; Entry point into catharsis
; Modify this to fit your system.
(defglobal MAIN
           ?*catharsis-root* = (str-cat (get-shell-variable HOME)
                                        "/dev/catharsis"))

(defmountpoint catharsis ?*catharsis-root*)

(batch* (proton: /lib/core.clp))
(batch* (proton: /lib/neutron.clp))
; begin catharsis
(defglobal MAIN
           ?*old-point-x* = 0
           ?*old-point-y* = 0)

(deftemplate pen-size
             (slot min
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 1))
             (slot max
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 128))
             (slot current
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 1)))

(defmethod on-resized
  "method to handle resizing of the window"
  ((?value SYMBOL (not (neq ?value FALSE TRUE))))
  (if (and ?value (< (getwindow) 0)) then
    (printout werror "ERROR: couldn't reattach to window" crlf)
    (exit))
  (bind ?two-thirds (/ 2 3))
  (bind ?width (screen/dimensions/width))
  (bind ?height (screen/dimensions/height))
  (bind ?point-dim (as-point:screen/dimensions))
  (bind ?f2/3-width (* ?width ?two-thirds))
  (bind ?f2/3-height (* ?height ?two-thirds))
  (bind ?f2/3-point (new Point ?f2/3-width ?f2/3-height))
  (bind ?p0height-point (new Point 0 ?height))
  (bind ?pwidth0-point (new Point ?width 0))
  (bind ?zpointer (send [ZP] get-pointer))
  (bind ?pipointer (send [pixel-image] get-pointer))
  (screen/draw-line ?zpointer
                    ?p0height-point
                    0
                    0
                    8
                    ?pipointer
                    ?zpointer)
  (screen/draw-line ?p0height-point
                    ?point-dim
                    0
                    0
                    8
                    ?pipointer
                    ?zpointer)
  (screen/draw-line ?point-dim
                    ?pwidth0-point
                    0
                    0
                    8
                    ?pipointer
                    ?zpointer)
  (screen/draw-line ?zpointer
                    ?pwidth0-point
                    0
                    0
                    8
                    ?pipointer
                    ?zpointer)
  (screen/draw-line (new Point 0 ?f2/3-height)
                    ?f2/3-point
                    0
                    0
                    8
                    ?pipointer
                    ?zpointer)
  (screen/draw-line (new Point ?f2/3-width 0)
                    (new Point ?f2/3-width ?height)
                    0
                    0
                    8
                    ?pipointer
                    ?zpointer)
  )

(definstances elements
              (menu1 of menu (menu-entries cut copy paste))
              (menu2 of menu (menu-entries eat sleep drink))
              (scratch-rect of rectangle (x 0) (y 0) (bx 0) (by 0))
              (pixel-image of image (rectangle [pixel])
                           (replicate TRUE)
                           (color (get-standard-color black))))

(deffacts query-operation
          (query input)
          (pen-size (min 1)
                    (max 128)
                    (current 1)))

(defrule query-input
         ?f <- (query input)
         =>
         (retract ?f)
         (send [mouse] query)
         (send [keyboard] query)
         (assert (check mouse)
                 (check keyboard)))

(defrule process-mouse-inputs
         (declare (salience -1))
         ?f <- (check mouse)
         =>
         (retract ?f)
         (assert (query mouse)))

(defrule process-mouse-inputs:button1
         ?f <- (check mouse)
         (object (is-a mouse)
                 (name [mouse])
                 (buttons button1)
                 (position ?x ?y))
         ;?rect <- (object (is-a rectangle)
         ;                 (name [scratch-rect]))
         (pen-size (current ?factor))
         =>
         (retract ?f)
         ;(modify-instance ?rect (x ?x) (y ?y)
         ;                 (bx (+ ?x ?factor))
         ;                 (by (+ ?y ?factor)))
         ;rebuild the native memory since we've made
         ; changes to the fields
         ;(send ?rect build-pointer)
         (screen/draw-line (new Point ?*old-point-x* ?*old-point-y*)
                           (new Point ?x ?y)
                           0
                           0
                           ?factor
                           (send [pixel-image] get-pointer)
                           (send [ZP] get-pointer))
         (screen/draw-line (new Point ?*old-point-x* ?y)
                           (new Point ?x ?*old-point-y*)
                           0
                           0
                           ?factor
                           (send [pixel-image] get-pointer)
                           (send [ZP] get-pointer))
         (screen/draw-line (new Point ?x ?y)
                           (new Point ?*old-point-x* ?*old-point-y*)
                           0
                           0
                           ?factor
                           (send [pixel-image] get-pointer)
                           (send [ZP] get-pointer))
         (screen/draw-line (new Point ?x ?*old-point-y*)
                           (new Point ?*old-point-x* ?y)
                           0
                           0
                           ?factor
                           (send [pixel-image] get-pointer)
                           (send [ZP] get-pointer))
         (bind ?*old-point-x* ?x)
         (bind ?*old-point-y* ?y)
         (assert (query mouse)))

;(screen/draw ?rect [pixel-image] [ZP])
;(assert (query mouse)))

(defrule process-mouse-inputs:menu1
         (declare (salience 1))
         ?f <- (check mouse)
         (object (is-a mouse)
                 (name [mouse])
                 (buttons button3))
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu1] show-menu 3) crlf)
         (assert (query mouse)))

(defrule process-mouse-inputs:menu2
         (declare (salience 1))
         ?f <- (check mouse)
         (object (is-a mouse)
                 (name [mouse])
                 (buttons button2)
                 (timestamp ?ts))
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu2] show-menu 2) crlf)
         (assert (query mouse)))

(defrule process-keyboard-inputs:quit
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys ESC))
         =>
         (retract ?f)
         (exit))
(defrule process-keyboard-inputs:left
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys LEFT))
         =>
         (retract ?f)
         (assert (query keyboard))
         (halt))
(defrule process-keyboard-inputs:nil
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys NIL))
         =>
         (retract ?f)
         (assert (query keyboard)))

(defrule process-keyboard-inputs:up
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys UP))
         ?pen <- (pen-size
                   (current ?factor)
                   (max ?max))
         =>
         (if (< ?factor ?max) then
           (modify ?pen (current (+ ?factor 1))))
         (retract ?f)
         (assert (query keyboard)))

(defrule process-keyboard-inputs:down
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys DOWN))
         ?pen <- (pen-size (min ?min)
                           (current ?factor))
         =>
         (if (> ?factor ?min) then
           (modify ?pen (current (- ?factor 1))))
         (retract ?f)
         (assert (query keyboard)))
(defrule process-keyboard-inputs
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys ?b&~NIL))
         =>
         (retract ?f)
         (printout t "Pressed " ?b crlf)
         (assert (query keyboard)))

(defrule ready-to-query-input-again
         ?f <- (query keyboard)
         ?f2 <- (query mouse)
         =>
         (retract ?f ?f2)
         (send [mouse] clear)
         (send [keyboard] clear)
         (assert (query input)))

(batch* (proton: /lib/reset-run-exit.clp))

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


Added painter.clp[

Added painter.clp[

(load* /lib/chicanery/input.clp)
(load* /lib/chicanery/menu.clp)

(defglobal MAIN
           ?*system-initialized* = FALSE)

(deffacts query-operation
          (query input)
          (defmenu menu1 cut copy paste)
          (defmenu menu2 eat sleep drink))

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

(defrule build-menus
         (declare (salience 9999))
         ?f <- (defmenu ?a $?b)
         =>
         (retract ?f)
         (defmenu ?a ?b))

(defrule on-resized
         ?f <- (event resized new ?value)
         =>
         (if (and ?value (< (getwindow) 0)) then
           (printout werror "ERROR: couldn't reattach to window" crlf)
           (exit)
           else
           (retract ?f)))

(defrule query-input
         ?f <- (query input)
         =>
         (retract ?f)
         (mouse/query)
         (assert (input mouse
                        buttons: (translate/mouse/buttons)
                        position: (mouse/position)
                        time-stamp: (mouse/timestamp))
                 (input keyboard
                        button: (translate/kbd/query))))

(defrule process-mouse-inputs
         (declare (salience -1))
         ?f <- (input mouse
                      buttons: $?
                      position: ? ?
                      time-stamp: ?)
         =>
         (retract ?f)
         (assert (query mouse)))

(defrule process-mouse-inputs:menu1
         ?f <- (input mouse
                      buttons: button3
                      position: ? ?
                      time-stamp: ?)
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu1] show-menu 3) crlf)
         (assert (query mouse)))

(defrule process-mouse-inputs:menu2
         ?f <- (input mouse
                      buttons: button2
                      position: ? ?
                      time-stamp: ?)
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu2] show-menu 2) crlf)
         (assert (query mouse)))

(defrule process-keyboard-inputs:quit
         (declare (salience 1))
         ?f <- (input keyboard button: ESC)
         =>
         (retract ?f)
         (exit))

(defrule process-keyboard-inputs:passthrough
         (declare (salience 1))
         ?f <- (input keyboard button: NIL)
         =>
         (retract ?f)
         (assert (query keyboard)))

(defrule process-keyboard-inputs
         ?f <- (input keyboard
                      button: ?b)
         =>
         (retract ?f)
         (printout t "Pressed " ?b crlf)
         (assert (query keyboard)))

(defrule ready-to-query-input-again
         ?f <- (query keyboard)
         ?f2 <- (query mouse)
         =>
         (retract ?f ?f2)
         (assert (query input)))

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


added one more sfc test. khk.

added one more sfc test.
khk.

git-svn-id: 9643e93313b82f5e4da82d8413267a0daa4b5472@1075 2cd91b7d-3b21-0410-a5f4-f42db4f24360

(deftemplate wurst
	(slot name (type STRING))
	(multislot zutaten (default "Fleisch" "Salz" "Wasser"))
	(slot gewicht (type INTEGER))
	(slot laenge (type INTEGER) (default 25))
	(slot hersteller (type STRING))
)

(deftemplate bier
	(slot name )
	(slot gewicht )
	(slot hersteller )
)

(deftemplate senf
	(slot gewicht)
	(slot name)
)

(assert (wurst
		(name "Fischwurst schwer")
		(gewicht 200)
		(laenge 100)
		(hersteller "Nordmann")
	)
)

(assert (wurst
		(name "Fischwurst2")
		(gewicht 100)
		(laenge 100)
		(hersteller "Nordmann")
	)
)

(assert (wurst
		(name "miniwurst")
		(gewicht 10)
		(laenge 15)
		(hersteller "Nordmann")
	)
)

(assert (bier
		(name "Bitburger")
		(gewicht 100)
		)
)

(assert (bier
		(name "Eifel Champus")
		(gewicht 200)
		)
)

(assert (senf (name scharf) (gewicht 100)))

(assert (senf (name auchscharf) (gewicht 200)))

(assert (senf (name nix) (gewicht 1)))

(defrule wurst-meter "Regel zur Ausgabe der Wurst-Lnge"
	(declare (rule-version "performance version") (salience 101) (auto-focus TRUE))
	(wurst (gewicht ?x) (name ?y))
	(bier (gewicht ?x) (name ?z))
	(senf (gewicht ?x) (name ?w))
	=>
	(printout t "Lebensmittel die zusammenpassen. wurst:" ?y " Bier: " ?z  "Senf: " ?w " Gewicht: " ?x)
)

(defrule wurst-meter-langsam "Regel zur Ausgabe der Wurst-Laenge"
	(wurst (laenge 100) (gewicht 200))
	(bier (gewicht 100))
	=>
	(printout t "Eine Wurst gefunden.")
)

;modify test:
(deftemplate modifywurst
	(slot name)
	(slot laenge)
	(multislot zutaten)
)

(assert (modifywurst
		(name "zukurz")
		(laenge 25)
		(zutaten "wasser" "salz" "pferd")
	)
)

(defrule bessereWurst
	 ?wurstFact <-(modifywurst (laenge 25)(zutaten $?zutatenlist))
	=>
	(modify ?wurstFact (laenge 35) )
	;(printout t $?zutatenlist )
	(printout t "laengere wurst" )
	(foreach ?i $?zutatenlist (printout t ?i))
 )

; binding tests

(defrule bier-senf-vergleich
	 (bier (gewicht ?x)(name ?y))
	 (wurst (gewicht ?x)(name ?z))
	=>
	(printout t "das bier " ?y " und die wurst " ?z " haben das gewicht " ?x " !" )
 )