RSS
When you've eliminated the possible, consider the impossible
by Tim Kerchmar. 
Hello Reader,
I was writing a little utility for manipulating XYZ files, which works great in debug mode, but fails in release mode. Here's the code:
#define PATHSIZE 260
int WINAPI WinMain(HINSTANCE hI, HINSTANCE hPI, LPSTR acCmdLine, int iWinMode)
{
// if the path isn't at least as long as needed to contain the
// smallest absolute paths possible: "c:\a.xyz" "\a\b.xyz", then
// we can be sure that it is garbage.
size_t stCmdLineLength = strlen(acCmdLine);
if(stCmdLineLength < 10)
{
MessageBox(0, "Please supply an absolute path to a .xyz file",
"Error", 0);
return -3;
}
if(stCmdLineLength >= PATHSIZE)
{
MessageBox(0, "Sorry, that path is too long", "Error", 0);
return -4;
}
// Remove double quotes from XYZ path
char acXYZPath[PATHSIZE];
/* Fails here --> */ strcpy_s(acXYZPath, PATHSIZE - 1, &acCmdLine[1]);
acXYZPath[strlen(acXYZPath) - 1] = 0;
// Confirm that path really points to .xyz
char acXYZPathLowerCase[PATHSIZE];
strcpy_s(acXYZPathLowerCase, PATHSIZE, acXYZPath);
_strlwr_s(acXYZPathLowerCase, PATHSIZE);
if(strcmp(&acXYZPathLowerCase[strlen(acXYZPathLowerCase) - 4],
".kfm") != 0)
{
char acError[256];
sprintf_s(acError, 256, "'%s' is not a valid XYZ", acXYZPath);
MessageBox(0, acError, "Error", 0);
return -2;
}
.
.
.
Right at the "Fails here" spot, in release mode, acXYZPath would have a few garbage characters, followed by a proper copy of acCmdLine. I googled a bit and nothing turned up. Usually, these kinds of errors occur from uninitialized data. Debug mode clears most heap or stack allocated data automatically. If your program depends on those values being cleared for you, and you don't run it in release mode often enough, you'll have a hard to track down bug. But strcpy_s overwrites whatever is in the destination string, and the source string was smaller by a large margin! I tried to use PATHSIZE - 1, but it still failed in the same exact way. Nothing is heap allocated, and the string is copied into acXYZPath, just not at the beginning!
So I did the last resort in these situations, carefully combing the project properties and making release resemble debug mode in the Visual Studio Project Properties dialog. When I turned off the optimizer, voila!, it all works in release mode!
-Tim Kerchmar
Comments
Hide comments
Hi Reader,
Here are a few of my old game projects from times past for your pleasure, with source code. Laugh all you want, learning experiences may not be pretty, but they matter.
Laserbyk will need to be run in DOSBox. The .rcd files in RopesV2Test are replay files that can be passed to ConversionTest.exe, and the rest are faily self explanatory. If you have dual monitors on an ATI card, you probably will run into the OpenGL problem with their drivers, and will be unable to view some of these samples on those displays. I have a second card on my PC that runs the third display, and just dragging the window over to that display works just fine.
-Tim
Hello Reader,
Here's a nifty little tool that I made from bits of string and wire and pieces of code that I ganked from the internet (due to a bug in the blogging software, you'll need to replace "" with a backquote in the source):
;;---------------------------------------------------------------------------
;; Code to parse templates
;;---------------------------------------------------------------------------
(defmacro automaton (event-func states &key (stop 'stop) (debug nil) )
""(tagbody
,@(reduce
#'append
(mapcar (lambda (state)
(let ((state-name (car state))
(transitions (cdr state)))
(list state-name
""(let ((current (funcall, event-func)))
(case current
,@(mapcar (lambda (trans)
(let ((match (car trans))
(next (cadr trans))
(actions (cddr trans)))
(cons match
(append actions
(when debug
""((format t "Matched ~A. Transitioning to state ~A.~%" ,match (quote ,next))))
""((go ,next))))))
transitions)))
""(go ,state-name))))
states))
,stop))
(defmacro add-char (s c)
""(setf ,s (concatenate 'string ,s (string ,c))))
(defun parse (file-name)
(with-open-file (is file-name :direction :input)
(let ((text "") (output ""))
(automaton (lambda () (read-char is nil 'eof))
((just-text
; Found beginning of escape sequence
(#\< open-escape)
; Found end of file, dump remaining output
('eof stop
(setf output (concatenate 'string output
(format NIL "~S" text))))
; Ordinary character, just write to output string
(otherwise just-text
(add-char text current)))
(open-escape
; Escape sequence found
(#\% escaped
(setf output (concatenate 'string output
(format NIL "~S" text)))
(setf text ""))
; The <% was not found, so write out < and current
; and go back to collecting text
(otherwise just-text
(add-char text #\<)
(add-char text current)))
(escaped
; Found start of end escape sequence
(#\% close-escape)
; Found end of file, dump remaining output
('eof stop)
; in escaped mode, this should be valid code that we are emitting
(otherwise escaped
(add-char output current)))
(close-escape
; Found second character for end escape sequence
(#\> just-text)
; The %> was not found, so write out % and current
; and go back to collecting text
(otherwise escaped
(add-char output #\%)
(add-char output current)))))
output)))
(defun generate-text (template)
(with-input-from-string (s template)
(let ((result ""))
(loop
(let ((form (read s nil 'eof)))
(if (eq form 'eof)
(return-from generate-text result)
(let* ((form-result (eval form))
(extend
(if (and form-result (not (stringp form-result)))
(format nil "~S" form-result)
form-result)))
;(format t "~S" extend)
(setf result (concatenate 'string result extend)))))))))
;;---------------------------------------------------------------------------
;; Set up environment
;;---------------------------------------------------------------------------
(setf (current-directory) "c:/programming/lispplayground/")
(defparameter *recipient* "Proggit")
(defparameter *sender* 'TIM)
(defparameter *rich* T)
(setf template-text (parse "Hello.gen"))
(generate-text template-text)
Here's the sample template:
Hello <% *recipient* %>!
<%
(when *rich*
%>I am Muffo, president of New Nigeria, can I borrow $5?<%
)
(unless *rich*
%>Here's $5, you poor wretch!<% ) %>
Sincerely,
<% *sender* %>
And the output is:
AUTOMATON
ADD-CHAR
PARSE
GENERATE-TEXT
#P"c:\programming\nitemplatematerial\"
*RECIPIENT*
*SENDER*
*RICH*
"\"Hello \" *recipient* \"!
\"
(when *rich*
\"I am Muffo, president of New Nigeria, can I borrow $5?\"
)
(unless *rich*
\"Here's $5, you poor wretch!\" ) \"
Sincerely,
\" *sender* \" \""
"Hello Proggit!
I am Muffo, president of New Nigeria, can I borrow $5?
Sincerely,
TIM "
I love how easy it is to extend Lisp in ways that would be absolutely aggravating in just about any other language. Macroexpand the automaton in the parse function, and you can see how the finite state machine is automatically wired for you. If you need quickly generate HTML, code, mailmerge, or any other code generation technique for non-lisp code from Lisp, this is a very lightweight implementation.
-Tim Kerchmar
Hello,
Today, I just spent 6 hours hammering through the toughest bug that I have ever solved. Ever. Period. The leads were all dead ends, and there was absolutely nothing remaining except for this:
The Output window wasn't much better with its:
First-chance exception at 0x00000000 in TheGame.exe: 0xC0000005: Access violation reading location 0x00000000.
The app was big and messy, and the error messages worthless. Since the application was haphazardly multithreaded, there wasn't even one logical path that I could use to follow my merry way along until the app crashed. It only crashed if the mouse was created in exclusive mode on DirectInput8, and worked perfectly if the mouse was created in non exclusive mode.
To trigger the bug, the app had to either lose focus before it was finished loading, or I had to manually take away focus. The instant that it regained focus, it would crash.
Step one, find a reproducible case, and see what other things always occur at the same time
In a multithreaded application, the first thing to do is start writing stuff to the Visual Studio Output window. It is an integrated threadsafe logger that you should use when it is the right tool for the job. 4 times in a row, I was able to get the crash to occur right after the first render after the window had regained focus. A lead!
But then I was able to reproduce a crash at a different point in the execution (use the last item logged to narrow down the crash).
Step two, exhaust all the easy options first
Although this bug would occur at different points in the main thread's execution (or in a thread whose activities I was carefully logging), it was reproducible 100% of the time. It never failed to occur. Since the bug could be toggled on and off by changing m_bExclusiveMouse to true or false (which is used to decide which flags to sent to directX), I had two places to look.
- Make sure that the mouse was being created properly. From a valid DI8 device, the flags were good, ect.
- Remember, detailed logging was useless for this bug, at least in the places that I was logging heavily, because the last log entry before the crash was not consistent.
- Check for WM_MOUSEMOVE or other message handlers and hooks that could be triggering the fault.
- In Visual Studio, you can go to Debug/Exceptions/Win32 Exceptions/c0000005 Access violation and check it, which will cause a dialog to come up whenever that exception occurs. This is disabled by default, because many garbage collectors use a memory write barrier. As an aside, 80000001 is thrown for the same reason, but by different GCs.
- I posted the error on gamedev.net, in hopes for an answer. I actually got one right away, and ignored it until google confirmed it.
- I feel really dumb for not looking at this first, but I had been dismissing a dialog box that comes up when the error happens, and it contained slightly new information. When the exception first came up, there is an option to hit Break at the assert dialog. If I choose that option, a second dialog comes up, saying "No symbols are loaded for any call stack frame. The source code cannot be displayed." Turns out, unlike "00000000()", the previous string is actually searchable in google with decent results. A little research confirmed that I was kinda on the wrong track. I was looking for a pure multithreading bug, but apparently this bug is caused by stack corruption of a sort, which in turn may be a multithreading bug.
Unfortunately, after step 5, all that I really knew is that I had a complex bug on my hands, and no clue how to solve it. Time to break out the big guns. There is only one way that I know of to solve an unsolvable bug. By this time, I had already spent 6 hours digging in.
Divide and conquer.
When you cannot solve a bug, there are two useful things to do. One is to start from square one, find the minimal application that reproduces the error and debug that, and the second method is to start ripping out parts of the program, commenting out whole .h and .cpp files, until the error stops occuring. Make a backup first, or better yet, use a source control system. Divide and conquer did some very nice things for me:
- First, many of the places that I suspected to be at fault simply weren't. Whole dependencies on 3rd party libraries were removed.
- Surprisingly, the very very very last spot in the entire codebase or dependency codebase that created a secondary thread was commented out, and the error still occured!
- Finally, I found a single line of code that caused the problem.
The cause of the bug
Microsoft! Their detours library caused the problem. Well, more correctly, is that someone got in over his head with *drum roll* ---> a custom hacked version of DetourFunction! Look!
/////////////////////////////////////////////////////////////////
//Function : DetourFunction()
//Description : Detours a function by putting a jmp in the
// function to our detour function, and copying
// the old function so we can still use that too.
//
//addroffunction : Address of function to detour
//addrofdetour : address of where to detour it to
//addrofreal : address returned of original function
/////////////////////////////////////////////////////////////////
And then it just goes on with memcpy calls and a memory permission unlock for a code segment to be made writable. Basically, this function is designed so that you can provide a hook for something that windows doesn't provide a hook for, but this hook is installed processwide. I'm guessing that one part of this Rube Goldberg contraption (look at the source for yourself if you don't believe me!) was off by just a little bit, and somehow made the return value for one of the hacked in functions be 0x00000000, which is how I got my nice useful call stack. And since it wasn't a function pointer, like I had also considered at one point, MSVC was completely oblivious until after I lost all stack information.
The library was Detouring ::GetCursorPos, which was being used in other places. I just wanted to thank you Microsoft for making libraries that only a very clever person could use, and I thank you, you very clever person, for choosing to use it. That is all.
Hide comments
-
technochakra said 8/3/08
Interesting problem. I ran across your blog today. Thought you'd want to see my article http://www.technochakra.com/debugging-divide-and-conquer-the-input-data/ which also talks about divide and conquer but not with code as you do.
Hello Reader,
A plumber adds hoses and T-connectors to a complex plumbing system, and then runs back to the other side of the basement to turn on the water. To turn on the water, he holds a button down, and dangerously high pressure water is released into the entry point for the water system. From across the basement, he notices some a puddle coming out of the back room.
He stop pushing the button and starts to run back into the little room to make some observations, but the room is dry! The room is a special room that blasts scorching heat the instant the button is released and instantly evaporates all water. Apparently, that's why the button to turn on the water requires him to hold it down. It is a clever little system that avoids getting him fried!
Realizing that he has been in this situation before, he goes through his toolbox. He's looking for something that can give him visibility into that room when he's not in there. "Hmm, I've got a few tools that could work..."
- A heat resistant Coredump© camera.
- A few assert clips that can be attached to the pipes.
- A single-stepping sewer snake.
- Some chalky logging powder.
Eight painful hours later, he realizes that he'll need to disassemble the entire matrix of pipes into smaller chunks and divide and conquer in order to discover which section is leaking. Once he finds out which section is leaking, then he can use something from his toolbox on the entire system again, but focus on how that part interacts with the entire system. Experience over the next few years teach him to painstakingly unit test each of those parts before ever assembling them in the first place.
Is this really the state of the art in development today?!
-Tim Kerchmar
Hello,
They say, if it ain't broke... But I couldn'thelp it when Box2D 2.0.0 came out with the killer feature, continuouscollision detection. By now, Carrot Run has moved along from a smallprototype to a medium sized project, and the conversion ended up beingmore late nights than I had originally presumed.
Chipmunkwas branched from Box2D, but now I can see how different thedevelopment philosophies are for the two libraries, and how much thatnon-technical stuff that many other software blogs write about actually affected Carrot Run's development.
- Erin wants to make a full featured 2D physics engine. Scottwants to make an optimized 2D engine, focussing on the features thathis games require.
- Box2D contains native support for motors, joints, ect. Chipmunk is very easy to integrate with other languages.
- Box2D makes few assumptions about the type of game that the userwill be creating, and uses broadphase algorithms that are resiliant.Chipmunk is very very fast when carefully tuned.
I don't get the impression that Box2D is bloated.I get the impression that Erin's limited time (remember that he writesBox2D when not asleep or at Blizzard writing cool physicsstuff for the mutalisk) is spent on features and usability. I thinkthat Box2D is Erin's pet project, and its forums are certainlygarnering a passionate following with a few very technically adeptusers among them, who seem to debate approaches and submit largepatches to Box2D.
Occasionally,someone posts on a forum that Chipmunkis more polished than Box2D, which is odd considering Box2D's focus onfeatures and usability. But it is true that Chipmunk's samples lookbetter. As it turns out, its a matter of Chipmunk's optimizationsmaking it look better. I think that Chipmunk's samples shipped with a180Hz timestep, and 15 iterations per update. Box2D is using 60Hz and10 iterations per update. Chipmunk's obsessive use with hashtablescertainly pays off. It seems kind of funny to suggest that otheralgorithms are more resiliant than a hashtable, but it is kind of true.If you do not tune the spatial hashing mechanism in Chipmunk, yourapplication can lose out on the net win.
Onething that surprised me about Box2D was that Erin ships it with its ownsmall object allocator. Chipmunk did seem to use heap allocation alot,perhaps on a per frame basis, so I'm not surprised to see my memoryusage drop. Constant heap allocation in a C++ program generally meansthat memory will get utterly fragmented, which would certainly limitChipmunk's usefulness on the PS3 or XBox. And if you have seen theLittleBigWorld videos, you know how cool 2D physics are. Nothing inLittleBigWorld actually requires the physics engine to know about a Zaxis, even though the game is rendered in 3D and does a few things thatSuper Smash Brothers never did.
I also perused theBox2D forums pretty heavily to learn how Erin did continuous collisiondetection without having to actually read his code. As it turns out,like everything else he does in Box2D, he took a deeply pragmaticapproach (meaning that he does what works well, not what is best in theideal world). I suspect that his experience in the game industry,writing games, taught him the benefits of this. I work for a gamesmiddleware company, so the lesson of "do what works now, right now"isn't as well drilled into my head. We have to consider all thewhat-ifs. Erin doesn't have paying customers, so releasing a patchevery few weeks is just fine. I'm a little sad for ToyBox (my ownattempt at 2D physics, with perfect everything, very idealist, wouldprevent penetrations 100% of the time, ran at 0.1FPS on dual 3.4GHzPC), but kind of happy that I can just use someone else's solution andnot worry about tunnelling ever again.
Box2D's CCDuses a binary search to determine time-of-impact for collisions. ToyBoxused numerically unstable polynomial root finding algorithms that hadO(1), but ended up being unstable enough to cause endless problems. Thebinary search algorithm seems to run just fine and the engine seemsvery tolerable of penetrations, which is also very nice.A spatialhashing broadphase would be easy to add to Box2D. The only change fromChipmunk's spatial hashing is that you have to hash the boundingrectangle for an object's swept motion, not just the object's currentposition.
One place that Chipmunk really shined wasease of integration with a dynamic language. Most languages come with amethod for integrating with C, and the good foreign function interfacesprovide a way to directly access memory in a struct. Because Chipmunkwas written in C, symbols were left unmangled and were easy to wire upto be called from Lisp, and there were no invisible this pointers or vtables hidden in memory and function calls. It was a huge pain in the butt to convert my physics wrapper to work with Box2D.
Scott, best wishes on your game! I always did love the meteor smash videos.
Hello Reader,
Check out this great article about game loops.The article is great, and explains some of the most popular methods ofseparating parts of your game logic to allow different parts of yourgame to update with different frequencies. However, the article'sconclusion is a bad idea, and furthermore, the author thinks that notusing 100% CPU is sin itself.
1) Unused cpu is NOT wasted.
It is trivial to set a thread's priority to realtime on Win32, and thencall sleep with the precise number of milliseconds that the game hasnothing to do until the next update. At least on WinXP, this results inmy game taking up only 20-85% of CPU and allowing other stuff to runsmoothly in the background.
2) Base your game loop timings closely with your physics.
a) Nearly all games use physics engines.
b) Higher frequency = less tunnelling (Tunnelling in game physics iswhen updates are infrequent enough that a small, fast moving objectmoves from one side of an object in a single update, most physicsengines won't detect a collision!)
c) Double the updates isn't twice as expensive, because some physicsengines' update cost is linearly corrolated to the number of collisionsthat are detected. More updates with smaller time deltas = lesscollisions per update.
d) The fixed cost of a physics engine's update is often reduced by aggressive caching, spatial coherence graphs, ect.
e) The caching mechanisms in most physics engines break if the physics is not given fixed timesteps.
The author of that article suggested that displayshould use interpolation in order to maximize use of extra possibledisplay frames, so that faster computers have a smoother lookingdisplay. However, I think that he was imagining that a game's updateloop was running between 25-100 times each second. Carrot Run's physicsare updated 900 times each second.In such a scenario where the physics runsso frequently, we are guaranteed that no two vsync'ed frames willdisplay the same view, since most displays cannot refresh faster than120 times each second.
Icould easily disconnect the game object logic from the physics sothat the game object logic is either only triggered to run when acollision occurs, or when a 1/25th of a second has passed, but for nowperformance isn't a problem. If I had a very expensive to run AI, andthe AIwas stable at 5Hz, and a particular user's machine was too fast, Iwould just run the AI at a higher frequency for them. Unlike physics,AI is more resiliant to time step changes, and could produce slightlybetter results with more CPU. Why complicate the display routines?Furthermore, I do know people who like to play games while theirmachine is churning away on other tasks. If the game is trying to take100% CPU for no additional benefit, large network file transfers orother batch processes will crawl.
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
;;;;======