-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathchipmunkimport.pas
4070 lines (3371 loc) · 122 KB
/
chipmunkimport.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
unit ChipmunkImport;
// Chipmunk Engine fully ported by Paul Robello
// with help from Fernando Nadal and Ruben Javier
// paulr@par-com.net
//{$DEFINE CHIPMUNK_DOUBLE_PRECISION} // This is needed when you want to use double precision
interface
uses
{$IFDEF __GPC__}
system,
gpc,
{$ENDIF}
{$IFDEF UNIX}
{$IFDEF FPC}
{$IFDEF Ver1_0}
linux,
{$ELSE}
pthreads,
baseunix,
unix,
{$ENDIF}
x,
xlib,
{$ELSE}
Types,
Libc,
Xlib,
{$ENDIF}
{$ENDIF}
{$IFDEF __MACH__}
GPCMacOSAll,
{$ENDIF}
Classes, SysUtils, math;
//chipmunk.inc should set this correctly now
//{$DEFINE INLINE}
const
CP_CIRCLE_SHAPE = 0;
CP_SEGMENT_SHAPE = 1;
CP_POLY_SHAPE = 3;
CP_NUM_SHAPES = 3;
CP_PIN_JOINT = 0;
CP_PIVOT_JOINT = 1;
CP_SLIDE_JOINT = 2;
CP_GROOVE_JOINT = 3;
CP_HASH_COEF = 3344921057;
M_PI = 3.1415926535897932;
M_2PI = M_PI * 2;
M_1RAD = M_PI /180;
INFINITY = 1e10000;
cp_bias_coef = 0.1;// Determines how fast penetrations resolve themselves.
cp_collision_slop = 0.1;// Amount of allowed penetration. Used to reduce vibrating contacts.
cp_joint_bias_coef = 0.1;
cp_contact_persistence = 3;// Number of frames that contact information should persist.
CP_ARRAY_INCREMENT = 10;
(*Comment this line if you get weird errors*)
{$DEFINE NICE_CODE_PARAMS}
type
{simple types}
{$IFDEF CHIPMUNK_DOUBLE_PRECISION}
Float = Double;
{$ELSE}
Float = Single;
{$ENDIF}
///////////////
//Chipmunk types
///////////////
type
pcpUnsignedIntArray=^cpUnsignedIntArray;
cpUnsignedIntArray = Array [0..32767] of LongWord;
PcpFloat = ^cpFloat;
cpFloat = Float;
PcpVect = ^cpVect;
cpVect = packed record
x : cpFloat;
y : cpFloat;
end;
PcpVectArray = ^cpVectArray;
cpVectArray = Array [0..32767] of cpVect;
Const cpVZero : cpVect = (x: 0; y: 0);
cpVRight : cpVect = (x: 1; y: 0);
cpVLeft : cpVect = (x: -1; y: 0);
cpVUp : cpVect = (x: 0; y: 1);
cpVDown : cpVect = (x: 0; y:-1);
Type
PcpBB = ^cpBB;
cpBB = packed record
l : cpFloat;
b : cpFloat;
r : cpFloat;
t : cpFloat;
end;
PcpBody = ^cpBody;
cpBody = packed record
m : cpFloat;// Mass and it's inverse.
m_inv : cpFloat;
i : cpFloat;// Moment of inertia and it's inverse.
i_inv : cpFloat;
p : cpVect;// Linear components of motion (position, velocity, and force)
v : cpVect;
f : cpVect;
v_bias : cpVect;// NOTE: v_bias and w_bias are used internally for penetration/joint correction.
a : cpFloat;// Angular components of motion (angle, angular velocity, and torque)
w : cpFloat;
t : cpFloat;
w_bias : cpFloat;// NOTE: v_bias and w_bias are used internally for penetration/joint correction.
rot : cpVect;// Unit length
data : pointer; // user defined data
drawRotInc : cpFloat; //TISFAT SPECIFIC
tag : cardinal; // user usable field
sleeping : boolean;
end;
pcpBodyPair=^cpBodyPair;
cpBodyPair=array[0..1] of pcpbody;
// NOTE: cpArray is rarely used and will probably go away.
PcpPointerArray=^cpPointerArray;
cpPointerArray=Array [0..32767] of pointer;
PcpArray = ^cpArray;
cpArray = packed record
num : integer;
max : integer;
arr : PcpPointerArray;
end;
PcpArrayIter = ^TcpArrayIter;
TcpArrayIter = procedure (ptr : pointer; data : pointer ); //CFUNCTYPE(None, c_void_p, c_void_p) // typedef void (*cpArrayIter)(void *ptr, void *data);
// cpHashSet uses a chained hashtable implementation.
// Other than the transformation functions, there is nothing fancy going on.
// cpHashSetBin's form the linked lists in the chained hash table.
PcpHashSetBin = ^cpHashSetBin;
PPcpHashSetBin = ^PcpHashSetBin;
cpHashSetBin = packed record
elt : pointer;// Pointer to the element.
hash : LongWord;// Hash value of the element.
next : PcpHashSetBin;// Next element in the chain.
end;
PcpHashSetBinArray = ^cpHashSetBinArray;
cpHashSetBinArray = Array [0..32767] of PcpHashSetBin;
// Equality function. Returns true if ptr is equal to elt.
TcpHashSetEqlFunc = function (ptr : pointer; elt : pointer): boolean;
// Used by cpHashSetInsert(). Called to transform the ptr into an element.
TcpHashSetTransFunc = function (ptr : pointer; data : pointer): pointer;
// Iterator function for a hashset.
TcpHashSetIterFunc = procedure (elt : pointer; data : pointer);
// Reject function. Returns true if elt should be dropped.
TcpHashSetRejectFunc = function (elt : pointer; data : pointer): integer;
PcpHashSet = ^cpHashSet;
cpHashSet = packed record
entries : integer;// Number of elements stored in the table.
size : integer;// Number of cells in the table.
eql : TcpHashSetEqlFunc;
trans : TcpHashSetTransFunc;
default_value : pointer;// Default value returned by cpHashSetFind() when no element is found.// Defaults to NULL.
table : PcpHashSetBinArray;
end;
// The spatial hash is Chipmunk's default (and currently only) spatial index type.
// Based on a chained hash table.
// Used internally to track objects added to the hash
PcpHandle = ^cpHandle;
cpHandle = packed record
obj : pointer;// Pointer to the object
retain : integer;// Retain count
stamp : integer;// Query stamp. Used to make sure two objects
end; // aren't identified twice in the same query.
// Linked list element for in the chains.
PcpSpaceHashBin = ^cpSpaceHashBin;
cpSpaceHashBin = packed record
handle : PcpHandle;
next : PcpSpaceHashBin;//
end;
PcpSpaceHashBinArray=^cpSpaceHashBinArray;
cpSpaceHashBinArray = Array [0..32767] of pcpSpaceHashBin;
// BBox callback. Called whenever the hash needs a bounding box from an object.
PTcpSpaceHashBBFunc = ^TcpSpaceHashBBFunc;
TcpSpaceHashBBFunc = function (obj : pointer): cpBB;
PcpSpaceHash = ^cpSpaceHash;
cpSpaceHash = packed record
numcells : integer;// Number of cells in the table.
celldim : cpFloat;// Dimentions of the cells.
bbfunc : TcpSpaceHashBBFunc;// BBox callback.
handleSet : PcpHashSet;// Hashset of all the handles.
table : PcpSpaceHashBinArray;
bins : PcpSpaceHashBin;// List of recycled bins.
stamp : integer;// Incremented on each query. See cpHandle.stamp.
end;
// Iterator function
TcpSpaceHashIterator = procedure (obj : pointer; data : pointer); //maybe a procedure
// Query callback.
TcpSpaceHashQueryFunc = function (obj1 : pointer; obj2 : pointer; data : pointer): integer;
PcpEachPair=^cpEachPair;
cpEachPair=packed record
func:TcpSpaceHashIterator;
data:pointer;
end;
// Similar to struct eachPair above.
pcpQueryRehashPair =^cpQueryRehashPair;
cpQueryRehashPair = packed record
hash:pcpSpaceHash;
func:TcpSpaceHashQueryFunc;
data:pointer;
end;
// Enumeration of shape types.
cpShapeType = integer;
// Basic shape struct that the others inherit from.
PcpShape = ^cpShape;
cpShape = packed record
cptype : cpShapeType;//original name was "type"
cacheData : function (shape : PcpShape; const p : cpVect; const rot : cpVect) : cpBB; //Called by cpShapeCacheBB().
destroy : procedure (shape : PcpShape); // Called to by cpShapeDestroy().
id : LongWord;// Unique id used as the hash value.
bb : cpBB;// Cached BBox for the shape.
collision_type: LongWord;// User defined collision type for the shape.
group : LongWord;// User defined collision group for the shape.
layers : LongWord;// User defined layer bitmask for the shape.
data : pointer;// User defined data pointer for the shape.
body : PcpBody;// cpBody that the shape is attached to.
is_static : boolean;// set to true if body is static
e : cpFloat;// Coefficient of restitution. (elasticity)
u : cpFloat;// Coefficient of friction.
surface_v : cpVect;// Surface velocity used when solving for friction.
tag : LongWord;// user usable
end;
cpShapePair=array[0..1] of pcpShape;
cpShapeArray=Array [0..32767] of PcpShape;
PcpShapeArray=^cpShapeArray;
// Circle shape structure.
PcpCircleShape = ^cpCircleShape;
cpCircleShape = packed record
shape : cpShape;
c : cpVect;// Center. (body space coordinates)
r : cpFloat;// Radius.
tc : cpVect;// Transformed center. (world space coordinates)
end;
// Segment shape structure.
PcpSegmentShape = ^cpSegmentShape;
cpSegmentShape = packed record
shape : cpShape;
a : cpVect;// Endpoints and normal of the segment.a,b,n (body space coordinates)
b : cpVect;
n : cpVect;
r : cpFloat;// Radius of the segment. (Thickness)
ta : cpVect;// Transformed endpoints and normal.ta,tb,tn (world space coordinates)
tb : cpVect;
tn : cpVect;
end;
// Axis structure used by cpPolyShape.
PcpPolyShapeAxis = ^cpPolyShapeAxis;
cpPolyShapeAxis = packed record
n : cpVect;// normal
d : cpFloat;// distance from origin
end;
cpPolyShapeAxisArray = Array [0..32767] of cpPolyShapeAxis;
PcpPolyShapeAxisArray = ^cpPolyShapeAxisArray;
// Convex polygon shape structure.
PcpPolyShape = ^cpPolyShape;
cpPolyShape = packed record
shape : cpShape;
numVerts : integer;// Vertex and axis list count.
verts : PcpVectArray;
axes : PcpPolyShapeAxisArray;
tVerts : PcpVectArray;// Transformed vertex and axis lists.
tAxes : PcpPolyShapeAxisArray;
convex : boolean; // true if poly is convex
end;
// Data structure for contact points.
PcpContact = ^cpContact;
cpContact = packed record
p : cpVect;// Contact point.
n : cpVect;// Contact point normal.
dist : cpFloat;// Penetration distance.
r1 : cpVect;// Calculated by cpArbiterPreStep.
r2 : cpVect;// Calculated by cpArbiterPreStep.
nMass : cpfloat;// Calculated by cpArbiterPreStep.
tMass : cpfloat;// Calculated by cpArbiterPreStep.
bounce : cpfloat;// Calculated by cpArbiterPreStep.
jnAcc : cpfloat;// Persistant contact information.
jtAcc : cpfloat;// Persistant contact information.
jBias : cpfloat;// Persistant contact information.
bias : cpfloat;// Persistant contact information.
hash : LongWord;// Hash value used to (mostly) uniquely identify a contact.
end;
cpContactArray = Array [0..32767] of cpContact;
PcpContactArray = ^cpContactArray;
// Data structure for tracking collisions between shapes.
PcpArbiter = ^cpArbiter;
cpArbiter = packed record
numContacts : integer;// Information on the contact points between the objects.
contacts : PcpContactArray;// Information on the contact points between the objects.
a : PcpShape;// The two shapes involved in the collision.
b : PcpShape;// The two shapes involved in the collision.
u : cpFloat;// Calculated by cpArbiterPreStep().
e : cpFloat;// Calculated by cpArbiterPreStep().
target_v : cpVect;// Calculated by cpArbiterPreStep().
stamp : integer;// Time stamp of the arbiter. (from cpSpace)
end;
PcpJoint = ^cpJoint;
cpJoint = packed record
cpType : integer;
a : PcpBody;
b : PcpBody;
preStep : procedure (joint : PcpJoint; const dt_inv : cpFloat);
applyImpulse : procedure (joint : PcpJoint);
tisJoint : pointer;
x,y : cpFloat;
end;
PcpPinJoint = ^cpPinJoint;
cpPinJoint = packed record
joint : cpJoint;
anchr1 : cpVect;
anchr2 : cpVect;
dist : cpFloat;
r1 : cpVect;
r2 : cpVect;
n : cpVect;
nMass : cpFloat;
jnAcc : cpFloat;
jBias : cpFloat;
bias : cpFloat;
end;
PcpSlideJoint = ^cpSlideJoint;
cpSlideJoint = packed record
joint : cpJoint;
anchr1 : cpVect;
anchr2 : cpVect;
min : cpFloat;
max : cpFloat;
r1 : cpVect;
r2 : cpVect;
n : cpVect;
nMass : cpFloat;
jnAcc : cpFloat;
jBias : cpFloat;
bias : cpFloat;
end;
PcpPivotJoint = ^cpPivotJoint;
cpPivotJoint = packed record
joint : cpJoint;
anchr1 : cpVect;
anchr2 : cpVect;
r1 : cpVect;
r2 : cpVect;
k1 : cpVect;
k2 : cpVect;
jAcc : cpVect;
jBias : cpVect;
bias : cpVect;
end;
PcpGrooveJoint = ^cpGrooveJoint;
cpGrooveJoint = packed record
joint : cpJoint;
grv_n : cpVect;
grv_a : cpVect;
grv_b : cpVect;
anchr2 : cpVect;
grv_tn : cpVect;
clamp : cpFloat;
r1 : cpVect;
r2 : cpVect;
k1 : cpVect;
k2 : cpVect;
jAcc : cpVect;
jBias : cpVect;
bias : cpVect;
end;
// User collision pair function.
TcpCollFunc = function (a : PcpShape; b : PcpShape; contacts : PcpContactArray; numContacts : integer; normal_coef : cpFloat; data : pointer): integer;
// Structure for holding collision pair function information.
// Used internally.
PcpCollPairFunc = ^cpCollPairFunc;
cpCollPairFunc = packed record
a : LongWord;
b : LongWord;
func : TcpCollFunc;
data : pointer;
end;
pcpCollFuncData=^cpCollFuncData;
cpCollFuncData = packed record
func :TcpCollFunc;
data:pointer;
end;
PcpSpace = ^cpSpace;
cpSpace = packed record
iterations : integer;// Number of iterations to use in the impulse solver.
gravity : cpVect;// Self explanatory.
damping : cpFloat;// Self explanatory.
stamp : integer;// Time stamp. Is incremented on every call to cpSpaceStep().
staticShapes : PcpSpaceHash;// The static and active shape spatial hashes.
activeShapes : PcpSpaceHash;// The static and active shape spatial hashes.
bodies : PcpArray;// List of bodies in the system.
arbiters : PcpArray;// List of active arbiters for the impulse solver.
contactSet : PcpHashSet;// Persistant contact set.
joints : PcpArray;// List of joints in the system.
collFuncSet : PcpHashSet;// Set of collisionpair functions.
defaultPairFunc : cpCollPairFunc;// Default collision pair function.
end;
// Iterator function for iterating the bodies in a space.
TcpSpaceBodyIterator = procedure (body : PcpBody; data : pointer); //maybe a procedure
TcpCollisionFunc=function (a,b:pcpShape; var contact:PcpContactArray):integer;
PcpCollisionFuncArray = ^TcpCollisionFuncArray;
TcpCollisionFuncArray = Array [0..32767] of TcpCollisionFunc;
// *****************************************************************************************************************************
//
// main functions
//
// *****************************************************************************************************************************
function calloc(Num,ElemSize : integer) : pointer; overload;{$IFDEF INLINE}inline;{$ENDIF}
function calloc(Size : integer) : pointer; overload;{$IFDEF INLINE}inline;{$ENDIF}
procedure cfree(p : pointer); {$IFDEF INLINE}inline;{$ENDIF}
function malloc(Num,ElemSize : integer) : pointer; overload;{$IFDEF INLINE}inline;{$ENDIF}
function malloc(Size : integer) : pointer; overload;{$IFDEF INLINE}inline;{$ENDIF}
function CP_HASH_PAIR(A, B :LongWord):LongWord; overload;{$IFDEF INLINE}inline;{$ENDIF}
function CP_HASH_PAIR(A, B :pointer):LongWord; overload;{$IFDEF INLINE}inline;{$ENDIF}
function CP_HASH_PAIR(A: Longword; B :pointer):LongWord; overload;{$IFDEF INLINE}inline;{$ENDIF}
function CP_HASH_PAIR(A: Pointer; B :Longword):LongWord; overload;{$IFDEF INLINE}inline;{$ENDIF}
procedure cpInitChipmunk;
procedure cpShutdownChipmunk;
procedure cpAddColFunc(a, b:cpShapeType; func:TCPCollisionFunc);
procedure cpInitCollisionFuncs;
function cpMomentForCircle(const m,r1,r2 : cpFloat; const offset : cpVect) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpMomentForPoly(const m : cpFloat; numVerts : integer; verts : PcpVectArray; const offset : cpVect) : cpFloat;
// math functions
function cpfmax(const a : cpFloat; const b : cpFloat) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpfmin(const a : cpFloat; const b : cpFloat) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
// *****************************************************************************************************************************
//
// Vect functions
//
// *****************************************************************************************************************************
function cpv(const x : cpFloat; const y : cpFloat):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvadd(const v1 : cpVect; const v2 : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvneg(const v : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvsub(const v1 : cpVect; const v2 : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvmult(const v : cpVect; const s : cpFloat):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvdot(const v1 : cpVect; const v2 : cpVect):cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpvcross(const v1 : cpVect; const v2 : cpVect):cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpvperp(const v : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvrperp(const v : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvproject(const v1 : cpVect; const v2 : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvrotate(const v1 : cpVect; const v2 : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvunrotate(const v1 : cpVect; const v2 : cpVect):cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvforangle(const a : cpFloat) : cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvtoangle(const v : cpVect) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpvlength(const v : cpVect) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpvdist(const v1,v2 : cpVect) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpvdistsq(const v1,v2 : cpVect) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpvlengthsq(const v : cpVect) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
function cpvnormalize(const v : cpVect) : cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpvstr(const v : cpVect) : string; {$IFDEF INLINE}inline;{$ENDIF}
function cpvEqual(const v1,v2 : cpVect) : boolean; {$IFDEF INLINE}inline;{$ENDIF}
function modf(const a,b: cpFloat) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
// *****************************************************************************************************************************
//
// BB functions
//
// *****************************************************************************************************************************
function cpBBNew (const l : cpFloat; const b : cpFloat; const r : cpFloat; const t : cpFloat):cpBB; {$IFDEF INLINE}inline;{$ENDIF}
function cpBBintersects(const a : cpBB; const b : cpBB):integer; {$IFDEF INLINE}inline;{$ENDIF}
function cpBBcontainsBB(const bb : cpBB; const other : cpBB):integer; {$IFDEF INLINE}inline;{$ENDIF}
function cpBBcontainsVect(const bb : cpBB; const v : cpVect):integer; {$IFDEF INLINE}inline;{$ENDIF}
function cpBBClampVect(const bb : cpBB; const v : cpVect) : cpVect; {$IFDEF INLINE}inline;{$ENDIF}
function cpBBWrapVect(const bb : cpBB; const v : cpVect) : cpVect; {$IFDEF INLINE}inline;{$ENDIF}
// *****************************************************************************************************************************
//
// Body functions
//
// *****************************************************************************************************************************
// Basic allocation/destruction functions
function cpBodyAlloc() : PcpBody;
function cpBodyInit( body : PcpBody; const m : cpFloat; const i : cpFloat) : PcpBody;
function cpBodyNew( const m : cpFloat; const i : cpFloat) : PcpBody;
procedure cpBodyDestroy( body : PcpBody);
procedure cpBodyFree( body : PcpBody);
// Setters for some of the special properties (mandatory!)
procedure cpBodySetMass( body : PcpBody; const m : cpFloat);
procedure cpBodySetMoment( body : PcpBody; const i : cpFloat);
procedure cpBodySetAngle( body : PcpBody; const a : cpFloat);
// Modify the velocity of an object so that it will
procedure cpBodySlew( body : PcpBody; const pos : cpVect; const dt : cpFloat);
// Integration functions.
procedure cpBodyUpdateVelocity( body : PcpBody; const gravity : cpVect; const damping : cpFloat; const dt : cpFloat);
procedure cpBodyUpdatePosition( body : PcpBody; const dt : cpFloat);
// Convert body local to world coordinates
function cpBodyLocal2World( body : PcpBody; const v : cpVect):cpVect;
// Convert world to body local coordinates
function cpBodyWorld2Local( body : PcpBody; const v : cpVect):cpVect;
// Apply an impulse (in world coordinates) to the body.
procedure cpBodyApplyImpulse( body : PcpBody; const j : cpVect; const r : cpVect);
// Not intended for external use. Used by cpArbiter.c and cpJoint.c.
procedure cpBodyApplyBiasImpulse( body : PcpBody; const j : cpVect; const r : cpVect);
// Zero the forces on a body.
procedure cpBodyResetForces( body : PcpBody);
// Apply a force (in world coordinates) to a body.
procedure cpBodyApplyForce( body : PcpBody; const f : cpVect; const r : cpVect);
// Apply a damped spring force between two bodies.
procedure cpDampedSpring( a : PcpBody; b : PcpBody; const anchr1 : cpVect; const anchr2 : cpVect; const rlen : cpFloat; const k : cpFloat; const dmp : cpFloat; const dt : cpFloat);
// *****************************************************************************************************************************
//
// Array functions
//
// *****************************************************************************************************************************
// NOTE: cpArray is rarely used and will probably go away.
function cpArrayAlloc() : PcpArray;
function cpArrayInit( arr : PcpArray; size :integer) : PcpArray;
function cpArrayNew( size :integer) : PcpArray;
procedure cpArrayDestroy( arr : PcpArray );
procedure cpArrayFree( arr : PcpArray );
procedure cpArrayPush( arr : PcpArray; cpobject : pointer );
procedure cpArrayDeleteIndex( arr : PcpArray; index :integer);
procedure cpArrayDeleteObj( arr : PcpArray; obj : pointer );
procedure cpArrayEach( arr : PcpArray; iterFunc : TcpArrayIter; data : pointer );
function cpArrayContains( arr : PcpArray; ptr : pointer ) : integer;
// *****************************************************************************************************************************
//
// HashSet functions
//
// *****************************************************************************************************************************
// cpHashSet uses a chained hashtable implementation.
// Other than the transformation functions, there is nothing fancy going on.
// Basic allocation/destruction functions.
function cpHashSetAlloc : PcpHashSet;
function cpHashSetInit( cpset : PcpHashSet; size : integer; eqlFunc : TcpHashSetEqlFunc; trans : TcpHashSetTransFunc) : PcpHashSet;
function cpHashSetNew( size : integer; eqlFunc : TcpHashSetEqlFunc; trans : TcpHashSetTransFunc) : PcpHashSet;
procedure cpHashSetDestroy( cpset : PcpHashSet);
procedure cpHashSetFree( cpset : PcpHashSet);
function cpHashSetIsFull( cpset : PcpHashSet) : boolean;
procedure cpHashSetResize( cpset : PcpHashSet );
// Insert an element into the set, returns the element.
// If it doesn't already exist, the transformation function is applied.
function cpHashSetInsert( cpset : PcpHashSet; hash : LongWord; ptr : pointer; data : pointer) : pointer;
// Remove and return an element from the set.
function cpHashSetRemove( cpset : PcpHashSet; hash : LongWord; ptr : pointer) : pointer;
// Find an element in the set. Returns the default value if the element isn't found.
function cpHashSetFind( cpset : PcpHashSet; hash : LongWord; ptr : pointer) : pointer;
// Iterate over a hashset.
procedure cpHashSetEach( cpset : PcpHashSet; func : TcpHashSetIterFunc; data : pointer);
// Iterate over a hashset while rejecting certain elements.
procedure cpHashSetReject( cpset : PcpHashSet; func : TcpHashSetRejectFunc; data : pointer);
// *****************************************************************************************************************************
//
// SpaceHash functions
//
// *****************************************************************************************************************************
//Basic allocation/destruction functions.
function cpHandleAlloc:pcpHandle;
function cpHandleInit(hand:pcpHandle; obj:pointer):pcpHandle;
function cpHandleNew(obj:pointer):pcpHandle;
procedure cphandleFreeWrap(elt:pointer; unused:pointer);
procedure cpHandleRetain(hand:pcpHandle); {$IFDEF INLINE}inline;{$ENDIF}
procedure cpHandleFree(hand:pcpHandle); {$IFDEF INLINE}inline;{$ENDIF}
procedure cpHandleRelease(hand:pcpHandle); {$IFDEF INLINE}inline;{$ENDIF}
procedure cpClearHashCell(hash:pcpSpaceHash; index:integer); {$IFDEF INLINE}inline;{$ENDIF}
procedure cpfreeBins(hash:pcpSpaceHash);
procedure cpClearHash(hash:pcpSpaceHash);
procedure cpSpaceHashAllocTable(hash:pcpSpaceHash; numcells: integer);
function cpSpaceHashAlloc() : PcpSpaceHash;
function cpSpaceHashInit( hash : PcpSpaceHash; celldim : cpFloat; numcells : integer; bbfunc : TcpSpaceHashBBFunc) : PcpSpaceHash;
function cpSpaceHashNew( celldim : cpFloat; cells : integer; bbfunc : TcpSpaceHashBBFunc) : PcpSpaceHash;
procedure cpSpaceHashDestroy( hash : PcpSpaceHash);
procedure cpSpaceHashFree( hash : PcpSpaceHash);
function cpContainsHandle(bin:pcpSpaceHashBin; hand:pcpHandle):integer; {$IFDEF INLINE}inline;{$ENDIF}
function getEmptyBin(hash:pcpSpaceHash) :pcpSpaceHashBin; {$IFDEF INLINE}inline;{$ENDIF}
function cphash_func(x:LongWord; y:LongWord; n:LongWord) :LongWord; {$IFDEF INLINE}inline;{$ENDIF}
procedure cphashHandle(hash:pcpSpaceHash; hand:pcpHandle;bb:cpBB); {$IFDEF INLINE}inline;{$ENDIF}
// Resize the hashtable. (Does not rehash! You must call cpSpaceHashRehash() if needed.)
procedure cpSpaceHashResize( hash : PcpSpaceHash; celldim : cpFloat; numcells: Integer);
// Add an object to the hash.
procedure cpSpaceHashInsert( hash : PcpSpaceHash; obj : pointer; id : LongWord; bb : cpBB);
// Remove an object from the hash.
procedure cpSpaceHashRemove( hash : PcpSpaceHash; obj : pointer; id : LongWord);
// Iterate over the objects in the hash.
procedure cpSpaceHashEach( hash : PcpSpaceHash; func : TcpSpaceHashIterator; data : pointer);
// Rehash the contents of the hash.
procedure cpSpaceHashRehash( hash : PcpSpaceHash);
// Rehash only a specific object.
procedure cpSpaceHashRehashObject( hash : PcpSpaceHash; obj : pointer; id : LongWord);
// Query the hash for a given BBox.
procedure cpSpaceHashQuery( hash : PcpSpaceHash; obj : pointer; bb : cpBB; func : TcpSpaceHashQueryFunc; data : pointer);
// Rehashes while querying for each object. (Optimized case)
procedure cpSpaceHashQueryRehash( hash : PcpSpaceHash; func : TcpSpaceHashQueryFunc; data : pointer);
// *****************************************************************************************************************************
//
// Shape functions
//
// *****************************************************************************************************************************
// For determinism, you can reset the shape id counter.
procedure cpResetShapeIdCounter;
// Low level shape initialization func.
function cpShapeInit( const shape : PcpShape; const cptype : cpShapeType; const body : PcpBody) : PcpShape;
// Basic destructor functions. (allocation functions are not shared)
procedure cpShapeDestroy( const shape : PcpShape);
procedure cpShapeFree( const shape : PcpShape);
// Cache the BBox of the shape.
function cpShapeCacheBB( const shape : PcpShape) : cpBB;
function bbFromCircle(const c:cpVect;const r:cpFloat ) :cpBB; {$IFDEF INLINE}inline;{$ENDIF}
// Basic allocation functions for cpCircleShape.
function cpCircleShapeCacheData(shape : PcpShape; const p : cpVect; const rot : cpVect):cpBB;
function cpCircleShapeAlloc() : PcpCircleShape;
function cpCircleShapeInit( const circle : PcpCircleShape; const body : PcpBody; const radius : cpFloat; const offset : cpVect) : PcpCircleShape;
function cpCircleShapeNew( const body : PcpBody; const radius : cpFloat; const offset : cpVect) : PcpShape;
// Basic allocation functions for cpSegmentShape.
function cpSegmentShapeCacheData(shape:pcpShape; const p:cpVect; const rot:cpVect):cpBB;
function cpSegmentShapeAlloc() : PcpSegmentShape;
function cpSegmentShapeInit( const seg : PcpSegmentShape; const body : PcpBody; const a : cpVect; const b : cpVect; const r : cpFloat) : PcpSegmentShape;
function cpSegmentShapeNew( const body : PcpBody; const a : cpVect; const b : cpVect; const r : cpFloat) : PcpShape;
// *****************************************************************************************************************************
//
// PolyShape functions
//
// *****************************************************************************************************************************
// Basic allocation functions.
procedure cpPolyShapeTransformAxes(poly:pcpPolyShape; p:cpVect; rot:cpVect);
procedure cpPolyShapeTransformVerts(poly:pcpPolyShape; const p:cpVect; const rot:cpVect);
function cpPolyShapeCacheData(shape:pcpShape; const p:cpVect; const rot:cpVect) :cpBB;
function cpIsPolyConvex(verts : pcpVectArray; numVerts : integer) : boolean;
procedure cpPolyShapeDestroy(shape:pcpShape);
function cpPolyShapeAlloc : PcpPolyShape;
function cpPolyShapeInit( poly : PcpPolyShape; body : PcpBody; numVerts : integer; verts : PcpVectArray; const offset : cpVect; assumeConvex : boolean = true) : PcpPolyShape;
function cpPolyShapeNew( body : PcpBody; numVerts : integer; verts : PcpVectArray; const offset : cpVect) : PcpShape;
// Returns the minimum distance of the polygon to the axis.
function cpPolyShapeValueOnAxis( const poly : PcpPolyShape; const n : cpVect; const d : cpFloat) : cpFloat; {$IFDEF INLINE}inline;{$ENDIF}
// Returns true if the polygon contains the vertex.
function cpPolyShapeContainsVert( const poly : PcpPolyShape; const v : cpVect) : integer; {$IFDEF INLINE}inline;{$ENDIF}
// *****************************************************************************************************************************
//
// Arbiter functions
//
// *****************************************************************************************************************************
// Contacts are always allocated in groups.
function cpContactInit( con : PcpContact; const p : cpVect; const n : cpVect; const dist : cpFloat; const hash : LongWord ) : PcpContact;
// Sum the contact impulses. (Can be used after cpSpaceStep() returns)
function cpContactsSumImpulses( contacts : PcpContactArray; const numContacts :integer) : cpVect;
function cpContactsSumImpulsesWithFriction( contacts : PcpContactArray; const numContacts :integer) : cpVect;
// Basic allocation/destruction functions.
function cpArbiterAlloc() : PcpArbiter;
function cpArbiterInit( arb : PcpArbiter; a : PcpShape; b : PcpShape; stamp :integer) : PcpArbiter;
function cpArbiterNew( a : PcpShape; b : PcpShape; stamp :integer) : PcpArbiter;
procedure cpArbiterDestroy( arb : PcpArbiter );
procedure cpArbiterFree( arb : PcpArbiter );
procedure cpFreeArbiters( space : pcpspace);
// These functions are all intended to be used internally.
// Inject new contact points into the arbiter while preserving contact history.
procedure cpArbiterInject( arb : PcpArbiter; var contacts : PcpContactArray; const numContacts :integer);
// Precalculate values used by the solver.
procedure cpArbiterPreStep( arb : PcpArbiter; const dt_inv : cpFloat );
// Run an iteration of the solver on the arbiter.
procedure cpArbiterApplyImpulse( arb : PcpArbiter );
// *****************************************************************************************************************************
//
// Collision functions
//
// *****************************************************************************************************************************
// Collides two cpShape structures. (this function is lonely :( )
function cpAddContactPoint(var arr:PcpContactArray; var max, num:integer) :pcpContact;
function cpCollideShapes( a : PcpShape; b : PcpShape; var arr : PcpContactArray) : integer;
// *****************************************************************************************************************************
//
// Joint functions
//
// *****************************************************************************************************************************
procedure cpJointDestroy( joint : PcpJoint);
procedure cpJointFree( joint : PcpJoint);
function cpPinJointAlloc : PcpPinJoint;
function cpPinJointReInit( joint : PcpPinJoint; a : PcpBody; b : PcpBody; anchr1 : cpVect; anchr2 : cpVect) : PcpPinJoint;
function cpPinJointInit( joint : PcpPinJoint; a : PcpBody; b : PcpBody; const anchr1 : cpVect; const anchr2 : cpVect) : PcpPinJoint;
function cpPinJointNew( a : PcpBody; b : PcpBody; const anchr1 : cpVect; const anchr2 : cpVect) : PcpJoint;
function cpSlideJointAlloc : PcpSlideJoint;
function cpSlideJointReInit( joint : PcpSlideJoint; a : PcpBody; b : PcpBody; anchr1 : cpVect; anchr2 : cpVect; min : cpFloat; max : cpFloat) : PcpSlideJoint;
function cpSlideJointInit( joint : PcpSlideJoint; a : PcpBody; b : PcpBody; const anchr1 : cpVect; const anchr2 : cpVect; const min : cpFloat; const max : cpFloat) : PcpSlideJoint;
function cpSlideJointNew( a : PcpBody; b : PcpBody; const anchr1 : cpVect; const anchr2 : cpVect; const min : cpFloat; const max : cpFloat) : PcpJoint;
function cpPivotJointAlloc() : PcpPivotJoint;
function cpPivotJointReInit( joint : PcpPivotJoint; a : PcpBody; b : PcpBody; pivot : cpVect) : PcpPivotJoint;
function cpPivotJointInit( joint : PcpPivotJoint; a : PcpBody; b : PcpBody; const pivot : cpVect) : PcpPivotJoint;
function cpPivotJointNew( a : PcpBody; b : PcpBody; const pivot : cpVect) : PcpJoint;
function cpGrooveJointAlloc : PcpGrooveJoint;
function cpGrooveJointReInit( joint : PcpGrooveJoint; a : PcpBody; b : PcpBody; groove_a : cpVect; groove_b : cpVect; anchr2 : cpVect) : PcpGrooveJoint;
function cpGrooveJointInit( joint : PcpGrooveJoint; a : PcpBody; b : PcpBody; const groove_a : cpVect; const groove_b : cpVect; const anchr2 : cpVect) : PcpGrooveJoint;
function cpGrooveJointNew( a : PcpBody; b : PcpBody; const groove_a : cpVect; const groove_b : cpVect; const anchr2 : cpVect) : PcpJoint;
// *****************************************************************************************************************************
//
// Space functions
//
// *****************************************************************************************************************************
// Basic allocation/destruction functions.
function cpSpaceAlloc : PcpSpace;
function cpSpaceInit( space : PcpSpace) : PcpSpace;
function cpSpaceNew : PcpSpace;
procedure cpSpaceClearArbiters ( space : PcpSpace);
procedure cpSpaceDestroy( space : PcpSpace);
procedure cpSpaceFree( space : PcpSpace);
// Convenience function. Frees all referenced entities. (bodies, shapes and joints)
procedure cpSpaceFreeChildren( space : PcpSpace);
// Collision pair function management functions.
procedure cpSpaceAddCollisionPairFunc( space : PcpSpace; a : LongWord; b : LongWord; func : TcpCollFunc; data : pointer);
procedure cpSpaceRemoveCollisionPairFunc( space : PcpSpace; a : LongWord; b : LongWord);
procedure cpSpaceSetDefaultCollisionPairFunc( space : PcpSpace; func : TcpCollFunc; data : pointer);
function cpContactSetReject(ptr : pointer; data : pointer) : integer;
// Add and remove entities from the system.
procedure cpSpaceAddShape( space : PcpSpace; shape : PcpShape);
procedure cpSpaceAddStaticShape( space : PcpSpace; shape : PcpShape);
procedure cpSpaceAddBody( space : PcpSpace; body : PcpBody);
procedure cpSpaceAddJoint( space : PcpSpace; joint : PcpJoint);
procedure cpSpaceRemoveShape( space : PcpSpace; shape : PcpShape);
procedure cpSpaceRemoveStaticShape( space : PcpSpace; shape : PcpShape);
procedure cpSpaceRemoveBody( space : PcpSpace; body : PcpBody);
procedure cpSpaceRemoveJoint( space : PcpSpace; joint : PcpJoint);
procedure cpSpaceEachBody( space : PcpSpace; func : TcpSpaceBodyIterator; data : pointer);
// Spatial hash management functions.
procedure cpSpaceResizeStaticHash( space : PcpSpace; dim : cpFloat; count : Integer);
procedure cpSpaceResizeActiveHash( space : PcpSpace; dim : cpFloat; count : Integer);
procedure cpUpdateBBCache(ptr:pointer;unused:pointer);
procedure cpSpaceRehashStatic( space : PcpSpace);
// Update the space.
function cpQueryFunc(p1:pointer; p2:pointer; data:pointer) : integer;
function cpQueryReject(a:pcpShape; b:pcpShape) : integer;{$IFDEF INLINE}inline;{$ENDIF}
procedure cpSpaceStep( space : PcpSpace; dt : cpFloat);
function cpTotalBodies : integer;
function cpTotalShapes : integer;
function cpTotalArbiters : integer;
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
implementation
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
const primes :array[0..29] of integer = (
5, //2^2 + 1
11, //2^3 + 3
17, //2^4 + 1
37, //2^5 + 5
67, //2^6 + 3
131, //2^7 + 3
257, //2^8 + 1
521, //2^9 + 9
1031, //2^10 + 7
2053, //2^11 + 5
4099, //2^12 + 3
8209, //2^13 + 17
16411, //2^14 + 27
32771, //2^15 + 3
65537, //2^16 + 1
131101, //2^17 + 29
262147, //2^18 + 3
524309, //2^19 + 21
1048583, //2^20 + 7
2097169, //2^21 + 17
4194319, //2^22 + 15
8388617, //2^23 + 9
16777259, //2^24 + 43
33554467, //2^25 + 35
67108879, //2^26 + 15
134217757, //2^27 + 29
268435459, //2^28 + 3
536870923, //2^29 + 11
1073741827, //2^30 + 3
0
);
var SHAPE_ID_COUNTER : integer=0;
NumBodies : integer=0;
NumShapes : integer=0;
NumArbiters : integer=0;
cpColfuncs : PcpCollisionFuncArray = nil;
// *****************************************************************************************************************************
//
// main functions
//
// *****************************************************************************************************************************
function cpTotalBodies : integer;
begin
result:=NumBodies;
end;
function cpTotalShapes : integer;
begin
result:=NumShapes;
end;
function cpTotalArbiters : integer;
begin
result:=NumArbiters;
end;
function calloc(Size : integer) : pointer;
begin
getmem(result,size);
fillchar(result^,size,0);
end;
function calloc(Num,ElemSize : integer) : pointer;
begin
result:=calloc(num*ElemSize);
end;
procedure cfree(p : pointer);
begin
if assigned(p) then freemem(p);
end;
function malloc(Size : integer) : pointer;
begin
getmem(result,size);
end;
function malloc(Num,ElemSize : integer) : pointer;
begin
result:=malloc(num*ElemSize);
end;
function CP_HASH_PAIR(A, B :LongWord):LongWord;
begin
result:=(A*CP_HASH_COEF) xor (B*CP_HASH_COEF);
end;
function CP_HASH_PAIR(A, B :pointer):LongWord;
begin
result:=CP_HASH_PAIR(cardinal(A), cardinal(B));
end;
function CP_HASH_PAIR(A: Longword; B :pointer):LongWord;
begin
result:=CP_HASH_PAIR(A, cardinal(B));
end;
function CP_HASH_PAIR(A: Pointer; B :Longword):LongWord;
begin
result:=CP_HASH_PAIR(cardinal(A), B);
end;
function cpfmax (const a : cpFloat; const b : cpFloat) : cpFloat;
begin
if a>b then
result:=a
else
result:=b;
end;
function cpfmin (const a : cpFloat; const b : cpFloat) : cpFloat;
begin
if a<b then
result:=a
else
result:=b;
end;
function cpAddContactPoint(var arr:PcpContactArray; var max, num:integer) :pcpContact;
begin
if not assigned(arr) then begin
// Allocate the array if it hasn't been done.
max := 2;
num := 0;
arr := calloc(max,sizeof(cpContact));
end else if (num = max) then begin
// Extend it if necessary.
max := max*2;
arr:=ReallocMemory(arr, max*sizeof(cpContact));
end;
result := @arr[num];
inc(num);
end;
// Add contact points for circle to circle collisions.
// Used by several collision tests.