;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;Computer Generated Architectural Design 
;;;;Generating Kenzo Tange's Plan for Tokyo 
;;;;
;;;;A Project by Paul Keel for MIT Course 4.204, Spring 1996
;;;;
;;;;Original 05/20/96 Paul Keel 
;;;;Modified 02/05/01 Takehiko Nagakura (AutoCAD2000 and AutoLOADER) 
;;;;
;;;;Copyright 1996 Paul Keel 
;;;;All Rights Reserved.
;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


; RANDOM
; TENDENCY
; MAKE_BUSINESS_CETER
; MAKE_BUSINESS_BUILDING
; MAIN
; MAKE_RESIDENCE_BUILDING
; GRID
; MAKE_RESIDENCE
; INPUT
; INTERFACE
; CURVE
; STREET
; STREET_LEVEL_1
; STREET_LEVEL_2
; STREET_LEVEL_3
; STREET_LEVEL_4
; GENETIC
; MAKE_PUBLIC

; ************************
; RANDOM
; ************************

(defun random (min max / range value)

  (setq range (- max min))

  (setq value (sqrt (getvar "tdusrtimer")))
  (setq value (rtos value 2 7))
  (setq value_len (strlen value))
  (setq value (substr value (- value_len 1) value_len))
  (setq value (atof value))
  (setq value (* (/ value 100) range))
  (setq value (+ value min))
  (setq value (fix value))

)

; ************************
; TENDENCY
; ************************

(defun c:te (/ i dist ten)

  (setq i 0)
  (command "erase" "all" "")
  (setq ten 1)


  (command "color" "red")
  (while (<= i 200)
    (setq dist (tendency 0 1000 0 ten))
    (command "line" (list 0 i 0) (list dist i 0) "")
    (setq i (+ i 10))
    )

  ;(command "color" "white")
  ;(command "line" (list 100 0 0) (list 100 200 0) "")

  (setq i (+ i 45))

  (command "color" "red")
  (while (<= i 450)
    (setq dist (tendency 0 1000 900 ten))
    (command "line" (list 0 i 0) (list dist i 0) "")
    (setq i (+ i 10))
    ) MAKE_RESIDENCE_BUILDING

  ;(command "color" "white")
  ;(command "line" (list 900 250 0) (list 900 450 0) "")

  )

(defun tendency (tmin tmax tten tlik / value_1 value_2)

  (setq count 0)
  (setq value_1 (random tmin tmax))

  (while (< count tlik)
    
    (setq value_2 (random tmin tmax))

    (setq test_1 (abs (- value_1 tten)))
    (setq test_2 (abs (- value_2 tten)))

    (if (< test_2 test_1)
	(setq value_1 value_2)
      )

    (setq count (+ count 1))
  
    )

  (setq value_1 value_1)

  )

; ************************
; MAKE_BUSINESS_CETER
; ************************

(defun c:mbc ( / i j p p1 p2)
  (command "layer" "new" "business" "color" "green" "public" "")
  (setvar "cmdecho" 0)
  (command "ucsicon" "off")
  (command "erase" "all" "")
  (setq base_unit 1000)
  (setq of_abstract "0")
  (setq p (list 0 0 0))
  (command "box" (list -500 0 -100) (list 2900 3400 300))
  (command "zoom" "a")
  (command "zoom" "0.8x")
  (command "erase" "all" "")
  (setq j 0)
  (while (< j 3)
    (setq i 0)
    (while (< i 3)
      (setq p1 (list (- (car p) 500) (cadr p) 0))
      (setq p2 (list (+ (car p) 500) (+ (cadr p) 1000) -100))
      (command "box" p1 p2)
      (make_business_center p)
      (setq p (list (+ (car p) 1200) (cadr p) 0))
      (setq i (+ i 1))
      (command "regen")
      )
    (setq p (list 0 (+ (cadr p) 1200) 0))
    (setq j (+ j 1))
    )
  )
  
(defun make_business_center (position / i displace x y)

  (setq displace (/ base_unit 10))
  (setq position (list (- (car position) (* displace 4)) (+ (cadr position) displace (caddr position))))

  (command "layer" "set" "business" "")
  (command "ucs" "o" position)

  ; (command "layer" "new" "grid" "color" "red" "grid" "")
  ; (command "layer" "set" "grid" "")

  ; (setq i 0)
  ; (while (<= i 800)
  ;   (command "line" (list 0 i 0) (list 800 i 0) "")
  ;   (command "line" (list i 0 0) (list i 800 0) "")
  ;   (setq i (+ i 200))
  ;   )

  (setq building_array (list "00" "01" "02" "03" "04"
                             "10" "11" "12" "13" "14" 
                             "20" "21" "22" "23" "24" 
                             "30" "31" "32" "33" "34" 
                             "40" "41" "42" "43" "44"))

  (setq count 0)
  (while (< count 10)
    (setq x (random 1 5))
    (setq y (random 1 5))
    (make_business_building x y (list x y 0))
    )

  (command "ucs" "w")
  (princ)
)

; ************************
; MAKE_BUSINESS_BUILDING
; ************************

(defun c:mbb () (make_business_building 0 0 (list 0 0 0)))

(defun make_business_building (x y p_point / l_p p_p last_point present_point hight hight2 x_pos y_pos apos npos value i prop r_max r_red r_min g_dist)

  (setq rand_max 120)
  (setq rand_red 40)shad
  (setq rand_min 20)
  (setq base_unit 1000)

  (setq x_pos x)
  (setq y_pos y)
  (setq i 0)
  (setq r_max rand_max)
  (setq r_red rand_red)
  (setq r_min rand_min)
  (setq g_dist (* base_unit 0.2))

  (setq last_point p_point)

  (while (< i 4)

    (if (= i 0) (setq apos (list (+ x_pos 1) y_pos)) )
    (if (= i 1) (setq apos (list x_pos (- y_pos 1))) )
    (if (= i 2) (setq apos (list (- x_pos 1) y_pos)) )
    (if (= i 3) (setq apos (list x_pos (+ y_pos 1))) )

    (setq present_point (list (* g_dist (car apos)) (* g_dist (cadr apos)) 0))

    (if (or (< (car apos) 0) (> (car apos) 4) (< (cadr apos) 0) (> (cadr apos) 4))
	()
      (progn
	(setq npos (+ (car apos) (* (cadr apos) 5)))
	(setq value (nth npos building_array))
	(if (and (/= value "XX") (/= value "DD"))
	    (progn
	      (setq prop (random 1 101))
	      (if (> r_max r_min)
		  (setq r_max (- r_max r_red))
		)
	      (if (> prop r_max)
		  ()
		(progn
		  (setq count (+ count 1))
		  (if (= of_abstract "0")
		      (progn
			(setq hight (random 200 275))
			(command "box" "c" present_point "l" 40 40 hight)
			(command "move" "l" "" (list 0 0 0) (list 0 0 (/ hight 2)))
			)
		    (command "line" present_point (list (* g_dist (car apos)) (* g_dist (cadr apos)) 200) "")
		    )
		  
		  (setq building_array (subst "XX" value building_array))
		  (make_business_building (car apos) (cadr apos) present_point)

		  (if (< 35 (random 0 100)) ; connecting two towers
		      (progn
			(setq height (random 75 150))
			(if (and (/= (car last_point) (car present_point)) (/= (cadr last_point) (cadr present_point)))
			    ()
			  (if (= of_abstract "1")
			      (command "line" last_point present_point "")
			    (progn
			      (setq hight2 (random 100 150))
			      (if (= (car last_point) (car present_point))
				  (progn
				    (setq p_p (list (- (car present_point) 20) (cadr present_point) hight2))
				    (setq l_p (list (+ (car last_point) 20) (cadr last_point) (+ hight2 50)))
				    )
				)
			      (if (= (cadr last_point) (cadr present_point))
				  (progn
				    (setq p_p (list (car present_point) (- (cadr present_point) 20) hight2))
				    (setq l_p (list (car last_point) (+ (cadr last_point) 20) (+ hight2 50)))
				    )
				)
			      (command "box" p_p l_p)
			      )
			    )
			  )
			)
		    )
		  )
		)
	      )
	  )
        )
      )
    (setq i (+ i 1))
    )
  (princ)
  )
  
; ************************
; MAIN
; ************************

(defun c:ma () (main) )

(defun main ( / pos_count)

  (setvar "cmdecho" 0)
  (command "ucsicon" "off")

  (command "layer" "new" "input"     "color" "red"    "input"     "")
  (command "layer" "new" "maingrid"  "color" "red"    "maingrid"  "")
  (command "layer" "new" "subgrid"   "color" "red"    "subgrid"   "")
  (command "layer" "new" "level_1"   "color" "250"    "level_1"   "")
  (command "layer" "new" "level_2"   "color" "251"    "level_2"   "")
  (command "layer" "new" "level_3"   "color" "252"    "level_3"   "")
  (command "layer" "new" "level_4"   "color" "253"    "level_4"   "")
  (command "layer" "new" "residence" "color" "yellow" "residence" "")
  (command "layer" "new" "business"  "color" "cyan"   "business"  "")
  (command "layer" "new" "public"    "color" "green"  "public"    "")

  (command "erase" "all" "")
  (command "regen")
  (command "ucs" "w")
  (command "osnap" "off")

  (interface)

  (setq no_units (abs (/ city_length (* 3 base_unit)))) ;number of 3km units
  (setq no_subunits (abs (/ city_length base_unit))) ;number of 1km units
  (setq units_rem (rem city_length (* 3 base_unit))) ;reminder of 3km units
  (setq subunits_rem (rem city_length base_unit)) ;reminder of 1km units
  (setq last_subunit (+ base_unit (+ subunits_rem base_unit))) ;lenght of last 1km unit
  (setq pos_count 1)
  (setq max_length 10000)
  (setq min_length 1500)
  (setq switch 500)
  (setq building_array_old_l (list (list (list 0 0 0) (list 0 0 0))))
  (setq building_array_old_r (list (list (list 0 0 0) (list 0 0 0))))
  (setq dir_1 (random 0 2))
  (setq dir_2 (random 0 2))
  (setq sl4_p1 (tendency max_length min_length (- max_length (/ (- max_length min_length) 2)) 2))
  (setq sl4_p2 (tendency max_length min_length (- max_length (/ (- max_length min_length) 2)) 2))
  (setq build_house_on 0)
  (setq building_site_1 (list 0 0 0))
  (setq building_site_2 (list 0 0 0))
  (setq building_site_3 (list 0 0 0))
  (setq building_site_4 (list 0 0 0))
  (setq street_prop 2) ; STREET_LEVEL_2: changes distance of highway
  (setq generations 3) ; GENETIC: how many generations
  (setq present_point (list 0 0 0)) ; MAKE_BUSINESS_BUILDING: initial value
  (setq population_control_0 0) ; MAIN
  (setq population_control_1 0) ; MAIN

  (command "layer" "set" "input" "")
  (command "line" (list 0 0 0) (list 0 city_length 0) "")
  (command "vpoint" (list 2.3864 -3.1076 1.6818))
  (command "zoom" "a")
  (command "zoom" ".7x")

  (if (= of_grid "1") (grid)) ; *** GRID
  (if (= of_highway "1") (street_level_2 building_site_2 50 1 1)) ; *** STREET_LEVEL_2
  (if (= of_highway "1") (street_level_1 building_site_1 65 1 1)) ; *** STREET_LEVEL_1
  (while (<= pos_count no_subunits)
    (if (< 50 (random 1 100))
	(if (= of_office "1")
	    (progn
	      (make_business_center building_site_3) ; *** MAKE_BUSINESS_CENTER
	      (setq population (+ population 1)) ; *** population + 1.5
	    )
	  )
      (if (and (< 20 (random 1 100)) (= of_public "1"))
	  (progn
 	    (genetic building_site_3) ; *** GENETIC
	    (setq population (+ population 1)) ; *** population + 1
	    )
	)
      )

    (if (= pos_count (* 2 (abs (/ pos_count 2))))
	(if (= of_highway "1") (street_level_3 building_site_3 27.5 1)) ; *** STREET_LEVEL_3
      (if (= of_highway "1") (street_level_3 building_site_3 35 1)) ; *** STREET_LEVEL_3
      )
    (if (= pos_count (* 3 (abs (/ pos_count 3))))
	(if (= pos_count (* 6 (abs (/ pos_count 6))))
	    (if (= of_highway "1") (street_level_2 building_site_2 50 1 2)) ; *** STREET_LEVEL_2
	  (if (= of_highway "1") (street_level_2 building_site_2 50 1 3)) ; *** STREET_LEVEL_2
	  )
      )
    (if (= pos_count (* 9 (abs (/ pos_count 9))))
	(if (= of_highway "1") (street_level_1 building_site_1 65 1 2)) ; *** STREET_LEVEL_1
      )
    (if (and (= build_house_on 1) (= of_street "1"))
	(progn
	  (street_level_4) ; *** STREET_LEVEL_4
	  (setq population (- population 2)) ; *** population - 2
	  (setq population_control_1 (+ population_control_1 2)) ; *** population_control_1 + 2
	  )
      (setq population_control_0 (+ population_control_0 2)) ; *** population_control_0 + 2
      )
    (if (and (> population 8) (= build_house_on 0) (> population_control_0 20))
	(progn
	  (setq build_house_on 1) ; *** build_house_on = 1
	  (setq population_control_1 0) ; *** population_control_1 = 0
	  )
      )
    (if (and (< population 1) (= build_house_on 1) (> population_control_1 25))
	(progn
	  (setq build_house_on 0) ; *** build_house_on = 0
	  (setq population_control_0 0) ; *** population_control_0 = 0
	  )
      )
    (setq pos_count (+ pos_count 1)) ; *** pos_count + 1

    (prin1 population_control_0) (prin1 "/") (prin1 population_control_1) (prin1 "/") (prin1 population) (prin1 "/") (print "*")

    (command "redraw")
    )

  (if (= of_highway "1") (street_level_2 building_site_2 50 1 4)) ; *** STREET_LEVEL_2
  (if (= of_highway "1") (street_level_1 building_site_1 65 1 4)) ; *** STREET_LEVEL_1

  (command "redraw")
  (princ)
  )

; ************************
; MAKE_RESIDENCE_BUILDING
; ************************

(defun c:mrb ()
  (command "erase" "all" "")
  (make_residence_building (list 10 10 0) (list 500 500 0))
  )

(defun make_residence_building  (edge1 edge2 / p1 p2 p3 p4)

  (setq p1 edge1)
  (setq p2 edge2)

  (if (= of_abstract "0")
      (progn
	
	(command "ucs" "w")
	(command "ucs" "x" 90)
	
	(if (> (car p1) 0)
	    (progn
	      (command "arc" "c" (trans (list (car p1) (cadr p1) 120) 0 1) (trans (list (car p1) (cadr p1) 10) 0 1) "a" 90 )
	      (setq ent (entlast))
	      (command "arc" "c" (trans (list (car p1) (cadr p2) 120) 0 1)  (trans (list (car p1) (cadr p2) 10) 0 1) "a" 90)
	      (command "rulesurf" ent (entlast))
	      
	      (command "arc" "c" (trans (list (car p2) (cadr p1) 120) 0 1) (trans (list (car p2) (cadr p1) 10) 0 1) "a" -90)
	      (setq ent (entlast))
	      (command "arc" "c" (trans (list (car p2) (cadr p2) 120) 0 1) (trans (list (car p2) (cadr p2) 10) 0 1) "a" -90)
	      (command "rulesurf" ent (entlast))
	      )
	  (progn
	    (command "arc" "c" (trans (list (car p1) (cadr p1) 120) 0 1) (trans (list (car p1) (cadr p1) 10) 0 1) "a" -90 )
	    (setq ent (entlast))
	    (command "arc" "c" (trans (list (car p1) (cadr p2) 120) 0 1)  (trans (list (car p1) (cadr p2) 10) 0 1) "a" -90)
	    (command "rulesurf" ent (entlast))
	    
	    (command "arc" "c" (trans (list (car p2) (cadr p1) 120) 0 1) (trans (list (car p2) (cadr p1) 10) 0 1) "a" 90)
	    (setq ent (entlast))
	    (command "arc" "c" (trans (list (car p2) (cadr p2) 120) 0 1) (trans (list (car p2) (cadr p2) 10) 0 1) "a" 90)
	    (command "rulesurf" ent (entlast))
	    )
	  )
	
	(command "ucs" "w")
	
	)
    
    (progn
      (command "line" p1
	              (list (car p2) (cadr p1) (caddr p1))
		      (list (car p2) (cadr p2) (caddr p1))
		      (list (car p1) (cadr p2) (caddr p1))
		      p1 "")
      )
    )
  )


; ************************
; GRID
; ************************

(defun c:gr () (grid))

(defun grid ( / x y )

  (command "layer" "set" "maingrid" "")

  (command "line" (list (/ base_unit 2) 0 0) (list (/ base_unit 2) city_length 0) "")
  (command "line" (list (* base_unit 1.5) 0 0) (list (* base_unit 1.5) city_length 0) "")
  (command "line" (list (- 0 (/ base_unit 2)) 0 0) (list (- 0 (/ base_unit 2)) city_length 0) "")
  (command "line" (list (- 0 (* base_unit 1.5)) 0 0) (list (- 0 (* base_unit 1.5)) city_length 0) "")

  (setq x 0)
  (while (< x city_length)
    (command "line" (list (* base_unit 1.5) x 0) (list (- 0 (* base_unit 1.5)) x 0) "")
    (setq x (+ x (* 3 base_unit)))
    )
  (command "line" (list (* base_unit 1.5) city_length 0) (list (- 0 (* base_unit 1.5)) city_length 0) "")

  (command "layer" "set" "subgrid" "")

  (setq y 0)
  (while (<= y city_length)
    (command "line" (list (* base_unit 1.5) y 0) (list (- 0 (* base_unit 1.5)) y 0) "")
    (setq y (+ y (/ base_unit 5)))
    )

  (setq x (- 0 (/ (* 3 base_unit) 2)))
  (while (<= x (/ (* 3 base_unit) 2))
    (command "line" (list x 0 0) (list x city_length 0) "")
    (setq x (+ x (/ base_unit 5)))
    )

  (princ)

)

; ************************
; MAKE_RESIDENCE
; ************************

(defun c:ir ()

  (command "erase" "all" "")
  (command "regen")

  (command "line" (list 0 12000 0) (list 8000 12000 0) "")
  (command "line" (list 0 12000 0) (list -8000 12000 0) "")

  (command "line" (list 0 13000 0) (list 8000 13000 0) "")
  (command "line" (list 0 13000 0) (list -8000 13000 0) "")

  (command "line" (list 0 14000 0) (list 8000 14000 0) "")
  (command "line" (list 0 14000 0) (list -8000 14000 0) "")


  (setq move_dir "back")
  (initial_residence (list 2000 12000 0) (list 8000 12000 0))
  (initial_residence (list -2000 12000 0) (list -8000 12000 0))

  (setq move_dir "for")
  (initial_residence (list 2000 12000 0) (list 8000 12000 0))
  (initial_residence (list -2000 12000 0) (list -8000 12000 0))

  (setq move_dir "back")
  (initial_residence (list 2000 13000 0) (list 8000 13000 0))
  (initial_residence (list -2000 13000 0) (list -8000 13000 0))

  (setq move_dir "for")
  (initial_residence (list 2000 13000 0) (list 8000 13000 0))
  (initial_residence (list -2000 13000 0) (list -8000 13000 0))

  (setq move_dir "back")
  (initial_residence (list 2000 14000 0) (list 8000 14000 0))
  (initial_residence (list -2000 14000 0) (list -8000 14000 0))

  (setq move_dir "for")
  (initial_residence (list 2000 14000 0) (list 8000 14000 0))
  (initial_residence (list -2000 14000 0) (list -8000 14000 0))

  )

(defun initial_residence (start_point end_point / dir x_pos y_pos x_1 x_2 x_1_o x_2_o y_1 y_2 p_1 p_2 building_shape building_array n n_o)

  (command "layer" "set" "residence" "")
  (if (> (car start_point) 0) (setq direction "right") (setq direction "left"))
  (setq x_1 (car start_point))
  (setq y_1 0)
  (setq y_2 0)
  (setq y_pos (cadr start_point))                               ; store inital y position
  (setq z_pos (caddr start_point))                              ; store inital z position

  (if (= move_dir "for")
      (progn
	
	(if (= direction "right")
	    (progn
	      
	      (while (< x_1 (- (car end_point) 250))
		
		(setq x_1 (+ x_1 (tendency 0 2000 0 5)))        ; distance from axis
		(setq y_1 (tendency 40 200 40 5))               ; distance from street
		(if (< y_1 100) (setq y_1 40))
		(setq y_2 (tendency 400 (- 960 y_1) 400 5))     ; lenght of building

		(foreach n building_array
			 (if (> (+ (car (cadr n)) 250) x_1)
			     (setq x_1 (car (cadr n)))
			   )
			 )

		(setq p_1 (list x_1 (+ y_pos y_1) z_pos))       ; position of first point !!!
		(setq p_2 (list (+ x_1 250) (+ y_pos y_2) 100)) ; position of second point !!!
		(setq building_shape (list p_1 p_2))
		(if (> (- (car end_point) 150) x_1)
		    (setq building_array (cons building_shape building_array))
		  )
		)
	      (setq building_array_old_r (reverse building_array))
	      )
	  )
	
	(if (= direction "left")
	    (progn
	      
	      (while (> x_1 (- (car end_point) 250))
		
		(setq x_1 (- x_1 (tendency 0 2000 0 5)))        ; distance from axis
		(setq y_1 (tendency 40 200 40 5))               ; distance from street
		(if (< y_1 100) (setq y_1 40))
		(setq y_2 (tendency 400 (- 960 y_1) 400 5))     ; lenght of building

		(foreach n building_array
			 (if (< (- (car (cadr n)) 250) x_1)
			     (setq x_1 (car (cadr n)))
			   )
			 )

		(setq p_1 (list x_1 (+ y_pos y_1) z_pos))       ; position of first point !!!
		(setq p_2 (list (- x_1 250) (+ y_pos y_2) 100)) ; position of second point !!!
		(setq building_shape (list p_1 p_2))
		(if (< (+ (car end_point) 150) x_1)
		    (setq building_array (cons building_shape building_array))
		  )
		)
	      (setq building_array_old_l (reverse building_array))
	      )
	  )

	)
    )

  (if (= move_dir "back")
      (progn
	
	(if (= direction "right")
	    (progn
	      
	      (while (<= x_1 (- (car end_point) 250))
		
		(setq x_1 (+ x_1 (tendency 0 2000 0 5)))        ; distance from axis
		(setq y_1 (tendency 40 200 40 5))               ; distance from street
		(if (< y_1 100) (setq y_1 40))
		(setq y_2 (tendency 400 (- 960 y_1) 400 5))     ; lenght of building
		
		(foreach n building_array
			 (if (>= (+ (car (cadr n)) 250) x_1)
			     (setq x_1 (car (cadr n)))
			   )
			 )

		(foreach n_o building_array_old_r
			 (if (and (>= x_1 (- (car (car n_o)) 250)) (<= x_1 (car (cadr n_o))))
			     (if (>= (cadr (cadr n_o)) (- y_pos y_2)) ; !!!
				 (setq x_1 (car (cadr n_o)))
			       ) ; !!!
			   )
			 )

		(setq p_1 (list x_1 (- y_pos y_1) z_pos))       ; position of first point
		(setq p_2 (list (+ x_1 250) (- y_pos y_2) 100)) ; position of second point
		(setq building_shape (list p_1 p_2))
		(if (>= (- (car end_point) 150) x_1)
		    (setq building_array (cons building_shape building_array))
		  )
		)
	      (setq building_array_old_r (reverse building_array))
	      )
	  )
	
	(if (= direction "left")
	    (progn
	      
	      (while (>= x_1 (- (car end_point) 250))
		
		(setq x_1 (- x_1 (tendency 0 2000 0 5)))        ; distance from axis
		(setq y_1 (tendency 40 200 40 5))               ; distance from street
		(if (<= y_1 100) (setq y_1 40))
		(setq y_2 (tendency 400 (- 960 y_1) 400 5))     ; lenght of building

		(foreach n building_array
			 (if (<= (- (car (cadr n)) 250) x_1)
			     (setq x_1 (car (cadr n)))
			   )
			 )

		(foreach n_o building_array_old_l
			 (if (and (<= x_1 (+ (car (car n_o)) 250)) (>= x_1 (car (cadr n_o))))
			     (if (>= (cadr (cadr n_o)) (- y_pos y_2)) ; !!!
			       (setq x_1 (car (cadr n_o)))
			       )
			   )
			 )

		(setq p_1 (list x_1 (- y_pos y_1) z_pos))       ; position of first point
		(setq p_2 (list (- x_1 250) (- y_pos y_2) 100)) ; position of second point
		(setq building_shape (list p_1 p_2))
		(if (<= (+ (car end_point) 150) x_1)
		    (setq building_array (cons building_shape building_array))
		  )
		)
	      (setq building_array_old_l (reverse building_array))
	      )
	  )
	
	)
    )
  
  (setq building_array (reverse building_array))
  (foreach n building_array
	   ; (print n)
	   (if (= of_domestic "1")
	       (make_residence_building (car n) (cadr n))
	     (command "box" (car n) (cadr n))
	     )
	   )
  )


; ************************
; INPUT
; ************************

(defun input ()

  (command "erase" "all" "")
  (command "vpoint" (list 0 0 1))
  (command "zoom" "w" (list 0 0 0) (list 50000 40000 0))
  (command "layer" "set" "input" "")
  (command "osnap" "end")

  (setq axis_min 5000) ;allowed minimum lenght for axis
  (setq axis_dist 0) ;axis distance
  
  (while (> axis_min axis_dist)
    (setq axis_start (getpoint "\nSelect axis start point")) ;axis start point
    (setq axis_end (getpoint "\nSelect axis end point")) ;axis end point
    (setq axis_dist (distance axis_end axis_start)) ;axis distance
    (setq axis_ang (angle axis_end axis_start)) ;axis angle
    (if (> axis_min axis_dist)
	(progn
	  (prompt "\nThe minimum lenght for the axis is ")
	  ; (princ axis_min)
	  )
      )
    )

  (command "line" axis_start axis_end "")

  (princ)

  )

; ************************
; INTERFACE
; ************************

(defun c:in () (interface))

(defun interface ()
  
  (setq dcl_id (load_dialog "pk.dcl"))
  (if (not (new_dialog "interface" dcl_id))
      (exit)
    )

  (setq slider1 "20")
  (setq slider2 "1000")

  (setq switch1 "0")
  (setq switch2 "1")
  (setq switch3 "1")
  (setq switch4 "1")
  (setq switch5 "1")
  (setq switch6 "1")
  (setq switch7 "1")
  (setq switch8 "0")

  (setq key1 "1")
  (setq key2 "30")
  (setq key3 "2000")
  (setq key4 "120")
  (setq key5 "40")
  (setq key6 "20")

  (action_tile "boxinfo1" "(slider_action1 $value $reason)")
  (action_tile "sliderinfo1" "(ebox_action1 $value $reason)")
  (action_tile "boxinfo2" "(slider_action2 $value $reason)")
  (action_tile "sliderinfo2" "(ebox_action2 $value $reason)")

  (action_tile "action1" "(setq switch1 $value)")
  (action_tile "action2" "(setq switch2 $value)")
  (action_tile "action3" "(setq switch3 $value)")
  (action_tile "action4" "(setq switch4 $value)")
  (action_tile "action5" "(setq switch5 $value)")
  (action_tile "action6" "(setq switch6 $value)")
  (action_tile "action7" "(setq switch7 $value)")
  (action_tile "action8" "(setq switch8 $value)")

  (action_tile "key1" "(setq key1 $value)")
  (action_tile "key2" "(setq key2 $value)")
  (action_tile "key3" "(setq key3 $value)")
  (action_tile "key4" "(setq key4 $value)")
  (action_tile "key5" "(setq key5 $value)")
  (action_tile "key6" "(setq key6 $value)")

  (action_tile "calculate" "(done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)

  (setq of_grid switch1)
  (setq of_highway switch2)
  (setq of_street switch3)
  (setq of_abstract switch4)
  (setq of_office switch5)
  (setq of_public switch6)
  (setq of_domestic switch7)
  (setq of_none switch8)

  (setq population (atof key1))
  (setq street_size (atof key2))
  (setq deviation (atof key3))
  (setq rand_max (atof key4))
  (setq rand_red (atof key5))
  (setq rand_min (atof key6))

  (setq city_length (* (atof slider1) 1000))
  (setq base_unit (atof slider2))

)

(defun slider_action1 (val why)
  (if (or (= why 2) (= why 1))
      (progn
	(set_tile "sliderinfo1" val)
	(setq slider1 val)
	)
    )
  )

(defun ebox_action1 (val why)
  (if (or (= why 2) (= why 1))
      (progn
	(set_tile "boxinfo1" val)
	(setq slider1 val)
	)
    )
  )

(defun slider_action2 (val why)
  (if (or (= why 2) (= why 1))
      (progn
	(set_tile "sliderinfo2" val)
	(setq slider2 val)
	)
    )
  )

(defun ebox_action2 (val why)
  (if (or (= why 2) (= why 1))
      (progn
	(set_tile "boxinfo2" val)
	(setq slider2 val)
	)
    )
  )

; ************************
; CURVE
; ************************

(defun curve (pc1 d1 d2 r type)

  (command "osnap" "off")
  (command "ucs" "w")

;  (setq pc1 (getpoint "\nSelect start point"))
;  (setq type (getreal "\nSelect type"))
;  (setq d1 40)
;  (setq d2 10)
;  (setq r 100)

  (if (= type 2)
      (progn
	(setq pc2 (list (- (car pc1) r) (+ (cadr pc1) r) (caddr pc1)))
	(setq pc1 pc2)
	)
    )

  (if (= type 3)
      (progn
	(setq pc2 (list (- (car pc1) r) (- (cadr pc1) r) (caddr pc1)))
	(setq pc1 pc2)
	)
    )

  (if (= type 6)
      (progn
	(setq pc2 (list (+ (car pc1) r) (- (cadr pc1) r) (caddr pc1)))
	(setq pc1 pc2)
	)
    )

  (if (= type 7)
      (progn
	(setq pc2 (list (+ (car pc1) r) (+ (cadr pc1) r) (caddr pc1)))
	(setq pc1 pc2)
	)
    )

  (setq pointer pc2)

  (if (= type 1) (command "ucs" "x" 180))
  (if (= type 2) (command "ucs" "x" 180))
  (if (= type 3) (command "ucs" "w"))
  (if (= type 4) (command "ucs" "w"))
  (if (= type 5) (command "ucs" "y" 180))
  (if (= type 6) (command "ucs" "y" 180))
  (if (= type 7) (command "ucs" "z" 180))
  (if (= type 8) (command "ucs" "z" 180))

  (setq pc1 (trans pc1 0 1 0))

  (setq pc1l (list (car pc1) (+ (cadr pc1) (/ d1 2)) (caddr pc1)))
  (setq pc1r (list (car pc1) (- (cadr pc1) (/ d1 2)) (caddr pc1)))
  (setq diff (abs (/ (- d1 d2) 2)))
  (setq pc2 (list (+ (car pc1) r) (+ (cadr pc1) r) (caddr pc1)))
  (setq pc2r (list (+ (car pc2) (/ d2 2)) (cadr pc2) (caddr pc1)))
  (setq pc2l (list (- (car pc2) (/ d2 2)) (cadr pc2) (caddr pc1)))
  (setq pc2r_d (list (car pc2r) (- (cadr pc2) diff) (caddr pc1)))
  (setq pc1l_d (list (+ (car pc1) diff) (cadr pc1l) (caddr pc1)))
  (setq cr (list (car pc1) (cadr pc2r_d) (caddr pc1)))
  (setq cl (list (car pc1l_d) (cadr pc2) (caddr pc1)))
  (setq hdg (list (car pc2l) (cadr pc1) (caddr pc1)))

  (command "pline" pc1r "arc" "ce" cr pc2r_d "line" pc2r pc2l "arc" "d" hdg pc1l_d "line" pc1l_d pc1l "c")

  (command "ucs" "w")
  (command "extrude" "l" "" 2 "")

)

; ************************
; STREET
; ************************

(defun street (pc1 pc2 d)

  (command "osnap" "off")
  (command "ucs" "w")

  (setq dist (distance pc1 pc2))

  (command "ucs" "z" pc1 pc2)

  (setq pc1 (trans pc1 0 1 0))
  (setq pc2 (trans pc2 0 1 0))

  (setq pc1l (list (car pc1) (+ (cadr pc1) (/ d 2)) (caddr pc1)))

  (command "ucs" "3" pc1 pc2 pc1l)

  (setq pc1l (list 0 (+ 0 (/ d 2)) 0))
  (setq pc1r (list 0 (- 0 (/ d 2)) 0))
  (setq pc2l (list dist (+ 0 (/ d 2)) 0))
  (setq pc2r (list dist (- 0 (/ d 2)) 0))

  (command "pline" pc1l pc1r pc2r pc2l "c")

  (command "ucs" "w")
  (command "extrude" "l" "" 2 "")

)

; ************************
; STREET_LEVEL_1
; ************************

(defun c:sl1 () (street_level_1 (list 0 0 0) 50 2 3))

(defun street_level_1 (start_point hight no_units type / level x_fac y_fac p1 p2)

  (command "layer" "set" "level_1" "")
  (setq counter 0)
  (setq r (/ base_unit 4))
  (setq x_fac 2)
  (setq y_fac 3)

  (if (= type 4)
      (progn
       (setq street_length_y (- units_rem (* r 2)))
       (setq street_length (- (* street_prop base_unit) (* r 2)))
       )
    (progn
      (setq street_length (- (* street_prop base_unit) (* r 2)))
      (setq street_length_y (- (* 9 base_unit) (* 2 r)))
      )
    )

  (if (= type 2) (setq level (- hight 7.5)) (setq level hight)) 

  (if (= type 1)
      (progn
	(setq p1 (list (- (car start_point) (/ street_length 2)) (cadr start_point) level))
	(setq p2 (list (+ (car start_point) (/ street_length 2)) (cadr start_point) level))
	(if (= of_abstract "0")
	    (street p1 p2 (* street_size y_fac))
	  (command "line" p1 p2 "")
	  )
	(setq p1 (list (- (car start_point) (/ street_length 2)) (cadr start_point) (- level 7.5)))
	(setq p2 (list (+ (car start_point) (/ street_length 2)) (cadr start_point) (- level 7.5)))
	(if (= of_abstract "0")
	    (street p1 p2 (* street_size y_fac))
	  (command "line" p1 p2 "")
	  )
	)
    )

  (while (< counter no_units)

    (if (> type 1)
	(progn
	  
	  (setq p1 (list (+ (car start_point) (/ street_length 2)) (cadr start_point) level))
	  (setq p2 (list (+ (car p1) r) (+ (cadr p1) r) level))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 4)
	    (command "line" p1 p2 "")
	    )
	  
	  (setq p1 p2)
	  (setq p2 (list (car p1) (+ (cadr p1) street_length_y) (- level 7.5)))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size x_fac))
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (- (car p1) r) (+ (cadr p1) r) (- level 7.5)))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 2)
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (- (car p1) street_length) (cadr p1) (- level 7.5)))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size y_fac))
	    (command "line" p1 p2 "")
	    )


	  (setq p1 (list (- (car start_point) (/ street_length 2)) (cadr start_point) (- level 7.5)))
	  (setq p2 (list (- (car p1) r) (+ (cadr p1) r) (- level 7.5)))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 5)
	    (command "line" p1 p2 "")
	    )
	  
	  (setq p1 p2)
	  (setq p2 (list (car p1) (+ (cadr p1) street_length_y) level))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size x_fac))
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (+ (car p1) r) (+ (cadr p1) r) level))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 7)
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (+ (car p1) street_length) (cadr p1)level))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size y_fac))
	    (command "line" p1 p2 "")
	    )

	  (setq start_point (list (car start_point) (+ (cadr start_point) (* base_unit 9)) level))
	  (setq building_site_1 (list (car start_point) (cadr start_point) 0))
	  )

      )

    (setq counter (+ counter 1))
    )

  )

; ************************
; STREET_LEVEL_2
; ************************

(defun c:sl2 () (street_level_2 (list 0 0 0) 50 3 3))

(defun street_level_2 (start_point hight no_units type / level x_fac y_fac p1 p2)

  (command "layer" "set" "level_2" "")
  (setq counter 0)
  (setq r (/ base_unit 4))
  (setq x_fac 2)
  (setq y_fac 3)

  (if (= type 4)
      (progn
       (setq street_length_y (- units_rem (* r 2)))
       (setq street_length (- (* street_prop base_unit) (* r 2)))
       )
    (progn
      (setq street_length (- (* street_prop base_unit) (* r 2)))
      
      (setq street_length_y (- (* 3 base_unit) (* 2 r)))
      )
    )

  (if (= type 2) (setq level (- hight 7.5)) (setq level hight)) 

  (if (= type 1)
      (progn
	(setq p1 (list (- (car start_point) (/ street_length 2)) (cadr start_point) level))
	(setq p2 (list (+ (car start_point) (/ street_length 2)) (cadr start_point) level))
	(if (= of_abstract "0")
	    (street p1 p2 (* street_size y_fac))
	  (command "line" p1 p2 "")
	  )
	(setq p1 (list (- (car start_point) (/ street_length 2)) (cadr start_point) (- level 7.5)))
	(setq p2 (list (+ (car start_point) (/ street_length 2)) (cadr start_point) (- level 7.5)))
	(if (= of_abstract "0")
	    (street p1 p2 (* street_size y_fac))
	  (command "line" p1 p2 "")
	  )
	)
    )

  (while (< counter no_units)

    (if (> type 1)
	(progn
	  
	  (setq p1 (list (+ (car start_point) (/ street_length 2)) (cadr start_point) level))
	  (setq p2 (list (+ (car p1) r) (+ (cadr p1) r) level))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 4)
	    (command "line" p1 p2 "")
	    )
	  
	  (setq p1 p2)
	  (setq p2 (list (car p1) (+ (cadr p1) street_length_y) level))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size x_fac))
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (- (car p1) r) (+ (cadr p1) r) level))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 2)
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (- (car p1) street_length) (cadr p1)level))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size y_fac))
	    (command "line" p1 p2 "")
	    )

	  (if (= level hight) (setq level (- hight 7.5)) (setq level hight))

	  (setq p1 (list (- (car start_point) (/ street_length 2)) (cadr start_point) level))
	  (setq p2 (list (- (car p1) r) (+ (cadr p1) r) level))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 5)
	    (command "line" p1 p2 "")
	    )
	  
	  (setq p1 p2)
	  (setq p2 (list (car p1) (+ (cadr p1) street_length_y) level))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size x_fac))
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (+ (car p1) r) (+ (cadr p1) r) level))
	  (if (= of_abstract "0")
	      (curve p1 (* street_size y_fac) (* street_size x_fac) r 7)
	    (command "line" p1 p2 "")
	    )

	  (setq p1 p2)
	  (setq p2 (list (+ (car p1) street_length) (cadr p1) level))
	  (if (= of_abstract "0")
	      (street p1 p2 (* street_size y_fac))
	    (command "line" p1 p2 "")
	    )

	  (setq start_point (list (car start_point) (+ (cadr start_point) (* base_unit 3)) level))
	  (setq building_site_2 (list (car start_point) (cadr start_point) 0))
	  )

      )

    (setq counter (+ counter 1))
    )

  )

; ************************
; STREET_LEVEL_3
; ************************

(defun c:sl3 () (street_level_3 (list 0 0 0) 40 10))

(defun street_level_3 (start_point hight no_units / level x_fac y_fac p1 p2)

  (command "layer" "set" "level_3" "")

  (setq r (/ base_unit 8))
  (setq street_length (- base_unit (* r 2)))
  (setq counter 0)
  (setq level hight)
  (setq x_fac 1)
  (setq y_fac 2)

  (while (< counter no_units)

    (setq p1 (list (- (car start_point) (/ street_length 2)) (cadr start_point) level))
    (setq p2 (list (+ (car start_point) (/ street_length 2)) (cadr start_point) level))
    (if (= of_abstract "0")
	(street p1 p2 (* street_size y_fac))
      (command "line" p1 p2 "")
      )

    (setq p1 p2)
    (setq p2 (list (+ (car p1) r) (+ (cadr p1) r) level))
    (if (= of_abstract "0")
	(curve p1 (* street_size y_fac) (* street_size x_fac) r 4)
      (command "line" p1 p2 "")
      )

    (setq p1 p2)
    (setq p2 (list (car p1) (+ (cadr p1) street_length) level))
    (if (= of_abstract "0")
	(street p1 p2 (* street_size x_fac))
      (command "line" p1 p2 "")
      )

    (setq p1 p2)
    (setq p2 (list (- (car p1) r) (+ (cadr p1) r) level))
    (if (= of_abstract "0")
	(curve p1 (* street_size y_fac) (* street_size x_fac) r 2)
      (command "line" p1 p2 "")
      )

    (setq p1 p2)
    (setq p2 (list (- (car p1) street_length) (cadr p1) level))
    (if (= of_abstract "0")
	(street p1 p2 (* street_size y_fac))
      (command "line" p1 p2 "")
      )

    (setq p1 p2)
    (setq p2 (list (- (car p1) r) (- (cadr p1) r) level))
    (if (= of_abstract "0")
	(curve p1 (* street_size y_fac) (* street_size x_fac) r 8)
      (command "line" p1 p2 "")
      )

    (setq p1 p2)
    (setq p2 (list (car p1) (- (cadr p1) street_length) level))
    (if (= of_abstract "0")
	(street p1 p2 (* street_size x_fac))
      (command "line" p1 p2 "")
      )

    (setq p1 p2)
    (setq p2 (list (+ (car p1) r) (- (cadr p1) r) level))
    (if (= of_abstract "0")
	(curve p1 (* street_size y_fac) (* street_size x_fac) r 6)
      (command "line" p1 p2 "")
      )

    (setq counter (+ counter 1))
    (setq start_point (list (car start_point) (+ (cadr start_point) base_unit) level))
    (setq building_site_3 (list (car start_point) (cadr start_point) 0))
    (if (= level hight) (setq level (- level 7.5)) (setq level hight))
    )

  (setq start_point start_point)

  )

; ************************
; STREET_LEVEL_4
; ************************

(defun c:sl4 () (street_level_4))

(defun street_level_4 ( / i p1 p2 tend_1 tend_2 middle)

  (command "layer" "set" "level_4" "")
  
  (setq middle (- max_length (/ (- max_length min_length) 2)))
  
  (if (and (= dir_1 1) (> sl4_p1 (- max_length switch))) (setq dir_1 0))
  (if (and (= dir_1 0) (< sl4_p1 (+ min_length switch))) (setq dir_1 1))
  (if (and (= dir_2 1) (> sl4_p2 (- max_length switch))) (setq dir_2 0))
  (if (and (= dir_2 0) (< sl4_p2 (+ min_length switch))) (setq dir_2 1))
  
  (if (= dir_1 0) (setq tend_1 (- 0 deviation)))
  (if (= dir_1 1) (setq tend_1 deviation))
  (if (= dir_2 0) (setq tend_2 (- 0 deviation)))
  (if (= dir_2 1) (setq tend_2 deviation))
  
  (setq sl4_p1 (+ sl4_p1 (tendency (- 0 deviation) deviation tend_1 3)))
  (setq sl4_p2 (+ sl4_p2 (tendency (- 0 deviation) deviation tend_2 3)))
  
  ;(setq i 0)
  (while (or (> sl4_p1 max_length) (< sl4_p1 min_length))
    ;(setq i (+ i 1))
    (setq sl4_p1 (+ sl4_p1 (tendency (- 0 deviation) deviation tend_1 3)))
    )
  
  ;(setq i 0)
  (while (or (> sl4_p2 max_length) (< sl4_p2 min_length))
    ;(setq i (+ i 1))
    (setq sl4_p2 (+ sl4_p2 (tendency (- 0 deviation) deviation tend_2 3)))
    )
  
  (setq p1 (list (+ (car building_site_3) sl4_p1) (cadr building_site_3) (caddr building_site_3)))
  (setq p2 (list (- (car building_site_3) sl4_p2) (cadr building_site_3) (caddr building_site_3)))
  
  (if (= of_abstract "0")
      (street p1 p2 street_size)
    (command "line" p1 p2 "")
    )
  
  (if (= of_domestic "1")
      (progn
	(setq move_dir "back")
	(initial_residence (list (+ base_unit 750) (cadr p1) 0) (list (car p1) (cadr p1) 0))
	(initial_residence (list (- 0 base_unit 750) (cadr p2) 0) (list (car p2) (cadr p2) 0))
	(setq move_dir "for")
	(initial_residence (list (+ base_unit 750) (cadr p1) 0) (list (car p1) (cadr p1) 0))
	(initial_residence (list (- 0 base_unit 750) (cadr p2) 0) (list (car p2) (cadr p2) 0))
	)
    
    )
  
  (princ)
  )

; ************************
; GENETIC
; ************************

(defun c:mp ( / i m p p1 p2)
  (command "layer" "new" "public" "color" "green" "public" "")
  (setvar "cmdecho" 0)
  (command "ucsicon" "off")
  (command "erase" "all" "")
  (setq base_unit 1000)
  (setq of_abstract "0")
  (setq p (list 0 0 0))
  (setq base_unit 1000)
  (setq p (list 0 0 0))
  (setq generations 3)
  (setq draw "off")
  (command "box" (list -500 0 -100) (list 2900 3400 300))
  (command "zoom" "a")
  (command "zoom" "0.8x")
  (command "erase" "all" "")
  (command "regen")
  (setq m 0)
  (while (< m 3)
    (setq i 0)
    (while (< i 3)
      (setq p1 (list (- (car p) 500) (cadr p) 0))
      (setq p2 (list (+ (car p) 500) (+ (cadr p) 1000) -100))
      (command "box" p1 p2)
      (genetic p)
      (setq p (list (+ (car p) 1200) (cadr p) 0))
      (setq i (+ i 1))
      )
    (setq p (list 0 (+ (cadr p) 1200) 0))
    (setq m (+ m 1))
    )
  (setq draw "off")
  (command "regen")
  )

(defun genetic (start_point / result gen_code new_gen make_gen gen_test_a gen_test_b)

  (setq p0 start_point)
  (setq int 0.2)
  (setq d_min 40)  (setq d_max 190) (setq d_ten 150) (setq d_lik 2)
  (setq v_min 0.8) (setq v_max 0.3) (setq v_ten 1)   (setq v_lik 1)
  (setq loops 5)
  (setq gen_code (list d_min d_max d_ten d_lik v_min v_max v_ten v_lik loops))

  (setq j 0)


  (while (< j generations)
    (setq j (+ j 1))
    
    (setq gen_base nil)
    
    (setq k 0)
    (while (< k 3)
      (setq k (+ k 1))
      
      ; gen_base = ( (result (gen_code)) (result (gen_code)) (result (gen_code)) )

      (setq gen_base (cons (list 0 (list
	 (+ (nth 0 gen_code) (/ (random (* int (* 10 (nth 0 gen_code))) (- 0 (* int (* 10 (nth 0 gen_code))))) 10.0))
	 (+ (nth 1 gen_code) (/ (random (* int (* 10 (nth 1 gen_code))) (- 0 (* int (* 10 (nth 1 gen_code))))) 10.0))
	 (+ (nth 2 gen_code) (/ (random (* int (* 10 (nth 2 gen_code))) (- 0 (* int (* 10 (nth 2 gen_code))))) 10.0))
	 (+ (nth 3 gen_code) (/ (random (* int (* 10 (nth 3 gen_code))) (- 0 (* int (* 10 (nth 3 gen_code))))) 10.0))
	 (+ (nth 4 gen_code) (/ (random (* int (* 10 (nth 4 gen_code))) (- 0 (* int (* 10 (nth 4 gen_code))))) 10.0))
	 (+ (nth 5 gen_code) (/ (random (* int (* 10 (nth 5 gen_code))) (- 0 (* int (* 10 (nth 5 gen_code))))) 10.0))
	 (+ (nth 6 gen_code) (/ (random (* int (* 10 (nth 6 gen_code))) (- 0 (* int (* 10 (nth 6 gen_code))))) 10.0))
	 (+ (nth 7 gen_code) (/ (random (* int (* 10 (nth 7 gen_code))) (- 0 (* int (* 10 (nth 7 gen_code))))) 10.0))
	 (+ (tendency -2 2 2 2) (nth 8 gen_code)))) gen_base))

      )

    (if (and (/= draw "on") (= j generations))
	(setq p0 start_point)
      (setq p0 (list (car start_point) (- (cadr p0) (* base_unit 1.2)) (caddr p0)))
      )
    (setq p2 (+ (+ (cadr p0) (/ base_unit 2)) (random -100 100)))
    (setq p1 (+ (car p0) (random -100 100)))

    (if (= draw "on") (draw_square p0))
    (setq l 1)
    (setq result (make_public p1 p2 (cadr (car gen_base))))
    (setq l 0)
    (setq gen_base (list (list result (cadr (car gen_base))) (cadr gen_base) (caddr gen_base)))
    
    (move_square)
    (if (= draw "on") (draw_square p0))
    (setq result (make_public p1 p2 (cadr (cadr gen_base))))
    (setq gen_base (list (car gen_base) (list result (cadr (cadr gen_base))) (caddr gen_base)))

    (move_square)
    (if (= draw "on") (draw_square p0))
    (setq result (make_public p1 p2 (cadr (caddr gen_base))))
    (setq gen_base (list (car gen_base) (cadr gen_base) (list result (cadr (caddr gen_base)))))

    ; *** start genetic manipulation

    (setq new_gen (list (list d_min d_max d_ten d_lik v_min v_max v_ten v_lik loops)))
    (foreach gen_test_a gen_base
	     (foreach gen_test_b gen_base
		      (if (< (car gen_test_a) (car gen_test_b))
			     (setq new_gen (cons (cadr gen_test_b) new_gen))
			)
		      )
	     )

    (setq gen_test_a (car new_gen))
    (setq new_gen (cdr new_gen))
    (foreach gen_test_b new_gen

	     ; (print "") 
	     ; (princ "+") 
	     ; (princ d_min) (princ "+") (princ d_max) (princ "+")
	     ; (princ d_ten) (princ "+") (princ d_lik) (princ "+") 
	     ; (princ v_min) (princ "+") (princ v_max) (princ "+")
	     ; (princ v_ten) (princ "+") (princ v_lik) (princ "+") 
	     ; (princ loops) (princ "+")

	     (if (= (random 0 2) 1) (setq d_min (nth 0 gen_test_a)) (setq loops (nth 0 gen_test_b)))
	     (if (= (random 0 2) 1) (setq d_max (nth 1 gen_test_a)) (setq loops (nth 1 gen_test_b)))
	     (if (= (random 0 2) 1) (setq d_ten (nth 2 gen_test_a)) (setq loops (nth 2 gen_test_b)))
	     (if (= (random 0 2) 1) (setq d_lik (nth 3 gen_test_a)) (setq loops (nth 3 gen_test_b)))

	     (if (= (random 0 2) 1) (setq v_min (nth 4 gen_test_a)) (setq loops (nth 4 gen_test_b)))
	     (if (= (random 0 2) 1) (setq v_max (nth 5 gen_test_a)) (setq loops (nth 5 gen_test_b)))
	     (if (= (random 0 2) 1) (setq v_ten (nth 6 gen_test_a)) (setq loops (nth 6 gen_test_b)))
	     (if (= (random 0 2) 1) (setq v_lik (nth 7 gen_test_a)) (setq loops (nth 7 gen_test_b)))

	     (if (= (random 0 2) 1) (setq loops (nth 8 gen_test_a)) (setq loops (nth 8 gen_test_b)))

	     (setq gen_test_a (list d_min d_max d_ten d_lik v_min v_max v_ten v_lik loops))

	     )

    (setq gen_code gen_test_a)

    ; *** end genetic manipulation
    
    )

  )

(defun draw_square (p0 / a b c d)

      (setq a (list (- (car p0) (/ base_unit 2)) (cadr p0) (caddr p0)))
      (setq d (list (+ (car p0) (/ base_unit 2)) (cadr p0) (caddr p0)))
      (setq b (list (car a) (+ (cadr p0) base_unit) (caddr p0)))
      (setq c (list (car d) (+ (cadr p0) base_unit) (caddr p0)))
      (command "line" a b c d a "")

  )
  
(defun move_square ()

    (setq p0 (list (+ (car p0) (* base_unit 1.2)) (cadr p0) (caddr p0)))
    (setq p2 (+ (+ (cadr p0) (/ base_unit 2)) (random -100 100)))
    (setq p1 (+ (car p0) (random -100 100)))

    )

; ************************
; MAKE_PUBLIC
; ************************

(defun make_public (p_c_x p_c_y gen_code / i result d_dir d_min d_max d_ten d_lik v_min v_max v_ten v_lik one_spline all_splines) ; dawing the buildings

  (setq d_min (nth 0 gen_code)) ; receive gen-code
  (setq d_max (nth 1 gen_code))
  (setq d_ten (nth 2 gen_code))
  (setq d_lik (nth 3 gen_code))
  (setq v_min (nth 4 gen_code))
  (setq v_max (nth 5 gen_code))
  (setq v_ten (nth 6 gen_code))
  (setq v_lik (nth 7 gen_code))
  (setq loops (nth 8 gen_code))

  (setq p_den 50) ; density of outgoing directions
  (setq result 0)

  (setq i 0)
  (while (< i loops)

    (setq d_dir (random 0 360))
    (setq d_dir (* (abs (/ d_dir p_den)) p_den))
    (command "ucs" "o" (list p_c_x p_c_y 0))
    (command "ucs" "z" d_dir)
    
    (setq pt_1 (trans (list p_c_x p_c_y 0) 0 1))
    (setq pt_2 (list (car pt_1) (+ (cadr pt_1) (random 50 150)) (caddr pt_1)))
    
    (setq y_dir (tendency d_min d_max d_ten d_lik))
    (setq x_dir (tendency (/ y_dir v_min) (* y_dir v_max) (* y_dir v_ten) v_lik))
    (if (= (random 0 2) 0) (setq x_dir (- 0 x_dir)))
    (setq pt_3 (list (+ (car pt_2) x_dir) (+ (cadr pt_2) y_dir) (caddr pt_2)))
    
    (setq x_dir_old x_dir)
    (setq y_dir (tendency d_min d_max d_ten d_lik))
    (setq x_dir (tendency (/ y_dir v_min) (* y_dir v_max) (* y_dir v_ten) v_lik))
    (if (> x_dir_old 0) (setq x_dir (- 0 x_dir)))
    (setq pt_4 (list (+ (car pt_3) x_dir) (+ (cadr pt_3) y_dir) (caddr pt_3)))
    
    (setq x_dir_old x_dir)
    (setq y_dir (tendency d_min d_max d_ten d_lik))
    (setq x_dir (tendency (/ y_dir v_min) (* y_dir v_max) (* y_dir v_ten) v_lik))
    (if (> x_dir_old 0) (setq x_dir (- 0 x_dir)))
    (setq pt_5 (list (+ (car pt_4) x_dir) (+ (cadr pt_4) y_dir) (caddr pt_4)))
    
    (setq x_dir_old x_dir)
    (setq y_dir (tendency d_min d_max d_ten d_lik))
    (setq x_dir (tendency (/ y_dir v_min) (* y_dir v_max) (* y_dir v_ten) v_lik))
    (if (> x_dir_old 0) (setq x_dir (- 0 x_dir)))
    (setq pt_6 (list (+ (car pt_5) x_dir) (+ (cadr pt_5) y_dir) (caddr pt_5)))
    
    (setq pt_1 (trans pt_1 1 0))
    (setq pt_2 (trans pt_2 1 0))
    (setq pt_3 (trans pt_3 1 0))
    (setq pt_4 (trans pt_4 1 0))
    (setq pt_5 (trans pt_5 1 0))
    (setq pt_6 (trans pt_6 1 0))
    
    (setq one_spline (list pt_1 pt_2 pt_3 pt_4 pt_5 pt_6))
    (setq all_splines (cons one_spline all_splines))

    (setq i (+ i 1))
    )

  (command "ucs" "w")

;  (command "color" "white")
;  (foreach one_spline all_splines
;	   (setq pt_2 (nth 1 one_spline))
;	   (setq pt_3 (nth 2 one_spline))
;	   (setq pt_4 (nth 3 one_spline))
;	   (setq pt_5 (nth 4 one_spline))
;	   (setq pt_6 (nth 5 one_spline))
;	   (command "line" pt_2 pt_3 pt_4 pt_5 pt_6 "")
;	   )
;  (command "color" "red")

  (foreach one_spline all_splines
	   (setq pt_2 (nth 1 one_spline))
	   (setq pt_3 (nth 2 one_spline))
	   (setq pt_4 (nth 3 one_spline))
	   (setq pt_5 (nth 4 one_spline))
	   (setq pt_6 (nth 5 one_spline))

	   (setq test 0)
	   (foreach test_spline all_splines

		    (setq t_2 (nth 1 test_spline))
		    (setq t_3 (nth 2 test_spline))
		    (setq t_4 (nth 3 test_spline))
		    (setq t_5 (nth 4 test_spline))
		    (setq t_6 (nth 5 test_spline))

		    (if (and (/= pt_2 t_2)
			     (/= pt_3 t_3)
			     (/= pt_4 t_4) 
			     (/= pt_5 t_5) 
			     (/= pt_6 t_6))
			(progn

			  (if (inters pt_2 pt_3 t_2 t_3) (setq test 1))
			  (if (inters pt_2 pt_3 t_3 t_4) (setq test 1))
			  (if (inters pt_2 pt_3 t_4 t_5) (setq test 1))
			  (if (inters pt_2 pt_3 t_5 t_6) (setq test 1))

			  (if (inters pt_3 pt_4 t_2 t_3) (setq test 1))
			  (if (inters pt_3 pt_4 t_3 t_4) (setq test 1))
			  (if (inters pt_3 pt_4 t_4 t_5) (setq test 1))
			  (if (inters pt_3 pt_4 t_5 t_6) (setq test 1))

			  (if (inters pt_4 pt_5 t_2 t_3) (setq test 1))
			  (if (inters pt_4 pt_5 t_3 t_4) (setq test 1))
			  (if (inters pt_4 pt_5 t_4 t_5) (setq test 1))
			  (if (inters pt_4 pt_5 t_5 t_6) (setq test 1))

			  (if (inters pt_5 pt_6 t_2 t_3) (setq test 1))
			  (if (inters pt_5 pt_6 t_3 t_4) (setq test 1))
			  (if (inters pt_5 pt_6 t_4 t_5) (setq test 1))
			  (if (inters pt_5 pt_6 t_5 t_6) (setq test 1))
			  
			  )

		      )

		    )
	   (if (= test 0)
	       (progn
		 (setq result (+ result 1))
		 (if (or (= draw "on") (and (/= draw "on") (= j generations) (= l 1)))
		     (progn
		       (command "layer" "set" "public" "")
		       (if (= (random 0 3) 1)
			   (command "pline" pt_2 pt_3 pt_4 pt_5 pt_6 "")
			 (command "pline" pt_2 pt_3 pt_4 pt_5 "")
			 )
		       (if (= of_abstract "0")
			   (progn
			     (command "move" "l" "" (list 0 0 0) (list 0 0 (random 25 75)))
			     (completer (random 25 75))
			     )
			 )
		       )
		   )
		 )
	     )

	   (setq all_splines (cdr all_splines))
	   )

  (setq result result) ; tell calling function the amount of splines created
  
  )


(defun dxf (code elist) ; by Jeffrey Krause
  (cdr (assoc code elist))   ;finds the association pair, strips 1st element
  )

(defun completer (ht / farpoint ent1 ent2 ent3 ent4 pt1 pt2 pt3 pt4 temp hold) ; by Jeffrey Krause, adjustments by Paul Keel
  
  (command "fillet" "r" 35)
  (command "fillet" "p" "l")
  
  (setq farpoint '(1000 1000 0))
  (setq ent1 (entlast))
  (command "offset" 30 ent1 farpoint "") ; building with
  (setq ent2 (entlast))

;;;; Modified by Takehiko Nagakura, 02.05.01

  (if (<= (read (getvar "ACADVER")) 14)
   (progn  ; AutoCAD versions before AutoCAD 2000
    (setq pt1 (cdr (assoc 10 (entget (entnext ent1)))))
    (setq temp ent1)
    (while (not (equal "SEQEND" (dxf 0 (entget (setq temp (entnext temp))))))
     (setq hold temp)
    )
    (setq pt2 (cdr (assoc 10 (entget hold))))
    (setq pt3 (cdr (assoc 10 (entget (entnext ent2)))))
    (setq temp ent2)
    (while (not (equal "SEQEND" (dxf 0 (entget (setq temp (entnext temp))))))
     (setq hold temp)
    )
    (setq pt4 (cdr (assoc 10 (entget hold))))
   )
   (progn ; AutoCAD versions after AutoCAD 2000 = version 15
    ; (setq xxx ent1); (setq yyy (entget ent1))
    (setq temp (entget ent1))
    (setq pt1 (cdr (assoc 10 temp))) 
    (setq pt2 (cdr (assoc 10 (reverse temp)))) 
    (setq temp (cdr (assoc 38 temp)))
    (setq pt1 (append pt1 (list temp)))
    (setq pt2 (append pt2 (list temp)))
 
    (setq temp (entget ent2))
    (setq pt3 (cdr (assoc 10 temp)))
    (setq pt4 (cdr (assoc 10 (reverse temp))))
    (setq temp (cdr (assoc 38 temp)))
    (setq pt3 (append pt3 (list temp)))
    (setq pt4 (append pt4 (list temp)))
   )
  ) ; end of if

;;;;; end of modification by Takehiko Nagakura 

  (command "pline" pt1 pt3 "")
  (setq ent3 (entlast))
  (command "pline" pt2 pt4 "")
  (setq ent4 (entlast))
  (command "pedit" ent1 "j" ent2 ent3 ent4 "" "")
  (command "extrude" "l" "" ht "")
  )


(princ "c:ma") 
(princ)