;Parametric Vocabulary:gateway.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 wall_face (x y z  left_w right_w d gate_w gate_d t) 

     (command "cmdecho" "0")
   
     ;Set up local coordinate system
     (command "ucs" "origin" (list 0 0 z) )

     (command "layer" "new" "wall_plane1" "color" "red" "wall_plane1" "")
   
     (command "layer" "set" "wall_plane1" "")

     ;Draw 2d_wall                       
     ;(command "pline" (list x y)
	;      (list (+ x left_w) y)
	;      (list (+ x left_w) (+ y gate_d))
	;      (list (+ (+ x left_w) gate_w) (+ y gate_d))
	;      (list (+ (+ x left_w) gate_w)  y)
	;      (list (+ (+ (+ x left_w) gate_w) right_w)  y)
	;      (list (+ (+ (+ x left_w) gate_w) right_w)  (+ y d))
	;      (list x  (+ y d))
	;      "c" )

     (command "pline" (list x y)
	      	      (list  x  (+ y gate_d))
	      (list (+  x  gate_w) (+ y gate_d))
	      (list (+  x  gate_w)  y)
	      (list (+  (+ x  gate_w) right_w)  y)
	      (list (+ (+  x  gate_w) right_w)  (+ y d))
	      (list (- x left_w) (+ y d))
	      (list (- x left_w)  y)
	      "c" )

  
     (setq ent1 (entlast))

     ;Draw 3d_wall
     (command "extrude" ent1 "" (list 0 0) (list 0 0 t) "" )
     (setq ent2(entlast))

     (rotate3d  ent2 (list x y) (list (+ x 1) y) 90)
     (setq ent3(entlast))

     ;Reset the ucs to world-coordinate-system
     (command "ucs" "world")
 
     ;Make 'ent' as a block for "nagakura" program   
     ;(nt_make_ablock ent)
     ent3
)    ; end of defun

     (nt_def_type "wall_face" 'wall_face
		  '(("xo" . 0) ("yo" . 0) ("zo" . 0) 
		    ("left_w" . 120) 
		    ("right_w" . 120)
		    ("d" . 312) ("gate_w" . 72) ("gate_d" . 110) ("t" . 12)))



(defun portal (x y z left_w right_w d gate_w gate_d t) 

     (command "cmdecho" "0")
   
     ;Set up local coordinate system
     (command "ucs" "origin" (list 0 0 z) )

     (command "layer" "new" "wall_plane1" "color" "red" "wall_plane1" "")
   
     (command "layer" "set" "wall_plane1" "")

     (command "pline" (list x y)
	      	      (list  x  (+ y gate_d))
	      (list (+  x  gate_w) (+ y gate_d))
	      (list (+  x  gate_w)  y)
	      (list (+  (+ x  gate_w) right_w)  y)
	      (list (+ (+  x  gate_w) right_w)  (+ y d))
	      (list (- x left_w) (+ y d))
	      (list (- x left_w)  y)
	      "c" )

  
     (setq ent1 (entlast))

     ;Draw 3d_wall
     (command "extrude" ent1 "" (list 0 0) (list 0 0 t) "" )
     (setq ent2(entlast))

     (rotate3d  ent2 (list x y) (list (+ x 1) y) 90)
     (setq ent3(entlast))

     ;Reset the ucs to world-coordinate-system
     (command "ucs" "world")
 
     ;Make 'ent' as a block for "nagakura" program   
     ;(nt_make_ablock ent)
     ent3
)    ; end of defun

     (nt_def_type "portal" 'portal
		  '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("left_w" . 12) 
		    ("right_w" . 12)
		    ("d" . 150) ("gate_w" . 72) ("gate_d" . 110) ("t" . 9)))



(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))
)



(nt_def_trans '("door") "wall_face" 'door&wall_face  nil 'add)
	     

 (defun door&wall_face (door_list trans_plist /
		     door c_plist f_plist door_plist)
  (setq door (car door_list))
  (setq door_plist (nt_plist door))

  (setq c_plist (list (cons "xo"  (nt_val "xo" door_plist) )
		      (cons "yo" (nt_val "yo" door_plist))
		      (cons "zo" (nt_val "zo" door_plist))
		      (cons "gate_w" (* (nt_val "w" door_plist) 
					(nt_val "n_door" door_plist)))
        
		      (cons "gate_d" (nt_val "d" door_plist))
		       (cons "t"  (nt_val "wall_t" door_plist) )
		      ))

  (setq f_plist (list (cons "left_w" 120)
		      (cons "right_w" 120)
		      (cons "d" 312)
		     
		     ))


  (list f_plist c_plist)
)


(nt_def_trans '("door") "portal" 'door&portal  nil 'add)
	     

 (defun door&portal (door_list trans_plist /
		     door c_plist f_plist door_plist)
  (setq door (car door_list))
  (setq door_plist (nt_plist door))

  (setq c_plist (list (cons "xo"  (nt_val "xo" door_plist) )
		      (cons "yo" (- (- (nt_val "yo" door_plist) 
				   (nt_val "wall_t" door_plist))  
				    6))
		      (cons "zo" (nt_val "zo" door_plist))
		      (cons "gate_w" (* (nt_val "w" door_plist) 
					(nt_val "n_door" door_plist)))
        
		      (cons "gate_d" (+ (nt_val "d" door_plist)
			    (/ (nt_val "d" door_plist) 4)) )
		      
		      ))

  (setq f_plist (list (cons "left_w" 9)
		      (cons "right_w" 9)
		      (cons "d" 150)
		      (cons "t" 9)
		     ))


  (list f_plist c_plist)
)









(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
)



(defun beam_ver (x y z w d h n_col gap_col)    
     ; Set up local coordinate system
     (command "ucs" "origin" (list 0 0  z) )
     
     (command "layer" "new" "beam1" "color" "red" "beam1" "")

     ; Draw 3d_base on layer "beam1"
     (command "layer" "set" "beam1" "")

     ; Draw 2d_block                      

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

     ;(command "extrude" ent1 "" (list 0 0) (list 0 0 h) "" )
     ;(setq ent1a (entlast))

     (command "3dface" (list x y)
	      (list x (- y d) )
	      (list  x  (- y d) h)
	      (list x y  h) "")
     (setq ent2(entlast))

     (command "3dface" (list x y)
	      (list (+ x w) y  )
	      (list  (+ x w) y  h)
           (list x y  h) "")
     (setq ent3(entlast))

     (command "copy" ent1 "" (list x y z) (list x  y (+ z h)))
     (setq ent1a(entlast))

     (command "copy" ent2 "" (list x y z) (list (+ x w)  y z))
     (setq ent2a(entlast))

     (command "copy" ent3 "" (list x y z) (list x  (- y d)  z ))
     (setq ent3a(entlast))

     ;(setq ss1 (ssadd ent1 ))
     ;(setq ss2 (ssadd ent1a ss1))
     ;(setq ss3 (ssadd ent2 ss2))
     ;(setq ss4 (ssadd ent2a ss3))
     ;(setq ss5 (ssadd ent3 ss4))
     ;(setq ss6 (ssadd ent3a ss5))

     

     (setq elist (list ent1 ent1a ent2 ent2a ent3 ent3a))

     (setq flist (beam_array elist 1 n_col 0 gap_col))
     (command "ucs" "world")
     (nt_make_ablock flist)

     ; Reset the ucs to world-coordinate-system
     
)    ; end of defun

     (nt_def_type "beam_ver" 'beam_ver
		  '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("w" . 1) 
		    
		    ("d" . 120) ("h" . 4) ("n_col" . 6) ("gap_col" . 6)))

(defun beam_hor (x y z w d h n_row gap_row)    
     ; Set up local coordinate system
     (command "ucs" "origin" (list 0 0  z) )
     
     (command "layer" "new" "beam1" "color" "red" "beam1" "")

     ; Draw 3d_base on layer "beam1"
     (command "layer" "set" "beam1" "")

     ; Draw 2d_block                      

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

     ;(command "extrude" ent1 "" (list 0 0) (list 0 0 h) "" )
     ;(setq ent1a (entlast))

     (command "3dface" (list x y)
	      (list x (- y d) )
	      (list  x  (- y d) h)
	      (list x y  h) "")
     (setq ent2(entlast))

     (command "3dface" (list x y)
	      (list (+ x w) y  )
	      (list  (+ x w) y  h)
           (list x y  h) "")
     (setq ent3(entlast))

     (command "copy" ent1 "" (list x y z) (list x  y (+ z h)))
     (setq ent1a(entlast))

     (command "copy" ent2 "" (list x y z) (list (+ x w)  y z))
     (setq ent2a(entlast))

     (command "copy" ent3 "" (list x y z) (list x  (- y d)  z ))
     (setq ent3a(entlast))

     ;(setq ss1 (ssadd ent1 ))
     ;(setq ss2 (ssadd ent1a ss1))
     ;(setq ss3 (ssadd ent2 ss2))
     ;(setq ss4 (ssadd ent2a ss3))
     ;(setq ss5 (ssadd ent3 ss4))
     ;(setq ss6 (ssadd ent3a ss5))

     

     (setq elist (list ent1 ent1a ent2 ent2a ent3 ent3a))

     (setq flist (beam_array elist n_row 1 gap_row 0))
     (command "ucs" "world")
     (nt_make_ablock flist)

     ; Reset the ucs to world-coordinate-system
     
)    ; end of defun

     (nt_def_type "beam_hor" 'beam_hor
		  '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("w" . 40) 
		    ("d" . 1) ("h" . 4) ("n_row" . 12) ("gap_row" . 6)))

(defun grid_canopy (x y z grid_w grid_d beam_ver_w  beam_ver_h 
		      beam_hor_d beam_hor_h n_row n_col wall_t  angle_y)

   (beam_ver x y z beam_ver_w grid_d beam_ver_h n_col 
	     (/ (- grid_w beam_ver_w) (- n_col 1)))
   (beam_hor x (- y  (- grid_d beam_hor_d)) z 
	     grid_w beam_hor_d 
		  beam_hor_h  n_row  (/ (- grid_d  beam_hor_d)  
					    (- n_row 1 )))
   (string (+ (+ x (/  (- grid_w beam_ver_w) (- n_col 1))) beam_ver_w)
       (+ (- y  (- grid_d beam_hor_d)) (/ (- grid_d  beam_hor_d) (- n_row 1 )))
	   (+ z beam_hor_h) beam_hor_d 
	   (- (- (- grid_d (/ (- grid_d   beam_hor_d) (- n_row 1 )))
		    beam_hor_d) wall_t)
	   angle_y (*  (/ (- grid_w beam_ver_w) (- n_col 1)) (- n_col 3))  
	   beam_ver_w)
)

(nt_def_type "grid_canopy" 'grid_canopy
	       '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("grid_w" . 36) 
		 ("grid_d" . 108) 
		 ("beam_ver_w" . 0.5)  ("beam_ver_h" . 4) 
		 ("beam_hor_d" . 0.5)  
		 ("beam_hor_h" . 4) ("n_row" . 12) ("n_col" . 4)
		 ("wall_t" . 12) ("angle_y" . 108)))
	       

(defun grid_canopy (xo yo zo grid_w grid_d beam_ver_w  beam_ver_h 
		      beam_hor_d beam_hor_h n_row n_col wall_t  angle_y
	   / c1 c2 beam_ver_c_plist beam_hor_c_plist string_c_plist)
  (setq beam_ver_c_plist
	(list (cons "xo" xo)
	      (cons "yo" yo)
	      (cons "zo" zo)
	      (cons "w" beam_ver_w)
	      (cons "d" grid_d)
	      (cons "h" beam_ver_h)	     	   
	      (cons "n_col" n_col)
	      (cons "gap_col" (/ (- grid_w beam_ver_w) (- n_col 1)))
	      ))

  (setq beam_hor_c_plist
	(list (cons "xo" xo)
	      (cons "yo" (- yo  (- grid_d beam_hor_d)))
	      (cons "zo" zo)
	      (cons "w" grid_w)
	      (cons "d" beam_hor_d)
	      (cons "h" beam_hor_h)	     	   
	      (cons "n_row" n_row)
	      (cons "gap_row" (/ (- grid_d beam_hor_d) (- n_row 1)))
	      ))
  (setq string_c_plist
	(list (cons "xo" (+ (+ xo (/ (-  grid_w beam_ver_w)  (- n_col 1)))
			    beam_ver_w))
	      (cons "yo" (+ (- yo  (- grid_d beam_hor_d)) 
			    (/ (- grid_d  beam_hor_d) (- n_row 1 ))))
	      (cons "zo" (+ zo beam_hor_h))
	      (cons "w" beam_hor_d)
	      (cons "angle_x" 
		    (- (- (- grid_d (/ (- grid_d   beam_hor_d) (- n_row 1 )))
		    beam_hor_d) wall_t))   
	      (cons "angle_y" angle_y)	     	   
	      (cons "dist" (*  (/ (- grid_w beam_ver_w) (- n_col 1)) 
			       (- n_col 3)))
	      (cons "t" beam_ver_w)
	      ))
  

  (setq c1 (list "beam_ver" nil beam_ver_c_plist))
  (setq c2 (list "beam_hor" nil beam_hor_c_plist))
  (setq c3 (list "string" nil string_c_plist))
  (nt_composit (list c1 c2 c3))
)

(nt_def_trans '("door") "grid_canopy" 'door&grid_canopy  nil 'add)
	     

 (defun door&grid_canopy (door_list trans_plist /
		     door c_plist f_plist door_plist)
  (setq door (car door_list))
  (setq door_plist (nt_plist door))

  (setq c_plist (list (cons "xo"  (nt_val "xo" door_plist) )
		      (cons "yo" (nt_val "yo" door_plist))
		      (cons "zo" (+ (nt_val "zo" door_plist)
				    (nt_val "d" door_plist)))
		      (cons "grid_w" (* (nt_val "w" door_plist) 
					(nt_val "n_door" door_plist)))
		       (cons "wall_t" (nt_val "wall_t" door_plist))
		     
		      ))

  (setq f_plist (list  
		 (cons "grid_d" 108)
		 (cons "beam_ver_w" 0.5)
		 (cons "beam_ver_h" 4)
		 (cons "beam_hor_d" 0.5)
		 (cons "beam_hor_h" 4)
		 (cons "n_row" 12)
		 (cons "n_col" 6)
		
		 (cons "angle_y" 108)
		     ))


  (list f_plist c_plist)
)


(defun string (x y z w angle_x angle_y dist t) 

     (command "cmdecho" "0")
   
     ;Set up local coordinate system
     (command "ucs" "origin" (list 0 0 z) )

     (command "layer" "new" "string1" "color" "red" "string1" "")
   
     (command "layer" "set" "string1" "")

     ;Draw 2d_wall                       
     (command "pline" (list x y)
	      (list (- x angle_x)  (+ y angle_y))
	      (list (- x angle_x) (+ (+ y angle_y) w))
	      (list (+ x w) y)
	      "c" )  
     (setq ent1 (entlast))

     ;Draw 3d_wall
     (command "extrude" ent1 "" (list 0 0) (list 0 0 t) "" )
     (setq ent2(entlast))

     (rotate3d  ent2  "x"   (list x y)   90 )
     (setq ent2a(entlast))

     (rotate3d  ent2a "z" (list x y)  -90 )
     (setq ent2a1(entlast))

     (command "copy" ent2a1 "" (list x y z) (list  (+ x dist)   y  z))
     (setq ent2b(entlast))

     ;Reset the ucs to world-coordinate-system
    
     (command "ucs" "world")

     (setq elist (list ent2a1 ent2b))
 
     ;Make 'ent' as a block for "nagakura" program   
     (nt_make_ablock elist)
      
)    ; end of defun

     (nt_def_type "string" 'string
		  '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("w" . 1) 
		    ("angle_x" . 100) ("angle_y" . 100) ("dist" . 50) 
		    ("t" . 1)))