New Babel




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DRSCHEME
;#lang scheme
;(require fluxus-016/drflux)
(require fluxus-016/fluxus)
(require alpha/armature)
(require scheme/class)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; INIT
(clear)
(scale (vector .2 .2 .2))

(hint-wire)
;(hint-origin)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REQUIRE
;(require alpha/db/db)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DEFINES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; STRUCTS
(define-struct tower (
                      
                      ;;; PARAMETERS
                      base-width
                      base-height
                      height
                      level-height    
                      tot
                      rand-factor
                      ; DEFORM
                      deform-on
                      delta
                      rand-slab
                      ; SLABS
                      slab-thick
                      slab-rotation
                      slab-center
                      slab-mode
                      ;;; OBJECTS
                      slab-list
                      facade-list
                      )
  #:mutable
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BUILD-SLAB

(define (build-slab center x y z width height thick rand-factor)
  
  (let 
      ([mesh (build-polygons 8 'quad-list)])
    
    (with-primitive mesh
                    
                    (cond
                      ;;; LDB
                      [(equal? "LDB" center)
                       (pdata-set! "p" 0 (vector x y z))
                       (pdata-set! "p" 1 (vector (+ x width) y z))
                       (pdata-set! "p" 2 (vector (+ x width) (+ y height) z))
                       (pdata-set! "p" 3 (vector x (+ y height) z))
                       
                       (pdata-set! "p" 4 (vector x y (- z thick)))
                       (pdata-set! "p" 5 (vector (+ x width) y (- z thick)))
                       (pdata-set! "p" 6 (vector (+ x width) (+ y height) (- z thick)))
                       (pdata-set! "p" 7 (vector x (+ y height) (- z thick)))
                       
                       (poly-set-index (list
                                        0 1 2 3
                                        4 5 1 0
                                        5 6 2 1
                                        6 7 3 2
                                        7 4 0 3
                                        4 7 6 5))
                       (recalc-normals 0)]
                      
                      ;;; MID
                      [(equal? center "MID")
                       (pdata-set! "p" 0 (vector (/ (- width) 2)(/ (- height) 2) z))
                       (pdata-set! "p" 1 (vector (/ width 2)(/ (- height )2) z))
                       (pdata-set! "p" 2 (vector (/ width 2)(/ height 2)  z))
                       (pdata-set! "p" 3 (vector (/ (- width)2)(/ height 2) z))
                       
                       (pdata-set! "p" 4 (vector (/ (- width) 2)(/ (- height) 2) (- z thick)))
                       (pdata-set! "p" 5 (vector (/ width 2)(/ (- height) 2) (- z thick)))
                       (pdata-set! "p" 6 (vector (/ width 2)(/ height 2)  (- z thick)))
                       (pdata-set! "p" 7 (vector (/ (- width)2)(/ height 2) (- z thick)))
                       
                       
                       (poly-set-index (list
                                        0 1 2 3
                                        4 5 1 0
                                        5 6 2 1
                                        6 7 3 2
                                        7 4 0 3
                                        4 7 6 5))
                       (recalc-normals 0)]
                      
                      ;;; RAND
                      [(equal? center "RAND")
                       (let
                           ([-X (/ (- width )2)]
                            [Y (/ height 2)]
                            [X (/ width 2)]
                            [-Y (/ (- height) 2)]
                            [RAND (flxrnd)]
                            [VRAND (vector (* rand-factor (flxrnd)) (* rand-factor (flxrnd)) 0) ])
                         (pdata-set! "p" 0 (vadd (vector -X -Y z) VRAND))
                         (pdata-set! "p" 1 (vadd (vector X -Y z) VRAND))
                         (pdata-set! "p" 2 (vadd (vector X Y z) VRAND))
                         (pdata-set! "p" 3 (vadd (vector -X Y z) VRAND))
                         
                         (pdata-set! "p" 4 (vadd (vector -X -Y (- z thick)) VRAND))
                         (pdata-set! "p" 5 (vadd (vector X -Y (- z thick)) VRAND))
                         (pdata-set! "p" 6 (vadd (vector X Y (- z thick)) VRAND))
                         (pdata-set! "p" 7 (vadd (vector -X Y (- z thick)) VRAND))
                         
                         
                         (poly-set-index (list
                                          0 1 2 3
                                          4 5 1 0
                                          5 6 2 1
                                          6 7 3 2
                                          7 4 0 3
                                          4 7 6 5))
                         (recalc-normals 0))]
                      
                      )
                    )
    ;;; return mesh
    mesh))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ADD-SLAB

(define (add-slab tower)
  (case (tower-slab-mode tower)
    ['regular
     (for/list
         ([i (in-range (tower-tot tower))])
       (build-slab
        (tower-slab-center tower) 
        0 0 
        (* i (tower-level-height tower))
        (tower-base-width tower)
        (tower-base-height tower)
        (tower-slab-thick tower)
        (tower-rand-factor tower)))]
    ['iregular
     (for/list
         ([i (in-range (tower-tot tower))])
       (build-slab
        (tower-slab-center tower)
        0 0  
        (* i (tower-level-height tower))
        (* (tower-base-width tower) (flxrnd))
        (tower-base-height tower)
        (tower-slab-thick tower)
        (tower-rand-factor tower)))]
    
    )) 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ROTATE-SLAB

(define (rotate-slab tower)
  (let
      ([i 0])
    (for
        ([slab (tower-slab-list tower)])
      (with-primitive slab
                      ;(apply-transform) ;; ROLL !
                      (rotate (vector 0 0 i))
                      (apply-transform))
      (set! i (+ i (tower-slab-rotation tower))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DEFORM-SLAB

(define (deform-slab tower)
  
  (letrec
      (
       [MOD 1]
       [NUM (lambda ()
              (if
               (> MOD (tower-delta tower))
               (begin (set! MOD 1) MOD)
               MOD))]
       [MODIFY (lambda (x)
                 (cond
                   [(not (zero? x))
                    (with-primitive (list-ref (tower-slab-list tower) x)
                                    (pdata-map! 
                                     (lambda (n)
                                       (vmul n
                                             (+ (NUM) (* (flxrnd) (tower-rand-slab tower)))
                                             ))
                                     "p"))
                    (set! MOD (+ MOD .1))
                    (MODIFY (- x 1))]))]
       )
    (if
     (= 1 (tower-deform-on tower))
     (MODIFY (- (tower-tot tower) 1))
     0)
    ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; FACADE

(colour (vector .20 .2 .5))
(opacity .4)
(define (build-facade slab-list)
  ;get coords
  (identity)
  (let
      (
       [LIST '()]
       [start 0]
       [prev-a 0]
       [prev-b 0]
       [prev-c 0]
       [prev-d 0]
       )
    (for
        ([slab slab-list])
      (if 
       (= 1 start)
       (with-primitive slab
                       (apply-transform)
                       (let
                           (
                            [FORM (build-polygons 8 'quad-list)]
                            [A (pdata-ref "p" 0)]
                            [B (pdata-ref "p" 1)]
                            [C (pdata-ref "p" 2)]
                            [D (pdata-ref "p" 3)]
                            
                            [a (pdata-ref "p" 4)]
                            [b (pdata-ref "p" 5)]
                            [c (pdata-ref "p" 6)]
                            [d (pdata-ref "p" 7)])
                         (with-state
                          ;(colour (vector 1 0 0))
                          (opacity 0)
                          (with-primitive FORM               
                                          (pdata-set! "p" 0 a)
                                          (pdata-set! "p" 1 b)
                                          (pdata-set! "p" 2 c)
                                          (pdata-set! "p" 3 d)
                                          
                                          (pdata-set! "p" 4 prev-a)
                                          (pdata-set! "p" 5 prev-b)
                                          (pdata-set! "p" 6 prev-c)
                                          (pdata-set! "p" 7 prev-d)
                                          
                                          (poly-set-index (list
                                                           0 4 5 1 
                                                           1 5 6 2 
                                                           2 6 7 3 
                                                           3 7 4 0))
                                          (recalc-normals 0))
                          ; store new data
                          (set! prev-a A)
                          (set! prev-b B)
                          (set! prev-c C)
                          (set! prev-d D))
                         (set! LIST (append LIST (list FORM)))
                         ))
       ; get the first salb's data
       (begin
         (set! start 1)
         (with-primitive (list-ref slab-list 0)
                         (apply-transform)
                         (set! prev-a (pdata-ref "p" 0))
                         (set! prev-b (pdata-ref "p" 1))
                         (set! prev-c (pdata-ref "p" 2))
                         (set! prev-d (pdata-ref "p" 3)))         
         )))
    LIST   
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; EXPORT SLABS

(define (get-coords slab)
  (letrec
      (
       [data '()]
       [GET (lambda ()
              (with-primitive slab
                              (pdata-map! 
                               (lambda (x)
                                 (set! data (append data (list x))) x) "p")))])
    (GET)
    data))

(define (join-slabs tower)
  (letrec
      (
       [i 0]
       [data '()]
       [FOLD (lambda ()
               (for
                   ([slab (tower-slab-list tower)])
                 (with-primitive slab
                                 (apply-transform))
                 (set! data (append data (get-coords slab)))))]
       )
    (FOLD)
    data))

(define (build-total data)
  (letrec
      (
       [N 0]
       [M 0]
       [local 0]
       [count 0]
       [LIST '()]
       [LENGTH (length data)]
       [FORM (build-polygons LENGTH  'quad-list)]
       [add-vertices (lambda ()
                       (for
                           (
                            (vertice data))
                         (with-primitive FORM
                                         (pdata-set! "p" N vertice)
                                         (set! N (+ N 1)))))]
       [build-list (lambda ()
                     (for 
                         (
                          (vertice data))
                       (cond
                         [(and (= local 0)(< M 7))
                          (set! LIST (append LIST (list
                                                   count (+ count 1) (+ count 2) (+ count 3)
                                                   (+ count 4)(+ count 5)(+ count 1) count
                                                   (+ count 5)(+ count 6)(+ count 2)(+ count 1)
                                                   (+ count 6)(+ count 7)(+ count 3)(+ count 2)
                                                   (+ count 7)(+ count 4) count (+ count 3)
                                                   (+ count 4)(+ count 7)(+ count 6)(+ count 5))))
                          (set! M (+ M 1))
                          (set! local 1)]
                         [(< M 7)
                          (set! M (+ M 1))]
                         [else
                          (set! local 0)
                          (set! M 0)
                          (set! count (+ count 8))])))]
       )
    (add-vertices)
    (build-list)
    (with-primitive FORM
                    (poly-set-index LIST)
                    (recalc-normals 0))
    FORM
    ))

(define (save-slabs form)
  (with-primitive form
                  (save-primitive "/home/milovann/Bureau/slabs.obj")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; EXPORT FACADE

(define (get-coords-facade facade)
  (letrec
      (
       [data '()]
       [GET (lambda ()
              (with-primitive facade
                              (pdata-map! 
                               (lambda (x)
                                 (set! data (append data (list x))) x) "p")))])
    (GET)
    data))

(define (join-facade tower)
  (letrec
      (
       [i 0]
       [data '()]
       [FOLD (lambda ()
               (for
                   ([facade (tower-facade-list tower)])
                 (with-primitive facade
                                 (apply-transform))
                 (set! data (append data (get-coords-facade facade)))))]
       )
    (FOLD)
    data))
;; build-total

(define (build-total-facade data)
  (letrec
      (
       [N 0]
       [M 0]
       [local 0]
       [count 0]
       [LIST '()]
       [LENGTH (length data)]
       [FORM (build-polygons LENGTH  'quad-list)]
       [add-vertices (lambda ()
                       (for
                           (
                            (vertice data))
                         (with-primitive FORM
                                         (pdata-set! "p" N vertice)
                                         (set! N (+ N 1)))))]
       [build-list (lambda ()
                     (for 
                         (
                          (vertice data))
                       (cond
                         [(and (= local 0)(< M 7))
                          (set! LIST (append LIST (list
                                                   count (+ count 4) (+ count 5) (+ count 1)
                                                   (+ count 1)(+ count 5)(+ count 6) (+ count 2)
                                                   (+ count 2)(+ count 6)(+ count 7)(+ count 3)
                                                   (+ count 3)(+ count 7)(+ count 4) count                                               
                                                   )))
                          (set! M (+ M 1))
                          (set! local 1)]
                         [(< M 7)
                          (set! M (+ M 1))]
                         [else
                          (set! local 0)
                          (set! M 0)
                          (set! count (+ count 8))])))]
       )
    (add-vertices)
    (build-list)
    (with-primitive FORM
                    (poly-set-index LIST)
                    (recalc-normals 0))
    FORM
    ))

(define (save-facade form)
  (with-primitive form
                  (save-primitive "/home/milovann/Bureau/facade.obj")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; CREATE TOWER

(define (create-single-tower)
  (let
      (
       [TOWER
        (make-tower 
         ;; PARAMETERS
         1 ;base-width
         1 ;base-height
         0 ;heigth
         3 ;level-height
         300 ;tot
         40 ;rand-factor
         ;; DEFORM
         0 ;deform-on
         2 ;delta
         0.1 ;rand-slab
         ;; SLABS
         5 ;slab-thick
         0 ;slab-rotation
         "LDB" ;slab-center  LDB|MID|RAND
         'regular ;slab-mode    regular|iregular
         ;; LIST OBJECTS
         'slab-list
         'facade-list
         )]
       )
    
    (set-tower-slab-list! TOWER (add-slab TOWER))
    (rotate-slab TOWER)
    (deform-slab TOWER)
    (set-tower-facade-list! TOWER (build-facade (tower-slab-list TOWER)))
    
    ))

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

(define (create-towers)
  (let
      (
       [TOWER
        (make-tower 
         ;; 0 -> (random 1)
         ;; PARAMETERS
         (+ 5 (random 10));base-width
         (+ 5 (random 1));base-height
         30;heigth
         (+ 3 (random 1));level-height
         (+ 15 (random 1));tot
         (random 1);rand-factor
         ;; DEFORM
         (random 1);deform-on
         1            ;delta
         (+ 1 (random 1))            ;rand-slab
         ;; SLABS
         .1           ;slab-thick
         (+ 20 (random 20))            ;slab-rotation
         "LDB"         ;slab-center  LDB|MID|RAND
         'iregular      ;slab-mode    regular|iregular
         ;; LIST OBJECTS
         'slab-list
         'facade-list
         )]
       )
    
    (set-tower-slab-list! TOWER (add-slab TOWER))
    (rotate-slab TOWER)
    (deform-slab TOWER)
    (set-tower-facade-list! TOWER (build-facade (tower-slab-list TOWER)))
    (build-armature (tower-facade-list TOWER))
    
    ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (build-armature ob)
  (for 
      ((i ob))
    (with-primitive i
                    (apply-transform)
                    (let
                        ((a (pdata-ref "p" 0))
                         (b (pdata-ref "p" 1))
                         (c (pdata-ref "p" 2))
                         (d (pdata-ref "p" 3))
                         
                         (e (pdata-ref "p" 4))
                         (f (pdata-ref "p" 5))
                         (g (pdata-ref "p" 6))
                         (h (pdata-ref "p" 7))
                         
                         (facade1 (make-object mesh%))
                         (facade2 (make-object mesh%))
                         (facade3 (make-object mesh%))
                         (facade4 (make-object mesh%))
                         )
                      ;(display "list")(newline)
                      ;(display a)(display b)(display c)(display d)(newline)
                      ;(display e)(display f)(display g)(display h)(newline)
                      
                      (send facade1 init)
                      (send facade1 set-points (list a b f e))
                      (send facade1 set-resol (cons 10 10))
                      (send facade1 build)
                      
                      (send facade2 init)
                      (send facade2 set-points (list b c g f))
                      (send facade2 build)
                      
                      (send facade3 init)
                      (send facade3 set-points (list c d h g))
                      (send facade3 build)
                      
                      (send facade4 init)
                      (send facade4 set-points (list d a e h))
                      (send facade4 build)
                      
                      
                      ))
    (destroy i)
    ))

(define (tower-row num delta)
  (cond
    [(not (zero? num))
     (with-state
      (translate (vector (* num delta) 0 0))
      (create-towers))
     (tower-row (- num 1) delta)]))

(define (tower-array width height delta)
  (cond
    [(not (zero? height))
     (with-state
      (translate (vector 0 (* height delta)  0))
      (tower-row width delta))
     (tower-array width (- height 1) delta)]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; **BUILD**


(tower-array  1 1 7)
;(tower-row 10 5)
;;;;;;;;;;;;;;;; CREATE TOWER
;(create-single-tower)
#|
(with-state
(translate (vector 2 0 0))
(create-single-tower))
(with-state
(translate (vector 14 0 0))
(create-single-tower))
|#
;;;;;;;;;;;;;;; BUILD SLABS
;(set-tower-slab-list! TOWER (add-slab TOWER))
;;;;;;;;;;;;;; DEFORM
;(rotate-slab TOWER)
;(deform-slab TOWER)
;;;;;;;;;;;;;; BUILD FACADE
;(set-tower-facade-list! TOWER (build-facade (tower-slab-list TOWER)))
;;;;;;;;;;;;;;; SAVE
;(translate (vector 10 0 0))
;(save-slabs (build-total (join-slabs TOWER)))
;(save-facade (build-total-facade (join-facade TOWER)))