added text, and lots of other things

This commit is contained in:
Dave Griffiths 2009-10-06 15:44:10 +01:00
parent dc75f3471c
commit b4187cae87
12 changed files with 382 additions and 117 deletions

Binary file not shown.

View file

@ -35,7 +35,12 @@
(seed-return-secs-per-point 3)
(twig-stack '())
(above-ground #f)
(cam-pos (vector 0 0 0)))
(cam-pos (vector 0 0 0))
(sent-welcome-text #f)
(sent-return-text #f)
(sent-growing-text #f)
(iso-view #f)
(debounce-i #t))
(define/public (set-player-plant s)
(set! pos (send s get-pos))
@ -80,12 +85,39 @@
(define/public (update t d)
(when (and (key-pressed " ") debounce-space (not current-twig-growing))
(when (not sent-welcome-text)
(send game-view display "going to your seed" 4)
(send game-view display "this is your seed" 4)
(send game-view display "look around with your cursor keys" 4)
(send game-view display "hold down space to grow" 4)
(set! sent-welcome-text #t))
(if (key-pressed "i")
(when debounce-i
(set! debounce-i #f)
(cond
((not iso-view)
(set! iso-view #t)
(ortho)
(set-ortho-zoom -500)
(set-camera-transform (mtranslate (vector 0 0 -40))))
(else
(set! iso-view #f)
(persp)
(set-camera-transform (mtranslate (vector 0 0 -4))))))
(set! debounce-i #t))
(when (and (key-pressed " ") debounce-space (not current-twig-growing)
; don't want the branch to be too small
(if current-twig (> (send current-twig get-width-at-point current-point) 1) #t))
(set! seed-return #f)
(set! debounce-space #f)
(set! last-pos pos)
(send game-view set-grow-mode #t)
(cond (current-twig
(set! pos (vadd player-pos (send current-twig get-point current-point)))
(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))))))
@ -97,7 +129,15 @@
(vmul fwd -1)
start-twig-width (send player-plant get-twig-size) 'extruded))
(send player-plant add-twig current-twig)
(set! current-twig-growing #t))))
(set! current-twig-growing #t)))
(send game-view set-grow-mode-on (send current-twig get-num-points))
(when (not sent-growing-text)
(send game-view display "growing..." 4)
(send game-view display "keep holding space to go forward" 4)
(send game-view display "use your cursor keys to steer" 4)
(send game-view display "look for nutrients in the soil..." 4)
(set! sent-growing-text #t)))
(when (and (key-pressed " ") current-twig-growing)
(let ((vel (vmul fwd (* d -3))))
@ -106,6 +146,7 @@
(set! pos (vadd pos vel))
(when (> (vdist last-pos pos) (send current-twig get-dist))
(set! last-pos pos)
(send game-view scrub-marker)
(send player-plant grow (vsub pos player-pos))))))
(when (and (not current-twig-growing) (not (key-pressed " ")))
@ -121,7 +162,13 @@
(when (< tilt -88) (set! tilt -88))
(when seed-return
(cond ((< current-point 2)
(when (not sent-return-text)
(send game-view display "returning to your seed..." 4)
(send game-view display "look around with your cursor keys" 4)
(send game-view display "hold space to grow a new branch" 4)
(set! sent-return-text #t))
(cond ((< current-point 2)
(cond ((null? twig-stack)
(set! current-twig #f)
(set! pos player-pos)
@ -133,9 +180,19 @@
(else
(set! seed-return-timer (- seed-return-timer d))
(set! pos (vadd player-pos (vmix (send current-twig get-point current-point)
(send current-twig get-point (- current-point 1))
(/ seed-return-timer seed-return-secs-per-point))))
(let* ((p (vadd player-pos (vmix (send current-twig get-point current-point)
(send current-twig get-point (- current-point 1))
(/ seed-return-timer seed-return-secs-per-point))))
(d (vnormalise (vsub (send current-twig get-point (- current-point 1))
(send current-twig get-point current-point))))
(dd (vnormalise (vcross d (vector 0 1 0))))
(r (vmul (vnormalise (vcross dd d)) (* 2
(lerp (send current-twig get-width-at-point current-point)
(send current-twig get-width-at-point (- current-point 1))
(/ seed-return-timer seed-return-secs-per-point)
)))))
(set! pos (vadd p r)))
(when (< seed-return-timer 0)
(set! seed-return-timer seed-return-secs-per-point)
(set! current-point (- current-point 1))))))
@ -149,25 +206,23 @@
; if we are on a twig not growing
(when (and current-twig-growing (not (send current-twig growing?)))
(send game-view set-grow-mode #f)
(send game-view set-grow-mode-off)
(set! current-twig-growing #f)
(set! seed-return #t)
(set! current-point (- (send current-twig get-num-points) 1)))
(cond
((and (not above-ground) (> (vy (vadd player-pos pos)) 0))
((and (not above-ground) (> (vy (vadd player-pos pos)) 10))
(set! above-ground #t)
(send game-view above-ground)
(printf "up~n"))
((and above-ground (< (vy (vadd player-pos pos)) 0))
(send game-view above-ground))
((and above-ground (< (vy (vadd player-pos pos)) 10))
(set! above-ground #f)
(send game-view below-ground)
(printf "down~n")))
(send game-view below-ground)))
(let* ((side (vnormalise (vcross up fwd)))
(up (vnormalise (vcross fwd side))))
(set! cam-pos (vlerp cam-pos pos 0.9))
(set! cam-pos (vlerp cam-pos pos 0.95))
(with-primitive cam
(identity)

View file

@ -169,6 +169,9 @@
(define/public (get-width)
width)
(define/public (get-width-at-point point-index)
(list-ref widths point-index))
(define/public (get-num-points)
num-points)
@ -310,7 +313,8 @@
(set! pickedups (cons (list pickup i) pickedups))
(send pickup pick-up) ; this will remove the pickup for us
(send-message 'pick-up-highlight
(list (list 'pickup-id (send pickup get-id))))
(list (list 'pickup-id (send pickup get-id))
(list 'plant-id (send plant get-id))))
#t)
(else #f)))
#f

View file

@ -303,7 +303,7 @@
"p")
(pdata-index-map!
(lambda (i p)
(* 0.1 (sin (* 3.141 (/ i (pdata-size))))))
(* 0.5 (sin (* 3.141 (/ i (pdata-size))))))
"w")
(pdata-map!
(lambda (c)
@ -323,13 +323,16 @@
(field
(rot (vmul (rndvec) 360))
(root (with-state
(root (let ((p (with-state
(translate pos)
(rotate rot)
(colour (pickup-colour))
(emissive (pickup-colour))
(texture (load-texture "textures/spark.png"))
(shader "shaders/spark.vert.glsl" "shaders/spark.frag.glsl")
(hint-nozwrite)
(hint-frustum-cull)
(cond ; 0127461816
(blend-mode 'src-alpha 'one)
(cond
((eq? type 'wiggle) (build-squiggle 4 2))
((eq? type 'leaf) (build-squiggle 2 4))
((eq? type 'curly) (build-squiggle 4 6))
@ -337,7 +340,8 @@
((eq? type 'horn) (build-squiggle 3 4))
((eq? type 'inflatoe) (build-squiggle 4 5))
((eq? type 'fork) (build-squiggle 5 2))
((eq? type 'flower) (build-squiggle 4 3)))))
((eq? type 'flower) (build-squiggle 4 3))))))
(with-primitive p (shader-set! (list "BaseMap" 0))) p))
(from pos)
(destination (vector 0 0 0))
(speed 0.05)
@ -346,6 +350,9 @@
(dissolve-time -99)
(delme #f))
(define/public (get-type)
type)
(define/public (pick-up point)
(set! destroy-time point))
@ -735,17 +742,16 @@
(set! path (build-list num-points (lambda (_) (vector 0 0 0))))
(set! widths (build-list num-points (lambda (_) 1)))
(set! root (let ((p (with-state
(backfacecull 0)
(backfacecull 1)
(when wire-mode
(hint-none)
(hint-wire))
(shader "shaders/twig.vert.glsl" "shaders/twig.frag.glsl")
;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(texture (load-texture "textures/cells-1.png"))
(multitexture 1 (load-texture "textures/cells-2.png"))
(multitexture 2 (load-texture "textures/cells-3.png"))
(multitexture 3 (load-texture "textures/root-norm.png"))
(opacity 0.6)
;(multitexture 1 (load-texture "textures/cells-2.png"))
;(multitexture 2 (load-texture "textures/cells-3.png"))
;(multitexture 3 (load-texture "textures/root-norm.png"))
(colour col)
#;(colour (vector 1 1 1))
#;(texture (load-texture "textures/root.png"))
@ -849,8 +855,7 @@
(build-locator)))
(seed (let ((p (with-state
(parent root)
(shader "shaders/twig.vert.glsl" "shaders/twig.frag.glsl")
;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(shader "shaders/seed.vert.glsl" "shaders/seed.frag.glsl")
(texture (load-texture "textures/cells-1.png"))
(multitexture 1 (load-texture "textures/cells-2.png"))
(multitexture 2 (load-texture "textures/cells-3.png"))
@ -909,6 +914,9 @@
"s"))
p) #f)))
(define/public (is-player?)
is-player)
(define/public (get-id)
id)
@ -1104,6 +1112,134 @@
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define grow-hud%
(class object%
(field
(cam #f)
(hud (build-locator))
(grow-mode-hud
(let ((p (with-state
(parent hud)
(translate (vector 0 0 3))
(scale (vector 1.3 1 1))
(hint-depth-sort)
(hint-nozwrite)
(texture (load-texture "textures/grow-mode-hud.png"))
(hint-unlit)
(build-plane))))
(with-primitive p (hide 1)) p))
(grow-mode-hud-state #f)
(grow-mode-hud-t 2)
(markers (make-marker-list 10))
(next-marker 0)
(text-list '())
(next-text-t -1)
(new-text #f))
(define/public (make-marker-list n)
(build-list n
(lambda (_)
(let ((p (with-state
(parent hud)
(hint-unlit)
(colour 0.5)
(build-sphere 8 8))))
(with-primitive p (hide 1)) p))))
(define/public (set-cam s)
(set! cam s)
(with-primitive hud
(parent cam)))
(define/public (set-mode-on num-markers)
(when (> num-markers (length markers))
(set! markers (append markers (make-marker-list 10))))
(set! next-marker 0)
(for ((i (in-range 0 num-markers)))
(with-primitive (list-ref markers i)
(identity)
(scale 0.1)
(hide 0)
(let ((a (* (/ i num-markers) 360 0.0174532925)))
(translate (vmul (vector (sin a) (cos a) 0) 15)))))
(with-primitive grow-mode-hud (hide 0) (opacity 0))
(set! grow-mode-hud-state #t)
(set! grow-mode-hud-t 0))
(define/public (set-mode-off)
(with-primitive grow-mode-hud (hide 0) (opacity 0))
(set! grow-mode-hud-state #f)
(set! grow-mode-hud-t 0))
(define/public (display text time)
(set! new-text #t)
(set! text-list (append text-list (list (list time (let ((t (with-state
(build-type "meshes/zeimusu_-_Let_s_Trace_Basic.ttf" text))))
(let* ((p (type->poly t))
(shad (build-copy p)))
(destroy t)
(with-primitive p
(hide 1)
(parent hud)
(hint-unlit)
(colour 1)
(scale 0.08)
(translate (vector 0 10 0))
; subtract the centre point to centre the text
(let ((c (vdiv (pdata-fold vadd (vector 0 0 0) "p") (pdata-size))))
(translate (vmul c -1))))
(with-primitive shad
(parent p)
(translate (vector 0 0 -0.01))
(hint-wire)
(wire-colour (vector 0 0 0))
(line-width 5))
p)))))))
(define/public (update-text t d)
(when (and new-text (eq? next-text-t -1))
(set! next-text-t (+ t (car (car text-list)))))
(set! new-text #f)
(when (not (null? text-list))
(let ((i (car text-list)))
(with-primitive (cadr i) (hide 0))
(when (> t next-text-t)
(destroy (cadr i))
(set! text-list (cdr text-list))
(if (null? text-list)
(set! next-text-t -1)
(set! next-text-t (+ t (car (car text-list)))))))))
(define/public (scrub-marker)
(with-primitive (list-ref markers next-marker)
(hide 1))
(set! next-marker (+ next-marker 1)))
(define/public (update t d)
(update-text t d)
(when (< grow-mode-hud-t 1)
(with-primitive grow-mode-hud
(opacity (if grow-mode-hud-state
(* grow-mode-hud-t 0.5)
(* (- 1 (* grow-mode-hud-t )) 0.5)))))
(when (and (> grow-mode-hud-t 1) (not grow-mode-hud-state))
(with-primitive grow-mode-hud (hide 1)))
(set! grow-mode-hud-t (+ grow-mode-hud-t d 0.02)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define game-view%
(class object%
@ -1115,34 +1251,8 @@
(env-root (with-state (scale 1000) (build-locator)))
(root-camera-t 0)
(num-msgs 0)
(cam #f)
(hud (build-locator))
(grow-mode-hud
(let ((p (with-state
(parent hud)
(translate (vector 0 0 3))
(scale (vector 1.3 1 1))
(hint-depth-sort)
(texture (load-texture "textures/grow-mode-hud.png"))
(hint-unlit)
(build-plane))))
(with-primitive p (hide 1)) p))
(grow-mode-hud-state #f)
(grow-mode-hud-t 2)
(floor (let ((p (with-state
(hint-unlit)
(colour 0.2)
(texture (load-texture "textures/stone.png"))
(translate (vector 0 -0.5 0))
(rotate (vector 90 0 0))
(scale 1000)
(backfacecull 0)
(build-seg-plane 10 10))))
(with-primitive p
(pdata-map!
(lambda (t)
(vmul t 10))
"t")) p))
(grow-hud (make-object grow-hud%))
(floor #f)
#;(upper-env (with-state
(parent env-root)
@ -1201,12 +1311,24 @@
(load-primitive (list-ref stone 1)))))
(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))
(list-ref world-list 2))))
(list-ref world-list 2)))
(set! floor (let ((p (with-state
(hint-unlit)
(colour 0.2)
(texture (load-texture "textures/stone.png"))
(translate (vector 0 10 0))
(rotate (vector 90 0 0))
(scale 1000)
(backfacecull 0)
(build-seg-plane 10 10))))
(with-primitive p
(pdata-map!
(lambda (t)
(vmul t 10))
"t")) p)))
(define/public (set-cam s)
(set! cam s)
(with-primitive hud
(parent cam)))
(send grow-hud set-cam s))
(define/public (above-ground)
(printf "above-ground~n")
@ -1297,10 +1419,23 @@
(when pu
(send (get-pickup pickup-id) pick-up point))))
(define/public (highlight-pickup pickup-id)
(let ((pu (get-pickup pickup-id)))
(define/public (highlight-pickup plant-id pickup-id)
(let ((pu (get-pickup pickup-id)))
(when pu
(send (get-pickup pickup-id) highlight))))
(let* ((p (get-pickup pickup-id))
(type (send p get-type)))
(send p highlight)
(when (send (get-plant plant-id) is-player?)
(display
(cond
((eq? type 'wiggle) "wiggle found")
((eq? type 'leaf) "leaf found")
((eq? type 'curly) "curly found")
((eq? type 'nutrient) "nutrients found")
((eq? type 'horn) "horn found")
((eq? type 'inflatoe) "inflatoe found")
((eq? type 'fork) "fork found")
((eq? type 'flower) "flower found")) 4))))))
(define/public (add-ornament plant-id twig-id point-index property)
(when (get-plant plant-id)
@ -1316,31 +1451,22 @@
(send (cadr plant) set-excitations! a b))
plants))
(define/public (set-grow-mode s)
(when s (with-primitive grow-mode-hud (hide 0) (opacity 0)))
(set! grow-mode-hud-state s)
(set! grow-mode-hud-t 0))
(define/public (set-grow-mode-on num)
(send grow-hud set-mode-on num))
(define/public (update-grow-mode-hud t d)
(when (< grow-mode-hud-t 1)
(with-primitive grow-mode-hud
(opacity (if grow-mode-hud-state
(* grow-mode-hud-t 0.5)
(* (- 1 (* grow-mode-hud-t )) 0.5)))))
(define/public (set-grow-mode-off)
(send grow-hud set-mode-off))
(when (and (> grow-mode-hud-t 1) (not grow-mode-hud-state))
(with-primitive grow-mode-hud (hide 1)))
(define/public (scrub-marker)
(send grow-hud scrub-marker))
(set! grow-mode-hud-t (+ grow-mode-hud-t d 0.02)))
(define/public (update-hud t d)
(update-grow-mode-hud t d))
(define/public (display text time)
(send grow-hud display text time))
(define/public (update t d messages)
(update-ground-change t d)
(update-hud t d)
(send grow-hud update t d)
(for-each
(lambda (plant)
@ -1445,7 +1571,8 @@
((eq? (send msg get-name) 'pick-up-highlight)
(highlight-pickup
(send msg get-data 'pickup-id)))
(send msg get-data 'plant-id)
(send msg get-data 'pickup-id)))
((eq? (send msg get-name) 'shrink-twig)
(shrink-twig

View file

@ -0,0 +1,58 @@
varying vec3 N;
varying vec3 L;
varying vec3 V;
varying vec2 T;
uniform sampler2D Maps[3];
uniform sampler2D NormalMap;
uniform float Time;
void main()
{
vec3 bump = normalize(texture2D(NormalMap,T).xyz*2.0-1.0)-vec3(0,0,1);
vec3 n = normalize(N);
vec3 bn = normalize(N);//+bump*2.0);
vec3 l = normalize(L);
vec3 v = normalize(V);
float HighlightSize=0.1;
float ShadowSize=0.2;
float OutlineWidth=0.2;
vec4 MidColour=gl_FrontMaterial.diffuse;
vec4 HighlightColour=MidColour*1.3;
vec4 ShadowColour=MidColour*0.6;
MidColour.a=1.0;
HighlightColour.a=1.0;
ShadowColour.a=1.0;
vec4 texture;
float t = fract(Time*0.1)*3.0;
if (t<1.0) // mix bet 0 and 1
{
texture = mix(texture2D(Maps[0], T*10.0),texture2D(Maps[1], T*10.0),t);
}
else if (t<2.0 && t>1.0) // mix bet 1 and 2
{
texture = mix(texture2D(Maps[1], T*10.0),texture2D(Maps[2], T*10.0),t-1.0);
}
else // mix bet 2 and 0
{
texture = mix(texture2D(Maps[2], T*10.0),texture2D(Maps[0], T*10.0),t-2.0);
}
float lambert = dot(l,bn);
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.0) colour = MidColour*texture*0.5;
// add linear fog
//float fog_factor = clamp((gl_Fog.end - gl_FogFragCoord) * gl_Fog.scale, 0.0, 1.0);
//gl_FragColor = mix(gl_Fog.color, colour, fog_factor);
gl_FragColor = colour;
}

View 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((LightPos-gl_Vertex));
T = gl_MultiTexCoord0.xy;
gl_Position = ftransform();
}

View file

@ -0,0 +1,7 @@
varying vec2 T;
uniform sampler2D BaseMap;
void main()
{
gl_FragColor = gl_FrontMaterial.diffuse*texture2D(BaseMap, T);
}

View file

@ -0,0 +1,7 @@
varying vec2 T;
void main()
{
T = gl_MultiTexCoord0.xy;
gl_Position = ftransform();
}

View file

@ -2,7 +2,6 @@ varying vec3 N;
varying vec3 L;
varying vec3 V;
varying vec2 T;
uniform sampler2D Maps[3];
uniform sampler2D NormalMap;
uniform float Time;
@ -25,31 +24,12 @@ void main()
HighlightColour.a=1.0;
ShadowColour.a=1.0;
vec4 texture;
float t = fract(Time*0.1)*3.0;
if (t<1.0) // mix bet 0 and 1
{
texture = mix(texture2D(Maps[0], T*10.0),texture2D(Maps[1], T*10.0),t);
}
else if (t<2.0 && t>1.0) // mix bet 1 and 2
{
texture = mix(texture2D(Maps[1], T*10.0),texture2D(Maps[2], T*10.0),t-1.0);
}
else // mix bet 2 and 0
{
texture = mix(texture2D(Maps[2], T*10.0),texture2D(Maps[0], T*10.0),t-2.0);
}
float lambert = dot(l,bn);
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.0) colour = MidColour*texture*0.5;
// add linear fog
//float fog_factor = clamp((gl_Fog.end - gl_FogFragCoord) * gl_Fog.scale, 0.0, 1.0);
//gl_FragColor = mix(gl_Fog.color, colour, fog_factor);

Binary file not shown.

Before

Width:  |  Height:  |  Size: 45 KiB

After

Width:  |  Height:  |  Size: 20 KiB

View file

@ -48,7 +48,7 @@
(build-list num-seeds
(lambda (_)
(make-ob 'seed 'seed "meshes/seed.obj"
(vmul (srndvec) (* size area 0.5))
(vmul (srndvec) (* size area 4.5))
(* 0.3 50)
(vmul (rndvec) 0) 0)))
@ -64,7 +64,7 @@
(build-list num-stones
(lambda (_)
(make-ob 'stone 'stone (choose stone-models)
(vmul (srndvec) area)
(vmul (srndvec) (* 150 area))
(* size 2 (- 1 (expt (rndf) 2)))
(vmul (rndvec) 360) 0)))))
@ -76,7 +76,7 @@
(cond
((eq? (ob-type ob) 'seed) (colour (vector 0 1 0)))
((eq? (ob-type ob) 'pickup) (backfacecull 0) (hint-unlit) (colour (vector 1 1 0)))
((eq? (ob-type ob) 'stone) (colour (vector 1 0.5 0))))
((eq? (ob-type ob) 'stone) (hint-none) (hint-wire) (colour (vector 1 0.5 0))))
(load-primitive (ob-mesh ob))))
#;(when (eq? (ob-type ob) 'stone) (with-primitive (ob-root ob) (hide 1))))
l))
@ -89,9 +89,15 @@
(cond ((< (vdist (ob-pos ob) (ob-pos other)) (* 2 (+ (ob-size ob) (ob-size other))))
(vadd r (vmul (vnormalise (vsub (ob-pos ob) (ob-pos other))) amount)))
(else r)))
(cond ((> (vy (ob-pos ob)) 0)
(vadd (ob-pos ob) (vector 0 (* amount -30) 0)))
(else (ob-pos ob)))
(if (eq? (ob-type ob) 'seed)
(cond ((> (vy (ob-pos ob)) -10)
(vadd (ob-pos ob) (vector 0 (* amount -10) 0)))
((< (vy (ob-pos ob)) -50)
(vadd (ob-pos ob) (vector 0 (* amount 10) 0)))
(else (ob-pos ob)))
(cond ((> (vy (ob-pos ob)) 0)
(vadd (ob-pos ob) (vector 0 (* amount -30) 0)))
(else (ob-pos ob))))
l)))
l))
@ -111,6 +117,9 @@
(define s (init 5 300 100 1 10))
(build s)
(ortho)
(set-ortho-zoom -500)
(define l (make-light 'spot 'free))
(light-diffuse 0 (vector 0 0 0))
(light-specular 0 (vector 0 0 0))