hello.clp

模糊clips专家系统

;;; hello.clp
;;; Shows how a frame may be created, with a menu bar and
;;; panel, using low-level windows functions.
;;; Load using -clips <file> on the command line or using the Batch
;;; or Load commands from the CLIPS development window; type
;;; (app-on-init) to start.

(defglobal ?*main-frame* = 0)
(defglobal ?*subframe* = 0)
(defglobal ?*panel* = 0)
(defglobal ?*canvas* = 0)
(defglobal ?*text-win* = 0)

(defglobal ?*small_font* = 0)
(defglobal ?*green_pen* = 0)
(defglobal ?*black_pen* = 0)
(defglobal ?*red_pen* = 0)
(defglobal ?*cyan_brush* = 0)

(defglobal ?*xpos* = -1.0)
(defglobal ?*ypos* = -1.0)

(defglobal ?*bitmap* = 0)
(defglobal ?*button-bitmap* = 0)
(defglobal ?*icon* = 0)

;;; Sizing callback
(deffunction on-size (?id ?w ?h)
 (if (and (> ?id 0) (> ?*panel* 0) (> ?*text-win* 0)) then
  (bind ?client-width (window-get-client-width ?id))
  (bind ?client-height (window-get-client-height ?id))
  (window-set-size ?*panel* 0 0 ?client-width (* ?client-height 0.666))
  (window-set-size ?*text-win* 0 (* ?client-height 0.666) ?client-width (/ ?client-height 3))
 )
)

;;; Utility function for drawing a bitmap
(deffunction draw-bitmap (?dc ?bitmap ?x ?y)
 (bind ?mem-dc (memory-dc-create))
 (memory-dc-select-object ?mem-dc ?bitmap)
 ; Blit the memory device context onto the destination device context
 (dc-blit ?dc ?x ?y (bitmap-get-width ?bitmap) (bitmap-get-height ?bitmap)
   ?mem-dc 0.0 0.0)
 (memory-dc-delete ?mem-dc)
)

;;; Painting callback
(deffunction on-paint (?id)
 (if (> ?id 0) then
  (bind ?dc (canvas-get-dc ?id))

  (if (> ?*bitmap* 0) then
   (draw-bitmap ?dc ?*bitmap* 0.0 250.0))

  (dc-set-font ?dc ?*small_font*)
  (dc-set-pen ?dc ?*green_pen*)
  (dc-draw-line ?dc 0.0 0.0 200.0 200.0)
  (dc-draw-line ?dc 200.0 0.0 0.0 200.0)

  (dc-set-pen ?dc ?*red_pen*)
  (dc-set-brush ?dc ?*cyan_brush*)
  (dc-draw-rectangle ?dc 100.0 100.0 100.0 50.0)
  (dc-draw-rounded-rectangle ?dc 150.0 150.0 100.0 50.0)

  (dc-set-clipping-region ?dc 150.0 150.0 100.0 50.0)
  (dc-draw-text ?dc "This text should be clipped within the rectangle" 150.0 170.0)
  (dc-destroy-clipping-region ?dc)

  (dc-draw-ellipse ?dc 250.0 250.0 100.0 50.0)
  (dc-draw-spline ?dc (mv-append 50.0 200.0 50.0 100.0 200.0 10.0))
  (dc-draw-line ?dc 50.0 230.0 200.0 230.0)
  (dc-draw-text ?dc "This is a test string" 50.0 230.0)
 )
)

(deffunction on-event (?canvas ?event)
  (bind ?dc (canvas-get-dc ?canvas))
  (dc-set-pen ?dc ?*black_pen*)
  (bind ?x (mouse-event-position-x ?event))
  (bind ?y (mouse-event-position-y ?event))
  (bind ?dragging (mouse-event-dragging ?event))
  (if (and (> ?*xpos* -1) (> ?*ypos* -1) (> ?dragging 0)) then
   (dc-draw-line ?dc ?*xpos* ?*ypos* ?x ?y)
  )
  (bind ?*xpos* ?x)
  (bind ?*ypos* ?y)
)

(deffunction on-close (?frame)
 (format t "Closing frame.%n")
 (window-delete ?*subframe*)
 (bind ?*panel* 0)
 (bind ?*text-win* 0)
 1)

(deffunction on-menu-command (?frame ?id)
 (if (eq ?id 200) 
  then (message-box "CLIPS for wxWindows Demo
by Julian Smart (c) 1993" "About wxWindows CLIPS Demo")
  else
  (if (eq ?id 3) then 
   (on-close ?frame)
   (window-delete ?frame)
   else (if (eq ?id 1) then
    (bind ?file (file-selector "Choose a text file to load"))
    (if (neq ?file "") then
     (text-window-load-file ?*text-win* ?file)))
   ))
 )

;;; Button callback
(deffunction frame-button-proc (?id)
 (bind ?parent (window-get-parent ?id))
 (bind ?grandparent (window-get-parent ?parent))
 (format t "Pressed button %d%n" ?id)
 (message-box "Hello")
)

;;; Test program to create a frame
(deffunction app-on-init ()
  (unwatch all)
  (if (= ?*small_font* 0) then
    (bind ?*small_font* (font-create 10 wxSWISS wxNORMAL wxNORMAL 0))
    (bind ?*green_pen* (pen-create GREEN 1 wxSOLID))
    (bind ?*black_pen* (pen-create BLACK 1 wxSOLID))
    (bind ?*red_pen* (pen-create RED 3 wxSOLID))
    (bind ?*cyan_brush* (brush-create CYAN wxSOLID))
    (bind ?*bitmap* (bitmap-load-from-file "wxwin.bmp"))
    (bind ?*button-bitmap* (bitmap-load-from-file "aiai.bmp"))
    (bind ?*icon* (icon-load-from-file "aiai.ico"))
  )

  (bind ?*main-frame* (frame-create 0 "Hello wxCLIPS!" -1 -1 500 460))
  (frame-create-status-line ?*main-frame*)
  (frame-set-status-text ?*main-frame* "Welcome to wxCLIPS")
  (if (> ?*icon* 0) then
   (frame-set-icon ?*main-frame* ?*icon*)
  )

  (window-add-callback ?*main-frame* OnSize on-size)
  (window-add-callback ?*main-frame* OnClose on-close)
  (window-add-callback ?*main-frame* OnMenuCommand on-menu-command)

  ;;; Make a menu bar
  (bind ?file-menu (menu-create))
  (menu-append ?file-menu 1 "&Load file")

  (bind ?pull-right (menu-create))
  (menu-append ?pull-right 100 "&Twips")
  (menu-append ?pull-right 101 "&10th mm")

  (menu-append ?file-menu 2 "&Scale picture" ?pull-right)
  (menu-append-separator ?file-menu)
  (menu-append ?file-menu 3 "&Quit")

  (bind ?help-menu (menu-create))
  (menu-append ?help-menu 200 "&About")

  (bind ?menu-bar (menu-bar-create))
  (menu-bar-append ?menu-bar ?file-menu "&File")
  (menu-bar-append ?menu-bar ?help-menu "&Help")

  (frame-set-menu-bar ?*main-frame* ?menu-bar)

  ;;; Make a panel and panel items
  (bind ?*panel* (panel-create ?*main-frame* 0 0 500 250))
  (panel-set-label-position ?*panel* wxVERTICAL)

  (bind ?*text-win* (text-window-create ?*main-frame* 0 250 500 250))

  (bind ?button (button-create ?*panel* frame-button-proc "A button"))
  (if (> ?*button-bitmap* 0) then
   (bind ?bitmap-button (button-create-from-bitmap ?*panel* frame-button-proc ?*button-bitmap*))
  )
  (bind ?text (text-create ?*panel* "" "A text item" "Initial value" -1 -1 200))
  (bind ?check (check-box-create ?*panel* "" "A check box"))

  (panel-new-line ?*panel*)

  (bind ?choice (choice-create ?*panel* "" "A choice item"))
  (choice-append ?choice "One")
  (choice-append ?choice "Two")
  (choice-append ?choice "Three")
  (choice-append ?choice "Four")

  (message-create ?*panel* "Hello! A simple message")

  (bind ?list (list-box-create ?*panel* "" "A list" 0 -1 -1 100 80))
  (list-box-append ?list "Apple")
  (list-box-append ?list "Pear")
  (list-box-append ?list "Orange")
  (list-box-append ?list "Banana")
  (list-box-append ?list "Fruit")

  (panel-new-line ?*panel*)

  (bind ?slider (slider-create ?*panel* "" "A slider" 40 22 101 200))

  (bind ?multi (multi-text-create ?*panel* "" "Multiline text" "Some text" -1 -1 200 100))

;  (window-fit ?*panel*)
;  (window-fit ?*main-frame*)

  (text-window-load-file ?*text-win* "hello.clp")
  (bind ?*subframe* (frame-create 0 "Canvas Frame" 300 300 400 400))
  (bind ?*canvas* (canvas-create ?*subframe* 0 0 400 400))
  (window-add-callback ?*canvas* OnPaint on-paint)
  (window-add-callback ?*canvas* OnEvent on-event)
  (canvas-set-scrollbars ?*canvas* 20 20 50 50 4 4)

  (window-show ?*subframe* 1)
  (window-show ?*main-frame* 1)

  ?*main-frame*)