(prompt "\nDoubling the Cube by AutoCAD -ERATOSTHENES.LSP")
(prompt "\nCommands:  TEST ERATOSTHENES CREATE_JPG ")
(prompt "\nFunctions: (LOCATE) (BLOCK_DISPLAY) (SETUP)(SHOW_STATUS)(DEF_BLOCK)")
(prompt "\nFunctions: (DEF_ANGLE) (RESET) (CONVERGE)(ZOOM_REGEN)")
(prompt "\n           (RESULT_DISPLAY)(INIT_DISPLAY)")
(prompt "\n           ")
;----------------------------------------------------------
;Eratosthenes' tool for doubling the cube
;;;By Takaya Iwamoto  May 15-th,2000
;;;		12/22/2006	added create_jpg
;;;	ERATOSTHENES.LSP
;;;copied from amadori.lsp
;;;Interactive search trial
;;;Execution #1   test   manual operation
;;;Execution #2   test2   zoom & regen is done automatically
;;;
;;;main trial routine
;;;
;;;TEST
;;;main trial routine
(defun c:TEST()
	(setup)		;setup parameters
	(init_display)	;set initial position
	(alert "Click your left mouse to begin moving the right triangle.\n
		\n\nHit return key to terminate." )
	(setq answer (getpoint "\nPress left mouse to begin."))
	
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_temp (cadr key) )
		(locate pnt_temp)
		(entdel last_ent_1)
		(entdel last_ent_2)
		(entdel line_ent)
		(block_display "tri_1" base_pnt)
			(setq last_ent_1 (entlast))
		(block_display "tri_2" base_pnt2)
			(setq last_ent_2 (entlast))
		(make_line_1 "0" 1 pnt_u0 ref_pnt)
			(setq line_ent (entlast))
	); while loop
	(reset_sysvar)
	
);TEST
;;;ANALYSIS
;;;main trial routine
(defun c:Analysis()
	(setup)		;setup parameters
	(init_display)	;set initial position
	(alert "Click your left mouse to begin moving the right triangle.\n
		\n\nHit return key to terminate." )
	(setq answer (getpoint "\nPress left mouse to begin."))
	
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_temp (cadr key) )
		(locate_2 pnt_temp)
		(entdel last_ent_1)
		(entdel last_ent_2)
		(entdel line_ent)
		(block_display "tri_1" base_pnt)
			(setq last_ent_1 (entlast))
		(block_display "tri_2" base_pnt2)
			(setq last_ent_2 (entlast))
		(make_line_1 "0" 1 pnt_u0 ref_pnt)
			(setq line_ent (entlast))
	); while loop
	(reset_sysvar)
	
);TEST
;;;;;;;
(prompt "#1")
;;;ERATOSTHENES
;;;
;;;main routine :::   zoom & regen is done automatically
(defun c:ERATOSTHENES()
	(setup)		;setup parameters
	(init_display)	;set initial position
	(setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
	(setq flag "GO" split_win "NO")
	(alert "Click your left mouse to begin moving the right triangle.\n
		\nHit return key to terminate." )
	(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 (cadr key))
		(locate pnt_temp)
			(entdel last_ent_1)
			(entdel last_ent_2)
			(entdel line_ent)
		(block_display "tri_1" base_pnt)
			(setq last_ent_1 (entlast))
		(block_display "tri_2" base_pnt2)
			(setq last_ent_2 (entlast))
		(make_line_1 "0" 1 pnt_u0 ref_pnt)
			(setq line_ent (entlast))
		(command "_.regen")
		
		(setq pnt_a (inters pnt_u0 ref_pnt  base_pnt base1_b nil)
			pnt_b (inters base2_u base2_b base_pnt base1_b nil)
		)
		(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_a pnt_temp )
		(setq split_win "YES")
	);outer while loop
	(command "_.vports" "SI" )	;;;single view port
	
	(show_nodes)			;;;show the resulting position
	(command "_.zoom" "_EXTENT")
	(reset_sysvar)
);TEST2
(prompt "#2")
;;;SETUP
;;; setup
(defun SETUP()
	(setup_sysvar)
	(set_txstyle "arial")
	(setvar "PDMODE" 34)
	(setvar "PDSIZE"  -1)
	(setq ref_rad 1.75
		b_value 0.5
		pnt_org '(0 0) 
		criteria 1.0e-5
		chr_size 0.075
	)
	(make_base)	;define the base plate
	(def_block)	;define block
;;;insert precision_meter
;block insert prec_meter.dwg 
	(setq ins_pnt '(1.0 -0.6) meter_scale 0.5 
		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")
	(setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE
);SETUP
;;;
(prompt "#3")
;;;SHOW_STATUS
;;; show the distance between tip and the horizontal line
(defun SHOW_STATUS( /  result)
	(setq diff_length (abs  (distance pnt_a pnt_b)))
	(setq 	result (strcat "dist = " (rtos diff_length 2 12)))
	(move_bar diff_length meter_scale)
	;(grtext -1 result)
);SHOW_STATUS
;;;
;;;DEF_BLOCK
;;;
;define a block named "tri_1" & "tri_2"
;these blocks will be used for finding two mean proportional points
(defun DEF_BLOCK(  / b_1 b_2 hatch_1)
	;;;tri_1
	(command "_.layer" "_set" "layer4" "")
	(command "_.pline" '(0 1)  '(1 1)  '(1 0) "Cl")
	(setq b_1 (entlast))
	(make_circle_1 "layer4" 1 '(1 0.5) 0.025)
	(setq b_2 (entlast))
	(command "_.hatch" "_solid" b_1  "")
		(setq hatch_1 (entlast))
	(command "_.block" "tri_1" '(0 1)  hatch_1 b_1 b_2  "")
	(command "_.layer" "_set" "0" "")
	;;;tri_2
	(command "_.layer" "_set" "layer5" "")
	(command "_.pline" '(0 1)  '(1 1)  '(1 0) "Cl")
	(setq b_1 (entlast))
	(command "_.hatch" "_solid" b_1  "")
		(setq hatch_1 (entlast))
	(command "_.block" "tri_2" '(0 1)  hatch_1  b_1  "")
	(command "_.layer" "_set" "0" "")

);DEF_BLOCK
;;;
;;;MAKE_BASE
;;;
(defun MAKE_BASE( )
	(setq pnt_b0 '(0 0) pnt_b1 '(1 0) pnt_b2 '(2 0) pnt_b3 '(3 0) pnt_b4 '(3.5 0)
		pnt_u0 '(0 1) pnt_u1 '(1 1) pnt_u2 '(2 1) pnt_u3 '(3 1) pnt_u4 '(3.5 1)
	)
	(make_line_1 "0" 8 pnt_b0 pnt_b4)
	(make_line_1 "0" 8 pnt_u0 pnt_u4)
	(make_line_1 "0" 0 pnt_b0 pnt_u0)
	(make_line_1 "0" 0 pnt_u0 pnt_b1)	
	(make_line_1 "0" 0 pnt_u1 pnt_b1)
	(make_line_1 "0" 5 pnt_u2 pnt_b2)	
	(make_line_1 "0" 4 pnt_u3 pnt_b3)
	(make_line_1 "0" 5 pnt_u1 pnt_b2)	
	(make_line_1 "0" 4 pnt_u2 pnt_b3)

);MAKE_BASE
;;;
;;;
;;;BLOCK_DISPLAY
;;;	display block
(defun block_display(block_name insert_pnt )
	;(if (/= last_ent nil) (entdel last_ent))
	(command "_insert" block_name insert_pnt 1.0 1.0 0.0)	
	;(setq last_ent (entlast))
	
);BLOCK_DISPLAY
;;;
;;;LOCATE
;;;
(defun locate(pnt_tmp  )
	(setq 	x_temp (car pnt_tmp))
	;(if (>  (abs x_temp) 2.0) (setq x_temp -1.5))
	(setq 	base_pnt (list (- x_temp 1) 1)
		ref_pnt (list x_temp b_value)
	)
	(setq pnt_int (inters pnt_u0 ref_pnt pnt_u1 pnt_b1 nil)
		base_pnt2 (list  (cadr pnt_int) 1)
	) 
	(setq base1_b (list (+ 1 (car base_pnt)) 0)
		base2_u (list (+ 1 (car base_pnt2)) 1)
		base2_b (list (+ 1 (car base_pnt2)) 0)
		
	) 
	           
);LOCATE
;;;LOCATE_2
;;;display points base_pnt & base_pnt2
;;;
(defun locate_2(pnt_tmp  )
	(setq 	x_temp (car pnt_tmp))
	;(if (>  (abs x_temp) 2.0) (setq x_temp -1.5))
	(setq 	base_pnt (list (- x_temp 1) 1)
		ref_pnt (list x_temp b_value)
	)
	(setq pnt_int (inters pnt_u0 ref_pnt pnt_u1 pnt_b1 nil)
		base_pnt2 (list  (cadr pnt_int) 1)
	) 
	(setq base1_b (list (+ 1 (car base_pnt)) 0)
		base2_u (list (+ 1 (car base_pnt2)) 1)
		base2_b (list (+ 1 (car base_pnt2)) 0)
		pnt_t (inters pnt_u0 ref_pnt base_pnt base1_b nil)
		pnt_s (inters base2_u base2_b base_pnt base1_b nil)
		pnt_r (inters pnt_u0 ref_pnt base2_u base2_b nil)
	) 
	(make_pt "0" 1 pnt_t)
	(make_pt "0" 3 pnt_s) 
	(make_pt "0" 2 pnt_r)  
	            
);LOCATE_2
;;;
;;;CONVERGE
;;;
;;;check the convergence comparing the ref_rad and line length DE.
(defun CONVERGE( / result)
	(setq diff_length (abs (distance pnt_a pnt_b)))
	(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 2.))	;;;focus on the target point
	(setvar "CVPORT" 3)		
	(command "_.zoom" "ce" pnt_target vscale)
	(command "_.regen")
	;;;Mouse control point
	(setq vscale (/ vscale 2.))	;;;focus on the control point
	(setvar "CVPORT" 4)		
	(command "_.zoom" "ce" pnt_move vscale)
	(command "_.regen")
);ZOOM_REGEN
;;;
;;;SHOW_NODES
;;;
(defun SHOW_NODES()
	(setq x2_x (+ (car base_pnt) 1)
		 x1_x (+ (car base_pnt2) 1)
		pnt_n2 (list x2_x 1)
		pnt_g2 (list x2_x 0)
		pnt_q2 (list x1_x 1)
		pnt_h2 (list x1_x 0)
		x2_int (inters pnt_u0 ref_pnt pnt_u1 pnt_b1 nil)
	)
		
	(regapp "my_point")
	
	(make_point "0" 0  pnt_u0  "A" 2 chr_size)
	(make_point "0" 0 pnt_u1 "M" 2 chr_size)
	(make_point "0" 0 pnt_b0 "E" 4 chr_size)
	(make_point "0" 0 pnt_b1 "F" 4 chr_size)
	(make_point "0" 0 base_pnt "N1'" 2 chr_size)
	(make_point "0" 0 base_pnt2 "M1" 1 chr_size)
	(make_point "0" 0 x2_int "B" 4 chr_size)
	(make_point "0" 0 pnt_a "C" 1 chr_size)
	(make_point "0" 0 pnt_u4 "S" 2 chr_size)
	(make_point "0" 0 pnt_b4 "T" 4 chr_size)
	(make_point "0" 0 pnt_u3 "Q0" 2 chr_size)
	(make_point "0" 0 pnt_b3 "H0" 4 chr_size)
	(make_point "0" 0 pnt_u2 "N0" 2 chr_size)
	(make_point "0" 0 pnt_b2 "G0" 4 chr_size)
	(make_point "0" 0 ref_pnt "D" 1 chr_size)
	(make_point "0" 0 pnt_n2 "Q1" 2 chr_size)
	(make_point "0" 0 pnt_g2 "H1" 4 chr_size)
	(make_point "0" 0 pnt_q2 "N1" 2 chr_size)
	(make_point "0" 0 pnt_h2 "G1" 4 chr_size)
)
;;;
;INIT_DISPLAY
(defun init_display()
	(setq init_pos '(3 0))
	(locate init_pos  )
	(command "_insert" "tri_1" base_pnt 1.0 1.0 0.0)
	(setq last_ent_1 (entlast))
	(command "_insert" "tri_2" base_pnt2 1.0 1.0 0.0)
	(setq last_ent_2 (entlast))
	(make_line_1 "0" 1 pnt_u0 ref_pnt)
			(setq line_ent (entlast))
	(command "_.zoom" "e")
);INIT_DISPLAY
;;;
;;CREATE_JPG
;;;make jpgfiles used for animation
(defun c:create_jpg()
;;;after running Eratosthenes, the values of base_pnt & base_pnt2 are
;;; !base_pnt =  (1.42366 1)  !base_pnt2= (0.793701 1)
;;;
	(make_base)
	(def_block)
	(command "_.zoom" "_e")
	(command "_.regen")
	(setq nstep (getint "\nHow many steps: (def = 5)"))
		(if (= nstep nil) (setq nstep 5))
	(setq 	x1_start 2.0  x2_start 1.0
		x1_end (car base_pnt) x2_end (car base_pnt2)
		x1_int (- x1_start x1_end) x2_int (- x2_start x2_end)
		x1_step (/ x1_int nstep) x2_step (/ x2_int nstep)
		step 0
	)
	(entdel line_ent)
	(alert "\nHit return key to start.")
	
	(while (<=  step nstep)
		(setq base_x1 (list (- x1_start (* step x1_step)) 1)
			base_x2 (list (- x2_start (* step x2_step)) 1)
			ref_pnt (list (+ 1 (car base_x1)) 0.5)
			x2_int (inters pnt_u0 ref_pnt pnt_u1 pnt_b1 nil)
			base_x2 (list (cadr x2_int) 1)
		)
		(entdel last_ent_1)
		(entdel last_ent_2)
		(entdel line_ent)
		(block_display "tri_1" base_x1)
			(setq last_ent_1 (entlast))
		(block_display "tri_2" base_x2)
			(setq last_ent_2 (entlast))
		(make_line_1 "0" 1 pnt_u0 ref_pnt)
			(setq line_ent (entlast))
		;(command "export"  (strcat "db_cube_" (itoa step) ".wmf") "all" ""  )
		(command "_.delay" 1000)
		(make_jpg)
		
		(setq step (1+ step))
	); while loop
	(make_jpg)
	(show_nodes)
	(command "_.zoom" "_e")
	(command "_.regen")
	(make_jpg)
	(make_jpg)
);CREATE_JPG
;;;
;;--------------------------------------------------------------------------
(princ)