100 lines
3.2 KiB
Scheme
100 lines
3.2 KiB
Scheme
|
(define (build-shells obj count dist col)
|
||
|
|
(when (not (zero? count))
|
||
|
|
(with-state
|
||
|
|
(parent obj)
|
||
|
|
(colour col)
|
||
|
|
(let ((shell (build-copy obj)))
|
||
|
|
(with-primitive shell
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (p n)
|
||
|
|
(vadd p (vmul (vector 0 1 0) dist)))
|
||
|
|
"p" "n"))
|
||
|
|
(build-shells shell (- count 1) dist (vmul col 1))))))
|
||
|
|
|
||
|
|
(define (build-shrub p n)
|
||
|
|
(with-state
|
||
|
|
(translate p)
|
||
|
|
(colour (vector 0.5 0.7 0.4))
|
||
|
|
(let ((shrub (build-ribbon (+ (random 10) 2))))
|
||
|
|
(with-primitive shrub
|
||
|
|
(pdata-index-map!
|
||
|
|
(lambda (i p)
|
||
|
|
(let ((j (* 0.2 (* i 0.2))))
|
||
|
|
(vector (* (crndf) j) (* i 0.2) (* (crndf) j))))
|
||
|
|
"p")
|
||
|
|
(pdata-index-map!
|
||
|
|
(lambda (i w)
|
||
|
|
(* (/ 1 (+ i 1)) 0.2))
|
||
|
|
"w")))))
|
||
|
|
|
||
|
|
(clear)
|
||
|
|
|
||
|
|
;----------------------------------------------
|
||
|
|
; build the set
|
||
|
|
|
||
|
|
(clear-colour (vector 0.5 0.8 1))
|
||
|
|
(define l (make-light 'spot 'free))
|
||
|
|
(light-diffuse 0 (vector 0 0 0))
|
||
|
|
(light-diffuse l (vector 1 1 1))
|
||
|
|
(light-position l (vector 0 9 -10))
|
||
|
|
(define l2 (make-light 'spot 'free))
|
||
|
|
(light-diffuse l2 (vector 0.5 0.5 0.5))
|
||
|
|
(light-position l2 (vector 0 9 10))
|
||
|
|
|
||
|
|
(clear-texture-cache)
|
||
|
|
(clear-geometry-cache)
|
||
|
|
|
||
|
|
(with-state
|
||
|
|
(backfacecull 0)
|
||
|
|
(texture (load-texture "textures/car-base.png"))
|
||
|
|
(load-primitive "meshes/car.obj"))
|
||
|
|
|
||
|
|
(define terrain (with-state
|
||
|
|
(texture (load-texture "textures/ground-base.png"))
|
||
|
|
(load-primitive "meshes/ground.obj")))
|
||
|
|
|
||
|
|
|
||
|
|
;(define grassmap (load-primitive "textures/set-grass.png"))
|
||
|
|
|
||
|
|
(define (tx->pi tx)
|
||
|
|
(+ (vy tx) (* (vx tx) (pixels-width))))
|
||
|
|
|
||
|
|
(with-primitive terrain
|
||
|
|
(poly-for-each-tri-sample
|
||
|
|
(lambda (indices bary)
|
||
|
|
(let ((tc (vadd
|
||
|
|
(vmul (pdata-ref "t" (list-ref indices 0)) (vx bary))
|
||
|
|
(vmul (pdata-ref "t" (list-ref indices 1)) (vy bary))
|
||
|
|
(vmul (pdata-ref "t" (list-ref indices 2)) (vz bary)))))
|
||
|
|
(when #t #;(> (va (with-primitive grassmap (pdata-ref "c" (tx->pi tc)))) 0.5)
|
||
|
|
(build-shrub (vadd
|
||
|
|
(vmul (pdata-ref "p" (list-ref indices 0)) (vx bary))
|
||
|
|
(vmul (pdata-ref "p" (list-ref indices 1)) (vy bary))
|
||
|
|
(vmul (pdata-ref "p" (list-ref indices 2)) (vz bary))) (vector 0 1 0)))))
|
||
|
|
1))
|
||
|
|
|
||
|
|
(define shell0 (build-copy terrain))
|
||
|
|
|
||
|
|
(with-primitive shell0
|
||
|
|
(pdata-copy "t" "t1")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (t)
|
||
|
|
(vmul t 4))
|
||
|
|
"t"))
|
||
|
|
|
||
|
|
(with-state
|
||
|
|
(multitexture 0 (load-texture "textures/shell.png"))
|
||
|
|
(multitexture 1 (load-texture "textures/ground-grassmap.png"))
|
||
|
|
(build-shells shell0 4 0.1 (vector 1 1 1)))
|
||
|
|
|
||
|
|
(define buildings (with-state
|
||
|
|
(backfacecull 0)
|
||
|
|
(texture (load-texture "textures/building-base.png"))
|
||
|
|
(load-primitive "meshes/buildings.obj")))
|
||
|
|
|
||
|
|
(with-state
|
||
|
|
(multitexture 0 (load-texture "textures/shell.png"))
|
||
|
|
(multitexture 1 (load-texture "textures/building-grassmap.png"))
|
||
|
|
(build-shells buildings 4 0.04 (vector 1 1 1)))
|
||
|
|
|