;Design Vocabulary: perg_capital_frame.lsp
;Autolisp file for 4.207 prepared by Lee, Hee Won
;Date: 11/10/96
;This file draws 3 dimensional capital  for pergola.
;Use of functions defined in this file
;(perg_capital2 (x y z w d gap_h nrow gap_row gap_col) 
;(demo perg_capital1)

;Load a file to use 'rotate3d' and 'mirror3d'.
;(xload "geom3d")
(load "nagakura")
;Load a function for array
;(load "beam_array") 
(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
) 

; Set up drawing for architectural unit.
(command "units" 4 "" "" "" "" "")

;This is setting up a new layer.
(command "layer" "new" "perg_1" "color" "red" "perg_1" "")

;This function allows a capital to be drawn parametrically at 
;a desired location with array.

(defun perg_capital_frame (x y z w gap_h nrow gap_row gap_col)
     ;Set up local coordinate system
     (command "ucs" "origin" (list 0 0  z))

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

     ;Draw long 2d_beam                       
     (command "pline" (list (- x (* 0.5 w)) (- y (* 0.5 w)))
	      (list (+ x (* 0.5 w)) (- y (* 0.5 w)))
	      (list (+ x (* 0.5 w)) (+ y (+ (* (- nrow 1) gap_row) (* 0.5 w))))
	      (list (- x (* 0.5 w)) (+ y (+ (* (- nrow 1) gap_row) (* 0.5 w))))
	      "c" )  
     (setq ent(entlast))

     ;Draw long 3d_beam
     (command "extrude" ent "" (list 0 0) (list 0 0 w) "")
     (setq ent1(entlast))

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

     (command "copy" ent1  "" (list x y z)  (list (+ x gap_col) y z))
     (setq ent3(entlast))

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

     ;Draw 2d_beam                       
     (command "pline" (list (- x (* 0.5 w)) (- y (* 0.5 w))) 
	      (list (+ x (* 0.5 w)) (- y (* 0.5 w)))
	      (list (+ x (* 0.5 w)) (+ y (* 0.5 w)))
	      (list (- x (* 0.5 w)) (+ y (* 0.5 w)))
	      "c" )  
     (setq ent5(entlast))

     ;Draw 3d_beam
     (command "extrude" ent5 "" (list 0 0) (list 0 0 gap_h) "")
     (setq ent6(entlast))

     (command "move" ent6 "" (list x y z)  (list x y (+ w z)))
     (setq ent7(entlast))

     (command "copy" ent7 "" (list x y z)  (list (+ x gap_col) y z)) 
     (setq ent8(entlast))

     (command "pline" (list (- x (* 0.5 w)) (- y (* 0.5 w))) 
	      (list (+ x (- gap_col (* 1.5 w))) (- y (* 0.5 w)))
	      (list (+ x (- gap_col (* 1.5 w))) (+ y (* 0.5 w)))
	      (list (- x (* 0.5 w)) (+ y (* 0.5 w)))
	      "c" )  
     (setq ent9(entlast))
     
     (command "extrude" ent9 "" (list 0 0) (list 0 0 w) "")
     (setq ent10(entlast))

     (command "move" ent10 "" (list x y z)  (list (+ x w) y z))
     (setq ent11(entlast))

     (command "copy" ent11 "" (list x y z)  (list x y (+ z (+ w gap_h)))) 
     (setq ent12(entlast)) 

     ;Variable 'elist' gets the result of 'beam_array' function
     (setq elist (beam_array (list ent7 ent8 ent11 ent12)  
			     nrow 1 gap_row gap_col))

     (setq flist (append  elist (list ent1 ent2 ent3 ent4)))

     ;Create axonometric view.
     ;(command "vpoint" (list -1 -1 1) )
   
     ;Reset the ucs to world-coordinate-system
     (command "ucs" "world")

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

;Define a type with its symbolic contents and shape specification
(nt_def_type "perg_capital_frame" 'perg_capital_frame
       '(("xo" . 0) ("yo" . 0) ("zo" . 0) ("w" . 3) ("gap_h" . 36)
	  ("nrow" . 21) ("gap_row" . 30) ("gap_col" . 120)))

;Test the function defined above with various parameter values.
;(defun demo1()
;     (command "limits" (list -300  -300) (list 300 300))
;     (perg_capital_frame 0 0 0 3 150 36 6  30 120) 
;     (command "hide" )   
;     (redraw)
;)

;Print message in double quotations
;(princ "(perg_capital2 x y z  w d gap_h nrow ncol gap_row gap_col) (demo)")

;Outputs a carriage return to the screen and returns 'nil'                    
;(terpri)