test-part.lisp 1.93 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
;;
;; Copyright 2002, 2009 Genworks International and Genworks BV 
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;; 
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;; 
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file.  If not, see
;; <http://www.gnu.org/licenses/>.
;; 


(in-package :gwl-user)

(define-object tasty-test-part (base-ajax-sheet)

  :input-slots
  ((control-points (list (make-point 0 0 0)
			 (make-point 2 3.0 0.0) 
			 (make-point 4 2.0 0.0) 
			 (make-point 5 0.0 0.0) 
			 (make-point 4 -2.0 0.0) 
			 (make-point 2 -3.0 0.0) 
			 (make-point 0 0 0))))


  :objects
  ((model :type 'curves-model
	  :pass-down (control-points))))


(define-object curves-model (outline-specialization-mixin)
  
  :input-slots (control-points)
  
  :objects
  ((curves :type 'b-spline-curve
           :sequence (:size 5)
           :control-points (the control-points)
	   :degree (1+ (the-child :index))
	   :display-controls (list :line-thickness (* .3 (1+ (the-child index)))
				   :color (ecase (the-child index)
					    (0 :red) (1 :orange) (2 :yellow) (3 :green)
					    (4 :blue) (5 :red-violet)))))
  
  :objects
  ((notes :type 'general-note
	  :sequence (:size (length (the control-points)))
	  :start (nth (the-child index) (the control-points))
	  :strings (format nil "C~a" (the-child index)))))