RSS
Hello,
First, I must apologize. I don't have acomplete project to post for you guys, because I am using Gamebryo, andcannot post code that would indicate the innards of that particularlibrary. However, perhaps a kind comment poster will post a completeproject using OGRE or Clanlib. Some excitement was generated when Ioffered to post a how-to for making a Win32 game with Lisp. Buckle up,because I'm going to cover a lot, quickly before we get down to actualcode. I will assume basic knowledge of "a" lisp.
Which Lisp Distribution?
I chose Corman Lisp, and that's what I'll be explaining this project in terms of. Why?
- Comes with full source for the Lisp runtime.
- Though not free, it is a steal at $250, and the evaluation neverexpires, so you can put off paying if you are aren't producingcommercial software.
- CCL 3.0 is much more compatible with the CL hyperspec than previous versions.
- SBCL wasn't remotely usable on Win32 back when I was looking for a Lisp distro.
- Painless compilation to .exe or .dll.
- The FFI is robust and stable.
- Compiled, not interpretted.
Gathering Tools and Parts
You'll need the items in bold for this tutorial:
- Microsoft Visual Studio 2005, 2005 Express (VC8)
- Corman Common Lisp 3.0
- FantastiqUI
- FMOD
- Chipmunk Physics
- Your favorite C/C++ 3D engine
How can Lisp be used?
Some games use a scripting language as a sandbox. Inthis application, I will be showing you how to use CCL as the maingame, pushing and scheduling all aspects of the game. The C++ based.exe is essentially a service provider that exposes different gamesubsystems (audio, graphics, networking, ect.) to the Lisp runtime. Youcould do the exact opposite, and have the C++ side be a giant DLL andthe Lisp runtime be a .exe file, but it doesn't really change how theytalk.
First, the nasty part of fixing (stack-trace)
I excluded VC7 from the list, because Corman CommonLisp's runtime uses VC8. Because the lisp runtime is a compiler, itdepends upon the particular way that code generated by VC8 behaves. Anew patch may come out with a fix, but that hasn't happened yet. LoadCCL_INSTALL_DIR/CormanLispServer/CormanLispServer.vcproj. FindLispFunc.cpp and search for this string: "LispFunction(Stack_Trace)".At the end of that function, replace the very last if statement with this one:
if (isFunction(func) && (symbolValue(TOP_LEVEL) == func ||
(funcName && symbolValue(TOP_LEVEL) == symbolFunction(funcName))))
break;
Thatfixes a hairy little problem that caused stack tracing to break whencalled from a Lisp generated DLL. Sorry about that. Rebuild solutionand close VC8. If you have a problem, I can post a link to a patchedCormanLispServer.dll.
Make the Lisp DLL
Open the Corman Lisp IDE. Press CTRL-N and paste this code into the new window:
#| (ccl::compile-dll "C:/Programming/LispGameTutorial/LispGame.lisp"
:output-file "C:/Programming/LispGameTutorial/bin/LispGame.dll"
:verbose t :print t) |#
(defpackage "lispgame")
(in-package "lispgame")
;;;;=========================================================================
;;;; *terminal-io* redirection to host app
;;;;=========================================================================
(defparameter *print-next-error* T)
(ct:defun-pointer StringWriterFNP
((string (:char *)))
:return-type :void :linkage-type :c)
(ct:defun-dll-export-c-function SetOutputCallback ((overflowCallback (:void *)))
(setf (uref *terminal-io* cl::stream-overflow-func-offset)
(lambda (stream)
(let ((buf (cl::stream-output-buffer stream))
(num (cl::stream-output-buffer-pos stream)))
(setf (cl::stream-output-buffer-pos stream) 0)
(StringWriterFNP overflowCallback (ct:lisp-string-to-c-string buf))
num)))
(let ((output-buffer-length 1))
(setf (uref *terminal-io* cl::stream-output-buffer-offset)
(make-array output-buffer-length :element-type 'character))
(setf (uref *terminal-io* cl::stream-output-buffer-length-offset) output-buffer-length))
(format t "*terminal-io* directed to host app.~%")
(force-output *terminal-io*))
(defmacro print-errors (&rest body)
`(catch 'trap-errors
(handler-bind ((error (lambda (c)
(when *print-next-error*
(format *terminal-io*
";;; An error of type ~S was detected~%;;; Error: ~S~%;;; Stack trace:~%"
(class-name (class-of c))
c)
(dolist (frame (cddddr (stack-trace)))
(format *terminal-io* "~S~%" frame))
(force-output *terminal-io*)
(setf *print-next-error* NIL))
(throw 'trap-errors NIL))))
,@body)))
;;;;=========================================================================
;;;; Dynamic callback creation interface
;;;;=========================================================================
(defvar *callbacks-to-create* NIL)
(ct:defun-dll-export-c-function CREATE_CALLBACK ((c-callback (:void *))
(declaration-string (:char *)))
(push (list c-callback declaration-string) *callbacks-to-create*))
;; FFI Notes: a - is seemingly translated to a _ on the C side.
;; But if you dont say so, it is actually broken.;;(ct:defun-dll-export-c-function loadlevel1 ()
;; (format t "this works~%"))
;;;;=========================================================================
;;;; C to lisp entry points
;;;;=========================================================================
(defparameter *collision-callback* NIL)
(ct:defun-dll-export-c-function collision_callback ((a (:void *))
(b (:void *))
(contacts (:void *))
(numContacts :long)
(data (:void *)))
(print-errors
(cond ((eq *collision-callback* NIL)
(progn
(setf *collision-callback* T)
(format t "*collision-callback* not set~%")))
((eq *collision-callback* T))
(T (funcall *collision-callback* a b contacts numContacts data)))))
(ct:defun-dll-export-c-function Start_Game ()
(setf *print-next-error* T)
(print-errors
(let ((*top-level* #'load))
(load "../data/start-game.lisp" :verbose t :print t))))
(setf (symbol-function 'update-frame) NIL)
(ct:defun-dll-export-c-function update_frame ((frame-time :single-float))
(print-errors
(if (eq #'update-frame nil)
(when *print-next-error*
(progn
(setf *print-next-error* NIL)
(format t "Error: No per-frame block exists!~%")))
(update-frame frame-time))))
(setf (symbol-function 'draw-frame) NIL)
(ct:defun-dll-export-c-function draw_frame ((frame-time :single-float))
(print-errors
(if (eq #'draw-frame nil)
(when *print-next-error*
(progn
(setf *print-next-error* NIL)
(format t "Error: No render-frame block exists!~%")))
(draw-frame frame-time))))
- Make a folder called C:\Programming\LispGameTutorial and a child of that directory, ./bin.
- Save the new window from the CCL IDE as C:\Programming\LispGameTutorial\LispGame.lisp.
- Go to the comment block at the top of the file, and find the last ) in it. Press CTRL + Enter, or Numpad Enter.
- You should see some output in the Lisp Output Window indicating that a DLL was made.
- If you get a crash, reload the IDE and try to compile the DLL again.
What's going on in that DLL?
- We define a "lispgame" package.
- We redirect output from Lisp to a function in the C++ caller.
- When you see ct:defun-dll-export-c-function, that's a DLL entry point in the generated DLL. See?
- Thereis a nifty macro called print-errors, which causes errors not to dropthe program down into the debugger, but just to print the error and thecall stack and stop.
- Thenext entry point is called CREATE_CALLBACK, which accepts a C functionpointer and a string that describes the C function interface. For now,we won't actaully create the callback, but just store the arguments ina list to be dealt with later.
- COLLISION_CALLBACK is loaded from the C++ side and given to Chipmunk as the callback function to call upon collisions.
- UPDATE_FRAME and DRAW_FRAME are called by Gamebryo at theappropiate times, so I don't technically have the entire game loop inLisp. This is a design decision on my part, and your game needn't do itthe same way.
- START_GAME is the function that is called once by the C++ side,in order to load and compile all the dynamic lisp code. It expectsC:\Programming\LispGameTutorial\data\start-game.lisp to exist. Notethat the path is relative from C:\Programming\LispGameTutorial\VC80 isthe working directory for debugging from VC80 in this sample project.
- Because of the way that the package and function names are mappedinto symbols in the generated DLL, just avoid putting dashes in thenames of the DLL entry points. Use underscores.
- Not sure why this is, but the CCL runtime goes bonkers if youdare try to pass a function pointer from a Corman Lisp generated DLL toC++. This is why we have to rely on properly generated DLL entrypoints, so that the C to Lisp call succeeds. Corman does supportgenerating a C callable function pointer on the fly, but those pointersdon't work outside of the DLL.
What does the C++ side need?
// LispInterface.cpp
#include <windows.h>
#include "LispInterface.h"
#include "Graphics.h"
#include "Sound.h"
#include "Physics.h"
#include "UI.h"
//========================================================================
// Set lisp text output callback
//========================================================================
void textWriter(char *text){
OutputDebugStr(str);
}
bool SetLispTextWriter(HMODULE module)
{
typedef void (*FNv)(void*);
FNv setOutputCallback =
(FNv)GetProcAddress(module, "carrotrun__SETOUTPUTCALLBACK");
if(!setOutputCallback) return false;
setOutputCallback(&textWriter);
return true;
}
//============================================================================
// Lisp game interface
//============================================================================
typedef void (*FN)();
FN start_game = NULL;
FNf update_frame = NULL;
bool StartLispInterface()
{
//========================================================================
// Load lisp runtime
//========================================================================
HMODULE module = LoadLibrary("../bin/LispGame.dll");
if(!module) return false;
if(!SetLispTextWriter(module)) return false;
//========================================================================
// Load lisp entry points
//========================================================================
start_game = (FN)GetProcAddress(module, "lispgame__START_GAME");
if(!start_game) return false;
update_frame = (FNf)GetProcAddress(module, "lispgame__UPDATE_FRAME");
if(!update_frame) return false;
FNvv setDynamicLispCallback =
(FNvv)GetProcAddress(module, "lispgame__CREATE_CALLBACK");
//========================================================================
// Initialize game subsystems' lisp interface
//========================================================================
if(!StartGraphics(module, setDynamicLispCallback)) return false;
if(!StartUI(module, setDynamicLispCallback)) return false;
if(!StartSound(module, setDynamicLispCallback)) return false;
if(!StartPhysics(module, setDynamicLispCallback)) return false;
return true;
}
void StopLispInterface()
{
StopGraphics();
StopUI();
StopSound();
StopPhysics();
}
bool StartGame()
{
if(!start_game) return false;
ResetGraphics();
ResetSound();
ResetUI();
ResetPhysics();
start_game();
return true;
}
bool UpdateFrame(float time)
{
if(!update_frame) return false;
update_frame(time);
return true;
}
We load the DLL. The DllMain inthat DLL will automatically initialize the Corman Lisp runtime for us.So, while I'm on the topic, I should mention that CormanLisp.img shouldbe copied into the LispGameTutorial's bin directory, andCormanLispServer.dll should be copied into the working directory forthe .exe when it is running. This is usually the VC80 directory.
Thetext writer outputs everything to the Visual Studio Output Window. Keepin mind that you should probably use a log file, since the outputwindow gets cluttered very quickly with warnings about first timememory access exceptions. These warnings are caused by Corman's garbagecollector, since it has to mark which memory pages have been touched.The first time a page is accessed for write, it is marked read only andan exception (not a C++ exception, this is lower level) is generated.The exception handler hook marks the page as writable, and stores thatpage in a list of pages that have been written to. Just in case youwere curious...
C++ Physics Interface
There are multiple subsystems in the game, but sincethe other subsystems are technically commercial, and Chipmunk has apermissive license, I'll just show the physics interface. Also, thephysics interface does a fine job of showing off all aspects of theC++/Lisp interface.
#include <windows.h>
#include <chipmunk.h>
#include "Physics.h
"#include "DrawingPlane.h"
cpCollFunc coll_func = NULL;
cpSpace *physics = NULL;
DrawingPlane *drawingPlane = NULL;
//============================================================================
// Callbacks
//============================================================================
cpShape* make_polygon(cpBody* body, float* points, long size, float x, float y)
{
cpShape *shape = cpPolyShapeNew(body, size, (cpVect*)points, cpv(x, y));
return shape;
}
cpShape* make_segment(cpBody* body, float x1, float y1, float x2, float y2)
{
cpShape *shape = cpSegmentShapeNew(body, cpv(x1, y1), cpv(x2, y2), 0);
return shape;
}
cpShape* make_circle(cpBody* body, float x, float y, float r)
{
cpShape *shape = cpCircleShapeNew(body, r, cpv(x, y));
return shape;
}
cpJoint* make_groove_joint(cpBody* body1, cpBody* body2,
float x1, float y1, float x2, float y2, float ax, float ay)
{
cpJoint* joint =
cpGrooveJointNew(body1, body2, cpv(x1, y1), cpv(x2, y2), cpv(ax, ay));
return joint;
}
void add_shape(cpShape* shape){ cpSpaceAddShape(physics, shape);}
void add_static_shape(cpShape* shape){ cpSpaceAddStaticShape(physics, shape);}
void add_body(cpBody* body){ cpSpaceAddBody(physics, body);}
void apply_spring(cpBody* body1, cpBody* body2, float x1, float y1,
float x2, float y2, float restLength, float k, float damping, float dt)
{
cpDampedSpring(body1, body2, cpv(x1, y1), cpv(x2, y2),
restLength, k, damping, dt);
}
void add_joint(cpJoint* joint){ cpSpaceAddJoint(physics, joint);}
void remove_shape(cpShape* shape)
{
cpSpaceRemoveShape(physics, shape);
cpShapeFree(shape);
}
void remove_body(cpBody* body)
{
cpSpaceRemoveBody(physics, body);
cpBodyFree(body);
}
void add_collision_notify(unsigned long a, unsigned long b)
{
cpSpaceAddCollisionPairFunc(physics, a, b, coll_func, NULL);
}
void set_gravity(float x, float y){ physics->gravity = cpv(x, y);}
void update_physics(float frameTime){ cpSpaceStep(physics, frameTime);}
void DrawPhysicsOutlines(){ drawingPlane->draw();}
//========================================================================
// Lisp interface
//========================================================================
bool StartPhysics(HMODULE module, FNvv setDynamicLispCallback)
{
drawingPlane = new DrawingPlane(NULL);
cpInitChipmunk();
coll_func = (cpCollFunc)GetProcAddress(module, "lispgame__COLLISION_CALLBACK");
if(!coll_func) return false;
setDynamicLispCallback(&cpBodyNew,
"(cpBody *) MakeBody :single-float mass :single-float angularMass");
setDynamicLispCallback(&make_polygon,
"(cpShape *) MakePolygon "
"(cpBody *) body "
"(:single-float *) points "
":long numEdges "
":single-float x "
":single-float y ");
setDynamicLispCallback(&make_segment,
"(cpShape *) MakeSegment "
"(cpBody *) body "
":single-float x1 "
":single-float y1 "
":single-float x2 "
":single-float y2 ");
setDynamicLispCallback(&make_circle,
"(cpShape *) MakeCircle "
"(cpBody *) body "
":single-float x "
":single-float y "
":single-float r");
setDynamicLispCallback(&make_groove_joint,
"(cpJoint *) MakeGrooveJoint "
"(cpBody *) body1 "
"(cpBody *) body2 "
":single-float x1 "
":single-float y1 "
":single-float x2 "
":single-float y2 "
":single-float ax "
":single-float ay");
setDynamicLispCallback(&add_shape, ":void AddShape (cpShape *) shape");
setDynamicLispCallback(&add_static_shape, ":void AddStaticShape (cpShape *) shape");
setDynamicLispCallback(&add_body, ":void AddBody (cpBody *) body");
setDynamicLispCallback(&add_joint, ":void AddJoint (cpJoint *) joint");
setDynamicLispCallback(&remove_shape, ":void RemoveShape (cpShape *) shape");
setDynamicLispCallback(&remove_body, ":void RemoveBody (cpShape *) shape");
setDynamicLispCallback(&apply_spring,
":void ApplySpring "
"(cpBody *) body1 "
"(cpBody *) body2 "
":single-float x1 "
":single-float y1 "
":single-float x2 "
":single-float y2 "
":single-float restLength "
":single-float k "
":single-float damping "
":single-float dt");
setDynamicLispCallback(&cpBodySetMass,
":void SetBodyMass (cpBody *) body :single-float mass");
setDynamicLispCallback(&cpBodySetMoment,
":void SetBodyMoment (cpBody *) body :single-float moment");
setDynamicLispCallback(&cpBodySetAngle,
":void SetBodyAngle (cpBody *) body :single-float angle");
setDynamicLispCallback(&add_collision_notify,
":void AddCollisionNotification :unsigned-long a :unsigned-long b");
setDynamicLispCallback(&set_gravity, ":void SetGravity :single-float x :single-float y");
setDynamicLispCallback(&update_physics, ":void UpdatePhysics :single-float frame-time");
setDynamicLispCallback(&DrawPhysicsOutlines, ":void DrawPhysicsOutlines");
ResetPhysics();
return true;
}
void StopPhysics()
{
cpSpaceFreeChildren(physics);
cpSpaceFree(physics);
physics = NULL;
delete drawingPlane;
}
bool ResetPhysics()
{
if(physics)
{
cpSpaceFreeChildren(physics);
cpSpaceFree(physics);
}
/* We first create a new space */
physics = cpSpaceNew();
/* Next, you'll want to set the properties of the space such as the
number of iterations to use in the constraint solver, the amount
of gravity, or the amount of damping. In this case, we'll just set the gravity. */
physics->gravity = cpv(0.0f, -900.0f);
/* This step is optional. While you don't have to resize the spatial
hashes, doing so can greatly increase the speed of the collision
detection. The first number should be the expected average size of
the objects you are going to have, the second number is related to
the number of objects you are putting. In general, if you have more
objects, you want the number to be bigger, but only to a
point. Finding good numbers to use here is largely going to be guess
and check. */
cpSpaceResizeStaticHash(physics, 100.0f, 4000);
cpSpaceResizeActiveHash(physics, 100.0f, 75);
// Create the debug drawing device and the static body (terrain)
drawingPlane->physics = physics;
return true;
}
ThedrawingPlane is a debugging tool that I wrote to see the physicsoutlines in Gamebryo, so it is non-essential. Save the above code asLispInterface.cpp in the root of the LispGameTutorial folder.
Lisp Physics Interface
(in-package "lispgame")
;;;;=========================================================================;;;; Chipmunk data types;;;;=========================================================================
#! ()
typedef float cpFloat;
struct cpBB {
cpFloat l;
cpFloat b;
cpFloat r;
cpFloat t;
};
struct cpVect {
cpFloat x;
cpFloat y;
};
struct cpBody{
cpFloat m;
cpFloat m_inv;
cpFloat i;
cpFloat i_inv;
cpVect p;
cpVect v;
cpVect f;
cpVect v_bias;
cpFloat a;
cpFloat w;
cpFloat t;
cpFloat w_bias;
cpVect rot;
void *data;
};
struct cpShape{
int shapeType;
void* cacheData;
void* destroy;
unsigned long id;
cpBB bb;
unsigned long collision_type;
unsigned long group;
unsigned long layers;
void *data;
cpBody *body;
cpFloat e;
cpFloat u;
cpVect surface_v;
};
struct cpJoint {
cpBody *a;
cpBody *b;
};
struct cpGrooveJoint {
cpJoint joint;
cpVect anchr1;
cpVect anchr2;
cpVect line;
cpVect r1;
cpVect r2;
cpVect t;
cpFloat tMass;
cpFloat jAcc;
cpFloat jBias;
cpFloat bias;
};
struct cpContact {
cpVect p;
cpVect n;
cpFloat dist;
cpVect r1;
cpVect r2;
cpFloat nMass;
cpFloat tMass;
cpFloat jnAcc;
cpFloat jtAcc;
cpFloat jBias;
cpFloat bias;
cpFloat bounce;
unsigned long hash;
};
!#
;;;;=========================================================================
;;;; Chipmunk getter/setter for cpBody/cpShape
;;;;=========================================================================
(defun friction (friction shapes)
(if (listp shapes)
(dolist (shape shapes) (friction friction shape))
(setf (ct:cref cpShape shapes u) (to-float friction)))
shapes)
(defun get-position (body)
(list (ct:cref cpVect (ct:cref cpBody (body-chipmunk-body body) p) x)
(ct:cref cpVect (ct:cref cpBody (body-chipmunk-body body) p) y)))
(defun set-position (position body)
(setf (ct:cref cpVect (ct:cref cpBody (body-chipmunk-body body) p) x) (to-float (first position)))
(setf (ct:cref cpVect (ct:cref cpBody (body-chipmunk-body body) p) y) (to-float (second position)))
(setf (ct:cref cpVect (ct:cref cpBody (body-chipmunk-body body) v) x) 0.0)
(setf (ct:cref cpVect (ct:cref cpBody (body-chipmunk-body body) v) y) 0.0))
(defun get-angular-mass (body)
(ct:cref cpBody (body-chipmunk-body body) i))
(defun set-angular-mass (i body) (SetBodyMoment (body-chipmunk-body body) (to-float i)))
(defun set-angle (angle body) (SetBodyAngle (body-chipmunk-body body) (to-float angle)))
(defun get-angular-velocity (body) (ct:cref cpBody (body-chipmunk-body body) w))
(defun set-angular-velocity (w body) (setf (ct:cref cpBody (body-chipmunk-body body) w) (to-float w)))
(defun add-torque (torque body)
(set-torque (+ (ct:cref cpBody (body-chipmunk-body body) t) torque) body))
(defun set-torque (torque body)
(setf (ct:cref cpBody (body-chipmunk-body body) t) (to-float torque)))
(defun set-collision-type (collision-type shape)
(setf (ct:cref cpShape shape collision_type) collision-type))
(defun get-collision-type (shape) (ct:cref cpShape shape collision_type))
(defun get-body (shape) (ct:cref cpShape shape body))
(defun get-mass (body) (ct:cref cpBody (body-chipmunk-body body) m))
;;;;=========================================================================
;;;; Create chipmunk objects
;;;;=========================================================================
(defstruct body chipmunk-body chipmunk-shapes)
(defun add-shape (shape)
(push shape (body-chipmunk-shapes *current-body*))
(if (eq *current-body* *static-body*)
(AddStaticShape shape)
(AddShape shape)))
(defun circle (pos r)
(let* ((world-pos (get-shape-position pos))
(shape (MakeCircle (body-chipmunk-body *current-body*)
(first world-pos) (second world-pos)
(to-float r))))
(setf (ct:cref cpShape shape group) *current-collision-group*)
(add-shape shape)
shape))
(defun segment (p1 p2) (let* ((world-p1 (get-shape-position p1))
(world-p2 (get-shape-position p2))
(shape (MakeSegment (body-chipmunk-body *current-body*)
(first world-p1) (second world-p1)
(first world-p2) (second world-p2))))
(setf (ct:cref cpShape shape group) *current-collision-group*)
(add-shape shape)
shape))
(defun segments (points)
(loop for p1 in (rest points)
and p2 = (first points) then p1
collect (segment p1 p2)))
(let ((point-c-array (ct:malloc (* (ct:sizeof :single-float) 32))))
(defun polygon (&rest points)
(if (> (length points) 16)
(error "ERROR: Please ask Tim to increase the maximum number of points~%"))
(let ((index 0))
(dolist (point points)
(let ((single-float-point (coerce-v point)))
(setf (ct:cref (:single-float *) point-c-array index)
(first single-float-point))
(setf (ct:cref (:single-float *) point-c-array (1+ index))
(second single-float-point)))
(setf index (+ index 2)))
(let ((shape (MakePolygon (body-chipmunk-body *current-body*)
point-c-array (/ index 2) 0.0 0.0)))
(setf (ct:cref cpShape shape group) *current-collision-group*)
(add-shape shape)
shape))))
(defmacro create-body (mass angular-mass &rest shapes)
`(let ((collision-type1 (get-game-object-collision-type (quote ,(first game-object-types))))
(collision-type2 (get-game-object-collision-type (quote ,(second game-object-types)))))
(set-collision-callback collision-type1 collision-type2
(lambda (a b contacts numContacts data)
(let ((,(first game-object-types) (get-game-object-from-shape a))
(,(second game-object-types) (get-game-object-from-shape b)))
,@body)))))
;;;;=========================================================================
;;;; cpSpace operations
;;;;=========================================================================
(defun set-gravity (dir)
(SetGravity (to-float (first dir)) (to-float (second dir))))
- The first section is what it looks like, a subset of C headers can be copied and pasted inside the #! section.
- The next section is a bunch of getters and setters. Some of thosefunctions are accessing the C structs directly, and some are callingthe C callbacks. Keep in mind that I have not even tested what it takesto access real C++ object instances directly, since C++ has a vtable.
- The collision callback interface defines an interesting macro upon-collision,which creates an unnamed function to be called when a collision isdetected between two object types. You can load some of these formsinto the Corman IDE and macroexpand-1 them to see what the macroproduces.
Start-Game.lisp
(in-package "lispgame")
;;;;=========================================================================
;;;; Infinity constant hack
;;;;=========================================================================
;;; Uses the bits of the passed integer to create a float.
(pl:defasm %make-single-float (num)
{
push ebp
mov ebp, esp
mov ecx, 0
callf cl::alloc-single-float
mov edx, [ebp + ARGS_OFFSET]
test edx, 7
jne :bignum
shr edx, 3
mov [eax + (uvector-offset cl::single-float-offset)], edx
jmp :exit
:bignum
mov ecx, [edx + (uvector-offset cl::bignum-first-cell-offset)]
mov [eax + (uvector-offset cl::single-float-offset)], ecx
:exit
mov ecx, 1
pop ebp
ret })
(defconstant *infinity* (%make-single-float #x7f800000))
;;;;=========================================================================
;;;; Create deferred C callback wrappers
;;;;=========================================================================
(dolist (callback *callbacks-to-create*)
(let* ((declaration-string (second callback))
(c-callback (first callback))
(c-declaration-string (ct:c-string-to-lisp-string declaration-string))
(c-declaration
(read-from-string (concatenate 'string "(" c-declaration-string ")")))
(arg-list
(loop for arg on (cddr c-declaration) by #'cddr
collecting (list (cadr arg) (car arg))))
(fnp (gensym))
(program
`(let ()
(defun draw-frame (frame-time)
; treat main render loop as top level
(setf *top-level* #'render-frame)
; Perform per frame render work
,@body
; Must return NIL, to override possible float return value
; which is not treated as cdecl by fpu
NIL)))
;;;;=========================================================================
;;;; Keyboard
;;;;=========================================================================
(defconstant *key-I* 23)
(defconstant *key-O* 24)
(defconstant *key-P* 25)
(defconstant *key-J* 36)
(defconstant *key-K* 37)
(defconstant *key-L* 38)
(defconstant *key-UP* 121)
(defconstant *key-LEFT* 123)
(defconstant *key-RIGHT* 124)
(defconstant *key-DOWN* 126)
(defconstant *key-SPACE* 57)
(load "../data/level1.lisp" :verbose T :print t)
- The infinity constant hack is to get around a limitation inCorman Common Lisp. There is no way to specify a positive infinitysingle float as a float constant, so I copied %make-single-float from the CCL guts and used that method with the bits that are in the positive infinity single float.
- The next section creates Lisp wrappers for the C callbacks. Thewrapper has two parts. The first part is a C function definition, whichsays what type of function the C function pointer is. The second partis a lisp function that calls the C function definition with the Cfunction pointer and the Lisp arguments that are passed to it.
- Some helper functions get created, and then each subsystem getsinitialized. The Physics.lisp file that you created earlier is one ofthose subsystems.
- The macros per-frame and render-frame are noteworthy. Notice that they produce a (let () block instead of a (progn block. Keep in mind that start-game.lisp is loaded by the DLL with a loadcommand. A top level progn block is treated specially in this case, andoutputs the values of each of its forms, but a NIL let block acts likeprogn normally acts, returning just the value of the last form.
- Those macros also set *top-level* to the function that they create, because the (stack-trace) will fail if it leaks down to the C++, and *top-level* is always the last form that the stack trace goes down to.
- The last thing that those macros do is ensure that they returnNIL. Those forms are called each frame by the DLL, and the last thingthat the DLL does in update_frame and draw_frame is callthose forms, so their return values would potentially get automaticallyreturned on the stack back to C++. Corman Lisp's foreign functioninterface does not allow the programmer to specify a return value, soyou have to be careful about which values are returned. Typically, thisdoes not matter since cdecl requires the caller and not the callee tomanage the stack when making calls, meaning that unnecessary returnarguments are ignored. However, when floating point arguments are leftsitting on the FPU, bad things happen.
- You may wonder about the other forms that clearly return floating point arguments. Those forms are called from (load and are not actually returned back to C++.
Using what we have so far from Lisp!!!
Now the exciting part, writing a game in Lisp. Again, Iapologize for not taking the time to compose a fully working sample,but here's what the code might look like for level1.lisp:
(in-package "lispgame")
(load "../data/game-objects.lisp" :verbose t :print t)
;;;;=========================================================================
;;;; Level pieces
;;;;=========================================================================
(defun make-straight ()
(friction 0.5 (segment '(0 0) '(1000 0)))
(link-graphic *static-body*
(graphic "road/straight.tga"
:translate '(500 500 0) :rotate '(90 0 1 0) :scale 1000)))
(defun make-curve-flat-up ()
(friction 0.5 (segments *curve-pointlist*))
(link-graphic *static-body*
(graphic "road/curve.tga"
:translate '(500 500 0) :rotate '(90 0 1 0) :scale 1000)))
(defun make-dirt ()
(link-graphic *static-body*
(graphic "road/dirt.tga"
:translate '(500 500 0) :rotate '(90 0 1 0) :scale 1000)))
(defun make-ceiling ()
(friction 0.5 (segments '((0 0) (1000 0))))
(link-graphic *static-body*
(graphic "road/dirt.tga"
:translate '(500 500 0) :rotate '(90 0 0 1) :scale 1000)))
(defun make-ramp ()
(friction 0.5 (segments *curve-pointlist*))
(link-graphic *static-body*
(graphic "road/ramp.tga"
:translate '(1000 0 0) :rotate '(-0 1 0 0) :scale 1000)))
(defparameter *curve-pointlist* '((0 0) (300 0) (500 30) (655 90)
(800 195) (905 335) (970 500) (1000 700) (1000 1000)))
(defun make-curve-flat-down ()
(friction 0.5
(segments
(map 'list (lambda (x) (list (first x) (- 1000 (second x))))
*curve-pointlist*)))
(link-graphic *static-body*
(graphic "road/curve.tga"
:translate '(500 500 0) :rotate '(120 -0.57735 0.57735 -0.57735) :scale 1000)))
(defun make-curve-up-flat ()
(friction 0.5
(segments
(map 'list (lambda (x) (v- '(1000 1000) x))
*curve-pointlist*)))
(link-graphic *static-body*
(graphic "road/curve.tga"
:translate '(500 500 0) :rotate '(180 0.707107 0 0.707107) :scale 1000)))
(defun make-curve-down-flat ()
(friction 0.5
(segments
(map 'list (lambda (x) (list (- 1000 (first x)) (second x)))
*curve-pointlist*)))
(link-graphic *static-body*
(graphic "road/curve.tga"
:translate '(500 500 0) :rotate '(120 0.57735 0.57735 0.57735) :scale 1000)))
(defun make-shallow-jump ()
(friction 0.5
(segments '((0 0) (300 10) (560 80))))
(link-graphic *static-body*
(graphic "road/ramp.tga"
:translate '(500 500 0) :rotate '(90 0 1 0) :scale 1000)))
;;;;=========================================================================
;;;; Level layout
;;;;=========================================================================
(offset '(-3000 1000) (make-dirt))
(offset '(-3000 2000) (make-dirt))
(offset '(-3000 0) (make-dirt))
(offset '(-3000 -1000) (make-dirt))
(offset '(-3000 -2000) (make-dirt))
(offset '(-2000 1000) (make-dirt))
(offset '(-2000 2000) (make-dirt))
(offset '(-2000 0) (make-dirt))
(offset '(-2000 -1000) (make-dirt))
(offset '(-2000 -2000) (make-dirt))
(offset '(-1000 4000) (make-dirt))
(offset '(-1000 3000) (make-dirt))
(offset '(-1000 2000) (make-dirt))
(offset '(-1000 1000) (make-dirt))
(offset '(-1000 1000) (make-ceiling))
(offset '(-1000 0) (make-curve-down-flat))
(offset '(-1000 -1000) (make-dirt))
(offset '(-1000 -2000) (make-dirt))
(offset '(0 4000) (make-dirt))
(offset '(0 3000) (make-dirt))
(offset '(0 2000) (make-dirt))
(offset '(0 1000) (make-dirt))
(offset '(0 1000) (make-ceiling))
(offset '(0 0) (make-straight))
(offset '(0 -1000) (make-dirt))
(offset '(0 -2000) (make-dirt))
(offset '(1000 4000) (make-dirt))
(offset '(1000 3000) (make-dirt))
(offset '(1000 2000) (make-curve-up-flat))
(offset '(1000 1000) (make-curve-down-flat))
(offset '(1000 1000) (make-ceiling))
(offset '(1000 0) (make-straight))
(offset '(1000 -1000) (make-dirt))
(offset '(1000 -2000) (make-dirt))
(offset '(2000 4000) (make-dirt))
(offset '(2000 3000) (make-dirt))
(offset '(2000 2000) (make-curve-flat-down))
(offset '(2000 1000) (make-shallow-jump))
(offset '(2000 0) (make-curve-flat-up))
(offset '(2000 -1000) (make-dirt))
(offset '(2000 -2000) (make-dirt))
(defun make-vehicle-instance ()
(self-collide-off
(let* ((beetle (graphic "beetle.tga"
:translate '(0 33 0) :rotate '(-90 0 1 0) :scale 3))
(chassis
(create-body 60 100000
(friction 0.1
(polygon '(-135 0) '(-130 20) '(-70 75) '(0 82) '(30 77) '(137 22) '(137 5) '(65 0)))))
(rear-wheel
(offset '(-75 3)
(create-body 2 18
(friction 3
(circle '(0 0) 19)))))
(front-wheel
(offset '(85 3)
(create-body 2 18
(friction 3
(circle '(0 0) 19))))))
(link-graphic chassis beetle)
(link-graphic rear-wheel (graphic-child "rearWheels" beetle))
(link-graphic front-wheel (graphic-child "frontWheels" beetle))
(attach-groove-joint chassis rear-wheel '(-75 -500) '(-75 500) '(0 0))
(attach-groove-joint chassis front-wheel '(85 -500) '(85 500) '(0 0))
(attach-spring chassis rear-wheel '(-75 100) '(0 0) 115 15000 400)
(attach-spring chassis front-wheel '(85 100) '(0 0) 115 15000 400)
(create-vehicle chassis rear-wheel front-wheel))))
(defun make-carrot ()
(let ((carrot (graphic "carrot.tga" :scale 10))
(body (create-body *infinity* *infinity* (circle '(0 0) 19))))
(link-graphic body carrot)
(create-collectible 1 body)))
(offset '(1000 100)
(make-carrot))
(offset '(500 500)
(make-vehicle-instance))
(defparameter *test-circle-body*
(create-body *infinity* *infinity*
(circle '(0 400) 40)))
;;;;=========================================================================
;;;; UI Configuration
;;;;=========================================================================
(LoadFullScreenFlashUI "..\\data\\testInterface.swf" 15.0)
(subscribe-to-flash-event "toggleOutlines" ((draw-outlines string))
(if (equal "true" draw-outlines)
(setf *draw-physics-outlines* T)
(setf *draw-physics-outlines* NIL)))
;;;;=========================================================================
;;;; Time settings
;;;;=========================================================================
(defparameter *paused* NIL)
(setf *time* (/ 1/60 15.0)) ; Physics updates happen at 900Hz
(defparameter *leftover-time* 0.0)
;;;;=========================================================================
;;;; Background music
;;;;=========================================================================
(play-sound "../data/Instant Remedy - Flimbo's Quest.mp3" 0.25)
;;;;=========================================================================
;;;; Misc/other global settings
;;;;=========================================================================
(defparameter *camera* (MakeCamera))
(SetBackgroundColor 0.0 0.0 0.0)
(set-gravity '(0 -2000))
(set-camera-field-of-view *camera* 60 1 5000)
(defparameter *draw-physics-outlines* T)
;;;;=========================================================================
;;;; Misc/other global settings
;;;;=========================================================================
(per-frame
(when (KeyWasPressed *key-P*)
(setf *paused* (not *paused*)))
(unless *paused*
(let ((used-time 0.0))
; Add in unused time from previous frame
(setf frame-time (min (+ frame-time *leftover-time*) 0.1))
; Do as many fixed time steps as possible
(loop while (>= frame-time *time*) do
; Count each time step that we use
(setf frame-time (- frame-time *time*))
(setf used-time (+ used-time *time*))
(setf *accumulated-time* (+ *accumulated-time* *time*))
; Update game state
(update-game-objects)
(set-position (list (* (sin *accumulated-time*) 400.0) 0.0) *test-circle-body*)
(UpdatePhysics *time*))
; save unused time for next frame
(setf *leftover-time* (+ frame-time *time*))
; update camera to view all vehicles
(let ((pos '(0 0)) (num-found 0))
(dolist (game-object *game-objects*)
(when (typep game-object 'VEHICLE)
(incf num-found)
(setf pos (v+ pos (get-position (vehicle-chassis game-object))))))
(unless (= num-found 0)
(setf pos (v/ pos num-found)))
(set-camera-transform *camera*
(list (first pos) (+ (second pos) 250) 1800)
'(0 1 0)
(list (first pos) (second pos) 0)))
; Update flash
(flash-call "UpdateFPS" (GetFrameRate))
(update-ui used-time)
; Sync graphics with game objects' bodies' positions
(update-graphics))))
(render-frame
(DrawGraphic *scene-root* *camera*)
(when *draw-physics-outlines* (DrawPhysicsOutlines))
(SetScreenSpaceCameraData)
(DrawFlashUI))
And lastly, game-objects.lisp:
(in-package "carrotrun")
;;;;=========================================================================
;;;; Carrot run game constants/maps/lists
;;;;=========================================================================
(defconstant RESET-WAIT-TIME 5)
;;;;=========================================================================
;;;; Springs (surprisingly, not a native chipmunk type)
;;;;=========================================================================
(defstruct (spring (:include game-object)) body1 body2 anchor1 anchor2 rest-length k damping)
(defun update-spring (spring)
(ApplySpring
(body-chipmunk-body (spring-body1 spring))
(body-chipmunk-body (spring-body2 spring))
(first (spring-anchor1 spring))
(second (spring-anchor1 spring))
(first (spring-anchor2 spring))
(second (spring-anchor2 spring))
(spring-rest-length spring)
(spring-k spring)
(spring-damping spring)
*time*))
(defun attach-spring (body1 body2 anchor1 anchor2 rest-length k damping)
(add-game-object
(make-spring :body1 body1 :body2 body2
:anchor1 (coerce-v anchor1) :anchor2 (coerce-v anchor2)
:rest-length (to-float rest-length) :k (to-float k)
:damping (to-float damping) :update #'update-spring)))
;;;;=========================================================================
;;;; Vehicles
;;;;=========================================================================
(defstruct keypress accelerate reverse brakes reset shoot)
(defparameter *available-vehicle-inputs*
(list
(make-keypress
:accelerate *key-RIGHT*
:reverse *key-LEFT*
:brakes *key-DOWN*
:reset *key-UP*
:shoot *key-SPACE*)))
(defun grab-next-input ()
(let ((input (first *available-vehicle-inputs*)))
(setf *available-vehicle-inputs* (rest *available-vehicle-inputs*))
input))
(defstruct (vehicle (:include game-object)) drive-wheel other-wheel chassis brakes throttle
reset-timestamp shoot-timestamp power
drive-wheel-offset other-wheel-offset wheel-angular-mass player-input)
(defun update-vehicle (vehicle)
(let* ((input (vehicle-player-input vehicle))
(power
(cond ((KeyIsDown (keypress-accelerate input))
(vehicle-power vehicle))
((KeyIsDown (keypress-reverse input))
(* -1 (vehicle-power vehicle)))
(T 0)))
(drive-wheel (vehicle-drive-wheel vehicle))
(chassis (vehicle-chassis vehicle))
(other-wheel (vehicle-other-wheel vehicle))
(wheel-angular-mass (vehicle-wheel-angular-mass vehicle)))
; In C++ it was called Vehicle::ResetVehicleIfApplicable
(when (and
(KeyIsDown (keypress-reset input))
(< (+ (vehicle-reset-timestamp vehicle) RESET-WAIT-TIME)
*accumulated-time*))
(let ((chassis-pos (get-position chassis)))
(set-position (v+ chassis-pos '(0 50)) chassis)
(set-position (v+ chassis-pos (vehicle-drive-wheel-offset vehicle)) drive-wheel)
(set-position (v+ chassis-pos (vehicle-other-wheel-offset vehicle)) other-wheel)
(set-angle 0 chassis)
(setf (vehicle-reset-timestamp vehicle) *accumulated-time*)))
; In C++ it was called Vehicle::ApplyWheelForces
(if (not (KeyIsDown (keypress-brakes input)))
(let ((torque (* -2000000 power)))
; If engine is engaged, then there is internal resistance.
(unless (= power 0)
(setf torque (+ torque (* -200 (get-angular-velocity drive-wheel)))))
(add-torque torque drive-wheel)
(add-torque (- torque) chassis)
(set-angular-mass wheel-angular-mass drive-wheel)
(set-angular-mass wheel-angular-mass other-wheel))
(progn
(add-torque (* 361 (+
(* (get-angular-velocity other-wheel) (get-angular-mass other-wheel))
(* (get-angular-velocity drive-wheel) (get-angular-mass drive-wheel))))
chassis)
; stopped using infinite wheel angular mass for brakes, so that i can
; get feedback on how much the wheels are stopping the car!
(set-angular-mass (* 100 wheel-angular-mass) drive-wheel)
(set-angular-mass (* 100 wheel-angular-mass) other-wheel)
(set-angular-velocity 0 drive-wheel)
(set-angular-velocity 0 other-wheel)
(set-torque 0 drive-wheel)
(set-torque 0 other-wheel)))))
(setf *vehicle-collision-type* (unique-collision-type))
(defun create-vehicle (chassis drive-wheel other-wheel)
(add-game-object
(make-vehicle
:bodies (list chassis drive-wheel other-wheel)
:chassis chassis
:drive-wheel drive-wheel
:other-wheel other-wheel
:throttle 0.0 :reset-timestamp 0.0
:shoot-timestamp 0.0 :power 1.0
:drive-wheel-offset (v- (get-position drive-wheel) (get-position chassis))
:other-wheel-offset (v- (get-position other-wheel) (get-position chassis))
:wheel-angular-mass (get-angular-mass drive-wheel)
:player-input (grab-next-input) :update #'update-vehicle)))
;;;;=========================================================================
;;;; Collectible
;;;;=========================================================================
(defstruct (collectible (:include game-object)) value)
(defun create-collectible (value body)
(add-game-object
(make-collectible :value value
:bodies (list body))))
(upon-collision (collectible vehicle)
(play-sound "../data/munch.ogg")
(remove-game-object collectible)
NIL)
Thereyou have it, folks! I know that I skipped some stuff, and again, I'mvery sorry. Both time constraints and a little concern for exposing toomuch of the internals of commercial libraries that I am very lucky tobe able to use prevent me from sharing the whole thing. Please, if oneof you can even begin to make heads or tails of what I've written,please ask me for clarification, and post a full sample for the rest ofus. As a parting note, here's a screenshot and the file tree for thistutorial:
- C:\Programming\LispGameTutorial
- bin
- LispGame.DLL
- CormanLisp.img
- data
- start-game.lisp
- level1.lisp
- game-objects.lisp
- LispInterface.cpp
- LispInterface.h
- Physics.cpp
- Physics.h
- VC80
- LispGameTutorial.vcproj
- LispGameTutorial.exe
- CormanLispServer.dll
Also, just remembered. You might need a LispGameTutorial.exe.manifest file:
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<dependency>
<dependentAssembly>
<assemblyIdentity type="win32" name="Microsoft.VC80.CRT" version="8.0.50608.0" processorArchitecture="x86" publicKeyToken="1fc8b3b9a1e18e3b"></assemblyIdentity>
</dependentAssembly>
</dependency>
</assembly>
Anyhow, let me know what you think!
Comments
Hide comments
