;Jessica Rosenkrantz, jrosenk at mit dot edu
;4.207 Assignment Two
;Professor Nagakura
;02/25/04

;this project is not yet finished,
;there is one bug in the height of the 3rd column and the colors could be more complicated
;also the code is not particularly legible or clean


;creating a parametric Mondrian-like painting
;based from Mondrian's "composition number 10"

;1)
(command "osnap" "off")
(command "ucs" "world")
(command "-units" "2" "0" "" "" "" "")


(defun mondrian_fancy (x1 x2 x3 x4 x5 x6 y1 y2 y3 y4 y5 y6 y7 y8 stroke_width stroke_height)
		;messy
		(setq messy-list
			(list
				;column1
				(list 1 (area x1 y2))
				(list 2 (area x1 y4))
				(list 3 (area x1 y5))
				(list 4 (area x1 y6))
				(list 5 (area x1 y8))
				;column2
				(list 6 (area x2 y2))
				(list 7 (area x2 y3))
				(list 8 (area x2 y4))
				(list 9 (area x2 y5))
				(list 10 (area x2 y8))
				;column3
				(list 11 (area x3 y1))
				(list 12 (area x3 y2))
				(list 13 (area x3 y3))
				(list 14 (area x3 y4))
				(list 15 (area x3 y5))
				(list 16 (area x3 y6))
				(list 17 (area x3 y7))
				;;what?
				;column4
				(list 18 (area x4 y1))
				(list 19 (area x4 y2))
				(list 20 (area x4 y3))
				(list 21 (area x4 y4))
				(list 22 (area x4 y5))
				(list 23 (area x4 y8))
				;column5
				(list 24 (area x5 y1))
				(list 25 (area x5 y2))
				(list 26 (area x5 y4))
				(list 27 (area x5 y5))
				(list 28 (area x5 y8))
				;column6
				(list 29 (area x6 y1))
				(list 30 (area x6 y2))
				(list 31 (area x6 y4))
				(list 32 (area x6 y5))
				(list 33 (area x6 y8))
				)
			)
		
		
		(setq ordered-list (reorder-max-min-cdr messy-list))
		
		;now we have a list of all the rectangles in the order they are to be drawn in accending order of area
		;we need to substitute colors for the areas

		;(setq color (rand 0 200))

		;this variable is used by other methods, probably should pass this as an argument not do it this way
		(setq true-color (list (rand 0 200) (rand 0 200) (rand 0 200)))
		(setq cspace1 (/ (- 255 (listref true-color 0)) 33))

		
		(setq ordered-list (substitute-color ordered-list))
		
		;lastly we ought to reorder the list so we can draw from it
		(setq true-color-list (reorder-max-min-car ordered-list))		
		(setq true-color-list (remove-tags true-color-list))
		
		
			
		
		;convert the dimensions to points
				
		(setq y1_ (+ y1 stroke_height))
  		(setq y2_ (+ y2 stroke_height))
  		(setq y3 (+ y3 y2_))
		(setq y3_ (+ y3 stroke_height))
  		(setq y4 (+ y4 y2_))
		(setq y4_ (+ y4 stroke_height))
  		(setq y5 (+ y5 y4_))
		(setq y5_ (+ y5 stroke_height))
  		(setq y6 (+ y6 y5_))
		(setq y6_ (+ y6 stroke_height))
  		(setq y7 (+ y7 y6_))
		(setq y7_ (+ y7 stroke_height))
		(setq y8 (+ y5_ y8))
		
		(setq x1_ (+ x1 stroke_width))
  		(setq x2 (+ x1_ x2))
		(setq x2_ (+ x2 stroke_width))
  		(setq x3 (+ x2_ x3))
		(setq x3_ (+ x3 stroke_width))
		(setq x4 (+ x3_ x4))
		
		(setq x4_ (+ x4 stroke_width))
  		(setq x5 (+ x4_ x5))
		(setq x5_ (+ x5 stroke_width))
		(setq x6 (+ x6 x5_))
		
		
		
		
		;column one - 5 rectangles
		(change-color)
		(command "solid" (list 0 0)  (list 0 y2) (list x1 0) (list x1 y2) "")
		(change-color)
		(command "solid" (list 0 y2_) (list 0 y4) (list x1 y2_) (list x1 y4) "")
		(change-color)
		(command "solid" (list 0 y4_) (list 0 y5) (list x1 y4_) (list x1 y5) "")
		(change-color)
		(command "solid" (list 0 y5_) (list 0 y6) (list x1 y5_) (list x1 y6) "")
			(change-color)
		(command "solid" (list 0 y6_) (list 0 y8) (list x1 y6_) (list x1 y8) "")
			(change-color)
			
		;column two - 5 rectangles

		(command "solid" (list x1_ 0) (list x1_ y2) (list x2 0) (list x2 y2) "")
			(change-color)
		(command "solid" (list x1_ y2_) (list x1_ y3) (list x2 y2_) (list x2 y3) "")
			(change-color)
		(command "solid" (list x1_ y3_) (list x1_ y4) (list x2 y3_) (list x2 y4) "")
			(change-color)
		(command "solid" (list x1_ y4_) (list x1_ y5) (list x2 y4_) (list x2 y5) "")
			(change-color)
		(command "solid" (list x1_ y5_) (list x1_ y8) (list x2 y5_) (list x2 y8) "")
			(change-color)
		
		;column three - 7 rectangles
  
		(command "solid" (list x2_ 0) (list x2_ y1) (list x3 0) (list x3 y1) "")
			(change-color)
		(command "solid" (list x2_ y1_) (list x2_ y2) (list x3 y1_) (list x3 y2) "")
			(change-color)
		(command "solid" (list x2_ y2_) (list x2_ y3) (list x3 y2_) (list x3 y3) "")
			(change-color)
		(command "solid" (list x2_ y3_) (list x2_ y4) (list x3 y3_) (list x3 y4) "")
			(change-color)
		(command "solid" (list x2_ y4_) (list x2_ y5) (list x3 y4_) (list x3 y5) "")
			(change-color)
		(command "solid" (list x2_ y5_) (list x2_ y6) (list x3 y5_) (list x3 y6) "")
			(change-color)
		(command "solid" (list x2_ y6_) (list x2_ y7) (list x3 y6_) (list x3 y7) "")
			(change-color)
		

		;there is a bug that I can't seem to find that sometimes leaves this column too high
		(if (> x7_ x8) 
			(command "solid" (list x2_ y8) (list x2_ y8) (list x3 y8) (list x3 y8) "")
			(command "solid" (list x2_ y7_) (list x2_ y8) (list x3 y7_) (list x3 y8) "")
		)	
		;column four - 6 rectangles

  		(command "solid" (list x3_ 0) (list x3_ y1) (list x4 0) (list x4 y1) "")
			(change-color)
		(command "solid" (list x3_ y1_) (list x3_ y2) (list x4 y1_) (list x4 y2) "")
			(change-color)
		(command "solid" (list x3_ y2_) (list x3_ y3) (list x4 y2_) (list x4 y3) "")
			(change-color)
		(command "solid" (list x3_ y3_) (list x3_ y4) (list x4 y3_) (list x4 y4) "")
			(change-color)
		(command "solid" (list x3_ y4_) (list x3_ y5) (list x4 y4_) (list x4 y5) "")
			(change-color)
		
		(command "solid" (list x3_ y5_) (list x3_ y8) (list x4 y5_) (list x4 y8) "")
			(change-color)
		
		;column five - 5 rectangles
  
		(command "solid" (list x4_ 0) (list x4_ y1) (list x5 0) (list x5 y1) "")
			(change-color)
		(command "solid" (list x4_ y1_) (list x4_ y2) (list x5 y1_) (list x5 y2) "")
			(change-color)
		(command "solid" (list x4_ y2_) (list x4_ y4) (list x5 y2_) (list x5 y4) "")
			(change-color)
		(command "solid" (list x4_ y4_) (list x4_ y5) (list x5 y4_) (list x5 y5) "")
			(change-color)
		
		(command "solid" (list x4_ y5_) (list x4_ y8) (list x5 y5_) (list x5 y8) "")
			(change-color)
		
		;column six - 5 rectangles
		
		(command "solid" (list x5_ 0) (list x5_ y1) (list x6 0) (list x6 y1) "")
			(change-color)
		(command "solid" (list x5_ y1_) (list x5_ y2) (list x6 y1_) (list x6 y2) "")
			(change-color)
		(command "solid" (list x5_ y2_) (list x5_ y4) (list x6 y2_) (list x6 y4) "")
			(change-color)
		(command "solid" (list x5_ y4_) (list x5_ y5) (list x6 y4_) (list x6 y5) "")
			(change-color)
		
		(command "solid" (list x5_ y5_) (list x5_ y8) (list x6 y5_) (list x6 y8) "")
		
		)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;accessory functions


;get the list element at a specified reference point
(defun listref (lst x)
	(if (= x 0) 
		(car lst)
		(listref (cdr lst) (- x 1))
		))

;a list of the primary mondrian colors
;this function isn't used for anything any longer
(defun color ()
	(setq colors (list "red" "blue" "white" "yellow"))
	(command "-layer" "set" (listref colors (rand 0 3)) "")
	)

;calculates and returns the area of a rectangle
(defun area (width height)
	(* width height)
	)
		
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;random numbers
;from 4.207 website

(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

  ; To generate a psudo-sandom number sequence
  ; I use the routine described in Kernighan and Ritchie's
  ; "C Programming Language" second edition, p46
  (setq *SeedRand* (+ (* *SeedRand* 1103515245) 12345))

 ; trim off the bits left of the 16th bits      
  (logand (/ *SeedRand* 65536) 32767)
)
(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
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;helper functions needed for randomizing and determining areas/colors

;function that deletes an element from a list
(defun delq (lst elt)
	(if 
		(eq (car lst) elt)
		(cdr lst)
		(cons (car lst) (delq (cdr lst) elt))
	)
)

;function that reorders a list randomly
(defun get-random (lst / n obj)
	(cond ((null lst) lst)
	      (t
		(setq n (rand 0 (- (length lst) 1)))
		(setq obj (listref lst n))
		(cons obj (get-random (delq lst obj)))
		)
	)
)

;(defun cddr (lst) (cdr (cdr lst)))

;returns the tagged list with the maximum cadr of all the tagged lists in a list
(defun rmax-cdr (a)
	(cond ((null (cdr a)) (car a))
		((greaterp (cadr (car a)) (cadr (cadr a)))
			(rmax-cdr (cons (car a) (cddr a))))
		(t (rmax-cdr (cdr a)))))

;returns the tagged list with the maxiumum car (the tag) of all the tagged lists in a list
(defun rmax-car (a)
	(cond ((null (cdr a)) (car a))
		((greaterp (car (car a)) (car (cadr a)))
			(rmax-car (cons (car a) (cddr a))))
		(t (rmax-car (cdr a)))))
;function that returns true if a>b		
(defun greaterp (a b) 
	(eq (max a b) a))
		
;this function will reorder the list by max area
(defun reorder-max-min-cdr (lst)
	(if
		(null lst) 
		lst
		(cons (rmax-cdr lst) (reorder-max-min-cdr (delq lst (rmax-cdr lst))))
)
)
(defun reorder-max-min-car (lst)
	(if
		(null lst) 
		lst
		(cons (rmax-car lst) (reorder-max-min-car (delq lst (rmax-car lst))))
	)
)	

;(setq cspace1 (/ (- 255 (listref true-color 0)) 33))


(defun substitute-color (lst)
	(cond
		((null lst) lst)
		(t
			(setq true-color
				(list 
					(+ (listref true-color 0) cspace1) 
					(+ (listref true-color 1) 1)
					(+ (listref true-color 2) 1)
				)
			)
			(cons (list (caar lst) true-color) 
			      (substitute-color (cdr lst))
			)
		)
	)
)		
;removes the number tags from the list
(defun remove-tags (lst)
	(if 
		(null lst)
		lst
		(cons (cadr (car lst)) (remove-tags (cdr lst)))
	))

;names for the layers
(setq layer-counter 0)

;function that creates new layers of appropriate color
(defun change-color ()
	(setq current-color 
		(strcat "" 
			(rtos (listref (car true-color-list) 0)) 
			","
			(rtos (listref (car true-color-list) 1))
			","
			(rtos (listref (car true-color-list) 2))))
	(setq layer-counter (+ layer-counter 1))
	;(command "-layer" "new" (car color-list) "color" (car color-list) (car color-list) "set" (car color-list) "")
	(command "-layer" "new"  layer-counter "color" "truecolor" current-color layer-counter "set" layer-counter "")
	(setq true-color-list (cdr true-color-list))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;demo
 
(defun run_fancy ()
	
	;this is somewhat complicated
	;1) randomly select values for the horizontal and vertical separation between blocks
	;2) randomly assign each variable needed for generating the 730x800in composition 
	;;;;a value so that the values equal 730x800 when summed
	;3) since there will be a higher probability one of the earlier numbers being large than the last numbers being large,
	;;;;randomize these coordinates 
	
	(setq wid (rand 5 20))
	(setq height (rand 5 20))

	;keep a sum so we know how much of the total width we have used up so far
	(setq sum (* 5 wid))
	(setq a (rand 0 (- 730 sum)))
	(setq sum (+ sum a))
	(setq b (rand 0 (- 730 sum)))
	(setq sum (+ sum b))
	(setq c (rand 0 (- 730 sum)))
	(setq sum (+ sum c))
	(setq d (rand 0 (- 730 sum)))
	(setq sum (+ sum d))
	(setq e (rand 0 (- 730 sum)))
	(setq sum (+ sum e))
	(setq f (- 730 sum))
	
	;keep a sum so we know how much of the total height we have used up so far
	;save a certain amount for the block separators = the strokes
	(setq sum (* 6 height))
	
	(setq b2 (rand height (- 800 sum)))
	(setq sum (+ sum b2))
	(setq sum (- sum height))
	
	;the y1 distances lies within the y2 distance
	(setq b1 (rand 0 (- b2 height)))
	
	(setq sum (- sum height))
	
	(setq b4 (rand height (- 800 sum)))
	(setq sum (+ sum b4))
	
	;the y3 distance lies within the y4 distance
	(setq b3 (rand 0 (- b4 height)))
	
	(setq b5 (rand 0 (- 800 sum)))
	(setq sum (+ sum b5))
	
	(setq sum (- sum (* 2 height)))
	;(print sum)
	(setq b8 (- 800 sum height))
	
	;the y6 and y7 distances lie within y8
	(setq sum (* 2 height))
	(setq b6 (rand 0 (- b8 sum)))
	(setq sum (+ sum b6))
	(setq b7 (rand 0 (- b8 sum)))  
	
	;put all x/y params in list so they can be reordered
  	(setq x-fancy (list a b c d e f))
  	(setq x-fancy (get-random x-fancy))
  	(setq y-fancy (list b1 b2 b3 b4 b5 b6 b7 b8))
  	;;(setq y-fancy (get-random y-fancy))  

;(print x-fancy)
;(print y-fancy)
;(print wid)
;(print height)

	(mondrian_fancy
	  (listref x-fancy 0)
	  (listref x-fancy 1)
	  (listref x-fancy 2)
	  (listref x-fancy 3)
	  (listref x-fancy 4)
	  (listref x-fancy 5)
	  (listref y-fancy 0)
	  (listref y-fancy 1)
	  (listref y-fancy 2)
	  (listref y-fancy 3)
	  (listref y-fancy 4)
	  (listref y-fancy 5)
	  (listref y-fancy 6)
	  (listref y-fancy 7) 
	  wid
	  height
	  )
	)
 
  (defun c:demo ()
	(repeat 5 
		(run_fancy)
		(setq ucs 800)
		(command "ucs" "move" (list ucs 0 0))
		
	)
	(command "zoom" "extents")
	)