box-solid.lisp 2.12 KB
Newer Older
Dave Cooper's avatar
Dave Cooper committed
1
2
(in-package :gdl-lift-tests)

3
#+allegro
Dave Cooper's avatar
Dave Cooper committed
4
5
(defparameter *box-solid-lock* (mp:make-process-lock :name "box-solid-lock"))

6
#+allegro
Dave Cooper's avatar
Dave Cooper committed
7
8
(defparameter *collected-breps* nil)

9
#+allegro
Dave Cooper's avatar
Dave Cooper committed
10
11
(defparameter *collected-breps-old* nil)

12
#+allegro
Dave Cooper's avatar
Dave Cooper committed
13
14
15
16
17
18
19
20
21
22
23
24
(defun make-and-check-box-solid (&key (value 20) (n nil))

    (let (self)
      (mp:with-process-lock (smlib::*smlib-lock*)
	(setq self (make-object 'box-solid :length value :width value :height value))
	(the %native-brep%))
      (mp:with-process-lock (smlib::*smlib-lock*)
	(unless (near-to? (the volume) (expt value 3))
	  (error "box dimensions got reset out from under us! Should be ~a and it is now ~a~a~%" 
		 (expt value 3) (the volume)
		 (if n (format nil " and n is ~a." n) ""))))))

25
#+allegro
Dave Cooper's avatar
Dave Cooper committed
26
27
28
29
30
31
(defun delete-collected-breps ()
  (mp:process-run-function "delete-breps" #'(lambda()
					      (dolist (brep *collected-breps*)
						(mp:with-process-lock (smlib::*smlib-lock*)
						  (smlib::delete-iwbrep brep))))))

32
#+allegro
Dave Cooper's avatar
Dave Cooper committed
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
(defun start-box-threads (&key (times 2000))
  
  
  (let ((*geometry-kernel* (make-instance (read-from-string 
					   "smlib::geometry-kernel")
				  :iw-context (funcall (read-from-string "smlib::make-iw-context")))))
    (mp:process-run-function "box-20" #'(lambda()(dotimes (n times) 
						   (when (zerop (mod n 100))
						     (format t "In 20-setter, n is: ~a~%" n))

						   (make-and-check-box-solid :value 20 :n n)))))

  (let ((*geometry-kernel* (make-instance (read-from-string 
					   "smlib::geometry-kernel")
					  :iw-context (funcall (read-from-string "smlib::make-iw-context")))))
    (mp:process-run-function "num-42" #'(lambda()(dotimes (n times) 
						   (when (zerop (mod n 100))
						     (format t "In 24-setter, n is: ~a~%" n))
						   (make-and-check-box-solid :value 24 :n n)))))

  (let ((*geometry-kernel* (make-instance (read-from-string 
					   "smlib::geometry-kernel")
					  :iw-context (funcall (read-from-string "smlib::make-iw-context")))))
    (mp:process-run-function "num-42" #'(lambda()(dotimes (n times) 
						   (when (zerop (mod n 100))
						     (format t "In 42-setter, n is: ~a~%" n))
						   (make-and-check-box-solid :value 42 :n n))))))