;;;Durer's Angle Trisection Scheme
;;;ALbrecht Durer  published in 1525
;;;
;;;DURER.LSP
;;;May 16,2006 by Takaya Iwamoto
;;;
(defun C:Durer()
	(setup_durer)
		;;define angle
	(setvar  "OSMODE" 512)	;; nearest mode
	(setq pnt_org (getpoint pnt_a "\nDefine an angle Theta"))
	
	(make_pt "0" 1 pnt_org)  (mark_id pnt_org "O" 4 0.1)
	(make_line_1 "0" 3 pnt_a pnt_org)  (make_line_1 "0" 3 pnt_b pnt_org)
	
	(setvar "OSMODE" 0)	;;reset Snap mode to zero
		(command "_.delay" 1000)
		;;Draw an arc
	(make_arc_cbe "0" 4 pnt_org pnt_a pnt_b)
		;;find C1 & C2
	(setq c (cadr pnt_org) c_sqr (* c c)
		c_y (+ c (sqrt (+ c_sqr (/ 8. 9.))))
		pnt_c1 (list one_third c_y)
		pnt_c2 (list (- one_third) c_y)
	)
	(make_pt "0" 0 pnt_c1)  (mark_id pnt_c1 "C1" 3 chr_size2)
	(make_pt "0" 0 pnt_c2)  (mark_id pnt_c2 "C2" 2 chr_size2)
	(make_line_1 "0" 8 pnt_b pnt_c2) (make_line_1 "0" 8 pnt_c2 pnt_c1)
	(make_line_1 "0" 8 pnt_c1 pnt_a) (make_line_1 "0" 8 pnt_c1 pnt_m1)
	(make_line_1 "0" 8 pnt_c2 pnt_m2)	
		;;find point D, E and length  AT
	(setq len_ac (distance pnt_a pnt_c1)
		pnt_d (pld pnt_a pnt_m1 len_ac)
		pnt_e (plt pnt_d pnt_m1 one_third)
		len_ae (distance pnt_a pnt_e)
	)
		;;
	(make_pt "0" 0 pnt_d)  (mark_id pnt_d "D" 2 chr_size2)
	(make_pt "0" 0 pnt_e)  (mark_id pnt_e "E" 4 chr_size2)
		;;find coordinate of point "T"
	(find_t)
;;display point T and draw line OT
	(make_pt "0" 1 pnt_t)  (mark_id pnt_t "T" 1 chr_size)
	(make_line_1 "0" 2 pnt_org pnt_t)

	(command "_.zoom" "_Extent")
	(command "_.regen")
	(reset_sysvar)
);;;DURER
;;;
;;;
(defun setup_durer()
	(setup_sysvar)
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -3)
	(setq pnt_a '(1 0) pnt_b '(-1 0) pnt_q '(0 0)
		one_third (/ 1. 3.) y_up '(0 1) y_down '(0 -1)
		pnt_m1 (list one_third 0) 
		pnt_m2 (list (- one_third) 0)
		chr_size 0.1 chr_size2 0.08 chr_size3 0.06
		sqrt_3 (sqrt 3.) 
		pnt_30 (list 0 (- sqrt_3))
		pnt_45 (list 0 -1)
		pnt_60 (list 0 (- (/ sqrt_3 3.)))
	)
		;;draw reference lines
	(make_line_1 "0" 8 y_up y_down)
	(make_line_1 "0" 8 pnt_b pnt_a)
		;;draw key points
	(make_pt "0" 0 pnt_a)  (mark_id pnt_a "A" 4 chr_size)
	(make_pt "0" 0 pnt_b)  (mark_id pnt_b "B" 4 chr_size)
	(make_pt "0" 0 pnt_m1)  (mark_id pnt_m1 "M1" 4 chr_size2)
	(make_pt "0" 0 pnt_m2)  (mark_id pnt_m2 "M2" 4 chr_size2)

	(make_pt "0" 0 pnt_30)  (mark_id pnt_30 "30" 1 chr_size3)
	(make_pt "0" 0 pnt_45) (mark_id pnt_45 "45" 1 chr_size3)
	(make_pt "0" 0 pnt_60)  (mark_id pnt_60 "60" 1 chr_size3)
	(command "_.zoom" "_Extent")
	(command "_.regen")
	


);;;setup_durer
;;;
;;;FIND_T
;;;
(defun find_t()
	(setq k len_ae 		m c
		k_sqr (* k k) m_sqr (* m m)
		num_1 (* m k_sqr)
		num_2 (* k (sqrt (+ (* 4 m_sqr) 4 (- k_sqr))))
		denom (* 2 (+ m_sqr 1) )
		y_sol (/ (+ num_1 num_2) denom)
		x_sol (+ (* m y_sol) 1. (- (* 0.5 k_sqr)))
		pnt_t (list x_sol y_sol)
	)
);;;FIND_T
;;;
;;;DISTANCE_CHECK
;;;check if length AT is the average of BC2, C2C1, C1A
;;;
(defun c:distance_check()
	(setq bc2 (distance pnt_b pnt_c2)
		c2c1 (distance pnt_c2 pnt_c1)
		c1a (distance pnt_c1 pnt_a)
		at (distance pnt_a pnt_t)
		average (/ (+ bc2 c2c1 c1a) 3.)
		t_x (car pnt_t) t_y (cadr pnt_t)
		pnt_td (list (- t_x) t_y)
		ttd (distance pnt_t pnt_td)
	)
	
);;;distance_check
;;;
;;;
(prompt "error_table loading")
;;;
(defun C:error_table()
	(setup_sysvar)
	(setq start_val 0. end_val 90. step_val  5.)
	(setq cur_val 0. nstep 1 er_list nil)
	(while (<= (setq cur_val (+ start_val (* (- nstep 1) step_val))) end_val)
		(setq th (dtr cur_val)
			sine (sin th) cosine (cos th)
			cos_sqr (* cosine cosine)
			c1 (* (/ 1. 9.) sine)
			c2 (sqrt (/ 2. 27.))
			c3 (+ 2 cos_sqr)
			c4 (sqrt (+ 8 cos_sqr))
			arg (+ c1 (* c2 (sqrt (- c3 (* cosine c4)))))
			tri_th   (* 2 (asin arg))
			
			tri_th_deg (rtd tri_th)
			third_th (* cur_val (/ 2. 3.) )
			error_deg (- third_th tri_th_deg)
			error_rad (dtr error_deg)
			error_in_minsec (angtos error_rad 1 4)
			output (list nstep cur_val third_th tri_th error_deg error_in_minsec)
			er_list (append   er_list (list (* 3600. error_deg)))
			nstep (1+ nstep)
		)
		(princ "output= ")(princ output)(terpri)
	);;;while loop end



	(reset_sysvar)
);;;error_table