added breadcumbs, toon shading...
This commit is contained in:
parent
c3b62fac83
commit
0c6c7132c0
10 changed files with 265 additions and 93 deletions
|
@ -18,8 +18,8 @@
|
|||
"plant0000001@fo.am"
|
||||
"plant0000002@fo.am"
|
||||
"plant0000003@fo.am"
|
||||
"plant0000004@fo.am"
|
||||
"plant0000005@fo.am"
|
||||
;"plant0000004@fo.am"
|
||||
;"plant0000005@fo.am"
|
||||
"dave@fo.am"
|
||||
))
|
||||
(plants-present '())
|
||||
|
|
|
@ -21,7 +21,8 @@
|
|||
(tilt 0)
|
||||
(yaw 0)
|
||||
(player-plant #f)
|
||||
(player-pos (vector 0 0 0)))
|
||||
(player-pos (vector 0 0 0))
|
||||
(last-pos (vector 0 0 0)))
|
||||
|
||||
(define/public (set-player-plant s)
|
||||
(set! pos (send s get-pos))
|
||||
|
@ -46,10 +47,30 @@
|
|||
(clip 1 1000)
|
||||
(set-camera-transform (mtranslate (vector 0 0 -4))))
|
||||
|
||||
; moveme
|
||||
(define (collide? line objs)
|
||||
(foldl
|
||||
(lambda (ob r)
|
||||
(if r r
|
||||
(with-primitive ob
|
||||
(cond ((bb/point-intersect? (cadr line) 0)
|
||||
(cond
|
||||
((not (null? (geo/line-intersect
|
||||
(car line) (cadr line))))
|
||||
#t)
|
||||
(else #f)))
|
||||
(else #f)))))
|
||||
|
||||
#f
|
||||
objs))
|
||||
|
||||
|
||||
|
||||
(define/public (update)
|
||||
(when (key-pressed-this-frame " ")
|
||||
(cond ((and current-twig (not current-twig-growing))
|
||||
(let ((new-twig (send current-twig add-twig current-point
|
||||
(when (and (key-pressed " ") (not current-twig-growing))
|
||||
(set! last-pos pos)
|
||||
(cond (current-twig
|
||||
(let ((new-twig (send player-plant add-sub-twig current-twig current-point
|
||||
(vector 0 1 0) #;(vsub (send current-twig get-point current-point)
|
||||
(send current-twig get-point (- current-point 1))))))
|
||||
(set! current-twig-growing #t)
|
||||
|
@ -60,6 +81,15 @@
|
|||
start-twig-width max-twig-points 'extruded))
|
||||
(send player-plant add-twig current-twig)
|
||||
(set! current-twig-growing #t))))
|
||||
|
||||
(when (and (key-pressed "f") current-twig-growing)
|
||||
(let ((vel (vmul fwd -0.1)))
|
||||
(when
|
||||
(not (collide? (list pos (vadd pos vel)) (send game-view get-stones)))
|
||||
(set! pos (vadd pos vel))
|
||||
(when (> (vdist last-pos pos) (send current-twig get-dist))
|
||||
(set! last-pos pos)
|
||||
(send player-plant grow (vsub pos player-pos))))))
|
||||
|
||||
(when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 2)))
|
||||
(when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 2)))
|
||||
|
@ -71,7 +101,7 @@
|
|||
(when (< tilt -88) (set! tilt -88))
|
||||
|
||||
(when (not current-twig-growing)
|
||||
(when (key-pressed-this-frame "q")
|
||||
(when (key-pressed "q")
|
||||
(cond ((not current-twig)
|
||||
(set! current-twig (send player-plant get-twig-from-dir (vmul fwd -1)))
|
||||
(set! current-point 2))
|
||||
|
@ -79,7 +109,7 @@
|
|||
(when (< current-point (- (send current-twig get-num-points) 1))
|
||||
(set! current-point (+ current-point 1))))))
|
||||
|
||||
(when (key-pressed-this-frame "z")
|
||||
(when (key-pressed "z")
|
||||
(cond (current-twig
|
||||
(set! current-point (- current-point 1))
|
||||
(when (< current-point 2)
|
||||
|
@ -104,17 +134,15 @@
|
|||
|
||||
(else
|
||||
(when current-twig-growing
|
||||
(let ((twig-view (send (send game-view get-plant (send player-plant get-id))
|
||||
#;(let ((twig-view (send (send game-view get-plant (send player-plant get-id))
|
||||
get-twig (send current-twig get-id))))
|
||||
(when twig-view
|
||||
(set! pos (vadd player-pos (vsub (send twig-view get-end-pos)
|
||||
(vmul (send current-twig get-dir) 1))))))
|
||||
(when (eq? (send current-twig get-num-points)
|
||||
(send current-twig get-length))
|
||||
(set! current-twig-growing #f)
|
||||
(when (not (send current-twig growing?))
|
||||
(set! current-twig-growing #f)
|
||||
(set! current-point (- (send current-twig get-num-points) 1))))))
|
||||
|
||||
|
||||
|
||||
(let* ((side (vnormalise (vcross up fwd)))
|
||||
(up (vnormalise (vcross fwd side))))
|
||||
|
||||
|
|
|
@ -108,8 +108,10 @@
|
|||
(to (list-ref path (+ (inexact->exact (floor t)) 0))))
|
||||
|
||||
(for ((i (in-range start (+ start (length profile)))))
|
||||
(pdata-set! "p" i (vmix to from (- t (floor t))))))))
|
||||
(pdata-set! "p" i (vmix (pdata-ref "p" i)
|
||||
(vmix to from (- t (floor t))) (- t (floor t))))))))
|
||||
|
||||
|
||||
(define (_ t v g)
|
||||
(cond
|
||||
((< t 1) (with-primitive p (recalc-normals 0)) v)
|
||||
|
@ -127,7 +129,8 @@
|
|||
1))))))
|
||||
(_ t (vector 0 0 0) 0)
|
||||
(scale-front)
|
||||
(collapse-front))
|
||||
(collapse-front)
|
||||
)
|
||||
|
||||
(define (build-circle-profile n r)
|
||||
(define (_ n c l)
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
(incoming '())
|
||||
(outgoing '())
|
||||
(thr 0)
|
||||
(debug-jab #t))
|
||||
(debug-jab #f))
|
||||
|
||||
(define/public (get-incoming)
|
||||
incoming)
|
||||
|
@ -34,8 +34,7 @@
|
|||
msg))
|
||||
|
||||
(define/public (send-msg to msg)
|
||||
(set! outgoing (append outgoing (list (list to msg))))
|
||||
#;(printf "~a~n" outgoing))
|
||||
(set! outgoing (append outgoing (list (list to msg)))))
|
||||
|
||||
(define (message-handler sz)
|
||||
(when debug-jab (printf "rx <---- ~a ~a~n" (xmpp:message-from sz) (xmpp:message-body sz)))
|
||||
|
@ -53,9 +52,9 @@
|
|||
(let loop ()
|
||||
(when debug-netloop (printf ".~n"))
|
||||
(when (not (null? outgoing))
|
||||
#;(when debug-jab (printf "tx ----> ~a ~a~n" (car (car outgoing)) (cadr (car outgoing))))
|
||||
(when debug-jab (printf "tx ----> ~a ~a~n" (car (car outgoing)) (cadr (car outgoing))))
|
||||
(xmpp:send (xmpp:message (car (car outgoing)) (cadr (car outgoing))))
|
||||
(set! outgoing (cdr outgoing)))
|
||||
(sleep 0.1)
|
||||
(sleep 0.221)
|
||||
(loop))))
|
||||
(super-new)))
|
||||
|
|
|
@ -29,7 +29,7 @@
|
|||
(children '()))
|
||||
|
||||
(define/public (send-message name data)
|
||||
(set! messages (cons (make-object message% name data) messages)))
|
||||
(set! messages (append messages (list (make-object message% name data)))))
|
||||
|
||||
; convert a list of lists in to just a single list - needed to convert
|
||||
; the update lists into one big list of messages
|
||||
|
@ -84,6 +84,9 @@
|
|||
|
||||
(define/public (get-type)
|
||||
type)
|
||||
|
||||
(define/public (get-dist)
|
||||
dist)
|
||||
|
||||
(define/public (get-dir)
|
||||
dir)
|
||||
|
@ -108,36 +111,36 @@
|
|||
(list-ref points (- (get-length) 1))
|
||||
#f))
|
||||
|
||||
(define/public (growing?)
|
||||
(< (length points) num-points))
|
||||
|
||||
(define/public (scale a)
|
||||
(set! width (* width a))
|
||||
(set! dist (* dist a)))
|
||||
|
||||
(define/public (grow ndir)
|
||||
(when (< (length points) num-points)
|
||||
|
||||
(define/public (grow pos)
|
||||
(when (growing?)
|
||||
(let ((new-point (if (zero? (length points))
|
||||
; first point should be at edge of the seed if we are a branch
|
||||
(if (eq? parent-twig-id -1) (vadd last-point (vmul dir dist))
|
||||
(if (eq? parent-twig-id -1) pos
|
||||
last-point)
|
||||
(vadd last-point (vmul dir dist)))))
|
||||
pos)))
|
||||
|
||||
(set! dir ndir)
|
||||
(set! w (* width (- 1 (/ (length points) num-points))))
|
||||
|
||||
|
||||
(set! w (* width (- 1 (/ (length points) num-points))))
|
||||
|
||||
(set! last-point new-point)
|
||||
(set! points (append points (list new-point)))
|
||||
(set! widths (append widths (list w)))
|
||||
(send-message 'twig-grow (list
|
||||
(send-message 'add-twig-point (list
|
||||
(list 'plant-id (send plant get-id))
|
||||
(list 'twig-id id)
|
||||
(list 'point new-point)
|
||||
(list 'width w)))
|
||||
#;(when (and (> (length points) 1) (> num-points 1)
|
||||
(zero? (random branch-probability)))
|
||||
(add-twig (- (length points) 1) (vadd dir (vmul (srndvec) branch-jitter))))))
|
||||
(for-each
|
||||
(list 'width w))))
|
||||
#;(for-each
|
||||
(lambda (twig)
|
||||
(send (cadr twig) grow ndir))
|
||||
twigs))
|
||||
twigs)))
|
||||
|
||||
(define/public (get-desc-list)
|
||||
(list
|
||||
|
@ -319,7 +322,8 @@
|
|||
(tex "fff"))
|
||||
|
||||
(field
|
||||
(twigs '()) ; a assoc list map of ages to twigs
|
||||
(twigs '()) ; a assoc list map of ids to twigs
|
||||
(leader-twig #f) ; the temporary twig controlled by the player
|
||||
(properties '()) ; a list of symbols - properties come from pickups
|
||||
(ornaments '()) ; map of ids to ornaments on the plant
|
||||
(size start-size) ; the age of this plant
|
||||
|
@ -345,11 +349,14 @@
|
|||
(define/public (get-tex)
|
||||
tex)
|
||||
|
||||
(define/public (grow dir)
|
||||
(for-each
|
||||
(lambda (twig)
|
||||
(send twig grow dir))
|
||||
twigs))
|
||||
(define/public (grow pos)
|
||||
(when leader-twig
|
||||
(send leader-twig grow pos)
|
||||
(when (not (send leader-twig growing?))
|
||||
(send-message 'start-growing (list
|
||||
(list 'plant-id id)
|
||||
(list 'twig-id (send leader-twig get-id))))
|
||||
(set! leader-twig #f))))
|
||||
|
||||
(define/public (add-property name)
|
||||
(set! properties (cons name properties)))
|
||||
|
@ -395,13 +402,17 @@
|
|||
(send twig set-id! (get-next-twig-id))
|
||||
(set! size (* size grow-amount))
|
||||
(send twig scale size)
|
||||
(set! leader-twig twig)
|
||||
(send-message 'grow-seed (list
|
||||
(list 'plant-id id)
|
||||
(list 'amount grow-amount)))
|
||||
(send-message 'new-twig (send twig get-desc-list))
|
||||
(set! twigs (cons-twig twig twigs max-twigs '())))
|
||||
|
||||
|
||||
(define/public (add-sub-twig ptwig point-index dir)
|
||||
(set! leader-twig (send ptwig add-twig point-index dir))
|
||||
leader-twig)
|
||||
|
||||
(define/public (get-random-twig)
|
||||
(if (not (null? twigs))
|
||||
(send (choose twigs) get-random-twig)
|
||||
|
@ -474,7 +485,7 @@
|
|||
(for ((i (in-range 0 num-pickups)))
|
||||
(add-pickup (make-object pickup-logic% i (choose (list 'leaf 'curly 'wiggle))
|
||||
(vmul (srndvec) pickup-dist-radius)))))
|
||||
|
||||
|
||||
(define/public (add-player plant)
|
||||
(printf "new player plant added ~a~n" (send plant get-id))
|
||||
(send-message 'player-plant (list
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require fluxus-016/drflux)
|
||||
;#lang scheme/base
|
||||
;(require fluxus-016/drflux)
|
||||
(require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss" "jabberer.ss" "list-utils.ss")
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
@ -42,15 +42,15 @@
|
|||
(field
|
||||
(players (list
|
||||
(make-player-info "plant0000001@fo.am" "plant0000001"
|
||||
"textures/plant0000001.png" (vector 0 0 0) (vector 0.5 1 0.5))
|
||||
"textures/plant0000001.png" (vector 11.682296752929688 -27.272457122802734 -2.8969409465789795) (vector 0.5 1 0.5))
|
||||
(make-player-info "plant0000002@fo.am" "plant0000002"
|
||||
"textures/plant0000002.png" (vector -100 0 0) (vector 0.5 1 0))
|
||||
"textures/plant0000002.png" (vector 22.92951774597168 -24.62310218811035 -4.961982727050781) (vector 0.5 1 0))
|
||||
(make-player-info "plant0000003@fo.am" "plant0000003"
|
||||
"textures/plant0000003.png" (vector 0 0 -100) (vector 0 1 0.5))
|
||||
"textures/plant0000003.png" (vector 11.626119613647461 -24.734521865844727 -25.146560668945312) (vector 0 1 0.5))
|
||||
(make-player-info "plant0000004@fo.am" "plant0000004"
|
||||
"textures/plant0000004.png" (vector 50 0 50) (vector 0.75 1 0.5))
|
||||
"textures/plant0000004.png" (vector -18.757593154907227 -10.819361686706543 37.17854690551758)(vector 0.75 1 0.5))
|
||||
(make-player-info "plant0000005@fo.am" "plant0000005"
|
||||
"textures/plant0000005.png" (vector 50 9 -50) (vector 0.5 1 0.75))
|
||||
"textures/plant0000005.png" (vector -10.964780807495117 -20.065677642822266 23.76084327697754) (vector 0.5 1 0.75))
|
||||
))
|
||||
(seeds '())
|
||||
(clicked -1))
|
||||
|
@ -65,9 +65,10 @@
|
|||
(with-state
|
||||
(translate (vmul (vector (sin (* 2 3.141 (/ c (length players))))
|
||||
(cos (* 2 3.141 (/ c (length players)))) 0) 4))
|
||||
(texture (load-texture (player-info-tex pi)))
|
||||
;(texture (load-texture (player-info-tex pi)))
|
||||
(colour (player-info-col pi))
|
||||
(set! c (+ c 1))
|
||||
;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
|
||||
(load-primitive "meshes/seed.obj")))
|
||||
players))))
|
||||
|
||||
|
@ -124,7 +125,7 @@
|
|||
|
||||
(define/public (update t d)
|
||||
(when (< tick-time t)
|
||||
(send player grow (vmul (send c get-fwd) -1))
|
||||
|
||||
|
||||
(let ((messages (send gl update)))
|
||||
; pass the messages to the network client
|
||||
|
@ -138,6 +139,7 @@
|
|||
(super-new)))
|
||||
|
||||
(clear)
|
||||
(clear-shader-cache)
|
||||
|
||||
(define mode 'gui)
|
||||
(define gui (make-object gui-game-mode%))
|
||||
|
|
31
plant-eyes/shaders/toon.frag.glsl
Normal file
31
plant-eyes/shaders/toon.frag.glsl
Normal file
|
@ -0,0 +1,31 @@
|
|||
varying vec3 N;
|
||||
varying vec3 L;
|
||||
varying vec3 V;
|
||||
varying vec2 T;
|
||||
uniform sampler2D BaseMap;
|
||||
|
||||
void main()
|
||||
{
|
||||
vec3 n = normalize(N);
|
||||
vec3 l = normalize(L);
|
||||
vec3 v = normalize(V);
|
||||
|
||||
float HighlightSize=0.1;
|
||||
float ShadowSize=0.2;
|
||||
float OutlineWidth=0.4;
|
||||
|
||||
vec4 MidColour=gl_FrontMaterial.diffuse;
|
||||
vec4 HighlightColour=MidColour*2.0f;
|
||||
vec4 ShadowColour=MidColour*0.5f;
|
||||
HighlightColour.a=1.0f;
|
||||
ShadowColour.a=1.0f;
|
||||
|
||||
float lambert = dot(l,n);
|
||||
vec4 colour = MidColour;
|
||||
if (lambert > 1.0-HighlightSize) colour = HighlightColour;
|
||||
if (lambert < ShadowSize) colour = ShadowColour;
|
||||
if (dot(n,v) < OutlineWidth) colour = vec4(0,0,0,1);
|
||||
if (dot(n,v) < 0) colour = MidColour*texture2D(BaseMap, T);
|
||||
|
||||
gl_FragColor = colour;
|
||||
}
|
18
plant-eyes/shaders/toon.vert.glsl
Normal file
18
plant-eyes/shaders/toon.vert.glsl
Normal file
|
@ -0,0 +1,18 @@
|
|||
// Copyright (C) 2007 Dave Griffiths
|
||||
// Licence: GPLv2 (see COPYING)
|
||||
varying vec3 N;
|
||||
varying vec3 P;
|
||||
varying vec3 V;
|
||||
varying vec3 L;
|
||||
varying vec2 T;
|
||||
|
||||
void main()
|
||||
{
|
||||
N = normalize(gl_NormalMatrix*gl_Normal);
|
||||
P = gl_Vertex.xyz;
|
||||
V = -vec3(gl_ModelViewMatrix*gl_Vertex);
|
||||
vec4 LightPos = gl_LightSource[1].position;
|
||||
L = vec3(gl_ModelViewMatrix*(LightPos-gl_Vertex));
|
||||
T = gl_MultiTexCoord0.xy;
|
||||
gl_Position = ftransform();
|
||||
}
|
|
@ -10,15 +10,21 @@
|
|||
(define (ornament-colour) (vector 0.5 1 0.4))
|
||||
(define (pickup-colour) (vector 1 1 1))
|
||||
(define (earth-colour) (vector 0.2 0.1 0))
|
||||
(define (stones-colour) (vmul (earth-colour) (+ 0.5 (* (rndf) 0.5))))
|
||||
|
||||
(define wire-mode #f)
|
||||
(define fog-col (earth-colour))
|
||||
(define fog-strength 0.001)
|
||||
(define max-ornaments 2) ; per twig
|
||||
(define default-grow-speed 2)
|
||||
(define default-grow-speed 0.5)
|
||||
|
||||
(when audio-on (oa-start)) ;; start openAL audio
|
||||
|
||||
(define stones-list (let* ((f (open-input-file "stones.txt"))
|
||||
(o (read f)))
|
||||
(close-input-port f)
|
||||
o))
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
(define ornament-view%
|
||||
|
@ -123,7 +129,11 @@
|
|||
(child-twig-ids '())
|
||||
(ornaments '())
|
||||
(col (vector 1 1 1))
|
||||
(tex ""))
|
||||
(tex "")
|
||||
(markers '())
|
||||
(grow-t 999)
|
||||
(marker-destroy-t 0)
|
||||
(grow-speed default-grow-speed))
|
||||
|
||||
(define/public (get-id)
|
||||
id)
|
||||
|
@ -161,13 +171,29 @@
|
|||
(define/public (get-point point-index)
|
||||
(error "need to overide this"))
|
||||
|
||||
(define/public (get-width point-index)
|
||||
(error "need to overide this"))
|
||||
|
||||
(define/public (add-child-twig-id twig-id)
|
||||
(set! child-twig-ids (cons twig-id child-twig-ids)))
|
||||
|
||||
(define/pubment (grow point width)
|
||||
(define/public (start-growing)
|
||||
(set! grow-t 0)
|
||||
(set! markers (cons (build-locator) markers)))
|
||||
|
||||
(define/pubment (add-point point width)
|
||||
(when audio-on (let ((growing-noise (oa-load-sample (fullpath "snd/event01.wav"))))
|
||||
(oa-play growing-noise (vector 0 0 0) (rndf) 0.3)))
|
||||
(inner (void) grow point width))
|
||||
|
||||
(set! markers (append markers (list (with-state
|
||||
(parent (get-root))
|
||||
(translate point)
|
||||
(scale 0.2)
|
||||
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
|
||||
(colour col)
|
||||
(build-sphere 10 10)))))
|
||||
|
||||
(inner (void) add-point point width))
|
||||
|
||||
(define/public (add-ornament point-index property)
|
||||
(when (< (length ornaments) max-ornaments)
|
||||
|
@ -187,7 +213,15 @@
|
|||
(send (cadr ornament) update t d))
|
||||
ornaments)
|
||||
|
||||
(inner (void) update t d))
|
||||
(inner (void) update t d)
|
||||
|
||||
(when (< grow-t num-points)
|
||||
(set! grow-t (+ grow-t (* d grow-speed)))
|
||||
(when (> 0 (- marker-destroy-t grow-t))
|
||||
; soundtodo: marker gobble
|
||||
(set! marker-destroy-t (+ 1 marker-destroy-t))
|
||||
(destroy (car markers))
|
||||
(set! markers (cdr markers)))))
|
||||
|
||||
(super-new)))
|
||||
|
||||
|
@ -222,8 +256,12 @@
|
|||
(define/override (get-point point-index)
|
||||
(with-primitive root
|
||||
(pdata-ref "p" point-index)))
|
||||
|
||||
(define/augment (grow point width)
|
||||
|
||||
(define/override (get-width point-index)
|
||||
(with-primitive root
|
||||
(pdata-ref "w" point-index)))
|
||||
|
||||
(define/augment (add-point point width)
|
||||
(with-primitive root
|
||||
(pdata-index-map! ; set all the remaining points to the end
|
||||
(lambda (i p) ; in order to hide them
|
||||
|
@ -249,14 +287,12 @@
|
|||
(define extruded-twig-view%
|
||||
(class twig-view%
|
||||
|
||||
(inherit-field index radius num-points pos dir col tex)
|
||||
(inherit-field index radius num-points pos dir col tex grow-t)
|
||||
|
||||
(field
|
||||
(profile '())
|
||||
(path '())
|
||||
(root 0)
|
||||
(grow-speed default-grow-speed)
|
||||
(anim-t 0)
|
||||
(widths '()))
|
||||
|
||||
(define/override (build)
|
||||
|
@ -268,9 +304,10 @@
|
|||
(when wire-mode
|
||||
(hint-none)
|
||||
(hint-wire))
|
||||
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
|
||||
(texture (load-texture tex))
|
||||
;(opacity 0.6)
|
||||
(colour (vmul col 2))
|
||||
(opacity 0.6)
|
||||
(colour col)
|
||||
#;(colour (vector 1 1 1))
|
||||
#;(texture (load-texture "textures/root.png"))
|
||||
(build-partial-extrusion profile path 3))))
|
||||
|
@ -281,27 +318,28 @@
|
|||
|
||||
(define/override (get-point point-index)
|
||||
(list-ref path point-index))
|
||||
|
||||
|
||||
(define/override (get-width point-index)
|
||||
(list-ref widths point-index))
|
||||
|
||||
(define (list-set l c s)
|
||||
(cond ((null? l) '())
|
||||
((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
|
||||
(else (cons (car l) (list-set (cdr l) (- c 1) s)))))
|
||||
|
||||
(define/augment (grow point width)
|
||||
|
||||
(define/augment (add-point point width)
|
||||
(set! path (list-set path index point))
|
||||
(set! widths (list-set widths index width))
|
||||
(set! anim-t 0)
|
||||
(set! index (+ index 1)))
|
||||
|
||||
(define/augment (update t d)
|
||||
(when (< anim-t 1)
|
||||
(when (< grow-t (length path))
|
||||
(with-primitive root
|
||||
(partial-extrude (+ (- index 2) anim-t)
|
||||
profile path widths (vector 1 0 0) 0.05)))
|
||||
(set! anim-t (+ anim-t (* d grow-speed))))
|
||||
(partial-extrude grow-t profile path widths (vector 1 0 0) 0.05))))
|
||||
|
||||
(define/public (get-end-pos)
|
||||
(with-primitive root (pdata-ref "p" (- (* index (length profile)) 1))))
|
||||
(list-ref path (if (zero? index) 0 (- index 1)))
|
||||
#;(with-primitive root (pdata-ref "p" (- (* index (length profile)) 1))))
|
||||
|
||||
(super-new)))
|
||||
|
||||
|
@ -325,6 +363,7 @@
|
|||
(build-locator)))
|
||||
(seed (with-state
|
||||
(parent root)
|
||||
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
|
||||
(texture (load-texture tex))
|
||||
(backfacecull 0)
|
||||
(opacity 0.6)
|
||||
|
@ -340,18 +379,29 @@
|
|||
(hint-depth-sort)
|
||||
(hint-unlit)
|
||||
(parent root)
|
||||
(blend-mode 'src-alpha 'one)
|
||||
(texture (load-texture "textures/star.png"))
|
||||
(build-particles 100))))
|
||||
(with-primitive p
|
||||
(pdata-add "twig" "f")
|
||||
(pdata-add "point" "f")
|
||||
(pdata-add "offset" "v")
|
||||
(pdata-add "speed" "f")
|
||||
(pdata-map!
|
||||
(lambda (point)
|
||||
0)
|
||||
"point")
|
||||
(pdata-map!
|
||||
(lambda (point)
|
||||
(* 0.12 (+ 0.1 (rndf))))
|
||||
"speed")
|
||||
(pdata-map!
|
||||
(lambda (offset)
|
||||
(vector 0 0 0))
|
||||
"offset")
|
||||
(pdata-map!
|
||||
(lambda (c)
|
||||
(rndvec))
|
||||
(vector 0 (rndf) (rndf)))
|
||||
"c")
|
||||
(pdata-map!
|
||||
(lambda (p)
|
||||
|
@ -359,7 +409,7 @@
|
|||
"p")
|
||||
(pdata-map!
|
||||
(lambda (s)
|
||||
(vmul (vector 4 4 4) (+ 0.1 (rndf))))
|
||||
(vmul (vector 1 1 1) (+ 0.1 (rndf))))
|
||||
"s"))
|
||||
p)))
|
||||
|
||||
|
@ -390,7 +440,7 @@
|
|||
(destroy-branch-twig (car twig)))
|
||||
twigs))
|
||||
|
||||
(define/public (add-twig parent-twig-id point-index twig)
|
||||
(define/public (add-twig parent-twig-id point-index twig)
|
||||
(let ((ptwig (get-twig parent-twig-id)))
|
||||
(when ptwig
|
||||
(send twig set-pos! (send ptwig get-point point-index)) ; attach to parent twig
|
||||
|
@ -407,8 +457,11 @@
|
|||
|
||||
(set! twigs (cons (list (send twig get-id) twig) twigs))))
|
||||
|
||||
(define/public (grow-twig twig-id point width)
|
||||
(send (get-twig twig-id) grow point width))
|
||||
(define/public (add-twig-point twig-id point width)
|
||||
(send (get-twig twig-id) add-point point width))
|
||||
|
||||
(define/public (start-twig-growing twig-id)
|
||||
(send (get-twig twig-id) start-growing))
|
||||
|
||||
(define/public (grow-seed amount)
|
||||
(with-primitive seed (scale amount)))
|
||||
|
@ -420,23 +473,25 @@
|
|||
(when (not (null? twigs))
|
||||
(with-primitive nutrients
|
||||
(pdata-index-map!
|
||||
(lambda (i p twig-id point)
|
||||
(lambda (i p twig-id point offset speed)
|
||||
(let* ((twig-id (inexact->exact twig-id))
|
||||
(twig (get-twig twig-id))
|
||||
(point (inexact->exact point)))
|
||||
(cond
|
||||
((or (< point 1) (not twig))
|
||||
(let* ((new-twig (choose twigs))
|
||||
(new-point (random (send (cadr new-twig) get-num-points))))
|
||||
(num-points (send (cadr new-twig) get-num-points))
|
||||
(new-point (if (zero? num-points) 0 (random num-points))))
|
||||
(pdata-set! "twig" i (car new-twig))
|
||||
(pdata-set! "point" i new-point)
|
||||
(pdata-set! "offset" i (vmix offset (vmul (srndvec) (send (cadr new-twig) get-width new-point)) 0.2))
|
||||
(send (cadr new-twig) get-point new-point)))
|
||||
((< (vdist (send twig get-point point) p) 0.1)
|
||||
((< (vdist (vadd (send twig get-point point) offset) p) 0.1)
|
||||
(pdata-set! "point" i (- point 1))
|
||||
(vadd p (vmul (vnormalise (vsub (send twig get-point (- point 1)) p)) 0.04)))
|
||||
(vadd p (vmul (vnormalise (vsub (vadd (send twig get-point (- point 1)) offset) p)) speed)))
|
||||
(else
|
||||
(vadd p (vmul (vnormalise (vsub (send twig get-point point) p)) 0.04))))))
|
||||
"p" "twig" "point"))))
|
||||
(vadd p (vmul (vnormalise (vsub (vadd (send twig get-point point) offset) p)) speed))))))
|
||||
"p" "twig" "point" "offset" "speed"))))
|
||||
|
||||
(define/public (update t d)
|
||||
(update-nutrients t d)
|
||||
|
@ -544,7 +599,9 @@
|
|||
(translate (vector 0 -0.22001 0))
|
||||
(build-env-box "textures/floor.png" "textures/earth-bottom.png"
|
||||
"textures/earth-side.png" "textures/earth-side.png"
|
||||
"textures/earth-side.png" "textures/earth-side.png" #t))))
|
||||
"textures/earth-side.png" "textures/earth-side.png" #t)))
|
||||
|
||||
(stones '()))
|
||||
|
||||
(define/public (setup)
|
||||
(let ((l (make-light 'point 'free)))
|
||||
|
@ -554,8 +611,27 @@
|
|||
|
||||
(clear-colour fog-col)
|
||||
(clip 0.5 10000)
|
||||
(fog fog-col fog-strength 1 100))
|
||||
|
||||
(fog fog-col fog-strength 1 100)
|
||||
|
||||
(set! stones
|
||||
(map
|
||||
(lambda (stone)
|
||||
(let ((p (with-state
|
||||
(hint-frustum-cull)
|
||||
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
|
||||
(colour (stones-colour))
|
||||
(translate (list-ref stone 1))
|
||||
(scale (list-ref stone 2))
|
||||
(rotate (list-ref stone 3))
|
||||
(texture (load-texture "textures/quartz.png"))
|
||||
(load-primitive (list-ref stone 0)))))
|
||||
(with-primitive p (apply-transform) (recalc-bb)) ; apply the transform to speed up the ray tracing, don't have to tranform the ray into object space
|
||||
p))
|
||||
stones-list)))
|
||||
|
||||
(define/public (get-stones)
|
||||
stones)
|
||||
|
||||
(define/public (add-plant plant)
|
||||
(destroy-plant (send plant get-id)) ; just in case
|
||||
(set! plants (cons (list (send plant get-id) plant) plants)))
|
||||
|
@ -658,12 +734,16 @@
|
|||
(send msg get-data 'width)
|
||||
(send msg get-data 'num-points))))))
|
||||
|
||||
((eq? (send msg get-name) 'twig-grow)
|
||||
(send (get-plant (send msg get-data 'plant-id)) grow-twig
|
||||
((eq? (send msg get-name) 'add-twig-point)
|
||||
(send (get-plant (send msg get-data 'plant-id)) add-twig-point
|
||||
(send msg get-data 'twig-id)
|
||||
(send msg get-data 'point)
|
||||
(send msg get-data 'width)))
|
||||
|
||||
((eq? (send msg get-name) 'start-growing)
|
||||
(send (get-plant (send msg get-data 'plant-id)) start-twig-growing
|
||||
(send msg get-data 'twig-id)))
|
||||
|
||||
((eq? (send msg get-name) 'new-pickup)
|
||||
(add-pickup
|
||||
(send msg get-data 'pickup-id)
|
||||
|
|
|
@ -114,7 +114,8 @@
|
|||
(close-input-port in)))
|
||||
|
||||
(define (read-async in)
|
||||
(bytes->string/utf-8 (list->bytes (read-async-bytes in))))
|
||||
(let ((r (bytes->string/utf-8 (list->bytes (read-async-bytes in)))))
|
||||
r))
|
||||
|
||||
(define (read-async-bytes in)
|
||||
(let ((bstr '()))
|
||||
|
@ -335,7 +336,6 @@
|
|||
(thread (lambda ()
|
||||
(let loop ()
|
||||
(parse-xmpp-response (read-async in))
|
||||
;(printf "hello~n")
|
||||
(sleep 0.1) ;; slight delay to avoid a tight loop
|
||||
(loop)))))
|
||||
|
||||
|
|
Loading…
Reference in a new issue