;;;sample algebraic computation for obtaining Haga's number 
;;;for a given ratio.  by  Takaya Iwamoto   Oct 19,2000
;;;Ref. "Origamics - Part I"  by  Kazuo Haga
;;;Input na, nb where   the ration is nb/na
;;;      both na & nb are integers
;;; LIST_HAGA_NUMBER	make a file lising all values for the ratios which have
;;;		denominator up to the given integer value.
;;;		e.g.  if max is 9, from 1/2 up to 8/9
;;;********************************************************************
;;;		output text file name is haga_number.txt
;;;********************************************************************
;;;
;;; HAGA_1	gives y1,y2,y3,y4 for a given nb/na
;;;		this works fine up to na < 32768
;;; HAGA_2	the same as HAGA_1, but this works for any numbers.
;;;		may require resetting system varaibles LUNITS & LUPREC
;;;		for a better precision
;;;
;;;
(defun c:List_Haga_number()
	(setq fil (open "haga_number.txt" "w"))
	(setq na_max (getint "\nMax Denominator ?:")
		na 2
	)
	(princ (setq title1 "\t\tHaga's Number List\n\n") fil)
	(princ (setq title2 (strcat  	"\t " "x"  "\t" "y1" "\t"
					"y2" "\t" "y3" "\t"
					"y4" "\t" "y5" "\t" "\n")) fil)
	(while (<= na na_max)
		(princ (strcat "\n     " "-" (itoa na)"-\n") fil)
		(setq nb 1)
		(while (> na nb)
		(setq a_sqr (* na na) b_sqr (* nb nb)
			a_p_b (+ na nb) a_m_b (- na nb)
			as_m_bs (- a_sqr b_sqr)
			as_p_bs (+ a_sqr b_sqr)

			2a_sqr (* 2 a_sqr) 
			2b (* 2 nb)
			a_apb (* na a_p_b)
			a_m_b_sqr (* a_m_b a_m_b)
			gcd_ab (gcd na nb)
		)
;;;skip this case,when na & nb have common divider not equal to 1 . 
		(if (= 1 gcd_ab)
		(progn
		
		(setq 
	;;x
		x_n (/ nb gcd_ab) y_n (/ na gcd_ab)
		n_x (itoa x_n)	d_x (itoa y_n) 
	;;y1
		gcd_y1 (gcd as_m_bs 2a_sqr)
		y1_n (/ as_m_bs gcd_y1) y1_d (/ 2a_sqr gcd_y1)
		n_y1 (itoa y1_n) 	d_y1 (itoa y1_d)
	;;y2
		gcd_y2 (gcd 2b a_p_b)
		y2_n (/ 2b gcd_y2) y2_d (/ a_p_b gcd_y2)
		n_y2 (itoa y2_n)		d_y2 (itoa y2_d)
	;;y3
		gcd_y3 (gcd as_p_bs a_apb)
		y3_n (/ as_p_bs gcd_y3) y3_d (/ a_apb gcd_y3)
		n_y3 (itoa y3_n)	d_y3 (itoa y3_d)
	;;y4
		gcd_y4 (gcd a_m_b_sqr 2a_sqr)
		y4_n (/ a_m_b_sqr gcd_y4) y4_d (/ 2a_sqr gcd_y4)
		n_y4 (itoa y4_n)	d_y4 (itoa y4_d)
	;;y5 = 1 
		n_y5 (itoa (- y2_d y2_n))
 		)
		(princ (setq final_str (strcat  "\t"
						n_x  "/" d_x  "   "
						n_y1 "/" d_y1 "   "
		  				n_y2 "/" d_y2 "   "
		  				n_y3 "/" d_y3 "   "
						n_y4 "/" d_y4 "   "
		  				n_y5 "/" d_y2 "\n"))	fil)
		);;;end of progn
		);;;end of if loop
		(setq nb (1+ nb))
	);;;inner while loop
		;(princ "\n\n\t(itoa na)" fil)
		(setq na (1+ na))
	);;;outer while loop
	(close fil)
);c:HAGA
;;;get y1, y2 ,y3, y4 for a given x value (na must be less than 32767)
(defun c:haga_1()
	(setq na (getint "\n Denominator ?:")
	      nb (getint "\n Numerator   ?:")
	)
	(princ (setq title1 "\t\tHaga's Number List\n\n") )
	(princ (setq title2 "\t x         y1              y2             y3            y4          y5\n") )
			(setq a_sqr (* na na) b_sqr (* nb nb)
			a_p_b (+ na nb) a_m_b (- na nb)
			as_m_bs (- a_sqr b_sqr)
			as_p_bs (+ a_sqr b_sqr)
			2a_sqr (* 2 a_sqr) 
			2b (* 2 nb)
			a_apb (* na a_p_b)
			a_m_b_sqr (* a_m_b a_m_b)
			gcd_ab (gcd na nb)
		)
	(setq 
	;;x
		x_n (/ nb gcd_ab) y_n (/ na gcd_ab)
		n_x (itoa x_n)	d_x (itoa y_n) 
	;;y1
		gcd_y1 (gcd as_m_bs 2a_sqr)
		y1_n (/ as_m_bs gcd_y1) y1_d (/ 2a_sqr gcd_y1)
		n_y1 (itoa y1_n) 	d_y1 (itoa y1_d)
	;;y2
		gcd_y2 (gcd 2b a_p_b)
		y2_n (/ 2b gcd_y2) y2_d (/ a_p_b gcd_y2)
		n_y2 (itoa y2_n)		d_y2 (itoa y2_d)
	;;y3
		gcd_y3 (gcd as_p_bs a_apb)
		y3_n (/ as_p_bs gcd_y3) y3_d (/ a_apb gcd_y3)
		n_y3 (itoa y3_n)	d_y3 (itoa y3_d)
	;;y4
		gcd_y4 (gcd a_m_b_sqr 2a_sqr)
		y4_n (/ a_m_b_sqr gcd_y4) y4_d (/ 2a_sqr gcd_y4)
		n_y4 (itoa y4_n)	d_y4 (itoa y4_d)
	;;y5 = 1 
		n_y5 (itoa (- y2_d y2_n))
	)
		(princ (setq final_str (strcat  "\t"
						n_x  "/" d_x  "\t"
						n_y1 "/" d_y1 "\t  "
		  				n_y2 "/" d_y2 "\t"
		  				n_y3 "/" d_y3 "\t"
						n_y4 "/" d_y4 "\t"
		  				n_y5 "/" d_y2 "\n"))	)\
);c:HAGA_1
;;;
;;;HAGA_2
;;;get y1, y2 ,y3, y4 for a given a, b  values bigger than 32767
;;;This is a general case both for integer & real numbers.
;;; set LUPREC = 0 or 1  LUNITS = 2
;;;if LUNITS is set to 1, then LUPREC must be set to 6-8 for a big number
(defun c:haga_2()
	(setvar "LUNITS" 2)
	(setvar "LUPREC" 0)
	(setq na (getreal "\n Denominator ?:")
	      nb (getreal "\n Numerator   ?:")
	)
	(princ (setq title1 "\t\tHaga's Number List\n\n") )
	(princ (setq title2 "\t x        y1       y2      y3       y4\n") )
	
		(setq a_sqr (* na na) b_sqr (* nb nb)
			a_p_b (+ na nb) a_m_b (- na nb)
			as_m_bs (- a_sqr b_sqr)
			as_p_bs (+ a_sqr b_sqr)
			2a_sqr (* 2 a_sqr) 
			2b (* 2 nb)
			a_apb (* na a_p_b)
			a_m_b_sqr (* a_m_b a_m_b)
		)
	(setq 
	;;x
		n_x (rtos  nb 2 )	d_x (rtos na 2 ) 
	;;y1
		n_y1 (rtos as_m_bs 2 ) 	d_y1 (rtos 2a_sqr 2 )
	;;y2
		n_y2 (rtos 2b 2 )		d_y2 (rtos a_p_b 2 )
	;;y3
		n_y3 (rtos as_p_bs 2 )	d_y3 (rtos a_apb 2 )
	;;y4
		n_y4 (rtos a_m_b_sqr 2 )	d_y4 (rtos  2a_sqr 2 )
 	
	)
		(princ (setq final_str (strcat  "\t"
						n_x  "/" d_x  "\t"
						n_y1 "/" d_y1 "\t  "
		  				n_y2 "/" d_y2 "\t"
		  				n_y3 "/" d_y3 "\t"
		  				n_y4 "/" d_y4 "\n"))	)
);c:HAGA_2
;;;
;;;Draw Haga model
;;;
(defun c:draw_haga_1()
	(haga_setup)
	(setq one_third (/ 1. 3.)
		pnt_e'(0.5 1)
		pnt_f '(0 0.625)
		pnt_g '(1 0.125)
		pnt_h (list 1 one_third)
		pnt_i '(1.1 0.2)
	)
;;draw points
	(make_pt "0" 0 pnt_e)
	(make_pt "0" 0 pnt_f)
	(make_pt "0" 0 pnt_g)
	(make_pt "0" 0 pnt_h)
	(make_pt "0" 0 pnt_i)
;;draw red lines
	(make_line_1 "0" 1 pnt_e pnt_f)
	(make_line_1 "0" 1 pnt_f pnt_g)
	(make_line_1 "0" 1 pnt_g pnt_i)
	(make_line_1 "0" 1 pnt_i pnt_h)
	(make_line_1 "0" 1 pnt_h pnt_e)
;;mark point ID	
	(mark_point  pnt_e  0.  0.1   "E"  chr_size)
	(mark_point  pnt_f  -1. 0.   "F"  chr_size)
	(mark_point  pnt_g  0.2  -0.7   "G"  chr_size)
	(mark_point  pnt_h  0.2   -0.1   "H"  chr_size)
	(mark_point  pnt_i  0.2   -0.2   "I"  chr_size)
;;arc for dimensions
	(normal_line_2pt pnt_a pnt_e -1 )
	(normal_line_2pt pnt_f pnt_a -1 )
	(normal_line_2pt pnt_d pnt_h -1 )
	(normal_line_2pt pnt_e pnt_h -1 )
	(normal_line_2pt pnt_c pnt_h -1 )
	(normal_line_2pt pnt_g pnt_i -1 )
	
	(command "_.zoom" "_e")
	(command "_.regen")


)

;;;*  ;setup
;;;
(defun haga_setup()
	(setup_sysvar)
	;(set_layer)
	(setq half_pi (* 0.5 pi))
	(setq pnt_a '(0 1)
		pnt_b '(0 0)
		pnt_c '(1 0)
		pnt_d '(1 1)
		limit_r (sqrt 2.0)
		limit_l 0.0
		min_val 0.1
		corner_list (list pnt_b pnt_c pnt_d pnt_a)
		chr_size 0.065
		nstep 0
	)
	(command "_.line" pnt_a pnt_b pnt_c pnt_d "_c" )
	(command "_.zoom" "_Extent")

	(mark_point  pnt_a  -1.0  0.1   "A"  chr_size)
	(mark_point  pnt_b  -1.0  -1.0   "B"  chr_size)
	(mark_point  pnt_c  0.2   -1.0   "C"  chr_size)
	(mark_point  pnt_d  0.2   0.1   "D"  chr_size)

;; This is a temp scale for testing
	(command "_.zoom" "_Extent" )
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -3)
;; Set the boundary hatch pattern to "_solid"
	(command "_.bhatch" "_P" "_Solid" "")
);HAGA_SETUP
;;
;;;NORMAL_LINE_2pt
;;;
(defun normal_line_2pt(pt1 pt2 dir_id / pnt_mid ver_line)
	(make_line_1 "0" col_id pt1 pt2)
		(setq ver_line (entlast))
	(setq pnt_mid (plt pt1 pt2 0.5))
	(command "_.move" ver_line "" pt1 pnt_mid)
	
	(if (= dir_id 1) (command "_.rotate" ver_line "" pnt_mid 90.))
	(if (= dir_id -1) (command "_.rotate" ver_line "" pnt_mid -90.))
	(setq 	pnt_temp (cdr (assoc 11 (entget ver_line))))
	(setq rad (distance pnt_temp pnt_f))
	(if (= dir_id 1) (command "_.arc" "_c" pnt_temp pt1 pt2))
	(if (= dir_id -1) (command "_.arc" "_c" pnt_temp pt2 pt1))
	(entdel ver_line)
)
;;;
;;;
;;;DRAW_HAGA_number
;;;
(defun c:draw_haga_number()
	(setup_sysvar)
	(setvar "PDMODE" 32)
	(setvar "PDSIZE" -3)
	(setq y_up '(0 1)
		pnt_org '(0 0)
		x_right '(1 0)
		pnt_across '(1 1)
		chr_size 0.05
	)
	(command "_pline" y_up pnt_org x_right pnt_across "cl")

	(mark_point  y_up  -1.2 0.2   "1"  chr_size)
	(mark_point  x_right  0.0 -1.2  "1"  chr_size)
	(mark_point  pnt_org  -1.5 -1.2   "(0,0)"  chr_size)
	(mark_point  pnt_across -1.5 0.5  "(1,1)"  chr_size)
;;;draw y1-y5 curve
	(draw_y1)
	(draw_y2)
	(draw_y3)
	(draw_y4)
	(draw_y5)
;;;draw x_axis lines and y-values
	(draw_fraction_lines)
;;;plot points 
	(plot_points)
	(command "_.zoom" "_e")
	(command "_.regen")

	(reset_sysvar)
)
;;;
;;;DRAW_Y1
;;;
(defun draw_y1()
	(setq ndiv 1000
		x_inc (/ 1. ndiv)
		step 1
		pnt_old '(0 0.5)
		x_start 0.
	)
	(repeat ndiv
		(setq x_new (+ x_start (* step x_inc))
			y_new (* 0.5 (- 1. (* x_new x_new)))
			pnt_new (list x_new y_new)
		)
		(make_line_1 "0" 1 pnt_old pnt_new)
		(setq step (1+ step)
			pnt_old pnt_new
		)
	)
)
;;; 
;;;
;;;DRAW_Y2
;;;
(defun draw_y2()
	(setq ndiv 1000
		x_inc (/ 1. ndiv)
		step 1
		pnt_old '(0 0)
		x_start 0.
	)
	(repeat ndiv
		(setq x_new (+ x_start (* step x_inc))
			y_new (/ (* 2 x_new) (+ 1 x_new))
			pnt_new (list x_new y_new)
		)
		(make_line_1 "0" 2 pnt_old pnt_new)
		(setq step (1+ step)
			pnt_old pnt_new
		)
	)
)
;;; 
;;;
;;;DRAW_Y3
;;;
(defun draw_y3()
	(setq ndiv 1000
		x_inc (/ 1. ndiv)
		step 1
		pnt_old '(0 1)
		x_start 0.
	)
	(repeat ndiv
		(setq x_new (+ x_start (* step x_inc))
			y_new (/ (+ 1 (* x_new x_new)) (+ 1 x_new) )
			pnt_new (list x_new y_new)
		)
		(make_line_1 "0" 3 pnt_old pnt_new)
		(setq step (1+ step)
			pnt_old pnt_new
		)
	)
)
;;; 		
;;;
;;;DRAW_Y4
;;;
(defun draw_y4()
	(setq ndiv 1000
		x_inc (/ 1. ndiv)
		step 1
		pnt_old '(0 0.5)
		x_start 0.
	)
	(repeat ndiv
		(setq x_new (+ x_start (* step x_inc))
			y_new (* 0.5 (* (- 1 x_new) (- 1 x_new)) )
			pnt_new (list x_new y_new)
		)
		(make_line_1 "0" 4 pnt_old pnt_new)
		(setq step (1+ step)
			pnt_old pnt_new
		)
	)
)
;;; 		
;;;
;;;DRAW_Y5
;;;
(defun draw_y5()
	(setq ndiv 1000
		x_inc (/ 1. ndiv)
		step 1
		pnt_old '(0 1)
		x_start 0.
	)
	(repeat ndiv
		(setq x_new (+ x_start (* step x_inc))
			y_new (/ (- 1 x_new) (+ 1 x_new) )
			pnt_new (list x_new y_new)
		)
		(make_line_1 "0" 6 pnt_old pnt_new)
		(setq step (1+ step)
			pnt_old pnt_new
		)
	)
)
;;; 		
;;;
(defun draw_fraction_lines( / nd n_repeat x_bot x_top y_left y_right a)
	(setq nd 2
		n_repeat 3
	)
	(repeat n_repeat
		(setq a (/ 1. nd)
			x_bot (list a 0)
			x_top (list a 1)
			y_left (list 0 a)
			y_right (list 1 a)
		)
		(make_line_1 "0" 8 x_bot x_top)
		(make_line_1 "0" 8 y_left y_right)
		(setq nd (1+ nd))
	)
;;repeat for (1-x) values
	(setq nd 2
		n_repeat 3
	)
	(repeat n_repeat
		(setq a (- 1 (/ 1. nd))
			x_bot (list a 0)
			x_top (list a 1)
			y_left (list 0 a)
			y_right (list 1 a)
		)
		(make_line_1 "0" 8 x_bot x_top)
		(make_line_1 "0" 8 y_left y_right)
		(setq nd (1+ nd))
	)

)
;;;plot points for 1/2, 1/3 and 1/4 cases
;;;
(defun plot_points()
	(setq list_pnt (list (list 0.5 0.375) (list 0.5 (/ 2. 3.)) (list 0.5 (/ 5. 6.)) 
			(list 0.5 0.125) (list 0.5 (/ 1. 3.)) 

			(list (/ 1. 3.) (/ 4. 9)) (list (/ 1. 3.) 0.5)
			(list (/ 1. 3.) (/ 5. 6)) (list (/ 1. 3.) (/ 2. 9))
			(list (/ 1. 3.) 0.5) 
			
			(list 0.25 (/ 15. 32)) (list 0.25 0.4) (list 0.25 (/ 17. 20))
			(list 0.25 (/ 9. 32)) (list 0.25 0.60)
		)
				
		index 0
	)
	(repeat 15
		(setq pnt (nth index list_pnt))
		(make_pt "0" 0 pnt)
		(setq index (1+ index))
	)
)
;;;
;;;
(defun x_and_y()
	(setq txt_height 0.050)
	(textdisplay "y" '(-0.1097   0.5233) txt_height 0.)
	(textdisplay "y1" '(0.6019   0.3572) txt_height 0.)
	(textdisplay "y2" '(0.4112   0.6503) txt_height 0.)
	(textdisplay "y3" '(0.5530   0.8774) txt_height 0.)
	(textdisplay "y4" '(0.3745   0.1056) txt_height 0.)
	(textdisplay "y5" '(0.0908   0.6600) txt_height 0.)
	(textdisplay "x"  '(0.4919  -0.0971) txt_height 0.)


)
;;;