ddetest.clp

模糊clips专家系统

;;; Demo of DDE functions: chatting to PROGMAN
;;;

(defglobal ?*progman-server* = 0)
(defglobal ?*progman-server-name* = "PROGMAN")
(defglobal ?*progman-host-name* = "none")
(defglobal ?*progman-topic-name* = "PROGMAN")
(defglobal ?*progman-client* = 0)
(defglobal ?*progman-connection* = 0)

;;; Function called if anything interesting happens (e.g. advice from server)
(deffunction progman-connection-callback (?id ?command ?topic ?item ?data)
 (format t "progman-connection-callback %ld %s %s %s %s" ?id ?command ?topic ?item ?data)
 1
)

;;; Convert a multi-value list of strings to one string
(deffunction many-strings-to-one ($?strings)
  (bind ?counter 1)
  (bind ?string "")
  (while (<= ?counter (length $?strings)) do
    (bind ?string (str-cat ?string (nth ?counter $?strings)))
    (bind ?counter (+ ?counter 1))
  )
  (return ?string)
)

(deffunction progman-demo ()
 ;; Get a group name from the user
 (bind ?new-group-name (get-text-from-user "New PROGMAN group name"))
 (if (neq ?new-group-name "") then
  ;; Form create group command
  (bind ?command (many-strings-to-one (mv-append "[CreateGroup(" ?new-group-name ")]")))

  ;; Construct a client object
  (bind ?*progman-client* (client-create "progman-connection-callback"))

  ;; Construct a connection object
  (bind ?*progman-connection* (client-make-connection
              ?*progman-client* ?*progman-host-name*
              ?*progman-server-name* ?*progman-topic-name*))

  ;; Execute a command to create a group
  (bind ?exe (connection-execute ?*progman-connection* ?command))

  ;; Request a list of groups
  (bind ?req (connection-request ?*progman-connection* "PROGMAN"))
  (format t "%nProgram Manager Groups:%n")
  (format t "%s%n%n" ?req)

  ;; Disconnect
  (connection-disconnect ?*progman-connection*)
 )
)

;;; Automatically called when running application from command line
;;; e.g. wxclips -start -clips ddetest.clp
;;; Also runnable from the Application: Run application.
(deffunction app-on-init ()
  (progman-demo)
)