LINUX.ORG.RU

История изменений

Исправление saufesma, (текущая версия) :

Зачем тебе вообще эта балалайка? Почему не sbcl?

Пару лет назад купил Hobbyist Edition из-за CAPI. Умудрился написать 

(defvar my-color)
(setf my-color (color:make-rgb 0.0 1.0 0.0))

(defun draw-an-ellipse 
       (output-pane self x y width height)
       (let ((x-radius (floor width 2))
             (y-radius (floor height 2)))
              (gp:draw-ellipse output-pane
                (+ x x-radius) (+ y y-radius)
                x-radius y-radius
                :foreground my-color ; :red
                :filled t)))

(capi:contain (make-instance 
                'capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
                :display-callback 'draw-an-ellipse))

;;; Change some colors
(setf my-color (color:make-rgb 0.0 1.0 1.0))

(capi:redraw-pinboard-object (capi:contain (make-instance 
                'capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
                :display-callback 'draw-an-ellipse)))

(capi:define-interface color-visualizing ()
  ((reds :accessor set-reds)
   (greens :accessor set-greens)
   (blues :accessor set-blues))
  (:panes
   (drawn-figure
   capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
					; :display-callback 'draw-an-ellipse
   )
   (reds-field
    capi:text-input-pane
    :title "Red")
   (greens-field
    capi:text-input-pane
    :title "Green")
   (blues-field
    capi:text-input-pane
    :title "Blue"))
  (:layouts
   (text-pane-row
    capi:row-layout
    '(reds-field greens-field blues-field))
   (column-pane
    capi:column-layout
    '(drawn-figure text-pane-row))))

(capi:display (make-instance 'COLOR-VISUALIZING))
;;;; ==========================================================

(defvar *r*)
(defvar *g*)
(defvar *b*)
(setq *r* 0)
(setq *g* 0.1)
(setq *b* 0.2)

(defun get-number-r (a c)
  (declare (ignore c))
 (setq *r* (with-input-from-string
				   (in a)
	     (read in))))

(defun get-number-g (a c)
  (declare (ignore c))
 (setq *g* (with-input-from-string
				   (in a)
	     (read in))))

(defun get-number-b (a c)
  (declare (ignore c))
 (setq *b* (with-input-from-string
				   (in a)
	     (read in))))

(defun draw-an-ellipse 
       (output-pane self x y width height)
       (let ((x-radius (floor width 2))
             (y-radius (floor height 2)))
              (gp:draw-ellipse output-pane
                (+ x x-radius) (+ y y-radius)
                x-radius y-radius
                :foreground (color:make-rgb *r* *g* *b*)
                :filled t)))

(defvar *drawn-figure*)
 (setf *drawn-figure*
   (make-instance
   'capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
		:display-callback 'draw-an-ellipse
   ))
(defvar *reds-field*)
(setf *reds-field*
   (make-instance
    'capi:text-input-pane
    :title "Red"
    :text "0"
    :callback 'get-number-r))

(defvar *greens-field*)
(setf *greens-field*
    (make-instance
    'capi:text-input-pane
    :title "Green"
    :text "0.1"
    :callback 'get-number-g))

  (defvar *blues-field*)
  (setf *blues-field*
   (make-instance
    'capi:text-input-pane
    :title "Blue"
    :text "0.2"
    :callback 'get-number-b))

  (defvar *text-pane-row*)
   (setf *text-pane-row*
	 (make-instance
	  'capi:row-layout
	  :description
	  (list *reds-field* *greens-field* *blues-field*)))

(defvar *button*)
(setf *button*
 (make-instance 'capi:push-button  
                :selection-callback 'change-color
                :mnemonic-text "See Color"))

   (defvar *column-pane*)
   (setf *column-pane*
	 (make-instance
	  'capi:column-layout
	  :description
	  (list *drawn-figure* *text-pane-row* *button*)))

(defun change-color (data interface)
  (declare (ignore data interface))
(capi:redraw-pinboard-object *drawn-figure*))

(capi:contain *column-pane*)

;;;=============== simple way to parse floating point numbers==========
(setf my-color (color:make-rgb (with-input-from-string
				   (in (capi:text-input-pane-text *reds-field*))
				 (read in))
			       (with-input-from-string
				   (in (capi:text-input-pane-text *greens-field*))
				 (read in))
			       (with-input-from-string
				   (in (capi:text-input-pane-text *blues-field*))
				 (read in))))

;;;; ==================== BUTTON callback args display ============
(defun f (a b)
  (capi:display-message "first arg ~s, second arg ~s" a b))

(defun ff (a b)
(capi:display-message "typeof first arg is ~s, second arg is ~s" (type-of a) b))

(capi:contain 
 (make-instance 'capi:push-button  
                :selection-callback 'f
                :mnemonic-text "Chicken && Rice"))

(capi:contain
 (make-instance
    'capi:text-input-pane
    :title "Blue"
    :text "0"
    :callback 'f))


(capi:contain
 (make-instance
    'capi:text-input-pane
    :title "Blue"
    :text "0"
    :callback 'get-number-r))

(defun get-number-r (a b)
  (declare (ignore b))
 (setq r (with-input-from-string
				   (in a)
				(read in))))

хотел написать более нужную прогу и попал. Жалко, блин.

Исходная версия saufesma, :

Зачем тебе вообще эта балалайка? Почему не sbcl?

Пару лет назад купил Hobbyist Edition из-за CAPI. Умудрился написать 

(defvar my-color)
(setf my-color (color:make-rgb 0.0 1.0 0.0))

(defun draw-an-ellipse 
       (output-pane self x y width height)
       (let ((x-radius (floor width 2))
             (y-radius (floor height 2)))
              (gp:draw-ellipse output-pane
                (+ x x-radius) (+ y y-radius)
                x-radius y-radius
                :foreground my-color ; :red
                :filled t)))

(capi:contain (make-instance 
                'capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
                :display-callback 'draw-an-ellipse))

;;; Change some colors
(setf my-color (color:make-rgb 0.0 1.0 1.0))

(capi:redraw-pinboard-object (capi:contain (make-instance 
                'capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
                :display-callback 'draw-an-ellipse)))

(capi:define-interface color-visualizing ()
  ((reds :accessor set-reds)
   (greens :accessor set-greens)
   (blues :accessor set-blues))
  (:panes
   (drawn-figure
   capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
					; :display-callback 'draw-an-ellipse
   )
   (reds-field
    capi:text-input-pane
    :title "Red")
   (greens-field
    capi:text-input-pane
    :title "Green")
   (blues-field
    capi:text-input-pane
    :title "Blue"))
  (:layouts
   (text-pane-row
    capi:row-layout
    '(reds-field greens-field blues-field))
   (column-pane
    capi:column-layout
    '(drawn-figure text-pane-row))))

(capi:display (make-instance 'COLOR-VISUALIZING))
;;;; ==========================================================

(defvar *r*)
(defvar *g*)
(defvar *b*)
(setq *r* 0)
(setq *g* 0.1)
(setq *b* 0.2)

(defun get-number-r (a c)
  (declare (ignore c))
 (setq *r* (with-input-from-string
				   (in a)
	     (read in))))

(defun get-number-g (a c)
  (declare (ignore c))
 (setq *g* (with-input-from-string
				   (in a)
	     (read in))))

(defun get-number-b (a c)
  (declare (ignore c))
 (setq *b* (with-input-from-string
				   (in a)
	     (read in))))

(defun draw-an-ellipse 
       (output-pane self x y width height)
       (let ((x-radius (floor width 2))
             (y-radius (floor height 2)))
              (gp:draw-ellipse output-pane
                (+ x x-radius) (+ y y-radius)
                x-radius y-radius
                :foreground (color:make-rgb *r* *g* *b*)
                :filled t)))

(defvar *drawn-figure*)
 (setf *drawn-figure*
   (make-instance
   'capi:drawn-pinboard-object
                :visible-min-width 200
                :visible-min-height 100
		:display-callback 'draw-an-ellipse
   ))
(defvar *reds-field*)
(setf *reds-field*
   (make-instance
    'capi:text-input-pane
    :title "Red"
    :text "0"
    :callback 'get-number-r))

(defvar *greens-field*)
(setf *greens-field*
    (make-instance
    'capi:text-input-pane
    :title "Green"
    :text "0.1"
    :callback 'get-number-g))

  (defvar *blues-field*)
  (setf *blues-field*
   (make-instance
    'capi:text-input-pane
    :title "Blue"
    :text "0.2"
    :callback 'get-number-b))

  (defvar *text-pane-row*)
   (setf *text-pane-row*
	 (make-instance
	  'capi:row-layout
	  :description
	  (list *reds-field* *greens-field* *blues-field*)))

(defvar *button*)
(setf *button*
 (make-instance 'capi:push-button  
                :selection-callback 'change-color
                :mnemonic-text "See Color"))

   (defvar *column-pane*)
   (setf *column-pane*
	 (make-instance
	  'capi:column-layout
	  :description
	  (list *drawn-figure* *text-pane-row* *button*)))

(defun change-color (data interface)
  (declare (ignore data interface))
(capi:redraw-pinboard-object *drawn-figure*))

(capi:contain *column-pane*)

;;;=============== simple way to parse floating point numbers==========
(setf my-color (color:make-rgb (with-input-from-string
				   (in (capi:text-input-pane-text *reds-field*))
				 (read in))
			       (with-input-from-string
				   (in (capi:text-input-pane-text *greens-field*))
				 (read in))
			       (with-input-from-string
				   (in (capi:text-input-pane-text *blues-field*))
				 (read in))))

;;;; ==================== BUTTON callback args display ============
(defun f (a b)
  (capi:display-message "first arg ~s, second arg ~s" a b))

(defun ff (a b)
(capi:display-message "typeof first arg is ~s, second arg is ~s" (type-of a) b))

(capi:contain 
 (make-instance 'capi:push-button  
                :selection-callback 'f
                :mnemonic-text "Chicken && Rice"))

(capi:contain
 (make-instance
    'capi:text-input-pane
    :title "Blue"
    :text "0"
    :callback 'f))


(capi:contain
 (make-instance
    'capi:text-input-pane
    :title "Blue"
    :text "0"
    :callback 'get-number-r))

(defun get-number-r (a b)
  (declare (ignore b))
 (setq r (with-input-from-string
				   (in a)
				(read in))))

хотел написать более нужную прогу и попал. Жалко, блин. Надо было Java учить.