;Parametric Vocabulary:door.lsp
;Autolisp file for 4.207 prepared by Lee, Hee Won
;Date: 3/22/97
(command "cmdecho" "0")
(defun c:x () (load "gateway"))
(xload "geom3d")

(command "units" 4 "" "" "" "" "")
(command "limits" (list -1200  -1200) (list 1200 1200))
(command "vpoint" (list -1 -1 1))
(load "nagakura")


(defun door (x y z w d wall_t door_wall_tr nrow ncol ver_gap hor_gap 
	       l_edge_ver_gap
	       r_edge_ver_gap  b_edge_hor_gap t_edge_hor_gap n_door)

     (command "cmdecho" "0")

     ;Set up local coordinate system
     (command "ucs" "origin" (list 0 0 z))
    
     ;This is setting up a new layer.
     (command "layer" "new" "door1" "color" "red" "door1" "")
  
     ;Draw 3d_shaft on layer "rect_shaft1"
     (command "layer" "set" "door1" "")

     (command "pline" (list x y)
	      (list (+ x  w)  y)
	      (list (+ x w) (+ y d))
	      (list  x  (+ y d))  "c" )  
     (setq ent1 (entlast))

     (command "pline" (list (+ x l_edge_ver_gap) (+ y b_edge_hor_gap))
	      (list (+ (+ x l_edge_ver_gap) (/ (- (- w (+ l_edge_ver_gap 
							r_edge_ver_gap))
		    (* (- ncol 1) ver_gap)) ncol)) (+ y b_edge_hor_gap))
	      (list (+ (+ x l_edge_ver_gap) (/ (- (- w (+ l_edge_ver_gap
							  r_edge_ver_gap))
		    (* (- ncol 1) ver_gap)) ncol)) 		    
		    (+ (+ y  b_edge_hor_gap) (/ (- (- d (+ b_edge_hor_gap
							   t_edge_hor_gap))
		    (* (- nrow 1) hor_gap)) nrow)))
	      (list (+ x l_edge_ver_gap) 		    
		    (+ (+ y  b_edge_hor_gap) (/ (- (- d (+ b_edge_hor_gap
							   t_edge_hor_gap))
		    (* (- nrow 1) hor_gap)) nrow)))
	      "c")
     (setq ent2 (entlast))

     ;Draw 3d_shaft
     (command "extrude" ent1 "" (list 0 0) (list 0 0 (* wall_t door_wall_tr))
	      "" )
     (setq ent1a (entlast))

     (command "extrude" ent2 "" (list 0 0) (list 0 0 (* wall_t door_wall_tr))
	      "" )
     (setq ent2a (entlast))  

     (setq A   (+ (/ (- (- d (+ b_edge_hor_gap t_edge_hor_gap))
		         (* (- nrow 1) hor_gap)) nrow) hor_gap))

     (setq B   (+ (/ (- (- w (+ l_edge_ver_gap r_edge_ver_gap))
		         (* (- ncol 1) ver_gap)) ncol) ver_gap))

     ;Varible 'elist' gets the result of 'tarry' function
     (setq elist (garray  ent2a nrow ncol A B ))

     (command "subtract" ent1a ""  elist "")
   
     (setq ent2b(entlast))
     (rotate3d  ent2b (list x y) (list (+ x 1) y) 90)

     ;Reset the ucs to world-coordinate-system
     
     (setq ent3(entlast))

     (setq clist1 (beam_array  ent3 1 n_door 0 w))

     ;(command "copy" ent3 "" (list x y) (list (+ x w) y))
     ;(setq ent4(entlast))

     ;(setq fflist (list ent3 ent4))
  
     (command "ucs" "world")

     ;Make 'elist' as a block for "nagakura" program   
     (nt_make_ablock clist1)
     ;clist1
)    ; end of defun

     ;Define a type with its symbolic contents and shape specification
     (nt_def_type "door" 'door
		  '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("w" . 36) 
		  ("d" . 96)  ("wall_t" . 12) ("door_wall_tr" . 0.25)
		  ("nrow" . 5) ("ncol" . 2)  
		  ("ver_gap" . 9) ("hor_gap" . 12) ("l_edge_ver_gap" . 9)
	          ("r_edge_ver_gap" . 9) ("b_edge_hor_gap" . 14) 
		  ("t_edge_hor_gap" . 14) ("n_door" . 1))
)



(defun garray (ent n_row n_col gap_row gap_col 
		   / M N  result_ss new_ent)
 
  (setq result_ss (ssadd ent))
  (setq M 0)
  (setq n_row (fix n_row))
  (setq n_col (fix n_col))
  (repeat n_row
	  (progn
	    (setq N 0)
	    (repeat n_col 
		    (command "copy" ent "" (list 0 0 0)
			     (list (* N gap_col) 
				   (* M gap_row) 0))
		    
		    (setq new_ent (entlast))
		   
		    (if (and (= N 0) (= M 0))
			(command "erase" new_ent "")
		      (ssadd new_ent result_ss)
		      
		      )   
		    (setq N (+ N 1))
		    ) ;end repeat ncol 
	    ) ;end progn
	  (setq M (+ M 1))
	  ) ; end repeat nraw
  result_ss
  ) 


(defun 3d_garray (ent n_row n_col gap_row gap_col 
		   / M N  result_ss new_ent)
  
  (setq result_ss (ssadd ent))
  (setq M 0)
  (setq n_row (fix n_row))
  (setq n_col (fix n_col))
  (repeat n_row
	  (progn
	    (setq N 0)
	    (repeat n_col 
		    (command "copy" ent "" (list 0 0 0)
			     (list (* N gap_col) 
				    0 (* M gap_row)))
		    
		    (setq new_ent (entlast))
		   
		    (if (and (= N 0) (= M 0))
			(command "erase" new_ent "")
		      (ssadd new_ent result_ss)
		      
		      )   
		    (setq N (+ N 1))
		    ) ;end repeat ncol 
	    ) ;end progn
	  (setq M (+ M 1))
	  ) ; end repeat nraw
  result_ss
  ) 

(defun beam_array_sub (ent  nrow ncol gap_row gap_col
		   / M N result_list new_ent)
  (setq result_list (list ent))
  (setq M 0)
  (setq nrow (fix nrow))
  (setq ncol (fix ncol))
  (repeat nrow
	  (progn
	    (setq N 0)
	    (repeat ncol 
                   (command "copy"
                            ent "" (list 0 0 0) 
			     (list (* N gap_col)
				   (* M gap_row) 0))
		    (setq new_ent (entlast))
		    (if (and (= N 0) (= M 0))
			(command "erase" new_ent "")
		      (setq result_list (cons new_ent result_list)) 
		      ) 		    
		    (setq N (+ N 1))
		    ) ;end repeat ncol 
	    ) ;end progn
	  (setq M (+ M 1))
	  ) ; end repeat nrow
  result_list
  )

(defun beam_array (ent_list nrow ncol gap_row gap_col / result sub_list)

   (if (null (listp ent_list))
      (setq ent_list (list ent_list)))


   (while ent_list
     (setq sub_list (beam_array_sub (car ent_list)  nrow ncol gap_row gap_col))
;  (print sub_list)
;  (print ent_list)
     (setq result (append sub_list result))
     (setq ent_list (cdr ent_list))
   )
 result
)