← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/ptc/examples/mojo.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/ptc/examples/mojo.pp
 
1
{
 
2
Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
 
3
}
 
4
 
 
5
{
 
6
Mojo demo for OpenPTC 1.0 C++ API
 
7
Coded by Alex Evans and adapted to OpenPTC 1.0 by Glenn Fiedler
 
8
 
 
9
nasty code by alex "statix" evans for ptc. (c) copyright alex evans 1998
 
10
time... 02.00 am on 13/1/98.
 
11
have fun
 
12
it's my take on some classic light mask effect
 
13
it's raytracing through properly modelled fog with occlusion, multiple
 
14
shadow rays cast back to the light for each pixel ray, and erm, its
 
15
s l o w... but it looks nice don't it?
 
16
 
 
17
oh and fresnel fall off... or something
 
18
 
 
19
UNTESTED! ok?
 
20
 
 
21
define inv for interesting fx (not)
 
22
}
 
23
 
 
24
Program Mojo;
 
25
 
 
26
{$MODE objfpc}
 
27
 
 
28
Uses
 
29
  ptc, SysUtils;
 
30
 
 
31
{ $DEFINE INV}
 
32
 
 
33
Const
 
34
  SC = 12;
 
35
  MINSEGSIZE = 2.5;
 
36
  NSEG = 5;
 
37
  frandtab_seed : Uint16 = 54;
 
38
 
 
39
Var
 
40
  MaskMap : PUint8;
 
41
  frandtab : Array[0..65535] Of Uint16;
 
42
 
 
43
Type
 
44
  FVector = Object
 
45
{    Case Boolean Of
 
46
      False : (X, Y, Z : Single);
 
47
      True : (R, G, B : Single);}
 
48
    X, Y, Z : Single;
 
49
 
 
50
    Constructor Init;
 
51
    Constructor Init(_x, _y, _z : Single);
 
52
 
 
53
    Function Magnitude : Single;
 
54
    Function MagnitudeSq : Single;
 
55
    Procedure Normalise;
 
56
  End;
 
57
  FMatrix = Object
 
58
    Row : Array[0..2] Of FVector;
 
59
    Constructor Init;
 
60
    Constructor Init(a, b, c : FVector);
 
61
    Function Column0 : FVector;
 
62
    Function Column1 : FVector;
 
63
    Function Column2 : FVector;
 
64
    Procedure MakeXRot(theta : Single);
 
65
    Procedure MakeYRot(theta : Single);
 
66
    Procedure MakeZRot(theta : Single);
 
67
    Procedure MakeID;
 
68
    Function Transpose : FMatrix;
 
69
    Procedure TransposeInPlace;
 
70
    Procedure Normalise;
 
71
  End;
 
72
  PRay = ^TRay;
 
73
  TRay = Object
 
74
    mPosn : FVector;
 
75
    mDir : FVector;
 
76
    Constructor Init(Const p, d : FVector);
 
77
  End;
 
78
  VLight = Class(TObject)
 
79
    mAng : Single;
 
80
    mPosn : FVector;
 
81
    mTarget : FVector;
 
82
    mAxis : FMatrix;
 
83
    mCol : FVector;
 
84
 
 
85
    p, p2, _d : FVector; { temp space }
 
86
 
 
87
    Constructor Create(Const col : FVector);
 
88
    Procedure Move(Const q : FVector);
 
89
    Procedure MoveT(Const q : FVector);
 
90
    Procedure Update;
 
91
    Function Light(Const ray : TRay) : FVector;
 
92
    Function CalcLight(t : Single) : Single;
 
93
  End;
 
94
 
 
95
Constructor FVector.Init;
 
96
 
 
97
Begin
 
98
End;
 
99
 
 
100
Constructor FVector.Init(_x, _y, _z : Single);
 
101
 
 
102
Begin
 
103
  X := _x;
 
104
  Y := _y;
 
105
  Z := _z;
 
106
End;
 
107
 
 
108
Function FVector.Magnitude : Single;
 
109
 
 
110
Begin
 
111
  Magnitude := Sqrt(Sqr(X) + Sqr(Y) + Sqr(Z));
 
112
End;
 
113
 
 
114
Function FVector.MagnitudeSq : Single;
 
115
 
 
116
Begin
 
117
  MagnitudeSq := Sqr(X) + Sqr(Y) + Sqr(Z);
 
118
End;
 
119
 
 
120
Procedure FVector.Normalise;
 
121
 
 
122
Var
 
123
  l : Single;
 
124
 
 
125
Begin
 
126
  l := 1 / Magnitude;
 
127
  X *= l;
 
128
  Y *= l;
 
129
  Z *= l;
 
130
End;
 
131
 
 
132
Operator * (a, b : FVector) res : Single;
 
133
 
 
134
Begin
 
135
  res := a.X * b.X + a.Y * b.Y + a.Z * b.Z;
 
136
End;
 
137
 
 
138
Operator * (a : FVector; b : Single) res : FVector;
 
139
 
 
140
Begin
 
141
  res.X := a.X * b;
 
142
  res.Y := a.Y * b;
 
143
  res.Z := a.Z * b;
 
144
End;
 
145
 
 
146
Operator + (a, b : FVector) res : FVector;
 
147
 
 
148
Begin
 
149
  res.X := a.X + b.X;
 
150
  res.Y := a.Y + b.Y;
 
151
  res.Z := a.Z + b.Z;
 
152
End;
 
153
 
 
154
Operator - (a, b : FVector) res : FVector;
 
155
 
 
156
Begin
 
157
  res.X := a.X - b.X;
 
158
  res.Y := a.Y - b.Y;
 
159
  res.Z := a.Z - b.Z;
 
160
End;
 
161
 
 
162
Operator ** (a, b : FVector) res : FVector;
 
163
 
 
164
Begin
 
165
  res.X := a.Y * b.Z - a.Z * b.Y;
 
166
  res.Y := a.Z * b.X - a.X * b.Z;
 
167
  res.Z := a.X * b.Y - a.Y * b.X;
 
168
End;
 
169
 
 
170
Constructor FMatrix.Init;
 
171
 
 
172
Begin
 
173
End;
 
174
 
 
175
Constructor FMatrix.Init(a, b, c : FVector);
 
176
 
 
177
Begin
 
178
  Row[0] := a;
 
179
  Row[1] := b;
 
180
  Row[2] := c;
 
181
End;
 
182
 
 
183
Function FMatrix.Column0 : FVector;
 
184
 
 
185
Var
 
186
  res : FVector;
 
187
 
 
188
Begin
 
189
  res.Init(Row[0].X, Row[1].X, Row[2].X);
 
190
  Column0 := res;
 
191
End;
 
192
 
 
193
Function FMatrix.Column1 : FVector;
 
194
 
 
195
Var
 
196
  res : FVector;
 
197
 
 
198
Begin
 
199
  res.Init(Row[0].Y, Row[1].Y, Row[2].Y);
 
200
  Column1 := res;
 
201
End;
 
202
 
 
203
Function FMatrix.Column2 : FVector;
 
204
 
 
205
Var
 
206
  res : FVector;
 
207
 
 
208
Begin
 
209
  res.Init(Row[0].Z, Row[1].Z, Row[2].Z);
 
210
  Column2 := res;
 
211
End;
 
212
 
 
213
Procedure FMatrix.MakeXRot(theta : Single);
 
214
 
 
215
Var
 
216
  c, s : Single;
 
217
 
 
218
Begin
 
219
  c := cos(theta);
 
220
  s := sin(theta);
 
221
  Row[1].Y := c; Row[1].Z := s; Row[1].X := 0;
 
222
  Row[2].Y := -s; Row[2].Z := c; Row[2].X := 0;
 
223
  Row[0].Y := 0; Row[0].Z := 0; Row[0].X := 1;
 
224
End;
 
225
 
 
226
Procedure FMatrix.MakeYRot(theta : Single);
 
227
 
 
228
Var
 
229
  c, s : Single;
 
230
 
 
231
Begin
 
232
  c := cos(theta);
 
233
  s := sin(theta);
 
234
  Row[2].Z := c; Row[2].X := s; Row[2].Y := 0;
 
235
  Row[0].Z := -s; Row[0].X := c; Row[0].Y := 0;
 
236
  Row[1].Z := 0; Row[1].X := 0; Row[1].Y := 1;
 
237
End;
 
238
 
 
239
Procedure FMatrix.MakeZRot(theta : Single);
 
240
 
 
241
Var
 
242
  c, s : Single;
 
243
 
 
244
Begin
 
245
  c := cos(theta);
 
246
  s := sin(theta);
 
247
  Row[0].X := c; Row[0].Y := s; Row[0].Z := 0;
 
248
  Row[1].X := -s; Row[1].Y := c; Row[1].Z := 0;
 
249
  Row[2].X := 0; Row[2].Y := 0; Row[2].Z := 1;
 
250
End;
 
251
 
 
252
Procedure FMatrix.MakeID;
 
253
 
 
254
Begin
 
255
  Row[0].Init(1, 0, 0);
 
256
  Row[1].Init(0, 1, 0);
 
257
  Row[2].Init(0, 0, 1);
 
258
End;
 
259
 
 
260
Function FMatrix.Transpose : FMatrix;
 
261
 
 
262
Var
 
263
  res : FMatrix;
 
264
 
 
265
Begin
 
266
  res.Init(Column0, Column1, Column2);
 
267
  Transpose := res;
 
268
End;
 
269
 
 
270
Procedure FMatrix.TransposeInPlace;
 
271
 
 
272
Begin
 
273
  Init(Column0, Column1, Column2);
 
274
End;
 
275
 
 
276
Procedure FMatrix.Normalise;
 
277
 
 
278
Begin
 
279
  Row[2].Normalise;
 
280
  Row[0] := Row[1]**Row[2];
 
281
  Row[0].Normalise;
 
282
  Row[1] := Row[2]**Row[0];
 
283
  Row[1].Normalise;
 
284
End;
 
285
 
 
286
Operator * (Const m : FMatrix; Const a : Single) res : FMatrix;
 
287
 
 
288
Begin
 
289
  res.Init(m.Row[0]*a, m.Row[1]*a, m.Row[2]*a);
 
290
End;
 
291
 
 
292
Operator * (Const m, a : FMatrix) res : FMatrix;
 
293
 
 
294
Var
 
295
  v1, v2, v3 : FVector;
 
296
 
 
297
Begin
 
298
  v1.Init(m.Row[0].X*a.Row[0].X+m.Row[0].Y*a.Row[1].X+m.Row[0].Z*a.Row[2].X,
 
299
          m.Row[0].X*a.Row[0].Y+m.Row[0].Y*a.Row[1].Y+m.Row[0].Z*a.Row[2].Y,
 
300
          m.Row[0].X*a.Row[0].Z+m.Row[0].Y*a.Row[1].Z+m.Row[0].Z*a.Row[2].Z);
 
301
  v2.Init(m.Row[1].X*a.Row[0].X+m.Row[1].Y*a.Row[1].X+m.Row[1].Z*a.Row[2].X,
 
302
          m.Row[1].X*a.Row[0].Y+m.Row[1].Y*a.Row[1].Y+m.Row[1].Z*a.Row[2].Y,
 
303
          m.Row[1].X*a.Row[0].Z+m.Row[1].Y*a.Row[1].Z+m.Row[1].Z*a.Row[2].Z);
 
304
  v3.Init(m.Row[2].X*a.Row[0].X+m.Row[2].Y*a.Row[1].X+m.Row[2].Z*a.Row[2].X,
 
305
          m.Row[2].X*a.Row[0].Y+m.Row[2].Y*a.Row[1].Y+m.Row[2].Z*a.Row[2].Y,
 
306
          m.Row[2].X*a.Row[0].Z+m.Row[2].Y*a.Row[1].Z+m.Row[2].Z*a.Row[2].Z);
 
307
  res.Init(v1, v2, v3);
 
308
End;
 
309
 
 
310
Operator * (Const m : FMatrix; Const a : FVector) res : FVector;
 
311
 
 
312
Begin
 
313
  res.Init(a*m.Row[0], a*m.Row[1], a*m.Row[2]);
 
314
End;
 
315
 
 
316
Operator + (Const m, a : FMatrix) res : FMatrix;
 
317
 
 
318
Begin
 
319
  res.Init(m.Row[0]+a.Row[0], m.Row[1]+a.Row[1], m.Row[2]+a.Row[2]);
 
320
End;
 
321
 
 
322
Operator - (Const m, a : FMatrix) res : FMatrix;
 
323
 
 
324
Begin
 
325
  res.Init(m.Row[0]+a.Row[0], m.Row[1]+a.Row[1], m.Row[2]+a.Row[2]);
 
326
End;
 
327
 
 
328
Constructor TRay.Init(Const p, d : FVector);
 
329
 
 
330
Begin
 
331
  mPosn := p;
 
332
  mDir := d;
 
333
  mDir.Normalise;
 
334
End;
 
335
 
 
336
Constructor VLight.Create(Const col : FVector);
 
337
 
 
338
Begin
 
339
  mCol := col * 0.9;
 
340
  mAng := 2.8;
 
341
  mPosn.Init(0, 0, 20);
 
342
  mTarget.Init(0, 0, 0.1);
 
343
  mAxis.MakeID;
 
344
  Update;
 
345
End;
 
346
 
 
347
Procedure VLight.Move(Const q : FVector);
 
348
 
 
349
Begin
 
350
  mPosn := q;
 
351
  Update;
 
352
End;
 
353
 
 
354
Procedure VLight.MoveT(Const q : FVector);
 
355
 
 
356
Begin
 
357
  mTarget := q;
 
358
  Update;
 
359
End;
 
360
 
 
361
Procedure VLight.Update;
 
362
 
 
363
Begin
 
364
  mAxis.Row[2] := (mTarget - mPosn);
 
365
  mAxis.Normalise;
 
366
End;
 
367
 
 
368
Function VLight.Light(Const ray : TRay) : FVector;
 
369
 
 
370
Var
 
371
  f, A, B, C, D, t1, t2, t3, fr, l1, l2, t, h : Single;
 
372
  frc, x, y, q : Integer;
 
373
  pp : FVector;
 
374
  res : FVector;
 
375
 
 
376
Begin
 
377
  f := 0;
 
378
 
 
379
  p2 := ray.mPosn;
 
380
  p := mAxis * (ray.mPosn - mPosn);
 
381
  _d := mAxis * ray.mDir;
 
382
  A := (_d.X*_d.X+_d.Y*_d.Y);
 
383
  B := 2*(_d.X*p.X+_d.Y*p.Y)-mAng*(_d.Z);
 
384
  C := (p.X*p.X+p.Y*p.Y)-mAng*(p.Z);
 
385
  D := B*B-4*A*C;
 
386
  If D <= 0 Then
 
387
  Begin
 
388
    res.Init(0, 0, 0);
 
389
    Light := res;
 
390
    Exit;
 
391
  End;
 
392
  D := Sqrt(D);
 
393
  A *= 2;
 
394
  t1 := (-B-D)/A;
 
395
  t2 := (-B+D)/A;
 
396
  frc := 255;
 
397
  t3 := -ray.mPosn.Z/ray.mDir.Z;
 
398
  If t2<=0 Then
 
399
  Begin
 
400
    res.Init(0, 0, 0);
 
401
    Light := res;
 
402
    Exit;
 
403
  End;
 
404
  If t1<0 Then
 
405
    t1 := 0;
 
406
  If t3>0 Then
 
407
  Begin
 
408
    { clip to bitmap plane }
 
409
    pp := ray.mPosn + ray.mDir*t3;
 
410
    x := 160+Trunc(SC*pp.X);
 
411
{$IFNDEF INV}
 
412
    If (x>=0) And (x<=319) Then
 
413
    Begin
 
414
      y := 100 + Trunc(SC*pp.Y);
 
415
      If (y>=0) And (y<=199) Then
 
416
      Begin
 
417
        {res.Init(0, 0, 1);
 
418
        Light := res;
 
419
        Exit;}
 
420
        frc := MaskMap[y*320+x];
 
421
        If frc<1 Then
 
422
        Begin
 
423
          If t1>t3 Then
 
424
            t1 := t3;
 
425
          If t2>t3 Then
 
426
            t2 := t3;
 
427
        End;
 
428
      End
 
429
      Else
 
430
        t3 := t2
 
431
    End
 
432
    Else
 
433
      t3 := t2;
 
434
{$ELSE}
 
435
    If (x >= 0) And (x <= 319) Then
 
436
    Begin
 
437
      y := 100 + Trunc(SC*pp.Y);
 
438
      If (y >= 0) And (y <= 199) And (MaskMap[y*320 + x] < 128) Then
 
439
        t3 := t2;
 
440
    End;
 
441
    If t1 > t3 Then
 
442
      t1 := t3;
 
443
    If t2 > t3 Then
 
444
      t2 := t3;
 
445
{$ENDIF}
 
446
  End;
 
447
  If t1>=t2 Then
 
448
  Begin
 
449
    res.Init(0, 0, 0);
 
450
    Light := res;
 
451
    Exit;
 
452
  End;
 
453
  fr := frc/255;
 
454
  l1 := CalcLight(t1);
 
455
  If t1>t3 Then
 
456
    l1 *= fr;
 
457
  q := NSEG;
 
458
  t := t1;
 
459
  h := (t2-t1)/NSEG;
 
460
  If h<MINSEGSIZE Then
 
461
    h := MINSEGSIZE;
 
462
  While (t<t3) And (q>0) And (t<t2) Do
 
463
  Begin
 
464
    t += h;
 
465
    If (t>t2) Then
 
466
    Begin
 
467
      h -= t2-t;
 
468
      t := t2;
 
469
      q := 0;
 
470
    End
 
471
    Else
 
472
      Dec(q);
 
473
    h := (t-t1);
 
474
    p += _d*h;
 
475
    p2 += ray.mDir*h;
 
476
    l2 := CalcLight(t);
 
477
    f += (l1+l2)*h;
 
478
    l1 := l2;
 
479
    t1 := t;
 
480
  End;
 
481
  While (q>0) And (t<t2) Do
 
482
  Begin
 
483
    t += h;
 
484
    If t>t2 Then
 
485
    Begin
 
486
      h -= t2-t;
 
487
      t := t2;
 
488
      q := 0;
 
489
    End
 
490
    Else
 
491
      Dec(q);
 
492
    p += _d*h;
 
493
    p2 += ray.mDir*h;
 
494
    l2 := CalcLight(t);
 
495
    If t>t3 Then
 
496
      l2 *= fr;
 
497
    f += (l1+l2)*h;
 
498
    l1 := l2;
 
499
    t1 := t;
 
500
  End;
 
501
  Light := mCol*f;
 
502
End;
 
503
 
 
504
Function VLight.CalcLight(t : Single) : Single;
 
505
 
 
506
Var
 
507
  f : Single;
 
508
  x, y, c : Integer;
 
509
 
 
510
Begin
 
511
  { trace line to bitmap from mPosn to p2 }
 
512
  If Not ((mPosn.Z > 0) Xor (p2.Z > 0)) Then
 
513
  Begin
 
514
    { fresnel fall off... }
 
515
    CalcLight := p.Z / p.MagnitudeSq;
 
516
    Exit;
 
517
  End;
 
518
  f := -(mPosn.Z)/(p2.Z - mPosn.Z);
 
519
  x := 160 + Trunc(SC*((p2.X-mPosn.X)*f+mPosn.X));
 
520
{$IFNDEF INV}
 
521
  If (x < 0) Or (x > 319) Then
 
522
  Begin
 
523
    CalcLight := p.Z / p.MagnitudeSq;
 
524
    Exit;
 
525
  End;
 
526
  y := 100 + Trunc(SC*((p2.Y-mPosn.Y)*f+mPosn.Y));
 
527
  If (y < 0) Or (y > 199) Then
 
528
  Begin
 
529
    CalcLight := p.Z / p.MagnitudeSq;
 
530
    Exit;
 
531
  End;
 
532
  c := MaskMap[y * 320 + x];
 
533
{$ELSE}
 
534
  If (x < 0) Or (x > 319) Then
 
535
  Begin
 
536
    CalcLight := 0;
 
537
    Exit;
 
538
  End;
 
539
  y := 100 + Trunc(SC*((p2.Y-mPosn.Y)*f+mPosn.Y));
 
540
  If (y < 0) Or (y > 199) Then
 
541
  Begin
 
542
    CalcLight := 0;
 
543
    Exit;
 
544
  End;
 
545
  c := 255 - MaskMap[y * 320 + x];
 
546
{$ENDIF}
 
547
  If c = 0 Then
 
548
  Begin
 
549
    CalcLight := 0;
 
550
    Exit;
 
551
  End;
 
552
  CalcLight := (c*(1/255))*p.Z / p.MagnitudeSq;
 
553
End;
 
554
 
 
555
Function CLIPC(f : Single) : Integer; {Inline;}
 
556
 
 
557
Var
 
558
  a : Integer;
 
559
 
 
560
Begin
 
561
  a := Trunc(f * 255);
 
562
  If a < 0 Then
 
563
    a := 0
 
564
  Else
 
565
    If a > 255 Then
 
566
      a := 255;
 
567
  CLIPC := a;
 
568
End;
 
569
 
 
570
Procedure initfrand;
 
571
 
 
572
Var
 
573
  s, c1 : Integer;
 
574
 
 
575
Begin
 
576
  FillChar(frandtab, SizeOf(frandtab), 0);
 
577
  s := 1;
 
578
  For c1 := 1 To 65535 Do
 
579
  Begin
 
580
    frandtab[c1] := s And $FFFF;
 
581
    s := (((s Shr 4) Xor (s Shr 13) Xor (s Shr 15)) And 1) + (s Shl 1);
 
582
  End;
 
583
End;
 
584
 
 
585
Function frand : Integer; {Inline;}
 
586
 
 
587
Begin
 
588
  frand := frandtab[frandtab_seed];
 
589
  frandtab_seed := (frandtab_seed + 1) And $FFFF;
 
590
End;
 
591
 
 
592
Procedure VLightPart(console : TPTCConsole; surface : TPTCSurface);
 
593
 
 
594
Var
 
595
  vl, vl2 : VLight;
 
596
  camposn : FVector;
 
597
  camaxis : FMatrix;
 
598
  c1, c2, c3, ti, xx, yy, zz, i, a, x, y : Integer;
 
599
  idx : Array[0..(200 Div 16) - 1, 0..(320 Div 16) - 1] Of Uint8;
 
600
  order : Array[0..10*19 - 1, 0..1] Of Integer;
 
601
  vlightt, t, cz, camf : Single;
 
602
  col : FVector;
 
603
  ray : TRay;
 
604
  oc, c, c2_ : Uint32;
 
605
  time, delta : Single;
 
606
  pitch : Integer;
 
607
  screenbuf, pd : PUint8;
 
608
  tmp : FVector;
 
609
  F : File;
 
610
 
 
611
Begin
 
612
  oc := 0;
 
613
  initfrand;
 
614
  tmp.Init(0.1, 0.4, 1);
 
615
  vl := VLight.Create(tmp);
 
616
  tmp.Init(1, 0.5, 0.2);
 
617
  vl2 := VLight.Create(tmp);
 
618
  tmp.Init(0, 0, 20);
 
619
  vl.Move(tmp);
 
620
  tmp.Init(0, 6, 30);
 
621
  vl2.Move(tmp);
 
622
 
 
623
  camposn.Init(7, 0.5, -10);
 
624
  camaxis.Init;
 
625
  camaxis.MakeID;
 
626
  tmp.Init(0, 0, 0);
 
627
  camaxis.Row[2] := tmp - camposn;
 
628
  camaxis.Normalise;
 
629
  camf := 100;
 
630
 
 
631
  MaskMap := GetMem(320 * 200);
 
632
  FillChar(MaskMap^, 320 * 200, 0);
 
633
 
 
634
  { load mojo.raw }
 
635
  ASSign(F, 'mojo.raw');
 
636
  Reset(F, 1);
 
637
  BlockRead(F, MaskMap^, 320*200);
 
638
  Close(F);
 
639
 
 
640
  { build the order of the squares }
 
641
  For c1 := 0 To 10*19 - 1 Do
 
642
  Begin
 
643
    order[c1, 0] := c1 Mod 19;
 
644
    order[c1, 1] := (c1 Div 19) + 1;
 
645
  End;
 
646
 
 
647
  { swap them around }
 
648
  For c1 := 0 To 9999 Do
 
649
  Begin
 
650
    c2 := Random(190);
 
651
    c3 := Random(190);
 
652
    ti := order[c2, 0]; order[c2, 0] := order[c3, 0]; order[c3, 0] := ti;
 
653
    ti := order[c2, 1]; order[c2, 1] := order[c3, 1]; order[c3, 1] := ti;
 
654
  End;
 
655
 
 
656
  { time settings }
 
657
  time := 0;
 
658
  delta := 0.01; { this controls the speed of the effect }
 
659
 
 
660
  { main loop }
 
661
  While Not console.KeyPressed Do
 
662
  Begin
 
663
    { get surface data }
 
664
    pitch := surface.pitch;
 
665
 
 
666
    { light time (makes the effect loop) }
 
667
    vlightt := 320 * Abs(Sin(time/5));
 
668
    
 
669
    t := 13 - 0.1822 * vlightt;
 
670
    cz := 1 - 0.01 * vlightt;
 
671
    {tmp.Init(Sin(t)*5, Cos(t*-0.675+4543)*5, 15);
 
672
    vl.Move(tmp);
 
673
    tmp.Init(0, 0, -15);
 
674
    vl.Move(tmp);}
 
675
    tmp.Init(t, 0, 22);
 
676
    vl.Move(tmp);
 
677
    tmp.Init(-t, -7, 28);
 
678
    vl2.Move(tmp);
 
679
 
 
680
    camposn.Init(cz*4+9, cz, -t/7-13);
 
681
    tmp.Init(0, 0, 0);
 
682
    camaxis.Row[2] := tmp - camposn;
 
683
    camaxis.Normalise;
 
684
 
 
685
    FillChar(idx, SizeOf(idx), 25);
 
686
 
 
687
    { swap them around }
 
688
    For c1 := 0 To 99 Do
 
689
    Begin
 
690
      c2 := Random(190);
 
691
      c3 := Random(190);
 
692
      ti := order[c2, 0]; order[c2, 0] := order[c3, 0]; order[c3, 0] := ti;
 
693
      ti := order[c2, 1]; order[c2, 1] := order[c3, 1]; order[c3, 1] := ti;
 
694
    End;
 
695
    For zz := 0 To 189 Do
 
696
    Begin
 
697
      xx := order[zz, 0];
 
698
      yy := order[zz, 1];
 
699
      i := 0;
 
700
      
 
701
      { lock surface }
 
702
      screenbuf := surface.lock;
 
703
      Try
 
704
        c2 := idx[yy, xx] Shr 1;
 
705
        For c1 := 0 To c2 - 1 Do
 
706
        Begin
 
707
          a := frand And 255;
 
708
          x := xx * 16 + (a And 15) + 6 + 4;
 
709
          y := yy * 16 + (a Shr 4) + 6;
 
710
 
 
711
          col.Init(0, 0, 0);
 
712
          ray.Init(camposn, camaxis.Row[2]*camf+camaxis.Row[0]*(x-160)+camaxis.Row[1]*(y-100));
 
713
          col += vl.Light(ray);
 
714
          col += vl2.Light(ray);
 
715
 
 
716
          c := (CLIPC(col.X) Shl 16) + (CLIPC(col.Y) Shl 8) + (CLIPC(col.Z));
 
717
          pd := screenbuf + x*4 + y*pitch;
 
718
          Inc(i, Abs(Integer(c And 255)-Integer(pd[321] And 255)) + Abs(Integer(c Shr 16)-Integer(pd[321] Shr 16)));
 
719
          If c1 <> 0 Then
 
720
            Inc(i, Abs(Integer(c And 255)-Integer(oc And 255)) + Abs(Integer(c Shr 16)-Integer(oc Shr 16)));
 
721
          oc := c;
 
722
 
 
723
          c2_ := (c Shr 1) And $7F7F7F;
 
724
          PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
 
725
          PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
 
726
          Inc(pd, pitch);
 
727
          PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
 
728
          PUint32(pd)[1] := c;
 
729
          PUint32(pd)[2] := c;
 
730
          PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
 
731
          Inc(pd, pitch);
 
732
          PUint32(pd)[0] := ((PUint32(pd)[0]) Shr 1) And $7F7F7F+ c2_;
 
733
          PUint32(pd)[1] := c;
 
734
          PUint32(pd)[2] := c;
 
735
          PUint32(pd)[3] := ((PUint32(pd)[3]) Shr 1) And $7F7F7F+ c2_;
 
736
          Inc(pd, pitch);
 
737
          PUint32(pd)[1] := ((PUint32(pd)[1]) Shr 1) And $7F7F7F+ c2_;
 
738
          PUint32(pd)[2] := ((PUint32(pd)[2]) Shr 1) And $7F7F7F+ c2_;
 
739
        End;
 
740
        i *= 5;
 
741
        i := i Div (3*idx[yy, xx]);
 
742
        If i < 2 Then
 
743
          i := 2;
 
744
        If i > {256}255 Then
 
745
          i := {256}255;
 
746
        idx[yy, xx] := i;
 
747
      Finally
 
748
        { unlock surface }
 
749
        surface.unlock;
 
750
      End;
 
751
      
 
752
      If (zz Mod 95) = 0 Then
 
753
      Begin
 
754
        { copy surface to console }
 
755
        surface.copy(console);
 
756
        
 
757
        { update console }
 
758
        console.update;
 
759
      End;
 
760
    End;
 
761
    { update time }
 
762
    time += delta;
 
763
  End;
 
764
  FreeMem(MaskMap);
 
765
  vl.Free;
 
766
  vl2.Free;
 
767
End;
 
768
 
 
769
Var
 
770
  format : TPTCFormat;
 
771
  console : TPTCConsole;
 
772
  surface : TPTCSurface;
 
773
 
 
774
Begin
 
775
  format := Nil;
 
776
  surface := Nil;
 
777
  console := Nil;
 
778
  Try
 
779
    Try
 
780
      { create format }
 
781
      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
 
782
      
 
783
      { create console }
 
784
      console := TPTCConsole.Create;
 
785
      
 
786
      { open console }
 
787
      console.open('mojo by statix', 320, 200, format);
 
788
      
 
789
      { create main drawing surface }
 
790
      surface := TPTCSurface.Create(320, 200, format);
 
791
      
 
792
      { do the light effect }
 
793
      VLightPart(console, surface);
 
794
      
 
795
    Finally
 
796
      { close console }
 
797
      console.close;
 
798
      console.Free;
 
799
      surface.Free;
 
800
      format.Free;
 
801
    End;
 
802
    
 
803
    { print message to stdout }
 
804
    Writeln('mojo by alex "statix" evans');
 
805
    Writeln('to be used as an example of bad coding and good ptc');
 
806
    Writeln('no responsibility taken for this!');
 
807
    Writeln('enjoy ptc! it''s great');
 
808
    Writeln;
 
809
    Writeln('-statix 13/1/98');
 
810
  Except
 
811
    On error : TPTCError Do
 
812
      { report error }
 
813
      error.report;
 
814
  End;
 
815
End.