(prompt "\nDoubling the Cube by AutoCAD - DIOCLES.LSP")
(prompt "\nCommands:  TEST  TEST_2 DIOCLES SPIRAL_1 ")
(prompt "\nCommands:  DIVIDE_ANGLE  ")
(prompt "\n           ")
;----------------------------------------------------------
;;
;;	DIOCLES.LSP
;;    Use Cissoid
;;
;;
;;					;Test --- one at a time
(defun c:test ()

  (setup_diocles)	;;setup
  (disp_pline -0.5)	;;initial display
  (while (setq pnt_temp	(getpoint
		  "\nPick a point on the line DO. Hit return key to quit"))
    (setq g_x (car pnt_temp))
    (entdel line_ent)
    (disp_pline g_x)
	(show_status)
  )
	
	(show_nodes)
  (reset_sysvar)
);TEST
;;
;;
;;;Test_2-- Continuous pick
(defun c:test_2 ()
  (setup_diocles)	;;setup
  (disp_pline -0.5)	;;initial display
  (setq	answer
	 (getpoint
	   "Place the cursor near the line DO, then press left mouse to start.\n
	Press left mouse or return key to terminate."
	 )
  )

;;; while loop to pick a point continuously

  (while (and (setq key (grread T)) (= (car key) 5))
    (setq g_x (car (cadr key)))
    (entdel line_ent)
    (disp_pline g_x)
   (show_status)
  )
   (show_nodes)						
   (reset_sysvar)
);TEST_2
;;
;;;
;;;
;;;DIOCLES
;;;
;;;main routine :::   zoom & regen is done automatically
(defun c:DIOCLES()
	(setup_diocles)		;;setup
  	(disp_pline -0.5)	;;initial display
	(setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
	(setq flag "GO" split_win "NO")
	(alert "Move the cursor to point G,
		\nthen click your left mouse to begin moving toward point O.\n
		\nMove the cursor to make the intersection point P pass through blue line. 
		\nHit return key to terminate." )
	(setq answer (getpoint "\nPress left mouse for automatic zooming and regen."))
	(entdel text_g) (entdel text_e) (entdel text_h) (entdel text_f) (entdel text_p)
	(while (= flag "GO")
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq g_x (car(cadr key)))
    		(entdel line_ent)
	;	(entdel pnt_ent)
    		(disp_pline g_x)
		(show_status)
				
	);inner while loop
	;;;after the 2-nd round,work with 3 viewports.
		;(if (= split_win "NO") (command "_.vports" "2" "v"))
	(if (= split_win "NO") 
		(progn
			(command "_.vports" "3" "_A")
			(setvar "CVPORT" 2)
			(command "_.zoom" "_E")
			(setvar "CVPORT" 3)
			(command "_.zoom" "_E")
			(setvar "CVPORT" 4)
			(command "_.zoom" "_E")
		)
	)
	;;;;convergence criteria check
		(if (= (converge) T) (setq flag "STOP"))
	;;;;zoom and regen automatically for 2 viewports
		(zoom_regen pnt_q pnt_g )
		(setq split_win "YES")
	);outer while loop
	(command "_.vports" "SI" )	;;;single view port
	;(result_display)
	(show_nodes)
	(command "_.zoom" "_EXTENT")
	(reset_sysvar)
);DIOCLES
;;
;;;
;;;CONVERGE
;;;
;;;check the convergence comparing the radius and line segment OL
(defun CONVERGE( / result)
	(setq diff_length (distance pnt_p pnt_q) )
	(if (< diff_length criteria) (setq result T) (setq result nil))
);CONVERGE
;;;
;;;ZOOM_REGEN
;;;
(defun ZOOM_REGEN(pnt_target pnt_move)
	;;;Target point
	(setq vscale (/ vscale 4.))	;;;focus on the target point
	(setvar "CVPORT" 2)		
	(command "_.zoom" "ce" pnt_target vscale)
	(command "_.regen")
	;;;Mouse control point
	(setq vscale (/ vscale 4.))	;;;focus on the control point
	(setvar "CVPORT" 3)		
	(command "_.zoom" "ce" pnt_move vscale)
	(command "_.regen")
);ZOOM_REGEN
;;;
;;;SHOW_STATUS
;;; show the distance between tip and the horizontal line
(defun SHOW_STATUS( /  result)
	(setq diff_length (distance pnt_p pnt_q) )
	(setq 	result (strcat "dist = " (rtos diff_length 2 12)))
	(move_bar diff_length meter_scale)
	;(grtext -1 result)
);SHOW_STATUS
;;;
;;;
;;;RESULT_DISPLAY
;;; show the distance between tip and the horizontal line
(defun RESULT_DISPLAY( /  result)
	(make_line_1 "layer1" 1 pnt_a pnt_b)
	(make_line_1 "layer2" 2 pnt_a pnt_new)
	(make_line_1 "layer3" 3 pnt_a pnt_c)

	(setq diff_length (abs (- (distance pnt_o pnt_new) ref_rad)))
	(setq 	result (strcat "dist = " (rtos diff_length 2 12)))
	;(grtext -1 result)
	(make_point "0" 0 pnt_g "G" 1 chr_size)
  	(make_point "0" 0 pnt_new "L" 1 chr_size)
	(setq len_ab 1.0
		len_al (distance pnt_a pnt_new)
		len_ac 2.0
		cube_al (expt len_al 3)
	)
	
	(setq
		line_1  "Result"
		line_2  "AL**3 = AC / AB"
		line_3  (strcat "AL        = " (rtos len_al 2 10))
		line_31         "(Exact  = 1.259921049895)"
		line_4  (strcat "AL**3    = " (rtos cube_al 2 10))
		line_5          "AC / AB = 2.0  (Given)"
	
	)
	(textdisplay  line_1 '(1.0 0.75) 0.090 0)
	(textdisplay  line_2   '(0.85 0.60) 0.075 0)
	(textdisplay  line_3   '(0.90 0.50) 0.05 0)
	(textdisplay  line_31  '(0.90 0.40) 0.05 0)
	(textdisplay  line_4 '(0.90 0.25) 0.05 0)
	(textdisplay  line_5 '(0.90 0.10) 0.05 0)
	
);RESULT_DISPLAY
;;;
;;SETUP_DIOCLES
(defun setup_diocles()
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -1)
  (setup_sysvar)
  (setq	pnt_a '(0 1)
	pnt_b '(0 -1)
	pnt_c '(1 0)
	pnt_d '(-1 0)
	pnt_k '(0 -0.5)
	pnt_i '(0.6 -0.8)
	pnt_o '(0 0)
	chr_size 0.075
	ref_rad 1.0
	criteria 1.e-7
  )

  (make_line_1 "0" 8 pnt_a pnt_b)
  (make_line_1 "0" 8 pnt_d pnt_c)
  (make_line_1 "0" 5 pnt_d pnt_i)
  (make_circle_1 "0" 8 pnt_o ref_rad)
  (regapp "my_point")
  (make_point "0" 0 pnt_o "O" 1 chr_size)
  (make_point "0" 0 pnt_a "A" 1 chr_size)
  (make_point "0" 0 pnt_b "B" 4 chr_size)
  (make_point "0" 0 pnt_c "C" 1 chr_size)
  (make_point "0" 0 pnt_d "D" 3 chr_size)
  (make_point "0" 0 pnt_k "K" 1 chr_size)
  (make_point "0" 0 pnt_i "I" 2 chr_size)
 
(textdisplay  "Go" '(-0.5 0) 0.075 0)
	(setq text_g (entlast))
(textdisplay  "Eo" '(-0.5 -1) 0.075 0)
	(setq text_e (entlast))
(textdisplay  "Ho" '(0.5 0) 0.075 0)
	(setq text_h (entlast))
(textdisplay  "Fo" '(0.5 -0.95) 0.075 0)
	(setq text_f (entlast))
(textdisplay  "Po" '(0.55 -0.35) 0.075 0)
	(setq text_p (entlast))
;;;insert precision_meter
	;block insert prec_meter.dwg 
	(setq ins_pnt '(0.4 -1.25) meter_scale 0.45 
		m_x (car ins_pnt) m_y (cadr ins_pnt)
		pm_factor (* 0.25 (/ 1. (log 10.)))
	)
	(my_block_insert "prec_meter" ins_pnt meter_scale)
	;display initial bar
	(my_block_insert "prec_bar" ins_pnt meter_scale)
	(setq old_bar (entlast))	;;;prec_bar just created



  (command "_.zoom" "_EXTENT")
  (command "_.regen")
  ;(setvar "OSMODE" 8)

);SETUP_DIOCLES
;;;
;;;
;;;ERASE_NODE
;;;
(defun erase_node_text()
	(entdel text_g)
	(entdel text_e)
	(entdel text_h)
	(entdel text_f)
	(entdel text_p)
)
;;;
;;;
;;;SHOW_NODES
;;;
(defun show_nodes()
  (setq pnt_j (inters pnt_e pnt_c pnt_o pnt_b))
  (make_point "0" 0 pnt_g "G" 1 chr_size)
  (make_point "0" 0 pnt_e "E" 4 chr_size)
  (make_point "0" 0 pnt_h "H" 1 chr_size)
  (make_point "0" 0 pnt_f "F" 4 chr_size)
  (make_point "0" 0 pnt_p "P,Q" 4 chr_size)
  (make_point "0" 0 pnt_j "J" 4 chr_size)
  ;(make_point "0" 0 pnt_i "I" 4 chr_size)
)
;;
;;DISP_PLINE
;;;display pline GECHF after points E,F,and H are computed
;;;
(defun disp_pline(g_x)
  (setq e_y (- (sqrt (- 1.0 (* g_x g_x))))
	h_x (- g_x)
	pnt_g (list g_x 0)
	pnt_e (list g_x e_y)
	pnt_h (list h_x 0)
	pnt_f (list h_x e_y)
  )
    (command "_.pline" pnt_g pnt_e pnt_c pnt_h pnt_f "")
	(setq line_ent (entlast))
	(setq pnt_q (inters pnt_e pnt_c pnt_d pnt_i))
        (setq pnt_p (inters pnt_e pnt_c pnt_h pnt_f))
);DISP_PLINE
;;
;;
;;;draw Cissoid curve  invented by Diocles					
(defun c:draw_cissoid()

;;draw Y^2 = (1-x)^3 / (x+1)  from x -0.5 to x = 1.
	(setq x_start -0.5 x_end 1. x_inc 0.01 a_value 1.)
	(setq pnt_start (list x_start (f_cissoid x_start a_value)))
	(setq step 0    pnt_old  pnt_start)

	(while (< (setq x_t (+ x_start (* step x_inc))) x_end)

		(setq x_t (+ x_start (* step x_inc))
			y_t (f_cissoid x_t a_value )
			pnt_new (list x_t y_t))

		;;;; draw a line segment--later merged into one polyline
		(make_line_1 "layer2" 2  pnt_old pnt_new )

		(setq pnt_old pnt_new
			 step (+ 1 step))
	)
);;DRAW_CISSOID
;;;
;;;Evaluate y value for  y*y = (a-x)^3 / (a + x)
;;
(defun f_cissoid(x_val a_val / num den y_val)
	(setq num (expt (- a_val x_val) 3)
		den (+ x_val a_val)
		y_val (- (sqrt (/ num den)))
	)
);; f_cissoid
;;;
;;MAKE_WMF
;;;make windows meta file
(defun c:MAKE_WMF()
	(setup_diocles)
	;(make_line_1 "layer1" 1 pnt_a pnt_b)
	
	(make_line_1 "layer4" 4 pnt_d pnt_i)
	;(setq nstep (getint "\nHow many steps:"))
	(setq 	nstep 10 step 0
		x_start -0.5 x_end -0.227024
		x_inc (/ (- x_end x_start)  nstep)
	)
	;(setq answer (getpoint "\nPress left mouse to begin."))
	
	(while (<=  step nstep)
		(setq x_val (+ x_start (* x_inc step)))
		(disp_pline x_val)
		(command "_.delay" 500)
		(command "_.export"  (strcat "diocles_" (itoa step) ".wmf") "_all" ""  )
		(setq step (1+ step))
		(entdel line_ent)
		(show_status)
		(command "_.delay" 1000)
	); while loop
	(disp_pline x_val)
	(show_nodes)
	(command "_.export"  (strcat "diocles_" (itoa step) ".wmf") "_all" ""  )
	(reset_sysvar)

);MAKE_WMF
;;;
;;--------------------------------------------------------------------------
(princ)