(prompt "\nDelian Problem by Nicomedes_modified - modified_Nicomedes_DELIAN.LSP")
(prompt "\nCommands:  TEST  mod_Nicomedes")
(prompt "\nFunctions: (LOCATE) (BLOCK_DISPLAY) (SETUP)(SHOW_STATUS)")
(prompt "\nFunctions: (RESET) (CONVERGE)(ZOOM_REGEN)")
(prompt "\n           (RESULT_DISPLAY)(INIT_DISPLAY)")
;----------------------------------------------------------
;Doubling the Cube using Insertion method
;;;By Takaya Iwamoto   Dec 9, 2000
;;;modified_Nicomedes_DELIAN.LSP
;;;Insertion method by Rene Descartes
;;;Interactive search trial
;;;This can be also solved by Conchoid (Jan 20, 2006)
;;;TEST
;;;main trial routine
(defun c:TEST()
	(Descartes_setup)		;setup parameters
	
	(init_display)	;set initial position
	(alert "Select a point on the line BF. \nplace a red marker on the line DE\n\nHit return key to terminate." )
	;(command "_.vports" "2" "v")	;;;2 view ports
	;(command "_.zoom" "w" lower_left upper_right)
	(command "_.zoom" "_ext")
	(while ( setq pnt_temp (getpoint "\nSelect a point on the line BF, Hit return key to terminate." )) 
		(locate pnt_temp)
		(block_display)
		(show_status)			
	)
	(reset_sysvar)
	
);C:TEST
;;;
;;;main trial routine
;;;DRAW_CONCHOID
;;;		pnt_a, pnt_b	end coordinate of line AB (ruler)
;;;		pnt_c		Pole
;;;		a_length	constant length
;;;		ndiv		no. of division between Point A & B
(defun c:TEST_0()
	(Descartes_setup)		;setup parameters
	(alert "\ndraw conchoid curve")
;;;draw conchoid
	(conchoid_draw pnt_e pnt_b pnt_c 1.0 100)
	(make_jpg)
	(command "_.delay" 1000)	
	(setq pnt_p '(2.5874010520 0))
	(setq pnt_q (inters pnt_c pnt_p pnt_b pnt_e))
	(make_line_1 "0" 8 pnt_q pnt_p)
	(make_line_1 "0" 1 pnt_c pnt_q)
	(make_line_1 "0" 3 pnt_b pnt_p)
	(make_jpg)
	(command "_.delay" 1000)
	(make_pt "0" 0 pnt_p)
	(make_pt "0" 0 pnt_q)
	(make_jpg)
	(command "_.delay" 1000)
	(textdisplay "P" pnt_p chr_size 0.)
	(textdisplay "Q" pnt_q chr_size 0.)
	(make_jpg)
	(reset_sysvar)
	
);C:TEST
;;;
;;;mod_Nicomedes
;;;main routine :::   zoom & regen is done automatically
(defun c:mod_Nicomedes()
	(descartes_setup)		;setup parameters
	
	(init_display)	;set initial position
	(setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
	(setq flag "GO" split_win "NO")
	(command "_.zoom" "e" )
	(alert "Place the cursor on the line AF, then click left mouse to start.\n\nPress left mouse for automatic zooming.")
	(setq answer (getpoint "\nPress left mouse for automatic zooming and regen."))
	(while (= flag "GO")
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_temp (list (car (cadr key)) 0) ) 
		(locate pnt_temp)
		(block_display)
		(show_status)			
	);inner while loop
	;;;after the 2-nd round,work with 2 viewports.
		;(if (= split_win "NO") (command "_.vports" "2" "h"))
	(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")
		)
	)
	;;;;compute the location of point D
		(setq pnt_int (inters pnt_b pnt_e pnt_p pnt_c nil))
	;;;;convergence criteria check
		(if (= (converge) T) (setq flag "STOP"))
	;;;;zoom and regen
		(zoom_regen pnt_int pnt_temp)
		(setq split_win "YES")
	);outer while loop
	(command "_.vports" "SI" )	;;;single view port
	(make_point "0" 0 pnt_p "P" 4 chr_size)
	(make_point "0" 0 pnt_int "Q" 4 chr_size)
	(command "_.zoom" "_EXTENT")
	;(c:result_display)
	(reset_sysvar)

);DESCART
;;;
;;;DESCARTES_SETUP
;;; setup
(defun DESCARTES_SETUP()
	(setup_sysvar)
	;(set_layer)	;define layers
	(set_txstyle "arial")
	(setvar "PDMODE" 34)
	(setvar "PDSIZE" -3)
	(def_block)	;define block
	
	(setq pnt_a '(0 0) pnt_b '(1 0) pnt_c (list 0.5 (* 0.5 (sqrt 3.)))
		pnt_d (list -0.5 (- (* 0.5 (sqrt 3.0)) ))
		pnt_f '(3.5 0)
		criteria 1.e-10
		chr_size 0.1
		lower_left '(0.9 -0.1)
		upper_right '(3.1 1.1)
		ref_len 1.0
	)
	(pt_extend pnt_d pnt_b 1.75)
	(setq pnt_e new_pt)

	(regapp "my_point")
	(make_point "0" 0  pnt_a  "A" 3 chr_size)
	(make_point "0" 0  pnt_b  "B" 4 chr_size)
	(make_point "0" 0  pnt_c  "C" 2 chr_size)
	(make_point "0" 0  pnt_d  "D" 3 chr_size)
	(make_point "0" 0  pnt_e  "E" 1 chr_size)
	(make_point "0" 0  pnt_f  "F" 2 chr_size)

	(make_line_1 "0" 8 pnt_a pnt_b)
	(make_line_1 "0" 8 pnt_d pnt_e)
	(make_line_1 "0" 8 pnt_b pnt_c)
	(make_line_1 "0" 8 pnt_c pnt_a)
	(make_line_1 "0" 8 pnt_a pnt_d)
	(make_line_1 "0" 8 pnt_b pnt_f)
;;;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" "E")
	(command "_.regen")

);SETUP
;;;
;;;SHOW_STATUS
;;; show the deviation from the exact solution in status line
(defun SHOW_STATUS( / test_dist dif_dist result)
	;get intersection of line CP and BE
	(setq pnt_int (inters pnt_c pnt_p pnt_b pnt_e nil)
		test_dist (distance pnt_int pnt_p)
	)
	(setq dif_dist (abs (- test_dist ref_len))
		result (strcat "dist = " (rtos dif_dist 2 12))
	)
	(move_bar dif_dist meter_scale)
	;(grtext -1 result)
);SHOW_STATUS
;;;
;;;DEF_BLOCK
;;;
;define a block named "marked_bar"
;this block will be used for Delian Problem
(defun DEF_BLOCK()
	(command "_.layer" "_set" "layer3" "")
	(make_line_1 "0" 0 '(0 0) '(3 0))
	
	(make_pt "0" 1 '(1 0))
	(command "_.zoom" "_EXTENT" )
	(command "_.block" "marked_bar" '(0 0) "_all" "")
	(command "_.layer" "_set" "0" "")
);DEF_BLOCK
;;;
;;;
;;;BLOCK_DISPLAY
;;;	display block
(defun block_display()
	(if (/= last_ent nil) (entdel last_ent))
	(command "_insert" "marked_bar" pnt_p 1.0 1.0 theta)	
	(setq last_ent (entlast))
);BLOCK_DISPLAY
;;;
;;;
;;;LOCATE
;;;
(defun locate(pnt_temp / x_temp theta_rad)

	(setq x_temp (car pnt_temp)
		pnt_p (list x_temp 0)
		theta_rad (angle pnt_p pnt_c)
		theta (rtd theta_rad)
	)
);LOCATE
;;;
;;;CONVERGE
;;;
;;;check the convergence comparing the ref_len and line length DE.
(defun CONVERGE( / result)

	(setq test_length (abs (- ref_len (distance pnt_p pnt_int))))
	(if (< test_length criteria) (setq result T) (setq result nil))

);CONVERGE
;;;
;;;ZOOM_REGEN_1
;;;
(defun ZOOM_REGEN_1( / delta x_int y_int lower_left upper_right)

	(setq delta  (* 1.0 test_length)
		x_int (car pnt_int)
		y_int (cadr pnt_int)
		lower_left (list (- x_int delta) (- y_int delta))
		upper_right (list (+ x_int delta) (+ y_int delta))
	)
	(command "_.zoom" lower_left upper_right)
	(command "_.regen")

);ZOOM_REGEN
;;;
;;;ZOOM_REGEN
;;;
(defun ZOOM_REGEN(pnt_target pnt_move)
	;;;Target point
	(setq vscale (/ vscale 5.))	;;;focus on the target point
	(setvar "CVPORT" 2)		
	(command "_.zoom" "ce" pnt_target vscale)
	(command "_.regen")
	;;;Mouse control point
	(setq vscale (/ vscale 5.))	;;;focus on the control point
	(setvar "CVPORT" 3)		
	(command "_.zoom" "ce" pnt_move vscale)
	(command "_.regen")
);ZOOM_REGEN
;;;
;;;RESULT_DISPLAY
;;;display the results on the drawing window
(defun C:RESULT_DISPLAY( / aob adb ratio angle_aob
			   angle_adb angle_ratio 
			   deg_aob deg_adb result_title)

	(setq angle_aob (rtd (angle pnt_org pnt_a))
		angle_adb (rtd (angle pnt_d pnt_a))
	)
	(setq   deg_aob (rtos  angle_aob 2 12)
		deg_adb (rtos  angle_adb 2 12)
		angle_ratio (rtos (/ angle_aob angle_adb ) 2 12)
	)
	(setq
		aob   (strcat "Angle AOB = " deg_aob " deg")
		adb   (strcat "Angle ADB = " deg_adb " deg")
		ratio (strcat "AOB / ADB = " angle_ratio)
	)
	(textdisplay "Result   summary" '(-3.5 3.25) 0.25)
	(textdisplay  aob   '(-4.5 2.80) 0.20 )
	(textdisplay  adb   '(-4.5 2.50) 0.20 )
	(textdisplay  ratio '(-4.5 2.20) 0.20 )
	 
);RESULT_DISPLAY
;INIT_DISPLAY
(defun init_display()
	(setq init_pos '(2.8 0))
	(locate init_pos)
	(block_display)
	(setq last_ent (entlast))
	(command "_.zoom" "_e")
);INIT_DISPLAY
;;;
;;;
;;;DRAW_CONCHOID
;;;		pnt_a, pnt_b	end coordinate of line AB (ruler)
;;;		pnt_c		Pole
;;;		a_length	constant length
;;;		ndiv		no. of division between Point A & B
;;;
(defun conchoid_draw(pnt_a pnt_b pnt_c a_length ndiv 
		     / 	inc nstep pnt_old pnt_t pnt_new 
			dist_ca dist_ct
		    )
	
	(setq inc (/ 1. (float ndiv))
		nstep 1
		dist_ca (distance pnt_c pnt_a)
		pnt_old (pld pnt_c pnt_a (+ dist_ca a_length))
	)
	(make_line_1 "0" 3 pnt_c pnt_old)
		(setq temp_line (entlast))
	(repeat ndiv
		(entdel temp_line)
		(setq pnt_t (plt pnt_a pnt_b (* nstep inc))
			dist_ct (distance pnt_c pnt_t)
			pnt_new (pld pnt_c pnt_t (+ dist_ct a_length))
		)
		;undo

		(grdraw pnt_c pnt_new 3)
		;(command "_.point" pnt_new)
		(make_line_1 "0" 2 pnt_old pnt_new)
		(setq nstep (1+ nstep)
			pnt_old pnt_new
		)
		(make_line_1 "0" 3 pnt_old pnt_c)
		(setq temp_line (entlast))
		(if (= (rem nstep 10) 0) (make_jpg))
		(command "_.delay" 50)
		(command "_.redraw")
	)
	(make_jpg)
	(command "_.delay" 1000)
	(entdel temp_line)
);;;DRAW_CONCHOID
;;;
;;;
;;MAKE_WMF
;;;make windows meta file
(defun c:MAKE_WMF()
	(Descartes_setup)
	(setq init_pos '(2.0 0))
	(locate init_pos)
	(block_display)
	(setq last_ent (entlast))
	(command "_.zoom" "_e")
	(setq 	nstep 10 step 0
		x_start 2.0 x_end 2.5874010520
		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)))
		(setq pnt_temp (list x_val 0))
		(locate pnt_temp)
		(block_display)
		(command "_.delay" 500)
		(command "_.export"  (strcat "mod_Nicomed_" (itoa step) ".wmf") "_all" ""  )
		(setq step (1+ step))
		;(entdel line_ent)
		(show_status)
		(command "_.delay" 1000)
		(princ "step= ")(princ step)(terpri)
	); while loop
	(command "_.delay" 500)
	(setq pnt_q (inters pnt_c pnt_p pnt_b pnt_e))
	
	(make_line_1 "0" 1 pnt_c pnt_q)
	(make_line_1 "0" 3 pnt_b pnt_p)
	(make_pt "0" 0 pnt_p)
	(make_pt "0" 0 pnt_q)
	
	(textdisplay "P" pnt_p chr_size 0.)
	(textdisplay "Q" pnt_q chr_size 0.)
	(command "_.export"  (strcat "mod_Nicomed_" (itoa step) ".wmf") "_all" ""  )
	(reset_sysvar)

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