;;;sum of two succeeding trangular numbers is a square 
;;;	SUMTRIG.LSP
;;;	Sept 25, 2003	Takaya Iwamoto
;;;	Copyright 2006  Takaya Iwamoto
;;;	Aug 2,2006	Takaya Iwamoto used sumsqr_2.lsp as a template
;;;	Aug 3, 2006	added group name & arrows
;;;**ref**
;;;
;;;
(defun c:sumTRIG ( )
  (setup_sumtrig)
  (setq nstep 2)
  (while (= (Yes_or_No "Go to next step ?") "_Y")
    (trig_ball nstep)
    (IF	(= JPG_YES 1)
      (make_jpg)
    )
    (setq nstep (1+ nstep))
  )
;;;end of while loop
;;;copy ,rotate and move group of white balls to the right
  (copy_white)
  (IF (= JPG_YES 1)
    (make_jpg)
  )
;;;copy ,rotate and move group of red balls to the right  
  (copy_red) 
  (IF (= JPG_YES 1)
    (make_jpg)
  )
  (draw_text)
  (IF (= JPG_YES 1)
    (make_jpg)
  )
 
(reset_sysvar)
)
;;;C:sumtrig
;;;
;;;copy_white
(defun copy_white( )
   (setq ss_white (ssget "C" white_upper_r white_base))
  (alert "\nmake a copy of white balls")
  (command "_.copy" ss_white "" white_last white_last)

  (alert "\nrotate -135 degrees")
  ;(command "_.rotate" ss_white "" white_last -135.)
  (slow_rotate ss_white white_last -135. 4 500)

  (alert "\nmove white ball group to the right")
  ;(command "_.move" ss_white "" white_last white_next)
  (slow_move ss_white white_last white_next 4 500)
)
;;;
;;;copy_red
(defun copy_red( )
   (setq ss_red (ssget "C" red_upper_r red_base))
  (alert "\nmake a copy of red balls")
  (command "_.copy" ss_red "" red_last red_last)
  
  (alert "\nmove red ball group to the right")
  ;(command "_.move" ss_red "" red_base red_next)
  (slow_move ss_red red_base red_next 4 500)

  (alert "\nrotate +45 degrees")
  ;(command "_.rotate" ss_red "" red_next 45.)
  (slow_rotate ss_red red_next 45. 3 500)

  (alert "\nmove red ball group down")
  ;(command "_.move" ss_red "" red_next red_final)
   (slow_move ss_red red_next red_final 4 500)
)
;;;
;;;draw_text
(defun draw_text()
	
	
  (textdisplay "Sum of two successive"   '(6.5 0.)  0.8 0.)
  (textdisplay "Triangular numbers is"  '(6.5 -1.3)    0.8 0.)
  (textdisplay "a square number (N x N)"  '(6.5 -2.6)  0.8 0.)
  (textdisplay "T(n-1) + T(n) = N x N"      '(7.5 -4.5)  0.8 0.)

  (setq mid_red (shift_pnt (mid_point red_org red_base) (list (* 2 space_left) 1.))
	mid_white (shift_pnt (mid_point white_org white_base) (list (* 2 space_left) 0.5))
  )

  (textdisplay "T(n-1)"   mid_red  0.8 0.)	
  (textdisplay "T(n)"   mid_white  0.8 0.)
  
  
)
;;;
;;;
(defun setup_sumtrig ( )
  (setup_sysvar)
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -3)
  (if (/= (getvar "UNDOCTL") 0)
    (command "_.undo" "_C" "_N")
  )					;no und
  (if (= ICAD 0) (command "shademode" "Gouraud"))
  (setq space_down -1.5
        space_right 1.5
	space_left -1.5
	space_2 (* 2 space_right)
	ref_len 15.
	lower_left '(-11 -18.0)
	upper_right '(20. 2.)
  )
  (setq	red_org	'(0 0 )
	white_org  '(0 -10)
	white_left (shift_pnt white_org (list space_left space_down))
  )
	

  (command "_.zoom" "W" lower_left upper_right) 
  (my_block_insert "red_ball" red_org 0.5)
  (my_block_insert "white_ball" white_org 0.5)
;;;add 2-nd row for white balls
  (my_block_insert "white_ball" white_left 0.5)
  (command "_.array" (entlast) "" "R" 1 2 space_2)
  ;;this will be used as a reference later
;  (setq ss1 (ssadd))


   
  (command "_.regen")
  (IF (= JPG_YES 1)
    (make_jpg)
  )

)
;;;SETUP_sumtrig
;;;
;;;trig_ball	create N-th triangular number
;;;
(defun trig_ball(num / pnt_base col_id ring_name base_ring)
  (setq nm1 (1- num)
        np1 (1+ num)
	red_base (shift_pnt red_org (list (* space_left nm1) (* space_down nm1) ))
	white_base (shift_pnt white_org (list (* space_left num) (* space_down num) ))
	
  )
;;;red ball array
  (my_block_insert "red_ball" red_base  0.5)	
  (command "_.array" (entlast) "" "R" 1 num space_2)
;;;white ball array
  (my_block_insert "white_ball" white_base  0.5)	
  (command "_.array" (entlast) "" "R" 1 np1 space_2)
;;;compute the positions of the last red & white balls
  (setq red_last (shift_pnt red_base (list (* num space_2) 0))
        red_next (shift_pnt red_base (list (+ space_right (* num space_2)) space_down))
	white_last (shift_pnt white_base (list (* num space_2) 0))
	white_next (shift_pnt white_last (list space_2 0))
	red_upper_r  (list (* 0.5 num space_2) 0)
	white_upper_r (list (* 0.5 np1 space_2) -10)
	red_final (shift_pnt white_next (list 0. (* (sqrt 2) space_right)) )
  )

)
;;;TRIG_BALL
;;;
(defun c:square_pyramid	()
  (setup_ball)
  (setq nstep 2)
  (while (= (Yes_or_No "Go to next step ?") "_Y")
    (nxn_ball nstep)
    (IF	(= JPG_YES 1)
      (make_jpg)
    )
    (setq nstep (1+ nstep))
  )
;;;end of while loop
  (reset_sysvar)
)
;;;C:square_pyramid
;;;
;;;
(defun setup_ball ()
  (setup_sysvar)
	;(setvar "PDMODE" 32)
	;(setvar "PDSIZE" -3)
  (if (/= (getvar "UNDOCTL") 0)
    (command "_.undo" "_C" "_N")
  )		;no und
  (command "shademode" "Gouraud")
  (setq ref_len 15.)
  (setq	z_up	'(0 0 2)
	z_down	'(0 0 -5)
	x_left	'(-10 0 0)
	x_right	'(10 0 0)
	y_far	'(0 10 0)
	y_near	'(0 -10 0)
  )
  (make_pt "0" 0 z_up)
  (make_pt "0" 0 z_down)
  (make_pt "0" 0 x_left)
  (make_pt "0" 0 x_right)
  (make_pt "0" 0 y_far)
  (make_pt "0" 0 y_near)

  (command "_.vpoint" "-18.3967,-26.1979,22.8342")
  ;;SW isometric view

  (my_block_insert
    "white_ball"
    (list -1 -1 (- ref_len 2))
    1.0
  )
  (setq ref_ball1 (entlast))
  ;;this will be used as a reference later

  (command "_.zoom" "_EXTENT")
  (command "_.regen")
  (IF (= JPG_YES 1)
    (make_jpg)
  )

)
;;;SETUP_ball
;;;
;;;
;;;nxn_ball	create N by N cannon-ball pyramid using array command
;;;
(defun nxn_ball	(num / pnt_ins col_id ball_name base_ball)
  (setq pnt_ins (list (- num) (- num) (- ref_len (* num 2.))))
  (setq	col_id	  (rem num 7)
	ball_name
		  (cond	((= col_id 0) "white_ball")
			((= col_id 1) "red_ball")
			((= col_id 2) "yellow_ball")
			((= col_id 3) "green_ball")
			((= col_id 4) "cyan_ball")
			((= col_id 5) "blue_ball")
			((= col_id 6) "magenta_ball")
			(t "white_ball")
		  )
  )
  (princ pnt_ins)
  (terpri)
  (my_block_insert ball_name pnt_ins 1.0)
  (setq base_ball (entlast))
;;;use ARRAY command to make N x N 
  (command "_.array" base_ball "" "_R" num num 2.0 2.0)
)
;;;NXN_ball
;;;************************************************************************
;;; Function: PLT_3D
;;;
;;; get a point off the line segment defined by two end points and angle.
;;;	
					; utility routine 
;; get a point along the line segment defined by two end points 
;;
;; pnt_a pnt_b      end points
;; loc_from_a       ratio of distance from a to length AB
;; output           point data (x,y)
(defun PLT_3D
	      (pnt_a  pnt_b  loc_from_a	   /	  xa	 xb	ya
	       yb     za     zb	    dist_ab	  dx	 dy	dz
	       xm     ym     zm
	      )

  (setq	xa (car pnt_a)
	ya (cadr pnt_a)
	za (caddr pnt_a)
	xb (car pnt_b)
	yb (cadr pnt_b)
	zb (caddr pnt_b)
	dx (- xb xa)
	dy (- yb ya)
	dz (- zb za)
	xm (+ xa (* loc_from_a dx))
	ym (+ ya (* loc_from_a dy))
	zm (+ za (* loc_from_a dz))
  )
  (list xm ym zm)
)					;PLT_3D
;;;************************************************************************
;;; Function: PLD_3d
;;;
;;; get a point off the line segment defined by two end points and angle.
;;;	
					; utility routine 
;; get a point along the line segment defined by two end points 
;;
;; pnt_a pnt_b      end points
;; dist_from_a      distance from a to b
;;
;; output           point data (x,y)
;;
(defun PLD_3D
	      (pnt_a  pnt_b  dist_from_a   /	  xa	 xb	ya
	       yb     za     zb	    dx	   dy	  dz	 xm	ym
	       zm     loc_from_a
	      )

  (setq	xa	   (car pnt_a)
	ya	   (cadr pnt_a)
	za	   (caddr pnt_a)
	xb	   (car pnt_b)
	yb	   (cadr pnt_b)
	zb	   (caddr pnt_b)
	dx	   (- xb xa)
	dy	   (- yb ya)
	dz	   (- zb za)
	loc_from_a (/ dist_from_a (distance pnt_a pnt_b))
	xm	   (+ xa (* loc_from_a dx))
	ym	   (+ ya (* loc_from_a dy))
	zm	   (+ za (* loc_from_a dz))
  )
					;(princ zm)
  (list xm ym zm)

)					;PLD_3D
;;;
;;;*******************************************************************************************
;;;		move_ent_3d      move a sinlge entity slowly
;;;
(defun move_ent_3d (move_entity		  pnt_start  pnt_end
		    n_speed    ndiv	  ncolor     layer_name
		    /	       nstep	  pnt_from   pnt_to
		    inc
		   )
  (setq	inc	 (/ 1. ndiv)
	nstep	 1
	pnt_from pnt_start
	pnt_to	 (plt_3d pnt_start pnt_end inc)
  )
  (repeat ndiv
    (slow_line_3d n_speed layer_name ncolor pnt_from pnt_to)
    (entdel (entlast))
;;;test delete the trace
    (command "_.move" move_entity "" pnt_from pnt_to)

    (setq nstep	   (1+ nstep)
	  pnt_from pnt_to
	  pnt_to   (plt_3d pnt_start pnt_end (* inc nstep))
    )
  )
)
;;;move_ent_3d
;;;

;;; Function: SLOW_LINE_3D
;;;
;;;draw a line slowly between two given points
;;;
(defun SLOW_LINE_3D (n_section	layer_name color_code pnt_begin
		     pnt_end	/	   n_section  nstep
		     x0		x1	   delta_x    y0
		     y1		delta_y	   z0	      z1
		     delta_z	pnt_cur	   x_next     y_next
		     z_next	pnt_next
		    )

  (setq sblip (getvar "blipmode"))
  (setq scmde (getvar "cmdecho"))
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)

  (setq nstep 1)
  (setq	x0	(car pnt_begin)
	x1	(car pnt_end)
	y0	(cadr pnt_begin)
	y1	(cadr pnt_end)
	z0	(caddr pnt_begin)
	z1	(caddr pnt_end)
	delta_x	(/ (- x1 x0) (float n_section))
	delta_y	(/ (- y1 y0) (float n_section))
	delta_z	(/ (- z1 z0) (float n_section))
  )
  (setq pnt_cur pnt_begin)

  (while (< nstep n_section)
    (progn

      (setq x_next   (+ x0 (* delta_x nstep))
	    y_next   (+ y0 (* delta_y nstep))
	    z_next   (+ z0 (* delta_z nstep))
	    pnt_next (list x_next y_next z_next)
      )
      (command "_.line" pnt_begin pnt_next "")
      (entdel (entlast))
    )
    (setq nstep (+ 1 nstep))
  )
  (make_line_1 layer_name color_code pnt_begin pnt_end)
		;slow displayed line
  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
)					;SLOW_LINE_3d
;;;************************************************************************
;;;SLOW_MOVE
;;;
(defun slow_move(move_object pnt_from pnt_to nstep time_delay / del_inc nloop from to)
  (if (= jpg_yes 1) (setq nstep 3))
  (setq del_inc (/ 1. nstep)
	nloop 0
  )	

  (repeat nstep
	
	(setq from (plt pnt_from pnt_to (* nloop del_inc))
		to (plt pnt_from pnt_to (* (1+ nloop) del_inc))
	)
	(command "_.move" move_object "" from to)
	(if (= jpg_yes 1) (make_jpg))
	(command "_.delay" time_delay)
	(setq nloop (1+ nloop))
  )
)
;;;SLOW_MOVE
;;;
;;;
;;;SLOW_ROTATE
;;;
(defun slow_rotate(move_object pivot rot_angle nstep time_delay / deg_inc nloop  )
  (if (= jpg_yes 1) (setq nstep 3))
  (setq deg_inc (/ rot_angle (float nstep))
	nloop 1
  )	

  (repeat nstep
	(command "_.rotate" move_object "" pivot deg_inc)
	(if (= jpg_yes 1) (make_jpg))
	(command "_.delay" time_delay)
	(setq nloop (1+ nloop))
  )
)
;;;SLOW_ROTATE
;;;