;;
;; shape grammar ice rays: an implementation.
;; haldane liew
;; may 18, 1999
;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; random functions                                                          ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq *SeedRand* nil) ; initialize the global

;;
;; (rand16) : generates a random number between 1 and 32767,
;;            that is, a positive 16 bit integer(defun rand16 ( / s )
;;
(defun rand16 ( / s )
  ; when this is used for the first time, initialize the seed
  ; from the system clock.
  (if (null *SeedRand*)
        (progn
          (setq s (getvar "date"))
      (setq *SeedRand* (fix (* 86400 (- s (fix s)))))
    ) ; progn
  ) ; if

  (setq *SeedRand* (+ (* *SeedRand* 1103515245) 12345))

  ; trim off the bits left of the 16th bits
  (logand (/ *SeedRand* 65536) 32767)
  )

;;
;; generates a random number between min and max.
;; min and max must be a non-negative integer smaller than 32678.
;;
(defun rand (min max / r16 range quotient remainder result)
  (setq r16         (rand16))          ; random number smaller than 32678
  (setq range       (+ 1 (- max min))) ; number of integers to be produced
  (setq quotient    (/ r16 range))     ; result in non-neg. integer
  (setq remainder   (- r16 (* quotient range)))
  (setq result      (+ min remainder))
  result
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;
;; finds a random point such that it lies on a line between
;; two points and is between low and high percentages.
;; low and high need to be expressed as whole numbers. eg. 35% = 35.
;;
(defun pointBetween (first second low high / 
			   x1 y1 x2 y2 range rangenum 
			   x3 y3 delta_x delta_y
			   ydiff xdiff m bhere)
  (setq x1 (car first) 
	y1 (cadr first)
	x2 (car second) 
	y2 (cadr second)
	range (rand low high))
  (setq rangenum (float (* range 0.01)))

  (setq delta_x (* (abs (- x2 x1)) rangenum))
  (if (> x2 x1) 
      (setq x3 (+ x1 delta_x))
    (setq x3 (- x1 delta_x))
    )
  (setq ydiff (- y2 y1))
  (setq xdiff (- x2 x1))
  (if (= xdiff 0)
      (progn
	(setq delta_y (* (abs (- y2 y1)) rangenum))
	(if (> y2 y1)
	    (setq y3 (+ y1 delta_y))
	  (setq y3 (- y1 delta_y))
	  )
	)
      (progn
	(setq m (/ ydiff xdiff))
	(setq bhere (- (cadr second) (* m (car second))))
	(setq y3 (+ (* m x3) bhere))
	)
      )
  (list x3 y3)
  )

;;
;; draws the polygon given a list of points of the polygon.
;;
(defun drawpolygon (pointslist / numsides index)
  (setq numsides (length pointslist))
  (setq index 0)
  (command "pline")
  (repeat numsides
	  (command (nth index pointslist))
	  (setq index (+ index 1))
	  )
  (command "c")
  )

;;
;; given a polygon entity, creates a solid with a given offset_thickness
;;
(defun frames ( / total num_objects i )
  (setq total (ssget "CP" boundarylist '((0 . "LWPOLYLINE"))))
  (setq num_objects (sslength total))
  (setq i 0)
  (repeat num_objects
	  (setq cur_entity (ssname total i))
	  (setq cur_points (entity_to_points cur_entity))
	  (setq numsides (length cur_points))
	  (setq a (pointBetween (nth 0 cur_points) (nth 1 cur_points) 45 55))
	  (setq b (pointBetween (nth 1 cur_points) (nth 2 cur_points) 45 55))
	  (setq innerpoint (pointBetween a b 45 55))
	  (command "offset" offset_thickness cur_entity innerpoint "")
	  (setq innerframe (entlast))
	  (command "extrude" innerframe "" offset_thickness 0)
	  (setq innerframe (entlast))
	  (command "extrude" cur_entity "" offset_thickness 0)
	  (setq outerframe (entlast))
	  (command "subtract" outerframe "" innerframe "")
	  (setq i (+ i 1))
	  )
  )

;;
;; create a frame around the first object which is also the boundary
;;
(defun firstframe ()
  (setq numsides (length boundarylist))
  (setq item 0)

  (command "pline")
  (repeat numsides
	  (setq point (nth item boundarylist))
	  (command point)
	  (setq item (+ item 1))
	  )
  (command "c")

  (setq originalframe (entlast))

  (setq firsttime true)
  (setq item 0)
  (repeat numsides
	  (setq point (nth item boundarylist))
	  (setq additive (+ (car point) (cadr point)))
	  (if (= firsttime true)
	      (setq minpoint point)
	      (if (< additive (+ (car minpoint) (cadr minpoint)))
		  (setq minpoint point)))
	  (setq item (+ item 1))
	  (setq firsttime false)
	  )
  (setq outerpoint (list (- (car minpoint) 1) (- (cadr minpoint) 1)))

  (command "offset" offset_thickness originalframe outerpoint "")
  (setq outerframe (entlast))
  (command "extrude" originalframe "" offset_thickness 0)
  (setq innerframe (entlast))
  (command "extrude" outerframe "" offset_thickness 0)
  (setq outerframe (entlast))
  (command "subtract" outerframe "" innerframe "")
  )

;;
;; test to see if all the distances of a polygon are greater than the
;; minimum distance.  if so return 1 else return 0.
;;
(defun test_mindist (pointslist / index nextindex
				faildistance point1 point2)
  (setq index 0)
  (setq nextindex 1)
  (setq faildistance 0)
  (repeat (length pointslist)
	  (setq point1 (nth index pointslist))
	  (setq point2 (nth nextindex pointslist))
	  (if (< (distance point1 point2) minlength)
	      (setq faildistance (+ faildistance 1)))
	  (setq index (+ index 1))
	  (if (= index (- numsides 1))
	      (setq nextindex 0)
	    (setq nextindex (+ index 1))
	    )
	  )
  (if (> faildistance 0)(setq return 0)(setq return 1))
  return
  )

;;
;; given a list of points of a k-sided polygon, two polygons will be
;; drawn.  sides adjacent to the first side will not be used therefore
;; the number of sides is not increased.  k= (k-1) & k
;;
(defun bisect_terminal (pointslist 
			/ numsides xpoint pba pbb okvalue distxp num_attempts)
  (setq numsides (length pointslist))
  (setq okvalue 0)
  (setq num_attempts (* 2 numsides)) ;; number of attempts to get right side

  (while (< okvalue num_attempts)
    (setq xpoint (rand 2 (- numsides 2)))
    (if (= xpoint (- numsides 1))
	(setq distxp (distance (nth xpoint pointslist) (nth 0 pointslist)))
      (setq distxp (distance (nth xpoint pointslist) 
			     (nth (+ xpoint 1) pointslist)))
      )
    (if (< distxp minlength) 
	(setq okvalue (+ okvalue 1)) 
      (setq okvalue num_attempts))
    )

  (setq pba (pointBetween (nth 0 pointslist) (nth 1 pointslist) 40 60))
  (if (= xpoint (- numsides 1))
      (setq pbb (pointBetween (nth xpoint pointslist) 
			      (nth 0 pointslist)
			      40 60))
    (setq pbb (pointBetween (nth xpoint pointslist) 
			    (nth (+ xpoint 1) pointslist)
			    40 60))
    )
  (setq index (+ xpoint 1))
  (command "pline" (nth 0 pointslist) pba pbb)
  (repeat (- (- numsides 1) xpoint)
	  (command (nth index pointslist))
	  (setq index (+ index 1))
	  )
  (command "c")
  (command "pline" (nth 1 pointslist) pba pbb)
  (setq index xpoint)
  (repeat (- xpoint 1)
	  (command (nth index pointslist))
	  (setq index (- index 1))
	  )
  (command "c")
  )

;;
;; given a list of points of a k-sided polygon, two polygons will be
;; drawn.  any edge is viable.  k = (k - 1) & k or k = 3 & (k + 1)
;;
(defun bisect_any (pointslist 
		   / numsides xpoint pba pbb distxp okvalue num_attempts)
  (setq numsides (length pointslist))
  (setq okvalue 0)
  (setq num_attempts (* 2 numsides)) ;; number of attempts to get right side

  (while (< okvalue num_attempts)
    (setq xpoint (rand 1 (- numsides 1)))
    (if (= xpoint (- numsides 1))
	(setq distxp (distance (nth xpoint pointslist) (nth 0 pointslist)))
      (setq distxp (distance (nth xpoint pointslist) 
			     (nth (+ xpoint 1) pointslist)))
      )
    (if (< distxp minlength) 
	(setq okvalue (+ okvalue 1)) 
      (setq okvalue num_attempts))
    )

  (setq pba (pointBetween (nth 0 pointslist) (nth 1 pointslist) 40 60))
  (if (= xpoint (- numsides 1))
      (setq pbb (pointBetween (nth xpoint pointslist) 
			      (nth 0 pointslist) 40 60))
    (setq pbb (pointBetween (nth xpoint pointslist) 
			    (nth (+ xpoint 1) pointslist) 40 60))
    )

  (setq index (+ xpoint 1))
  (command "pline" (nth 0 pointslist) pba pbb)
  (repeat (- (- numsides 1) xpoint)
	  (command (nth index pointslist))
	  (setq index (+ index 1))
	  )
  (command "c")

  (command "pline" (nth 1 pointslist) pba pbb)
  (setq index xpoint)
  (repeat (- xpoint 1)
	  (command (nth index pointslist))
	  (setq index (- index 1))
	  )
  (command "c")

  )

;;
;; given a list of points of polylines, returns the area of the polyline
;;
(defun area_of_poly (pointslist / pointa pointb x1 y1 x2 y2 term)
  (setq answer 0)
  (setq pointa (last pointslist))
  (setq pointb (car pointslist))
  (setq x1 (car pointa))
  (setq y1 (cadr pointa))
  (setq x2 (car pointb))
  (setq y2 (cadr pointb))
  (setq term (* 0.5 (- (* x1 y2) (* x2 y1))))
  (setq answer (+ answer term))
  (repeat (- (length pointslist) 1)
	  (setq pointa (car pointslist))
	  (setq pointb (cadr pointslist))
	  (setq x1 (car pointa))
	  (setq y1 (cadr pointa))
	  (setq x2 (car pointb))
	  (setq y2 (cadr pointb))
	  (setq term (* 0.5 (- (* x1 y2) (* x2 y1))))
	  (setq answer (+ answer term))
	  (setq pointslist (cdr pointslist))
	  )
  (abs answer)
  )

;;
;; take an polyline entity and returns a list of the points.
;; eg ((0 1) (1 1) (1 0))
;;
(defun entity_to_points (entity / index entity_info numsides)
  (setq index 12)
  (setq entity_info (entget entity))
  (setq numsides (cdr (assoc 90 entity_info)))
  (repeat numsides
	  (setq point (cdr (nth index entity_info)))
	  (if (= index 12) 
	      (setq pointslist (cons point ()))
	    (setq pointslist (cons point pointslist))
	    )
	  (setq index (+ index 4))
	  )
  (reverse pointslist)
  )

;;
;; given a list of points of a polyline, returns the maximum
;; distance in the polyline.
;;
(defun max_distance (pointslist / dist currentdist maxdist)
  (setq dist (distance (car pointslist) (last pointslist)))
  (repeat (- (length pointslist) 1)
	  (setq currentdist (distance (car pointslist) (cadr pointslist)))
	  (if (> currentdist dist) 
	      (setq maxdist currentdist)
	    (setq maxdist dist)
	    )
	  (setq pointslist (cdr pointslist))
	  )
  maxdist
  )

;;
;; given a list of points of a polyline, returns the minimum
;; distance in the polyline.
;;
(defun min_distance (pointslist / dist currentdist mindist)
  (setq dist (distance (car pointslist) (last pointslist)))
  (repeat (- (length pointslist) 1)
	  (setq currentdist (distance (car pointslist) (cadr pointslist)))
	  (if (< currentdist dist) 
	      (setq mindist currentdist)
	    (setq mindist dist)
	    )
	  (setq pointslist (cdr pointslist))
	  )
  mindist
  )

;;
;; given a list of points, returns a list of points where the first
;; two points will make up the max distance.
;;
(defun rearrange_max_points (pointslist 
   / index next maxdist numpoints startpoint currentdist)
  (setq index 0)
  (setq next (+ index 1))
  (setq maxdist (max_distance pointslist))
  (setq numpoints (length pointslist))
  (repeat numpoints
	  (setq a (nth index pointslist))
	  (setq b (nth next pointslist))
	  (setq currentdist (distance a b))
	  (if (= currentdist maxdist)
	      (setq startpoint index))
	  (setq index (+ index 1))
	  (if (= next (- numpoints 1))
	      (setq next 0)
	    (setq next (+ next 1))
	    )
	  )
  (setq index startpoint)
  (repeat numpoints
	  (setq a (nth index pointslist))
	  (if (= index startpoint)
	      (setq maxlist (cons a ()))
	    (setq maxlist (cons a maxlist))
	    )
	  (setq index (+ index 1))
	  (if (= index numpoints)
	      (setq index 0))
	  )
  (reverse maxlist)
  )

;;
;; main function
;;
(defun make-iceray (boundarylist)
  (setq total (ssget "CP" boundarylist '((0 . "LWPOLYLINE"))))
  (print total)
  (setq offset_thickness (* (max_distance boundarylist) 0.005))
  (setq mindist (min_distance boundarylist))
  (setq minarea (* (area_of_poly boundarylist) 0.10))
  (setq mindist_percent 0.20)
  (setq minlength (* mindist mindist_percent))
  (print "got here1")
  (setq maxpolysides 5)
  (setq num_entities (sslength total))
  (setq failtimes 0)
  (print "got here2")
  (while (< failtimes num_entities)
    (setq i 0)
    (repeat num_entities
	    (setq cur_entity (ssname total i))
	    (setq cur_points (entity_to_points cur_entity))
	    (setq cur_points (rearrange_max_points cur_points))
	    (setq numsides (length cur_points))
	    (entdel cur_entity)

	    (setq area (area_of_poly cur_points))
	    (princ "area=")(princ area)(princ "minarea=")(princ minarea)
	    (if (> area minarea)
		(progn
		  (setq mutate (rand 0 100))
		  (if (>=  mutate 0) ;; always mutate
		      (if (< numsides maxpolysides)
			  (bisect_any cur_points)
			(bisect_terminal cur_points))
		    (drawpolygon cur_points) 
		    )
		  )
	      (progn
		(setq failtimes (+ failtimes 1))
		(drawpolygon cur_points)
		)
	      ) ;if
	    (setq i (+ i 1))
	    ) ;repeat
    (setq total (ssget "CP" boundarylist '((0 . "LWPOLYLINE"))))
    (setq num_entities (sslength total))
    ) ;while
  (frames)
  (firstframe)
  (setq total (ssget "CP" boundarylist '((0 . "3DSOLID"))))
  (command "union" total "")
  (princ "...done")
  )

(defun iceray()
  (setq initobject (car (entsel "Pick an object to iceray:")))
  (setq boundarylist (entity_to_points initobject))
  (print boundarylist)
  ;;(entdel initobject)
  (make-iceray boundarylist)
  )

(defun make-tricuts (boundarylist / pointslist)
  (setq pointslist boundarylist)
  (command "line" 
	   (pointBetween (nth 0 pointslist) (nth 1 pointslist) 0 33)
	   (pointBetween (nth 2 pointslist) (nth 3 pointslist) 0 33) "")
  (setq line1 (entlast))
  (command "line"
	   (pointBetween (nth 1 pointslist) (nth 0 pointslist) 0 33)
	   (pointBetween (nth 3 pointslist) (nth 2 pointslist) 0 33) "")
  (setq line2 (entlast))
  ;;(print (entget line1))
  ;;(print (entget line2))
  (setq inter_point (inters
		     (cdr (assoc 10 (entget line1)))
		     (cdr (assoc 11 (entget line1)))
		     (cdr (assoc 10 (entget line2)))
		     (cdr (assoc 11 (entget line2))) nil))
  ;;(print "inter_point")(print inter_point)
  
  (if (> (distance 
	  (nth 1 pointslist) 
	  (list (car inter_point) (cadr (nth 1 pointslist))))
	 (distance
	  (nth 2 pointslist)
	  (list (car inter_point) (cadr (nth 2 pointslist)))))
      (command "line"
	       (pointBetween (nth 0 pointslist) 
			     (list (car inter_point) (cadr (nth 0 pointslist)))
			     10 90)
	       (pointBetween (nth 1 pointslist) 
			     (list (car inter_point) (cadr (nth 1 pointslist)))
			     10 90) "")
    (command "line"
	     (pointBetween (nth 3 pointslist)
			   (list (car inter_point) (cadr (nth 3 pointslist)))
			   10 90)
	     (pointBetween (nth 2 pointslist)
			   (list (car inter_point) (cadr (nth 2 pointslist)))
			   10 90) ""))
  (setq line3 (entlast))
  ;;(print (entget line3))

  (command "pline" 
	   (nth 0 pointslist)
	   (cdr (assoc 10 (entget line2)))
	   (inters (cdr (assoc 10 (entget line3)))
		   (cdr (assoc 11 (entget line3)))
		   (cdr (assoc 10 (entget line2)))
		   (cdr (assoc 11 (entget line2))) nil)
	   (cdr (assoc 10 (entget line3))) "c")
  (command "pline"
	   (cdr (assoc 10 (entget line2)))
	   (nth 1 pointslist)
	   (nth 2 pointslist)
	   (cdr (assoc 11 (entget line1)))
	   (inters (cdr (assoc 10 (entget line1)))
		   (cdr (assoc 11 (entget line1)))
		   (cdr (assoc 10 (entget line2)))
		   (cdr (assoc 11 (entget line2))) nil) "c")
  (command "pline"
	   (cdr (assoc 10 (entget line3)))
	   (inters (cdr (assoc 10 (entget line3)))
		   (cdr (assoc 11 (entget line3)))
		   (cdr (assoc 10 (entget line1)))
		   (cdr (assoc 11 (entget line1))) nil)
	   (cdr (assoc 11 (entget line1)))
	   (nth 3 pointslist) "c")
  (command "pline"
	   (inters (cdr (assoc 10 (entget line3)))
		   (cdr (assoc 11 (entget line3)))
		   (cdr (assoc 10 (entget line1)))
		   (cdr (assoc 11 (entget line1))) nil)
	   (inters (cdr (assoc 10 (entget line3)))
		   (cdr (assoc 11 (entget line3)))
		   (cdr (assoc 10 (entget line2)))
		   (cdr (assoc 11 (entget line2))) nil)
	   (inters (cdr (assoc 10 (entget line2)))
		   (cdr (assoc 11 (entget line2)))
		   (cdr (assoc 10 (entget line1)))
		   (cdr (assoc 11 (entget line1))) nil) "c")
  (entdel line1)
  (entdel line2)
  (entdel line3)
  ;;(entdel lastbox)
  )

(defun tri-iceray()
  
  ;; right this only works with 4-sides polygons!
  (setq initobject (car (entsel "Pick an object to iceray:")))
  (setq boundarylist (entity_to_points initobject))
  (entdel initobject)
  (make-tricuts boundarylist)
  (make-iceray boundarylist)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                           ;;
;; demos                                                                     ;;
;;                                                                           ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:demo ()
  (command "erase" "all" "")
  (command "pline" 
	   (list 0 0) 
	   (list 0 200) 
	   (list 600 200) 
	   (list 600 0) "c")
  (command "pline" 
	   (list -104 63) 
	   (list 15 -144) 
	   (list -203 -171) "c")
  (command "pline" 
	   (list 80 -80) 
	   (list 204 -29) 
	   (list 339 -149)
	   (list 221 -302) 
	   (list 83 -229) "c")
  (command "zoom" "extents")
  (command "zoom" ".8x")
  (iceray)
  )

(defun c:demo2 ()
  (command "erase" "all" "")
  (command "pline" 
	   (list 0 0) 
	   (list 0 200) 
	   (list 600 200) 
	   (list 600 0) "c")
  (command "zoom" "extents")
  (command "zoom" ".8x")
  (tri-iceray)
  )

(defun c:iceray ()
  (iceray)
  )

(defun c:tri-iceray ()
  (tri-iceray)
  )