(prompt "\nDoubling the Cube by AutoCAD - PLATO.LSP")
(prompt "\nCommands:  TEST_1  TEST_2 PLATO_Delian  ")
(prompt "\nCommands:    ")
(prompt "\n           ")
;----------------------------------------------------------
;;	12/17/2006	modified	added precision bar, make_jpg
;;	PLATO.LSP
;;    Doubling the cube
;;    A mechanical tool credited to Plato & his followers
;;	Making use of 3 similar triangles
;;      AOM, MON, NOB
;;	This scheme can be applied to get any cube root.
;;	The exmple here is for cube root of 2.
;;	In this example,  AO = 2.0, BO = 1.0
;;	The objective is find a point "N" on X axis so that 
;;	 NO is the cubic root of AO/BO = 2.0 .
;;
;;					;Test --- one at a time
(defun c:test_1 ()

  (setup_plato)	;;setup
  (disp_pline 0.5)	;;initial display
   (make_jpg)
  (while (setq pnt_temp	(getpoint
		  "\nPick a point on the positive X-axis.\nTry to place red point on Y-axis\n Hit return key to quit"))
    (setq pnt_x (car pnt_temp))
    (entdel line_ent)
    (disp_pline pnt_x)
	(make_jpg)
  )
  (result_display)
	(make_jpg)
  (reset_sysvar)
);TEST
;;
;;
					;Test_2-- Continuous pick
(defun c:test_2 ()
  (setup_plato)	;;setup
  (disp_pline 0.5)	;;initial display
  (setq	answer
	 (getpoint
	   "Place the cursor near the positive X-axis, 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 pnt_x (car(cadr key)))
    (entdel line_ent)
    (disp_pline pnt_x)
   
  );while
   (result_display)
   (reset_sysvar)
);TEST_2
;;;
;;;		;PLATO		zoom & regen is done automatically
;;;
;;;main routine :::   zoom & regen is done automatically
(defun c:PLATO_Delian()
	(setup_plato)		;;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 inside the 1_st quadrant,
		\nthen click your left mouse to begin moving along the X-axis.\n
		\nHit return key to terminate." )
	(setq answer (getpoint "\nPress left mouse for automatic zooming and regen."))
	(make_jpg)
	(while (= flag "GO")
	(while (and (setq key (grread T)) (= (car key) 5) )
		(setq pnt_x (car(cadr key)))
    		(entdel line_ent)
		
    		(disp_pline pnt_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_m pnt_n )
		(setq split_win "YES")
	);outer while loop
	(command "_.vports" "SI" )	;;;single view port
	(result_display)
	
	(command "_.zoom" "_EXTENT")
	(make_jpg)
	(reset_sysvar)
);TEST_3
;;
;;;
;;;CONVERGE
;;;
;;;check the convergence comparing the radius and line segment OL
(defun CONVERGE( / result)
	(setq diff_length (abs mx))
	(if (< diff_length criteria) (setq result T) (setq result nil))
);CONVERGE
;;;
;;;ZOOM_REGEN
;;;
(defun ZOOM_REGEN(pnt_target pnt_move)
	;;;Target point
	(make_jpg)
	(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_STATUS
;;; show the distance between tip and the horizontal line
(defun SHOW_STATUS( /  result)
	(setq diff_length mx)
	(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_o pnt_a)
	(make_line_1 "layer2" 2 pnt_o pnt_m)
	(make_line_1 "layer3" 3 pnt_o pnt_n)
	(make_line_1 "layer4" 4 pnt_o pnt_b)

	(setq diff_length mx)
	(setq 	result (strcat "dist = " (rtos diff_length 1 12)))
	(princ "final distance : ")(terpri)(princ result)(terpri)
	(make_point "0" 0 pnt_m "M" 1 chr_size)
  	(make_point "0" 0 pnt_n "N" 1 chr_size)
	(setq len_ao 2.0
		len_mo (distance pnt_m pnt_o)
		len_no pnt_x
		len_bo 1.0
		cube_al (expt len_no 3)
	)
	
	(setq
		line_1  "Result"
		line_2  "NO**3 = AO / BO"
		line_3  (strcat "NO        = " (rtos len_no 2 12))
		line_31         "(Exact  =  1.259921049895)"
		line_4  (strcat "NO**3    = " (rtos cube_al 2 10))
		line_5          "AO / BO = 2.0  (Given)"
	
	)
	(textdisplay  line_1   '(-3.0 -1.00)  0.200 0)
	(textdisplay  line_2   '(-2   -0.50)  0.100 0)
	(textdisplay  line_3   '(-2   -0.75)  0.100 0)
	(textdisplay  line_31  '(-2   -1.00)  0.100 0)
	(textdisplay  line_4   '(-2   -1.30)  0.100 0)
	(textdisplay  line_5   '(-2   -1.55)  0.100 0)
	
);RESULT_DISPLAY
;;;
;;SETUP_PLATO
(defun setup_plato()
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -1)
  (setup_sysvar)
  (setq	
	pnt_a '(-2 0)
	pnt_b '(0 -1)
	pnt_o '(0 0)
	x_left '(-3 0)
	x_right '(2 0)
	y_up   '(0 2.0)
	y_down '(0 -2.0)
	chr_size 0.200
	criteria 1.e-9
	cuberoot_2 (expt 2.0 (/ 1. 3.))
  )

  (make_line_1 "0" 8 x_left x_right)
  (make_line_1 "0" 8 y_down y_up)
  ;(make_arc_cbe "0" 8 pnt_o pnt_c pnt_a)
  (regapp "my_point")
  (make_point "0" 0 pnt_o "O" 3 chr_size)
  (make_point "0" 0 pnt_a "A" 4 chr_size)
  (make_point "0" 0 pnt_b "B" 3 chr_size)
;;;insert precision_meter
;block insert prec_meter.dwg 
	(setq ins_pnt '(-0.6 -2.0) meter_scale 0.75 
		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_PLATO
;;;
;;
;;DISP_PLINE
(defun disp_pline(temp_x)
  (setq k_c (/ 1. temp_x)
	k_sqr (* k_c k_c)
	k_cube (* k_sqr k_c)
	mx (/ (- 1 (* 2. k_cube)) (+ k_cube k_c))
	my (+ (* k_c mx) (* 2. k_c))
	pnt_m (list mx my)
	pnt_n (list temp_x 0)
    )
    (command "_.pline" pnt_a pnt_m pnt_n pnt_b "")
	(setq line_ent (entlast))
	(make_pt "0" 1 pnt_m)
    
);DISP_PLINE
;;
;;;
;;MAKE_WMF
;;;make windows meta file
(defun c:MAKE_WMF()
	(setup_plato_1)
	(make_line_1 "layer1" 1 pnt_o pnt_a)
	;(make_line_1 "layer2" 2 pnt_o pnt_m)
	;(make_line_1 "layer3" 3 pnt_o pnt_n)
	(make_line_1 "layer4" 4 pnt_o pnt_b)
	;(setq nstep (getint "\nHow many steps:"))
	(setq 	nstep 5 step 0
		x_start 0.5 x_end len_no
		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 "export"  (strcat "plato1_" (itoa step) ".wmf") "all" ""  )
		(setq step (1+ step))
		(entdel line_ent)
	); while loop
	(disp_pline x_val)

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