1 unit sdlutils;
2 {
3 $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $
4
5 }
6 {******************************************************************************}
7 { }
8 { Borland Delphi SDL - Simple DirectMedia Layer }
9 { SDL Utility functions }
10 { }
11 { }
12 { The initial developer of this Pascal code was : }
13 { Tom Jones <tigertomjones@gmx.de> }
14 { }
15 { Portions created by Tom Jones are }
16 { Copyright (C) 2000 - 2001 Tom Jones. }
17 { }
18 { }
19 { Contributor(s) }
20 { -------------- }
21 { Dominique Louis <Dominique@SavageSoftware.com.au> }
22 { R�bert Kisn�meth <mikrobi@freemail.hu> }
23 { }
24 { Obtained through: }
25 { Joint Endeavour of Delphi Innovators ( Project JEDI ) }
26 { }
27 { You may retrieve the latest version of this file at the Project }
28 { JEDI home page, located at http://delphi-jedi.org }
29 { }
30 { The contents of this file are used with permission, subject to }
31 { the Mozilla Public License Version 1.1 (the "License"); you may }
32 { not use this file except in compliance with the License. You may }
33 { obtain a copy of the License at }
34 { http://www.mozilla.org/MPL/MPL-1.1.html }
35 { }
36 { Software distributed under the License is distributed on an }
37 { "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
38 { implied. See the License for the specific language governing }
39 { rights and limitations under the License. }
40 { }
41 { Description }
42 { ----------- }
43 { Helper functions... }
44 { }
45 { }
46 { Requires }
47 { -------- }
48 { SDL.dll on Windows platforms }
49 { libSDL-1.1.so.0 on Linux platform }
50 { }
51 { Programming Notes }
52 { ----------------- }
53 { }
54 { }
55 { }
56 { }
57 { Revision History }
58 { ---------------- }
59 { 2000 - TJ : Initial creation }
60 { }
61 { July 13 2001 - DL : Added PutPixel and GetPixel routines. }
62 { }
63 { Sept 14 2001 - RK : Added flipping routines. }
64 { }
65 { Sept 19 2001 - RK : Added PutPixel & line drawing & blitting with ADD }
66 { effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }
67 { Added PSDLRect() }
68 { Sept 22 2001 - DL : Removed need for Windows.pas by defining types here}
69 { Also removed by poor attempt or a dialog box }
70 { }
71 { Sept 25 2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine, }
72 { SubSurface, MonoSurface & TexturedSurface }
73 { }
74 { Sept 26 2001 - DL : Made change so that it refers to native Pascal }
75 { types rather that Windows types. This makes it more}
76 { portable to Linix. }
77 { }
78 { Sept 27 2001 - RK : SDLUtils now can be compiled with FreePascal }
79 { }
80 { Oct 27 2001 - JF : Added ScrollY function }
81 { }
82 { Jan 21 2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface }
83 { }
84 { Mar 28 2002 - JF : Added SDL_RotateSurface }
85 { }
86 { May 13 2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub }
87 { }
88 { May 27 2002 - YS : GradientFillRect function }
89 { }
90 { May 30 2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit }
91 { & SDL_50Scanline2xBlit }
92 { }
93 { June 12 2002 - RK : Added SDL_PixelTestSurfaceVsRect }
94 { }
95 { June 12 2002 - JF : Updated SDL_PixelTestSurfaceVsRect }
96 { }
97 { November 9 2002 - JF : Added Jason's boolean Surface functions }
98 { }
99 { December 10 2002 - DE : Added Dean's SDL_ClipLine function }
100 { }
101 { April 26 2003 - SS : Incorporated JF's changes to SDL_ClipLine }
102 { Fixed SDL_ClipLine bug for non-zero cliprect x, y }
103 { Added overloaded SDL_DrawLine for dashed lines }
104 { }
105 {******************************************************************************}
106 {
107 $Log: sdlutils.pas,v $
108 Revision 1.5 2006/11/19 18:56:44 savage
109 Removed Hints and Warnings.
110
111 Revision 1.4 2004/06/02 19:38:53 savage
112 Changes to SDL_GradientFillRect as suggested by
113 �ngel Eduardo Garc�a Hern�ndez. Many thanks.
114
115 Revision 1.3 2004/05/29 23:11:54 savage
116 Changes to SDL_ScaleSurfaceRect as suggested by
117 �ngel Eduardo Garc�a Hern�ndez to fix a colour issue with the function. Many thanks.
118
119 Revision 1.2 2004/02/14 00:23:39 savage
120 As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
121
122 Revision 1.1 2004/02/05 00:08:20 savage
123 Module 1.0 release
124
125
126 }
127
128 interface
129
130 {$I jedi-sdl.inc}
131
132 uses
133 {$IFDEF UNIX}
134 Types,
135 {$IFNDEF DARWIN}
136 Xlib,
137 {$ENDIF}
138 {$ENDIF}
139 SysUtils,
140 sdl;
141
142 type
143 TGradientStyle = ( gsHorizontal, gsVertical );
144
145 // Pixel procedures
SDL_PixelTestnull146 function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
147 PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;
148
SDL_GetPixelnull149 function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
150
151 procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
152 Uint32 );
153
154 procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
155 cardinal );
156
157 procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
158 cardinal );
159
160 // Line procedures
161 procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
162 cardinal ); overload;
163
164 procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
165 cardinal; DashLength, DashSpace : byte ); overload;
166
167 procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
168 cardinal );
169
170 procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
171 cardinal );
172
173 // Surface procedures
174 procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
175 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
176
177 procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
178 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
179
180 procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
181 DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
182
183 procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
184 DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
185 TextureRect : PSDL_Rect );
186
187 procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
188
189 procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
190
191 // Flip procedures
192 procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
193
194 procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
195
PSDLRectnull196 function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
197
SDLRectnull198 function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;
199
SDLRectnull200 function SDLRect( aRect : TRect ) : TSDL_Rect; overload;
201
SDL_ScaleSurfaceRectnull202 function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
203 Width, Height : integer ) : PSDL_Surface;
204
205 procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
206
207 procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
208
209 procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
210 PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
211
212 procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
213 PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
214
ValidateSurfaceRectnull215 function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
216
217 // Fill Rect routine
218 procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
219
220 procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
221
222 procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
223
224 // NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!
225 procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
226
227 procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
228
229 procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
230
231 //
SDL_PixelTestSurfaceVsRectnull232 function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
233 PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
234 boolean;
235
236 // Jason's boolean Surface functions
237 procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
238 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
239
240 procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
241 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
242
243
244 procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
245 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
246
247 procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
248 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
249
250 function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
251
252 implementation
253
254 uses
255 Math;
256
257 function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
258 PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;
259 var
260 Src_Rect1, Src_Rect2 : TSDL_Rect;
261 right1, bottom1 : integer;
262 right2, bottom2 : integer;
263 Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
264 Mod1, Mod2 : cardinal;
265 Addr1, Addr2 : cardinal;
266 BPP : cardinal;
267 Pitch1, Pitch2 : cardinal;
268 TransparentColor1, TransparentColor2 : cardinal;
269 tx, ty : cardinal;
270 StartTick : cardinal;
271 Color1, Color2 : cardinal;
272 begin
273 Result := false;
274 if SrcRect1 = nil then
275 begin
276 with Src_Rect1 do
277 begin
278 x := 0;
279 y := 0;
280 w := SrcSurface1.w;
281 h := SrcSurface1.h;
282 end;
283 end
284 else
285 Src_Rect1 := SrcRect1^;
286 if SrcRect2 = nil then
287 begin
288 with Src_Rect2 do
289 begin
290 x := 0;
291 y := 0;
292 w := SrcSurface2.w;
293 h := SrcSurface2.h;
294 end;
295 end
296 else
297 Src_Rect2 := SrcRect2^;
298 with Src_Rect1 do
299 begin
300 Right1 := Left1 + w;
301 Bottom1 := Top1 + h;
302 end;
303 with Src_Rect2 do
304 begin
305 Right2 := Left2 + w;
306 Bottom2 := Top2 + h;
307 end;
308 if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=
309 Top2 ) then
310 exit;
311 if Left1 <= Left2 then
312 begin
313 // 1. left, 2. right
314 Scan1Start := Src_Rect1.x + Left2 - Left1;
315 Scan2Start := Src_Rect2.x;
316 ScanWidth := Right1 - Left2;
317 with Src_Rect2 do
318 if ScanWidth > w then
319 ScanWidth := w;
320 end
321 else
322 begin
323 // 1. right, 2. left
324 Scan1Start := Src_Rect1.x;
325 Scan2Start := Src_Rect2.x + Left1 - Left2;
326 ScanWidth := Right2 - Left1;
327 with Src_Rect1 do
328 if ScanWidth > w then
329 ScanWidth := w;
330 end;
331 with SrcSurface1^ do
332 begin
333 Pitch1 := Pitch;
334 Addr1 := cardinal( Pixels );
335 inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
336 with format^ do
337 begin
338 BPP := BytesPerPixel;
339 TransparentColor1 := colorkey;
340 end;
341 end;
342 with SrcSurface2^ do
343 begin
344 TransparentColor2 := format.colorkey;
345 Pitch2 := Pitch;
346 Addr2 := cardinal( Pixels );
347 inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );
348 end;
349 Mod1 := Pitch1 - ( ScanWidth * BPP );
350 Mod2 := Pitch2 - ( ScanWidth * BPP );
351 inc( Addr1, BPP * Scan1Start );
352 inc( Addr2, BPP * Scan2Start );
353 if Top1 <= Top2 then
354 begin
355 // 1. up, 2. down
356 ScanHeight := Bottom1 - Top2;
357 if ScanHeight > Src_Rect2.h then
358 ScanHeight := Src_Rect2.h;
359 inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
360 end
361 else
362 begin
363 // 1. down, 2. up
364 ScanHeight := Bottom2 - Top1;
365 if ScanHeight > Src_Rect1.h then
366 ScanHeight := Src_Rect1.h;
367 inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );
368 end;
369 case BPP of
370 1 :
371 for ty := 1 to ScanHeight do
372 begin
373 for tx := 1 to ScanWidth do
374 begin
375 if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>
376 TransparentColor2 ) then
377 begin
378 Result := true;
379 exit;
380 end;
381 inc( Addr1 );
382 inc( Addr2 );
383 end;
384 inc( Addr1, Mod1 );
385 inc( Addr2, Mod2 );
386 end;
387 2 :
388 for ty := 1 to ScanHeight do
389 begin
390 for tx := 1 to ScanWidth do
391 begin
392 if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>
393 TransparentColor2 ) then
394 begin
395 Result := true;
396 exit;
397 end;
398 inc( Addr1, 2 );
399 inc( Addr2, 2 );
400 end;
401 inc( Addr1, Mod1 );
402 inc( Addr2, Mod2 );
403 end;
404 3 :
405 for ty := 1 to ScanHeight do
406 begin
407 for tx := 1 to ScanWidth do
408 begin
409 Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
410 Color2 := PLongWord( Addr2 )^ and $00FFFFFF;
411 if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )
412 then
413 begin
414 Result := true;
415 exit;
416 end;
417 inc( Addr1, 3 );
418 inc( Addr2, 3 );
419 end;
420 inc( Addr1, Mod1 );
421 inc( Addr2, Mod2 );
422 end;
423 4 :
424 for ty := 1 to ScanHeight do
425 begin
426 for tx := 1 to ScanWidth do
427 begin
428 if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>
429 TransparentColor2 ) then
430 begin
431 Result := true;
432 exit;
433 end;
434 inc( Addr1, 4 );
435 inc( Addr2, 4 );
436 end;
437 inc( Addr1, Mod1 );
438 inc( Addr2, Mod2 );
439 end;
440 end;
441 end;
442
443 procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
444 cardinal );
445 var
446 SrcColor : cardinal;
447 Addr : cardinal;
448 R, G, B : cardinal;
449 begin
450 if Color = 0 then
451 exit;
452 with DstSurface^ do
453 begin
454 Addr := cardinal( Pixels ) + y * Pitch + x * format.BytesPerPixel;
455 SrcColor := PUInt32( Addr )^;
456 case format.BitsPerPixel of
457 8 :
458 begin
459 R := SrcColor and $E0 + Color and $E0;
460 G := SrcColor and $1C + Color and $1C;
461 B := SrcColor and $03 + Color and $03;
462 if R > $E0 then
463 R := $E0;
464 if G > $1C then
465 G := $1C;
466 if B > $03 then
467 B := $03;
468 PUInt8( Addr )^ := R or G or B;
469 end;
470 15 :
471 begin
472 R := SrcColor and $7C00 + Color and $7C00;
473 G := SrcColor and $03E0 + Color and $03E0;
474 B := SrcColor and $001F + Color and $001F;
475 if R > $7C00 then
476 R := $7C00;
477 if G > $03E0 then
478 G := $03E0;
479 if B > $001F then
480 B := $001F;
481 PUInt16( Addr )^ := R or G or B;
482 end;
483 16 :
484 begin
485 R := SrcColor and $F800 + Color and $F800;
486 G := SrcColor and $07C0 + Color and $07C0;
487 B := SrcColor and $001F + Color and $001F;
488 if R > $F800 then
489 R := $F800;
490 if G > $07C0 then
491 G := $07C0;
492 if B > $001F then
493 B := $001F;
494 PUInt16( Addr )^ := R or G or B;
495 end;
496 24 :
497 begin
498 R := SrcColor and $00FF0000 + Color and $00FF0000;
499 G := SrcColor and $0000FF00 + Color and $0000FF00;
500 B := SrcColor and $000000FF + Color and $000000FF;
501 if R > $FF0000 then
502 R := $FF0000;
503 if G > $00FF00 then
504 G := $00FF00;
505 if B > $0000FF then
506 B := $0000FF;
507 PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
508 end;
509 32 :
510 begin
511 R := SrcColor and $00FF0000 + Color and $00FF0000;
512 G := SrcColor and $0000FF00 + Color and $0000FF00;
513 B := SrcColor and $000000FF + Color and $000000FF;
514 if R > $FF0000 then
515 R := $FF0000;
516 if G > $00FF00 then
517 G := $00FF00;
518 if B > $0000FF then
519 B := $0000FF;
520 PUInt32( Addr )^ := R or G or B;
521 end;
522 end;
523 end;
524 end;
525
526 procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
527 cardinal );
528 var
529 SrcColor : cardinal;
530 Addr : cardinal;
531 R, G, B : cardinal;
532 begin
533 if Color = 0 then
534 exit;
535 with DstSurface^ do
536 begin
537 Addr := cardinal( Pixels ) + y * Pitch + x * format.BytesPerPixel;
538 SrcColor := PUInt32( Addr )^;
539 case format.BitsPerPixel of
540 8 :
541 begin
542 R := SrcColor and $E0 - Color and $E0;
543 G := SrcColor and $1C - Color and $1C;
544 B := SrcColor and $03 - Color and $03;
545 if R > $E0 then
546 R := 0;
547 if G > $1C then
548 G := 0;
549 if B > $03 then
550 B := 0;
551 PUInt8( Addr )^ := R or G or B;
552 end;
553 15 :
554 begin
555 R := SrcColor and $7C00 - Color and $7C00;
556 G := SrcColor and $03E0 - Color and $03E0;
557 B := SrcColor and $001F - Color and $001F;
558 if R > $7C00 then
559 R := 0;
560 if G > $03E0 then
561 G := 0;
562 if B > $001F then
563 B := 0;
564 PUInt16( Addr )^ := R or G or B;
565 end;
566 16 :
567 begin
568 R := SrcColor and $F800 - Color and $F800;
569 G := SrcColor and $07C0 - Color and $07C0;
570 B := SrcColor and $001F - Color and $001F;
571 if R > $F800 then
572 R := 0;
573 if G > $07C0 then
574 G := 0;
575 if B > $001F then
576 B := 0;
577 PUInt16( Addr )^ := R or G or B;
578 end;
579 24 :
580 begin
581 R := SrcColor and $00FF0000 - Color and $00FF0000;
582 G := SrcColor and $0000FF00 - Color and $0000FF00;
583 B := SrcColor and $000000FF - Color and $000000FF;
584 if R > $FF0000 then
585 R := 0;
586 if G > $00FF00 then
587 G := 0;
588 if B > $0000FF then
589 B := 0;
590 PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
591 end;
592 32 :
593 begin
594 R := SrcColor and $00FF0000 - Color and $00FF0000;
595 G := SrcColor and $0000FF00 - Color and $0000FF00;
596 B := SrcColor and $000000FF - Color and $000000FF;
597 if R > $FF0000 then
598 R := 0;
599 if G > $00FF00 then
600 G := 0;
601 if B > $0000FF then
602 B := 0;
603 PUInt32( Addr )^ := R or G or B;
604 end;
605 end;
606 end;
607 end;
608 // This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.
609 // In 8 bit color depth mode the procedure works with the default packed
610 // palette (RRRGGGBB). It handles all clipping.
611
612 procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
613 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
614 var
615 R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
616 Src, Dest : TSDL_Rect;
617 Diff : integer;
618 SrcAddr, DestAddr : cardinal;
619 WorkX, WorkY : word;
620 SrcMod, DestMod : cardinal;
621 Bits : cardinal;
622 begin
623 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
624 exit; // Remove this to make it faster
625 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
626 exit; // Remove this to make it faster
627 if SrcRect = nil then
628 begin
629 with Src do
630 begin
631 x := 0;
632 y := 0;
633 w := SrcSurface.w;
634 h := SrcSurface.h;
635 end;
636 end
637 else
638 Src := SrcRect^;
639 if DestRect = nil then
640 begin
641 Dest.x := 0;
642 Dest.y := 0;
643 end
644 else
645 Dest := DestRect^;
646 Dest.w := Src.w;
647 Dest.h := Src.h;
648 with DestSurface.Clip_Rect do
649 begin
650 // Source's right side is greater than the dest.cliprect
651 if Dest.x + Src.w > x + w then
652 begin
653 smallint( Src.w ) := x + w - Dest.x;
654 smallint( Dest.w ) := x + w - Dest.x;
655 if smallint( Dest.w ) < 1 then
656 exit;
657 end;
658 // Source's bottom side is greater than the dest.clip
659 if Dest.y + Src.h > y + h then
660 begin
661 smallint( Src.h ) := y + h - Dest.y;
662 smallint( Dest.h ) := y + h - Dest.y;
663 if smallint( Dest.h ) < 1 then
664 exit;
665 end;
666 // Source's left side is less than the dest.clip
667 if Dest.x < x then
668 begin
669 Diff := x - Dest.x;
670 Src.x := Src.x + Diff;
671 smallint( Src.w ) := smallint( Src.w ) - Diff;
672 Dest.x := x;
673 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
674 if smallint( Dest.w ) < 1 then
675 exit;
676 end;
677 // Source's Top side is less than the dest.clip
678 if Dest.y < y then
679 begin
680 Diff := y - Dest.y;
681 Src.y := Src.y + Diff;
682 smallint( Src.h ) := smallint( Src.h ) - Diff;
683 Dest.y := y;
684 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
685 if smallint( Dest.h ) < 1 then
686 exit;
687 end;
688 end;
689 with SrcSurface^ do
690 begin
691 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
692 Format.BytesPerPixel;
693 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
694 TransparentColor := Format.colorkey;
695 end;
696 with DestSurface^ do
697 begin
698 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
699 Format.BytesPerPixel;
700 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
701 Bits := Format.BitsPerPixel;
702 end;
703 SDL_LockSurface( SrcSurface );
704 SDL_LockSurface( DestSurface );
705 WorkY := Src.h;
706 case bits of
707 8 :
708 begin
709 repeat
710 WorkX := Src.w;
711 repeat
712 Pixel1 := PUInt8( SrcAddr )^;
713 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
714 begin
715 Pixel2 := PUInt8( DestAddr )^;
716 if Pixel2 > 0 then
717 begin
718 R := Pixel1 and $E0 + Pixel2 and $E0;
719 G := Pixel1 and $1C + Pixel2 and $1C;
720 B := Pixel1 and $03 + Pixel2 and $03;
721 if R > $E0 then
722 R := $E0;
723 if G > $1C then
724 G := $1C;
725 if B > $03 then
726 B := $03;
727 PUInt8( DestAddr )^ := R or G or B;
728 end
729 else
730 PUInt8( DestAddr )^ := Pixel1;
731 end;
732 inc( SrcAddr );
733 inc( DestAddr );
734 dec( WorkX );
735 until WorkX = 0;
736 inc( SrcAddr, SrcMod );
737 inc( DestAddr, DestMod );
738 dec( WorkY );
739 until WorkY = 0;
740 end;
741 15 :
742 begin
743 repeat
744 WorkX := Src.w;
745 repeat
746 Pixel1 := PUInt16( SrcAddr )^;
747 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
748 begin
749 Pixel2 := PUInt16( DestAddr )^;
750 if Pixel2 > 0 then
751 begin
752 R := Pixel1 and $7C00 + Pixel2 and $7C00;
753 G := Pixel1 and $03E0 + Pixel2 and $03E0;
754 B := Pixel1 and $001F + Pixel2 and $001F;
755 if R > $7C00 then
756 R := $7C00;
757 if G > $03E0 then
758 G := $03E0;
759 if B > $001F then
760 B := $001F;
761 PUInt16( DestAddr )^ := R or G or B;
762 end
763 else
764 PUInt16( DestAddr )^ := Pixel1;
765 end;
766 inc( SrcAddr, 2 );
767 inc( DestAddr, 2 );
768 dec( WorkX );
769 until WorkX = 0;
770 inc( SrcAddr, SrcMod );
771 inc( DestAddr, DestMod );
772 dec( WorkY );
773 until WorkY = 0;
774 end;
775 16 :
776 begin
777 repeat
778 WorkX := Src.w;
779 repeat
780 Pixel1 := PUInt16( SrcAddr )^;
781 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
782 begin
783 Pixel2 := PUInt16( DestAddr )^;
784 if Pixel2 > 0 then
785 begin
786 R := Pixel1 and $F800 + Pixel2 and $F800;
787 G := Pixel1 and $07E0 + Pixel2 and $07E0;
788 B := Pixel1 and $001F + Pixel2 and $001F;
789 if R > $F800 then
790 R := $F800;
791 if G > $07E0 then
792 G := $07E0;
793 if B > $001F then
794 B := $001F;
795 PUInt16( DestAddr )^ := R or G or B;
796 end
797 else
798 PUInt16( DestAddr )^ := Pixel1;
799 end;
800 inc( SrcAddr, 2 );
801 inc( DestAddr, 2 );
802 dec( WorkX );
803 until WorkX = 0;
804 inc( SrcAddr, SrcMod );
805 inc( DestAddr, DestMod );
806 dec( WorkY );
807 until WorkY = 0;
808 end;
809 24 :
810 begin
811 repeat
812 WorkX := Src.w;
813 repeat
814 Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
815 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
816 begin
817 Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
818 if Pixel2 > 0 then
819 begin
820 R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
821 G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
822 B := Pixel1 and $0000FF + Pixel2 and $0000FF;
823 if R > $FF0000 then
824 R := $FF0000;
825 if G > $00FF00 then
826 G := $00FF00;
827 if B > $0000FF then
828 B := $0000FF;
829 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
830 end
831 else
832 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
833 end;
834 inc( SrcAddr, 3 );
835 inc( DestAddr, 3 );
836 dec( WorkX );
837 until WorkX = 0;
838 inc( SrcAddr, SrcMod );
839 inc( DestAddr, DestMod );
840 dec( WorkY );
841 until WorkY = 0;
842 end;
843 32 :
844 begin
845 repeat
846 WorkX := Src.w;
847 repeat
848 Pixel1 := PUInt32( SrcAddr )^;
849 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
850 begin
851 Pixel2 := PUInt32( DestAddr )^;
852 if Pixel2 > 0 then
853 begin
854 R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
855 G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
856 B := Pixel1 and $0000FF + Pixel2 and $0000FF;
857 if R > $FF0000 then
858 R := $FF0000;
859 if G > $00FF00 then
860 G := $00FF00;
861 if B > $0000FF then
862 B := $0000FF;
863 PUInt32( DestAddr )^ := R or G or B;
864 end
865 else
866 PUInt32( DestAddr )^ := Pixel1;
867 end;
868 inc( SrcAddr, 4 );
869 inc( DestAddr, 4 );
870 dec( WorkX );
871 until WorkX = 0;
872 inc( SrcAddr, SrcMod );
873 inc( DestAddr, DestMod );
874 dec( WorkY );
875 until WorkY = 0;
876 end;
877 end;
878 SDL_UnlockSurface( SrcSurface );
879 SDL_UnlockSurface( DestSurface );
880 end;
881
882 procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
883 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
884 var
885 R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
886 Src, Dest : TSDL_Rect;
887 Diff : integer;
888 SrcAddr, DestAddr : cardinal;
889 _ebx, _esi, _edi, _esp : cardinal;
890 WorkX, WorkY : word;
891 SrcMod, DestMod : cardinal;
892 Bits : cardinal;
893 begin
894 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
895 exit; // Remove this to make it faster
896 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
897 exit; // Remove this to make it faster
898 if SrcRect = nil then
899 begin
900 with Src do
901 begin
902 x := 0;
903 y := 0;
904 w := SrcSurface.w;
905 h := SrcSurface.h;
906 end;
907 end
908 else
909 Src := SrcRect^;
910 if DestRect = nil then
911 begin
912 Dest.x := 0;
913 Dest.y := 0;
914 end
915 else
916 Dest := DestRect^;
917 Dest.w := Src.w;
918 Dest.h := Src.h;
919 with DestSurface.Clip_Rect do
920 begin
921 // Source's right side is greater than the dest.cliprect
922 if Dest.x + Src.w > x + w then
923 begin
924 smallint( Src.w ) := x + w - Dest.x;
925 smallint( Dest.w ) := x + w - Dest.x;
926 if smallint( Dest.w ) < 1 then
927 exit;
928 end;
929 // Source's bottom side is greater than the dest.clip
930 if Dest.y + Src.h > y + h then
931 begin
932 smallint( Src.h ) := y + h - Dest.y;
933 smallint( Dest.h ) := y + h - Dest.y;
934 if smallint( Dest.h ) < 1 then
935 exit;
936 end;
937 // Source's left side is less than the dest.clip
938 if Dest.x < x then
939 begin
940 Diff := x - Dest.x;
941 Src.x := Src.x + Diff;
942 smallint( Src.w ) := smallint( Src.w ) - Diff;
943 Dest.x := x;
944 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
945 if smallint( Dest.w ) < 1 then
946 exit;
947 end;
948 // Source's Top side is less than the dest.clip
949 if Dest.y < y then
950 begin
951 Diff := y - Dest.y;
952 Src.y := Src.y + Diff;
953 smallint( Src.h ) := smallint( Src.h ) - Diff;
954 Dest.y := y;
955 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
956 if smallint( Dest.h ) < 1 then
957 exit;
958 end;
959 end;
960 with SrcSurface^ do
961 begin
962 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
963 Format.BytesPerPixel;
964 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
965 TransparentColor := Format.colorkey;
966 end;
967 with DestSurface^ do
968 begin
969 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
970 Format.BytesPerPixel;
971 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
972 Bits := DestSurface.Format.BitsPerPixel;
973 end;
974 SDL_LockSurface( SrcSurface );
975 SDL_LockSurface( DestSurface );
976 WorkY := Src.h;
977 case bits of
978 8 :
979 begin
980 repeat
981 WorkX := Src.w;
982 repeat
983 Pixel1 := PUInt8( SrcAddr )^;
984 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
985 begin
986 Pixel2 := PUInt8( DestAddr )^;
987 if Pixel2 > 0 then
988 begin
989 R := Pixel2 and $E0 - Pixel1 and $E0;
990 G := Pixel2 and $1C - Pixel1 and $1C;
991 B := Pixel2 and $03 - Pixel1 and $03;
992 if R > $E0 then
993 R := 0;
994 if G > $1C then
995 G := 0;
996 if B > $03 then
997 B := 0;
998 PUInt8( DestAddr )^ := R or G or B;
999 end;
1000 end;
1001 inc( SrcAddr );
1002 inc( DestAddr );
1003 dec( WorkX );
1004 until WorkX = 0;
1005 inc( SrcAddr, SrcMod );
1006 inc( DestAddr, DestMod );
1007 dec( WorkY );
1008 until WorkY = 0;
1009 end;
1010 15 :
1011 begin
1012 repeat
1013 WorkX := Src.w;
1014 repeat
1015 Pixel1 := PUInt16( SrcAddr )^;
1016 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
1017 begin
1018 Pixel2 := PUInt16( DestAddr )^;
1019 if Pixel2 > 0 then
1020 begin
1021 R := Pixel2 and $7C00 - Pixel1 and $7C00;
1022 G := Pixel2 and $03E0 - Pixel1 and $03E0;
1023 B := Pixel2 and $001F - Pixel1 and $001F;
1024 if R > $7C00 then
1025 R := 0;
1026 if G > $03E0 then
1027 G := 0;
1028 if B > $001F then
1029 B := 0;
1030 PUInt16( DestAddr )^ := R or G or B;
1031 end;
1032 end;
1033 inc( SrcAddr, 2 );
1034 inc( DestAddr, 2 );
1035 dec( WorkX );
1036 until WorkX = 0;
1037 inc( SrcAddr, SrcMod );
1038 inc( DestAddr, DestMod );
1039 dec( WorkY );
1040 until WorkY = 0;
1041 end;
1042 16 :
1043 begin
1044 repeat
1045 WorkX := Src.w;
1046 repeat
1047 Pixel1 := PUInt16( SrcAddr )^;
1048 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
1049 begin
1050 Pixel2 := PUInt16( DestAddr )^;
1051 if Pixel2 > 0 then
1052 begin
1053 R := Pixel2 and $F800 - Pixel1 and $F800;
1054 G := Pixel2 and $07E0 - Pixel1 and $07E0;
1055 B := Pixel2 and $001F - Pixel1 and $001F;
1056 if R > $F800 then
1057 R := 0;
1058 if G > $07E0 then
1059 G := 0;
1060 if B > $001F then
1061 B := 0;
1062 PUInt16( DestAddr )^ := R or G or B;
1063 end;
1064 end;
1065 inc( SrcAddr, 2 );
1066 inc( DestAddr, 2 );
1067 dec( WorkX );
1068 until WorkX = 0;
1069 inc( SrcAddr, SrcMod );
1070 inc( DestAddr, DestMod );
1071 dec( WorkY );
1072 until WorkY = 0;
1073 end;
1074 24 :
1075 begin
1076 repeat
1077 WorkX := Src.w;
1078 repeat
1079 Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
1080 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
1081 begin
1082 Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
1083 if Pixel2 > 0 then
1084 begin
1085 R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
1086 G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
1087 B := Pixel2 and $0000FF - Pixel1 and $0000FF;
1088 if R > $FF0000 then
1089 R := 0;
1090 if G > $00FF00 then
1091 G := 0;
1092 if B > $0000FF then
1093 B := 0;
1094 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
1095 end;
1096 end;
1097 inc( SrcAddr, 3 );
1098 inc( DestAddr, 3 );
1099 dec( WorkX );
1100 until WorkX = 0;
1101 inc( SrcAddr, SrcMod );
1102 inc( DestAddr, DestMod );
1103 dec( WorkY );
1104 until WorkY = 0;
1105 end;
1106 32 :
1107 begin
1108 repeat
1109 WorkX := Src.w;
1110 repeat
1111 Pixel1 := PUInt32( SrcAddr )^;
1112 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
1113 begin
1114 Pixel2 := PUInt32( DestAddr )^;
1115 if Pixel2 > 0 then
1116 begin
1117 R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
1118 G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
1119 B := Pixel2 and $0000FF - Pixel1 and $0000FF;
1120 if R > $FF0000 then
1121 R := 0;
1122 if G > $00FF00 then
1123 G := 0;
1124 if B > $0000FF then
1125 B := 0;
1126 PUInt32( DestAddr )^ := R or G or B;
1127 end
1128 else
1129 PUInt32( DestAddr )^ := Pixel2;
1130 end;
1131 inc( SrcAddr, 4 );
1132 inc( DestAddr, 4 );
1133 dec( WorkX );
1134 until WorkX = 0;
1135 inc( SrcAddr, SrcMod );
1136 inc( DestAddr, DestMod );
1137 dec( WorkY );
1138 until WorkY = 0;
1139 end;
1140 end;
1141 SDL_UnlockSurface( SrcSurface );
1142 SDL_UnlockSurface( DestSurface );
1143 end;
1144
1145 procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
1146 DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
1147 var
1148 Src, Dest : TSDL_Rect;
1149 Diff : integer;
1150 SrcAddr, DestAddr : cardinal;
1151 _ebx, _esi, _edi, _esp : cardinal;
1152 WorkX, WorkY : word;
1153 SrcMod, DestMod : cardinal;
1154 TransparentColor, SrcColor : cardinal;
1155 BPP : cardinal;
1156 begin
1157 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
1158 exit; // Remove this to make it faster
1159 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
1160 exit; // Remove this to make it faster
1161 if SrcRect = nil then
1162 begin
1163 with Src do
1164 begin
1165 x := 0;
1166 y := 0;
1167 w := SrcSurface.w;
1168 h := SrcSurface.h;
1169 end;
1170 end
1171 else
1172 Src := SrcRect^;
1173 if DestRect = nil then
1174 begin
1175 Dest.x := 0;
1176 Dest.y := 0;
1177 end
1178 else
1179 Dest := DestRect^;
1180 Dest.w := Src.w;
1181 Dest.h := Src.h;
1182 with DestSurface.Clip_Rect do
1183 begin
1184 // Source's right side is greater than the dest.cliprect
1185 if Dest.x + Src.w > x + w then
1186 begin
1187 smallint( Src.w ) := x + w - Dest.x;
1188 smallint( Dest.w ) := x + w - Dest.x;
1189 if smallint( Dest.w ) < 1 then
1190 exit;
1191 end;
1192 // Source's bottom side is greater than the dest.clip
1193 if Dest.y + Src.h > y + h then
1194 begin
1195 smallint( Src.h ) := y + h - Dest.y;
1196 smallint( Dest.h ) := y + h - Dest.y;
1197 if smallint( Dest.h ) < 1 then
1198 exit;
1199 end;
1200 // Source's left side is less than the dest.clip
1201 if Dest.x < x then
1202 begin
1203 Diff := x - Dest.x;
1204 Src.x := Src.x + Diff;
1205 smallint( Src.w ) := smallint( Src.w ) - Diff;
1206 Dest.x := x;
1207 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
1208 if smallint( Dest.w ) < 1 then
1209 exit;
1210 end;
1211 // Source's Top side is less than the dest.clip
1212 if Dest.y < y then
1213 begin
1214 Diff := y - Dest.y;
1215 Src.y := Src.y + Diff;
1216 smallint( Src.h ) := smallint( Src.h ) - Diff;
1217 Dest.y := y;
1218 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
1219 if smallint( Dest.h ) < 1 then
1220 exit;
1221 end;
1222 end;
1223 with SrcSurface^ do
1224 begin
1225 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
1226 Format.BytesPerPixel;
1227 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
1228 TransparentColor := Format.colorkey;
1229 end;
1230 with DestSurface^ do
1231 begin
1232 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
1233 Format.BytesPerPixel;
1234 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
1235 BPP := DestSurface.Format.BytesPerPixel;
1236 end;
1237 SDL_LockSurface( SrcSurface );
1238 SDL_LockSurface( DestSurface );
1239 WorkY := Src.h;
1240 case BPP of
1241 1 :
1242 begin
1243 repeat
1244 WorkX := Src.w;
1245 repeat
1246 SrcColor := PUInt8( SrcAddr )^;
1247 if SrcColor <> TransparentColor then
1248 PUInt8( DestAddr )^ := SrcColor;
1249 inc( SrcAddr );
1250 inc( DestAddr );
1251 dec( WorkX );
1252 until WorkX = 0;
1253 inc( SrcAddr, SrcMod );
1254 inc( DestAddr, DestMod );
1255 dec( WorkY );
1256 until WorkY = 0;
1257 end;
1258 2 :
1259 begin
1260 repeat
1261 WorkX := Src.w;
1262 repeat
1263 SrcColor := PUInt16( SrcAddr )^;
1264 if SrcColor <> TransparentColor then
1265 PUInt16( DestAddr )^ := SrcColor;
1266 inc( SrcAddr );
1267 inc( DestAddr );
1268 dec( WorkX );
1269 until WorkX = 0;
1270 inc( SrcAddr, SrcMod );
1271 inc( DestAddr, DestMod );
1272 dec( WorkY );
1273 until WorkY = 0;
1274 end;
1275 3 :
1276 begin
1277 repeat
1278 WorkX := Src.w;
1279 repeat
1280 SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
1281 if SrcColor <> TransparentColor then
1282 PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or SrcColor;
1283 inc( SrcAddr );
1284 inc( DestAddr );
1285 dec( WorkX );
1286 until WorkX = 0;
1287 inc( SrcAddr, SrcMod );
1288 inc( DestAddr, DestMod );
1289 dec( WorkY );
1290 until WorkY = 0;
1291 end;
1292 4 :
1293 begin
1294 repeat
1295 WorkX := Src.w;
1296 repeat
1297 SrcColor := PUInt32( SrcAddr )^;
1298 if SrcColor <> TransparentColor then
1299 PUInt32( DestAddr )^ := SrcColor;
1300 inc( SrcAddr );
1301 inc( DestAddr );
1302 dec( WorkX );
1303 until WorkX = 0;
1304 inc( SrcAddr, SrcMod );
1305 inc( DestAddr, DestMod );
1306 dec( WorkY );
1307 until WorkY = 0;
1308 end;
1309 end;
1310 SDL_UnlockSurface( SrcSurface );
1311 SDL_UnlockSurface( DestSurface );
1312 end;
1313 // TextureRect.w and TextureRect.h are not used.
1314 // The TextureSurface's size MUST larger than the drawing rectangle!!!
1315
1316 procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
1317 DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
1318 TextureRect : PSDL_Rect );
1319 var
1320 Src, Dest : TSDL_Rect;
1321 Diff : integer;
1322 SrcAddr, DestAddr, TextAddr : cardinal;
1323 _ebx, _esi, _edi, _esp : cardinal;
1324 WorkX, WorkY : word;
1325 SrcMod, DestMod, TextMod : cardinal;
1326 SrcColor, TransparentColor, TextureColor : cardinal;
1327 BPP : cardinal;
1328 begin
1329 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
1330 exit; // Remove this to make it faster
1331 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
1332 exit; // Remove this to make it faster
1333 if SrcRect = nil then
1334 begin
1335 with Src do
1336 begin
1337 x := 0;
1338 y := 0;
1339 w := SrcSurface.w;
1340 h := SrcSurface.h;
1341 end;
1342 end
1343 else
1344 Src := SrcRect^;
1345 if DestRect = nil then
1346 begin
1347 Dest.x := 0;
1348 Dest.y := 0;
1349 end
1350 else
1351 Dest := DestRect^;
1352 Dest.w := Src.w;
1353 Dest.h := Src.h;
1354 with DestSurface.Clip_Rect do
1355 begin
1356 // Source's right side is greater than the dest.cliprect
1357 if Dest.x + Src.w > x + w then
1358 begin
1359 smallint( Src.w ) := x + w - Dest.x;
1360 smallint( Dest.w ) := x + w - Dest.x;
1361 if smallint( Dest.w ) < 1 then
1362 exit;
1363 end;
1364 // Source's bottom side is greater than the dest.clip
1365 if Dest.y + Src.h > y + h then
1366 begin
1367 smallint( Src.h ) := y + h - Dest.y;
1368 smallint( Dest.h ) := y + h - Dest.y;
1369 if smallint( Dest.h ) < 1 then
1370 exit;
1371 end;
1372 // Source's left side is less than the dest.clip
1373 if Dest.x < x then
1374 begin
1375 Diff := x - Dest.x;
1376 Src.x := Src.x + Diff;
1377 smallint( Src.w ) := smallint( Src.w ) - Diff;
1378 Dest.x := x;
1379 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
1380 if smallint( Dest.w ) < 1 then
1381 exit;
1382 end;
1383 // Source's Top side is less than the dest.clip
1384 if Dest.y < y then
1385 begin
1386 Diff := y - Dest.y;
1387 Src.y := Src.y + Diff;
1388 smallint( Src.h ) := smallint( Src.h ) - Diff;
1389 Dest.y := y;
1390 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
1391 if smallint( Dest.h ) < 1 then
1392 exit;
1393 end;
1394 end;
1395 with SrcSurface^ do
1396 begin
1397 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
1398 Format.BytesPerPixel;
1399 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
1400 TransparentColor := format.colorkey;
1401 end;
1402 with DestSurface^ do
1403 begin
1404 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
1405 Format.BytesPerPixel;
1406 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
1407 BPP := DestSurface.Format.BitsPerPixel;
1408 end;
1409 with Texture^ do
1410 begin
1411 TextAddr := cardinal( Pixels ) + UInt32( TextureRect.y ) * Pitch +
1412 UInt32( TextureRect.x ) * Format.BytesPerPixel;
1413 TextMod := Pitch - Src.w * Format.BytesPerPixel;
1414 end;
1415 SDL_LockSurface( SrcSurface );
1416 SDL_LockSurface( DestSurface );
1417 SDL_LockSurface( Texture );
1418 WorkY := Src.h;
1419 case BPP of
1420 1 :
1421 begin
1422 repeat
1423 WorkX := Src.w;
1424 repeat
1425 SrcColor := PUInt8( SrcAddr )^;
1426 if SrcColor <> TransparentColor then
1427 PUInt8( DestAddr )^ := PUint8( TextAddr )^;
1428 inc( SrcAddr );
1429 inc( DestAddr );
1430 inc( TextAddr );
1431 dec( WorkX );
1432 until WorkX = 0;
1433 inc( SrcAddr, SrcMod );
1434 inc( DestAddr, DestMod );
1435 inc( TextAddr, TextMod );
1436 dec( WorkY );
1437 until WorkY = 0;
1438 end;
1439 2 :
1440 begin
1441 repeat
1442 WorkX := Src.w;
1443 repeat
1444 SrcColor := PUInt16( SrcAddr )^;
1445 if SrcColor <> TransparentColor then
1446 PUInt16( DestAddr )^ := PUInt16( TextAddr )^;
1447 inc( SrcAddr );
1448 inc( DestAddr );
1449 inc( TextAddr );
1450 dec( WorkX );
1451 until WorkX = 0;
1452 inc( SrcAddr, SrcMod );
1453 inc( DestAddr, DestMod );
1454 inc( TextAddr, TextMod );
1455 dec( WorkY );
1456 until WorkY = 0;
1457 end;
1458 3 :
1459 begin
1460 repeat
1461 WorkX := Src.w;
1462 repeat
1463 SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
1464 if SrcColor <> TransparentColor then
1465 PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or ( PUInt32( TextAddr )^ and $FFFFFF );
1466 inc( SrcAddr );
1467 inc( DestAddr );
1468 inc( TextAddr );
1469 dec( WorkX );
1470 until WorkX = 0;
1471 inc( SrcAddr, SrcMod );
1472 inc( DestAddr, DestMod );
1473 inc( TextAddr, TextMod );
1474 dec( WorkY );
1475 until WorkY = 0;
1476 end;
1477 4 :
1478 begin
1479 repeat
1480 WorkX := Src.w;
1481 repeat
1482 SrcColor := PUInt32( SrcAddr )^;
1483 if SrcColor <> TransparentColor then
1484 PUInt32( DestAddr )^ := PUInt32( TextAddr )^;
1485 inc( SrcAddr );
1486 inc( DestAddr );
1487 inc( TextAddr );
1488 dec( WorkX );
1489 until WorkX = 0;
1490 inc( SrcAddr, SrcMod );
1491 inc( DestAddr, DestMod );
1492 inc( TextAddr, TextMod );
1493 dec( WorkY );
1494 until WorkY = 0;
1495 end;
1496 end;
1497 SDL_UnlockSurface( SrcSurface );
1498 SDL_UnlockSurface( DestSurface );
1499 SDL_UnlockSurface( Texture );
1500 end;
1501
1502 procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
1503 var
1504 xc, yc : cardinal;
1505 rx, wx, ry, wy, ry16 : cardinal;
1506 color : cardinal;
1507 modx, mody : cardinal;
1508 begin
1509 // Warning! No checks for surface pointers!!!
1510 if srcrect = nil then
1511 srcrect := @SrcSurface.clip_rect;
1512 if dstrect = nil then
1513 dstrect := @DstSurface.clip_rect;
1514 if SDL_MustLock( SrcSurface ) then
1515 SDL_LockSurface( SrcSurface );
1516 if SDL_MustLock( DstSurface ) then
1517 SDL_LockSurface( DstSurface );
1518 modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );
1519 mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );
1520 //rx := srcrect.x * 65536;
1521 ry := srcrect.y * 65536;
1522 wy := dstrect.y;
1523 for yc := 0 to dstrect.h - 1 do
1524 begin
1525 rx := srcrect.x * 65536;
1526 wx := dstrect.x;
1527 ry16 := ry shr 16;
1528 for xc := 0 to dstrect.w - 1 do
1529 begin
1530 color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );
1531 SDL_PutPixel( DstSurface, wx, wy, color );
1532 rx := rx + modx;
1533 inc( wx );
1534 end;
1535 ry := ry + mody;
1536 inc( wy );
1537 end;
1538 if SDL_MustLock( SrcSurface ) then
1539 SDL_UnlockSurface( SrcSurface );
1540 if SDL_MustLock( DstSurface ) then
1541 SDL_UnlockSurface( DstSurface );
1542 end;
1543 // Re-map a rectangular area into an area defined by four vertices
1544 // Converted from C to Pascal by KiCHY
1545
1546 procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
1547 const
1548 SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20)
1549 THRESH = 1 shl SHIFTS; // Threshold for pixel size value
1550 procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );
1551 var
1552 tm, lm, rm, bm, m : TPoint;
1553 mx, my : cardinal;
1554 cr : cardinal;
1555 begin
1556 // Does the destination area specify a single pixel?
1557 if ( ( abs( ul.x - ur.x ) < THRESH ) and
1558 ( abs( ul.x - lr.x ) < THRESH ) and
1559 ( abs( ul.x - ll.x ) < THRESH ) and
1560 ( abs( ul.y - ur.y ) < THRESH ) and
1561 ( abs( ul.y - lr.y ) < THRESH ) and
1562 ( abs( ul.y - ll.y ) < THRESH ) ) then
1563 begin // Yes
1564 cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );
1565 SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );
1566 end
1567 else
1568 begin // No
1569 // Quarter the source and the destination, and then recurse
1570 tm.x := ( ul.x + ur.x ) shr 1;
1571 tm.y := ( ul.y + ur.y ) shr 1;
1572 bm.x := ( ll.x + lr.x ) shr 1;
1573 bm.y := ( ll.y + lr.y ) shr 1;
1574 lm.x := ( ul.x + ll.x ) shr 1;
1575 lm.y := ( ul.y + ll.y ) shr 1;
1576 rm.x := ( ur.x + lr.x ) shr 1;
1577 rm.y := ( ur.y + lr.y ) shr 1;
1578 m.x := ( tm.x + bm.x ) shr 1;
1579 m.y := ( tm.y + bm.y ) shr 1;
1580 mx := ( x1 + x2 ) shr 1;
1581 my := ( y1 + y2 ) shr 1;
1582 CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );
1583 CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );
1584 CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );
1585 CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );
1586 end;
1587 end;
1588 var
1589 _UL, _UR, _LR, _LL : TPoint;
1590 Rect_x, Rect_y, Rect_w, Rect_h : integer;
1591 begin
1592 if SDL_MustLock( SrcSurface ) then
1593 SDL_LockSurface( SrcSurface );
1594 if SDL_MustLock( DstSurface ) then
1595 SDL_LockSurface( DstSurface );
1596 if SrcRect = nil then
1597 begin
1598 Rect_x := 0;
1599 Rect_y := 0;
1600 Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;
1601 Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;
1602 end
1603 else
1604 begin
1605 Rect_x := SrcRect.x;
1606 Rect_y := SrcRect.y;
1607 Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;
1608 Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;
1609 end;
1610 // Shift all values to help reduce round-off error.
1611 _ul.x := ul.x shl SHIFTS;
1612 _ul.y := ul.y shl SHIFTS;
1613 _ur.x := ur.x shl SHIFTS;
1614 _ur.y := ur.y shl SHIFTS;
1615 _lr.x := lr.x shl SHIFTS;
1616 _lr.y := lr.y shl SHIFTS;
1617 _ll.x := ll.x shl SHIFTS;
1618 _ll.y := ll.y shl SHIFTS;
1619 CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );
1620 if SDL_MustLock( SrcSurface ) then
1621 SDL_UnlockSurface( SrcSurface );
1622 if SDL_MustLock( DstSurface ) then
1623 SDL_UnlockSurface( DstSurface );
1624 end;
1625
1626 // Draw a line between x1,y1 and x2,y2 to the given surface
1627 // NOTE: The surface must be locked before calling this!
1628
1629 procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
1630 cardinal );
1631 var
1632 dx, dy, sdx, sdy, x, y, px, py : integer;
1633 begin
1634 dx := x2 - x1;
1635 dy := y2 - y1;
1636 if dx < 0 then
1637 sdx := -1
1638 else
1639 sdx := 1;
1640 if dy < 0 then
1641 sdy := -1
1642 else
1643 sdy := 1;
1644 dx := sdx * dx + 1;
1645 dy := sdy * dy + 1;
1646 x := 0;
1647 y := 0;
1648 px := x1;
1649 py := y1;
1650 if dx >= dy then
1651 begin
1652 for x := 0 to dx - 1 do
1653 begin
1654 SDL_PutPixel( DstSurface, px, py, Color );
1655 y := y + dy;
1656 if y >= dx then
1657 begin
1658 y := y - dx;
1659 py := py + sdy;
1660 end;
1661 px := px + sdx;
1662 end;
1663 end
1664 else
1665 begin
1666 for y := 0 to dy - 1 do
1667 begin
1668 SDL_PutPixel( DstSurface, px, py, Color );
1669 x := x + dx;
1670 if x >= dy then
1671 begin
1672 x := x - dy;
1673 px := px + sdx;
1674 end;
1675 py := py + sdy;
1676 end;
1677 end;
1678 end;
1679
1680 // Draw a dashed line between x1,y1 and x2,y2 to the given surface
1681 // NOTE: The surface must be locked before calling this!
1682
1683 procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
1684 cardinal; DashLength, DashSpace : byte ); overload;
1685 var
1686 dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;
1687 begin
1688 counter := 0;
1689 drawdash := true; //begin line drawing with dash
1690
1691 //Avoid invalid user-passed dash parameters
1692 if ( DashLength < 1 )
1693 then
1694 DashLength := 1;
1695 if ( DashSpace < 1 )
1696 then
1697 DashSpace := 0;
1698
1699 dx := x2 - x1;
1700 dy := y2 - y1;
1701 if dx < 0 then
1702 sdx := -1
1703 else
1704 sdx := 1;
1705 if dy < 0 then
1706 sdy := -1
1707 else
1708 sdy := 1;
1709 dx := sdx * dx + 1;
1710 dy := sdy * dy + 1;
1711 x := 0;
1712 y := 0;
1713 px := x1;
1714 py := y1;
1715 if dx >= dy then
1716 begin
1717 for x := 0 to dx - 1 do
1718 begin
1719
1720 //Alternate drawing dashes, or leaving spaces
1721 if drawdash then
1722 begin
1723 SDL_PutPixel( DstSurface, px, py, Color );
1724 inc( counter );
1725 if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
1726 begin
1727 drawdash := false;
1728 counter := 0;
1729 end;
1730 end
1731 else //space
1732 begin
1733 inc( counter );
1734 if counter > DashSpace - 1 then
1735 begin
1736 drawdash := true;
1737 counter := 0;
1738 end;
1739 end;
1740
1741 y := y + dy;
1742 if y >= dx then
1743 begin
1744 y := y - dx;
1745 py := py + sdy;
1746 end;
1747 px := px + sdx;
1748 end;
1749 end
1750 else
1751 begin
1752 for y := 0 to dy - 1 do
1753 begin
1754
1755 //Alternate drawing dashes, or leaving spaces
1756 if drawdash then
1757 begin
1758 SDL_PutPixel( DstSurface, px, py, Color );
1759 inc( counter );
1760 if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
1761 begin
1762 drawdash := false;
1763 counter := 0;
1764 end;
1765 end
1766 else //space
1767 begin
1768 inc( counter );
1769 if counter > DashSpace - 1 then
1770 begin
1771 drawdash := true;
1772 counter := 0;
1773 end;
1774 end;
1775
1776 x := x + dx;
1777 if x >= dy then
1778 begin
1779 x := x - dy;
1780 px := px + sdx;
1781 end;
1782 py := py + sdy;
1783 end;
1784 end;
1785 end;
1786
1787 procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
1788 cardinal );
1789 var
1790 dx, dy, sdx, sdy, x, y, px, py : integer;
1791 begin
1792 dx := x2 - x1;
1793 dy := y2 - y1;
1794 if dx < 0 then
1795 sdx := -1
1796 else
1797 sdx := 1;
1798 if dy < 0 then
1799 sdy := -1
1800 else
1801 sdy := 1;
1802 dx := sdx * dx + 1;
1803 dy := sdy * dy + 1;
1804 x := 0;
1805 y := 0;
1806 px := x1;
1807 py := y1;
1808 if dx >= dy then
1809 begin
1810 for x := 0 to dx - 1 do
1811 begin
1812 SDL_AddPixel( DstSurface, px, py, Color );
1813 y := y + dy;
1814 if y >= dx then
1815 begin
1816 y := y - dx;
1817 py := py + sdy;
1818 end;
1819 px := px + sdx;
1820 end;
1821 end
1822 else
1823 begin
1824 for y := 0 to dy - 1 do
1825 begin
1826 SDL_AddPixel( DstSurface, px, py, Color );
1827 x := x + dx;
1828 if x >= dy then
1829 begin
1830 x := x - dy;
1831 px := px + sdx;
1832 end;
1833 py := py + sdy;
1834 end;
1835 end;
1836 end;
1837
1838 procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
1839 cardinal );
1840 var
1841 dx, dy, sdx, sdy, x, y, px, py : integer;
1842 begin
1843 dx := x2 - x1;
1844 dy := y2 - y1;
1845 if dx < 0 then
1846 sdx := -1
1847 else
1848 sdx := 1;
1849 if dy < 0 then
1850 sdy := -1
1851 else
1852 sdy := 1;
1853 dx := sdx * dx + 1;
1854 dy := sdy * dy + 1;
1855 x := 0;
1856 y := 0;
1857 px := x1;
1858 py := y1;
1859 if dx >= dy then
1860 begin
1861 for x := 0 to dx - 1 do
1862 begin
1863 SDL_SubPixel( DstSurface, px, py, Color );
1864 y := y + dy;
1865 if y >= dx then
1866 begin
1867 y := y - dx;
1868 py := py + sdy;
1869 end;
1870 px := px + sdx;
1871 end;
1872 end
1873 else
1874 begin
1875 for y := 0 to dy - 1 do
1876 begin
1877 SDL_SubPixel( DstSurface, px, py, Color );
1878 x := x + dx;
1879 if x >= dy then
1880 begin
1881 x := x - dy;
1882 px := px + sdx;
1883 end;
1884 py := py + sdy;
1885 end;
1886 end;
1887 end;
1888
1889 // flips a rectangle vertically on given surface
1890
1891 procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
1892 var
1893 TmpRect : TSDL_Rect;
1894 Locked : boolean;
1895 y, FlipLength, RowLength : integer;
1896 Row1, Row2 : Pointer;
1897 OneRow : TByteArray; // Optimize it if you wish
1898 begin
1899 if DstSurface <> nil then
1900 begin
1901 if Rect = nil then
1902 begin // if Rect=nil then we flip the whole surface
1903 TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
1904 Rect := @TmpRect;
1905 end;
1906 FlipLength := Rect^.h shr 1 - 1;
1907 RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;
1908 if SDL_MustLock( DstSurface ) then
1909 begin
1910 Locked := true;
1911 SDL_LockSurface( DstSurface );
1912 end
1913 else
1914 Locked := false;
1915 Row1 := pointer( cardinal( DstSurface^.Pixels ) + UInt32( Rect^.y ) *
1916 DstSurface^.Pitch );
1917 Row2 := pointer( cardinal( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )
1918 * DstSurface^.Pitch );
1919 for y := 0 to FlipLength do
1920 begin
1921 Move( Row1^, OneRow, RowLength );
1922 Move( Row2^, Row1^, RowLength );
1923 Move( OneRow, Row2^, RowLength );
1924 inc( cardinal( Row1 ), DstSurface^.Pitch );
1925 dec( cardinal( Row2 ), DstSurface^.Pitch );
1926 end;
1927 if Locked then
1928 SDL_UnlockSurface( DstSurface );
1929 end;
1930 end;
1931
1932 // flips a rectangle horizontally on given surface
1933
1934 procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
1935 type
1936 T24bit = packed array[ 0..2 ] of byte;
1937 T24bitArray = packed array[ 0..8191 ] of T24bit;
1938 P24bitArray = ^T24bitArray;
1939 TLongWordArray = array[ 0..8191 ] of LongWord;
1940 PLongWordArray = ^TLongWordArray;
1941 var
1942 TmpRect : TSDL_Rect;
1943 Row8bit : PByteArray;
1944 Row16bit : PWordArray;
1945 Row24bit : P24bitArray;
1946 Row32bit : PLongWordArray;
1947 y, x, RightSide, FlipLength : integer;
1948 Pixel : cardinal;
1949 Pixel24 : T24bit;
1950 Locked : boolean;
1951 begin
1952 if DstSurface <> nil then
1953 begin
1954 if Rect = nil then
1955 begin
1956 TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
1957 Rect := @TmpRect;
1958 end;
1959 FlipLength := Rect^.w shr 1 - 1;
1960 if SDL_MustLock( DstSurface ) then
1961 begin
1962 Locked := true;
1963 SDL_LockSurface( DstSurface );
1964 end
1965 else
1966 Locked := false;
1967 case DstSurface^.format.BytesPerPixel of
1968 1 :
1969 begin
1970 Row8Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
1971 DstSurface^.pitch );
1972 for y := 1 to Rect^.h do
1973 begin
1974 RightSide := Rect^.w - 1;
1975 for x := 0 to FlipLength do
1976 begin
1977 Pixel := Row8Bit^[ x ];
1978 Row8Bit^[ x ] := Row8Bit^[ RightSide ];
1979 Row8Bit^[ RightSide ] := Pixel;
1980 dec( RightSide );
1981 end;
1982 inc( cardinal( Row8Bit ), DstSurface^.pitch );
1983 end;
1984 end;
1985 2 :
1986 begin
1987 Row16Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
1988 DstSurface^.pitch );
1989 for y := 1 to Rect^.h do
1990 begin
1991 RightSide := Rect^.w - 1;
1992 for x := 0 to FlipLength do
1993 begin
1994 Pixel := Row16Bit^[ x ];
1995 Row16Bit^[ x ] := Row16Bit^[ RightSide ];
1996 Row16Bit^[ RightSide ] := Pixel;
1997 dec( RightSide );
1998 end;
1999 inc( cardinal( Row16Bit ), DstSurface^.pitch );
2000 end;
2001 end;
2002 3 :
2003 begin
2004 Row24Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
2005 DstSurface^.pitch );
2006 for y := 1 to Rect^.h do
2007 begin
2008 RightSide := Rect^.w - 1;
2009 for x := 0 to FlipLength do
2010 begin
2011 Pixel24 := Row24Bit^[ x ];
2012 Row24Bit^[ x ] := Row24Bit^[ RightSide ];
2013 Row24Bit^[ RightSide ] := Pixel24;
2014 dec( RightSide );
2015 end;
2016 inc( cardinal( Row24Bit ), DstSurface^.pitch );
2017 end;
2018 end;
2019 4 :
2020 begin
2021 Row32Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
2022 DstSurface^.pitch );
2023 for y := 1 to Rect^.h do
2024 begin
2025 RightSide := Rect^.w - 1;
2026 for x := 0 to FlipLength do
2027 begin
2028 Pixel := Row32Bit^[ x ];
2029 Row32Bit^[ x ] := Row32Bit^[ RightSide ];
2030 Row32Bit^[ RightSide ] := Pixel;
2031 dec( RightSide );
2032 end;
2033 inc( cardinal( Row32Bit ), DstSurface^.pitch );
2034 end;
2035 end;
2036 end;
2037 if Locked then
2038 SDL_UnlockSurface( DstSurface );
2039 end;
2040 end;
2041
2042 // Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.
2043 // But you MUST free it after you don't need it anymore!!!
2044
2045 function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
2046 var
2047 Rect : PSDL_Rect;
2048 begin
2049 New( Rect );
2050 with Rect^ do
2051 begin
2052 x := aLeft;
2053 y := aTop;
2054 w := aWidth;
2055 h := aHeight;
2056 end;
2057 Result := Rect;
2058 end;
2059
2060 function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;
2061 begin
2062 with result do
2063 begin
2064 x := aLeft;
2065 y := aTop;
2066 w := aWidth;
2067 h := aHeight;
2068 end;
2069 end;
2070
2071 function SDLRect( aRect : TRect ) : TSDL_Rect;
2072 begin
2073 with aRect do
2074 result := SDLRect( Left, Top, Right - Left, Bottom - Top );
2075 end;
2076
2077 procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,
2078 depth : integer );
2079 var
2080 dx, dy, e, d, dx2 : integer;
2081 src_pitch, dst_pitch : uint16;
2082 src_pixels, dst_pixels : PUint8;
2083 begin
2084 if ( yw >= dst_surface^.h ) then
2085 exit;
2086 dx := ( x2 - x1 );
2087 dy := ( y2 - y1 );
2088 dy := dy shl 1;
2089 e := dy - dx;
2090 dx2 := dx shl 1;
2091 src_pitch := Surface^.pitch;
2092 dst_pitch := dst_surface^.pitch;
2093 src_pixels := PUint8( integer( Surface^.pixels ) + yr * src_pitch + y1 * depth );
2094 dst_pixels := PUint8( integer( dst_surface^.pixels ) + yw * dst_pitch + x1 *
2095 depth );
2096 for d := 0 to dx - 1 do
2097 begin
2098 move( src_pixels^, dst_pixels^, depth );
2099 while ( e >= 0 ) do
2100 begin
2101 inc( src_pixels, depth );
2102 e := e - dx2;
2103 end;
2104 inc( dst_pixels, depth );
2105 e := e + dy;
2106 end;
2107 end;
2108
2109 function sign( x : integer ) : integer;
2110 begin
2111 if x > 0 then
2112 result := 1
2113 else
2114 result := -1;
2115 end;
2116
2117 // Stretches a part of a surface
2118
2119 function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
2120 Width, Height : integer ) : PSDL_Surface;
2121 var
2122 dst_surface : PSDL_Surface;
2123 dx, dy, e, d, dx2, srcx2, srcy2 : integer;
2124 destx1, desty1 : integer;
2125 begin
2126 srcx2 := srcx1 + SrcW;
2127 srcy2 := srcy1 + SrcH;
2128 result := nil;
2129 destx1 := 0;
2130 desty1 := 0;
2131 dx := abs( integer( Height - desty1 ) );
2132 dy := abs( integer( SrcY2 - SrcY1 ) );
2133 e := ( dy shl 1 ) - dx;
2134 dx2 := dx shl 1;
2135 dy := dy shl 1;
2136 dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -
2137 desty1,
2138 SrcSurface^.Format^.BitsPerPixel,
2139 SrcSurface^.Format^.RMask,
2140 SrcSurface^.Format^.GMask,
2141 SrcSurface^.Format^.BMask,
2142 SrcSurface^.Format^.AMask );
2143 if ( dst_surface^.format^.BytesPerPixel = 1 ) then
2144 SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
2145 SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );
2146 if ( SDL_MustLock( dst_surface ) ) then
2147 if ( SDL_LockSurface( dst_surface ) < 0 ) then
2148 exit;
2149 for d := 0 to dx - 1 do
2150 begin
2151 SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,
2152 SrcSurface^.format^.BytesPerPixel );
2153 while e >= 0 do
2154 begin
2155 inc( SrcY1 );
2156 e := e - dx2;
2157 end;
2158 inc( desty1 );
2159 e := e + dy;
2160 end;
2161 if SDL_MUSTLOCK( dst_surface ) then
2162 SDL_UnlockSurface( dst_surface );
2163 result := dst_surface;
2164 end;
2165
2166 procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer );
2167 var
2168 src_pixels, dst_pixels : PUint8;
2169 i : integer;
2170 begin
2171 src_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + x2 *
2172 depth );
2173 dst_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + ( x2
2174 + xofs ) * depth );
2175 for i := x2 downto x1 do
2176 begin
2177 move( src_pixels^, dst_pixels^, depth );
2178 dec( src_pixels );
2179 dec( dst_pixels );
2180 end;
2181 end;
2182 { Return the pixel value at (x, y)
2183 NOTE: The surface must be locked before calling this! }
2184
2185 function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
2186 var
2187 bpp : UInt32;
2188 p : PInteger;
2189 begin
2190 bpp := SrcSurface.format.BytesPerPixel;
2191 // Here p is the address to the pixel we want to retrieve
2192 p := Pointer( Uint32( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *
2193 bpp );
2194 case bpp of
2195 1 : result := PUint8( p )^;
2196 2 : result := PUint16( p )^;
2197 3 :
2198 if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
2199 result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or
2200 PUInt8Array( p )[ 2 ]
2201 else
2202 result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or
2203 PUInt8Array( p )[ 2 ] shl 16;
2204 4 : result := PUint32( p )^;
2205 else
2206 result := 0; // shouldn't happen, but avoids warnings
2207 end;
2208 end;
2209 { Set the pixel at (x, y) to the given value
2210 NOTE: The surface must be locked before calling this! }
2211
2212 procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
2213 Uint32 );
2214 var
2215 bpp : UInt32;
2216 p : PInteger;
2217 begin
2218 bpp := DstSurface.format.BytesPerPixel;
2219 p := Pointer( Uint32( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x )
2220 * bpp );
2221 case bpp of
2222 1 : PUint8( p )^ := pixel;
2223 2 : PUint16( p )^ := pixel;
2224 3 :
2225 if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
2226 begin
2227 PUInt8Array( p )[ 0 ] := ( pixel shr 16 ) and $FF;
2228 PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
2229 PUInt8Array( p )[ 2 ] := pixel and $FF;
2230 end
2231 else
2232 begin
2233 PUInt8Array( p )[ 0 ] := pixel and $FF;
2234 PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
2235 PUInt8Array( p )[ 2 ] := ( pixel shr 16 ) and $FF;
2236 end;
2237 4 :
2238 PUint32( p )^ := pixel;
2239 end;
2240 end;
2241
2242 procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
2243 var
2244 r1, r2 : TSDL_Rect;
2245 //buffer: PSDL_Surface;
2246 YPos : Integer;
2247 begin
2248 if ( DstSurface <> nil ) and ( DifY <> 0 ) then
2249 begin
2250 //if DifY > 0 then // going up
2251 //begin
2252 ypos := 0;
2253 r1.x := 0;
2254 r2.x := 0;
2255 r1.w := DstSurface.w;
2256 r2.w := DstSurface.w;
2257 r1.h := DifY;
2258 r2.h := DifY;
2259 while ypos < DstSurface.h do
2260 begin
2261 r1.y := ypos;
2262 r2.y := ypos + DifY;
2263 SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );
2264 ypos := ypos + DifY;
2265 end;
2266 //end
2267 //else
2268 //begin // Going Down
2269 //end;
2270 end;
2271 end;
2272
2273 {procedure SDL_ScrollY(Surface: PSDL_Surface; DifY: integer);
2274 var
2275 r1, r2: TSDL_Rect;
2276 buffer: PSDL_Surface;
2277 begin
2278 if (Surface <> nil) and (Dify <> 0) then
2279 begin
2280 buffer := SDL_CreateRGBSurface(SDL_HWSURFACE, (Surface^.w - DifY) * 2,
2281 Surface^.h * 2,
2282 Surface^.Format^.BitsPerPixel, 0, 0, 0, 0);
2283 if buffer <> nil then
2284 begin
2285 if (buffer^.format^.BytesPerPixel = 1) then
2286 SDL_SetColors(buffer, @Surface^.format^.palette^.colors^[0], 0, 256);
2287 r1 := SDLRect(0, DifY, buffer^.w, buffer^.h);
2288 r2 := SDLRect(0, 0, buffer^.w, buffer^.h);
2289 SDL_BlitSurface(Surface, @r1, buffer, @r2);
2290 SDL_BlitSurface(buffer, @r2, Surface, @r2);
2291 SDL_FreeSurface(buffer);
2292 end;
2293 end;
2294 end;}
2295
2296 procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
2297 var
2298 r1, r2 : TSDL_Rect;
2299 buffer : PSDL_Surface;
2300 begin
2301 if ( DstSurface <> nil ) and ( DifX <> 0 ) then
2302 begin
2303 buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,
2304 DstSurface^.h * 2,
2305 DstSurface^.Format^.BitsPerPixel,
2306 DstSurface^.Format^.RMask,
2307 DstSurface^.Format^.GMask,
2308 DstSurface^.Format^.BMask,
2309 DstSurface^.Format^.AMask );
2310 if buffer <> nil then
2311 begin
2312 if ( buffer^.format^.BytesPerPixel = 1 ) then
2313 SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
2314 r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );
2315 r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );
2316 SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );
2317 SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );
2318 SDL_FreeSurface( buffer );
2319 end;
2320 end;
2321 end;
2322
2323 procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
2324 PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
2325 var
2326 aSin, aCos : Single;
2327 MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;
2328 Colour, TempTransparentColour : UInt32;
2329 MAXX, MAXY : Integer;
2330 begin
2331 // Rotate the surface to the target surface.
2332 TempTransparentColour := SrcSurface.format.colorkey;
2333 {if srcRect.w > srcRect.h then
2334 begin
2335 Width := srcRect.w;
2336 Height := srcRect.w;
2337 end
2338 else
2339 begin
2340 Width := srcRect.h;
2341 Height := srcRect.h;
2342 end; }
2343
2344 maxx := DstSurface.w;
2345 maxy := DstSurface.h;
2346 aCos := cos( Angle );
2347 aSin := sin( Angle );
2348
2349 Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );
2350 Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );
2351
2352 OX := Width div 2;
2353 OY := Height div 2; ;
2354 MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;
2355 MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;
2356 ROX := ( -( srcRect.w div 2 ) ) + Offsetx;
2357 ROY := ( -( srcRect.h div 2 ) ) + OffsetY;
2358 Tx := ox + round( ROX * aSin - ROY * aCos );
2359 Ty := oy + round( ROY * aSin + ROX * aCos );
2360 SX := 0;
2361 for DX := DestX - TX to DestX - TX + ( width ) do
2362 begin
2363 Inc( SX );
2364 SY := 0;
2365 for DY := DestY - TY to DestY - TY + ( Height ) do
2366 begin
2367 RX := SX - OX;
2368 RY := SY - OY;
2369 NX := round( mx + RX * aSin + RY * aCos ); //
2370 NY := round( my + RY * aSin - RX * aCos ); //
2371 // Used for testing only
2372 //SDL_PutPixel(DestSurface.SDLSurfacePointer,DX,DY,0);
2373 if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then
2374 begin
2375 if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then
2376 begin
2377 if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then
2378 begin
2379 Colour := SDL_GetPixel( SrcSurface, NX, NY );
2380 if Colour <> TempTransparentColour then
2381 begin
2382 SDL_PutPixel( DstSurface, DX, DY, Colour );
2383 end;
2384 end;
2385 end;
2386 end;
2387 inc( SY );
2388 end;
2389 end;
2390 end;
2391
2392 procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
2393 PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
2394 begin
2395 SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );
2396 end;
2397
ValidateSurfaceRectnull2398 function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
2399 var
2400 RealRect : TSDL_Rect;
2401 OutOfRange : Boolean;
2402 begin
2403 OutOfRange := false;
2404 if dstrect = nil then
2405 begin
2406 RealRect.x := 0;
2407 RealRect.y := 0;
2408 RealRect.w := DstSurface.w;
2409 RealRect.h := DstSurface.h;
2410 end
2411 else
2412 begin
2413 if dstrect.x < DstSurface.w then
2414 begin
2415 RealRect.x := dstrect.x;
2416 end
2417 else if dstrect.x < 0 then
2418 begin
2419 realrect.x := 0;
2420 end
2421 else
2422 begin
2423 OutOfRange := True;
2424 end;
2425 if dstrect.y < DstSurface.h then
2426 begin
2427 RealRect.y := dstrect.y;
2428 end
2429 else if dstrect.y < 0 then
2430 begin
2431 realrect.y := 0;
2432 end
2433 else
2434 begin
2435 OutOfRange := True;
2436 end;
2437 if OutOfRange = False then
2438 begin
2439 if realrect.x + dstrect.w <= DstSurface.w then
2440 begin
2441 RealRect.w := dstrect.w;
2442 end
2443 else
2444 begin
2445 RealRect.w := dstrect.w - realrect.x;
2446 end;
2447 if realrect.y + dstrect.h <= DstSurface.h then
2448 begin
2449 RealRect.h := dstrect.h;
2450 end
2451 else
2452 begin
2453 RealRect.h := dstrect.h - realrect.y;
2454 end;
2455 end;
2456 end;
2457 if OutOfRange = False then
2458 begin
2459 result := realrect;
2460 end
2461 else
2462 begin
2463 realrect.w := 0;
2464 realrect.h := 0;
2465 realrect.x := 0;
2466 realrect.y := 0;
2467 result := realrect;
2468 end;
2469 end;
2470
2471 procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
2472 var
2473 RealRect : TSDL_Rect;
2474 Addr : pointer;
2475 ModX, BPP : cardinal;
2476 x, y, R, G, B, SrcColor : cardinal;
2477 begin
2478 RealRect := ValidateSurfaceRect( DstSurface, DstRect );
2479 if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
2480 begin
2481 SDL_LockSurface( DstSurface );
2482 BPP := DstSurface.format.BytesPerPixel;
2483 with DstSurface^ do
2484 begin
2485 Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
2486 ModX := Pitch - UInt32( RealRect.w ) * BPP;
2487 end;
2488 case DstSurface.format.BitsPerPixel of
2489 8 :
2490 begin
2491 for y := 0 to RealRect.h - 1 do
2492 begin
2493 for x := 0 to RealRect.w - 1 do
2494 begin
2495 SrcColor := PUInt32( Addr )^;
2496 R := SrcColor and $E0 + Color and $E0;
2497 G := SrcColor and $1C + Color and $1C;
2498 B := SrcColor and $03 + Color and $03;
2499 if R > $E0 then
2500 R := $E0;
2501 if G > $1C then
2502 G := $1C;
2503 if B > $03 then
2504 B := $03;
2505 PUInt8( Addr )^ := R or G or B;
2506 inc( UInt32( Addr ), BPP );
2507 end;
2508 inc( UInt32( Addr ), ModX );
2509 end;
2510 end;
2511 15 :
2512 begin
2513 for y := 0 to RealRect.h - 1 do
2514 begin
2515 for x := 0 to RealRect.w - 1 do
2516 begin
2517 SrcColor := PUInt32( Addr )^;
2518 R := SrcColor and $7C00 + Color and $7C00;
2519 G := SrcColor and $03E0 + Color and $03E0;
2520 B := SrcColor and $001F + Color and $001F;
2521 if R > $7C00 then
2522 R := $7C00;
2523 if G > $03E0 then
2524 G := $03E0;
2525 if B > $001F then
2526 B := $001F;
2527 PUInt16( Addr )^ := R or G or B;
2528 inc( UInt32( Addr ), BPP );
2529 end;
2530 inc( UInt32( Addr ), ModX );
2531 end;
2532 end;
2533 16 :
2534 begin
2535 for y := 0 to RealRect.h - 1 do
2536 begin
2537 for x := 0 to RealRect.w - 1 do
2538 begin
2539 SrcColor := PUInt32( Addr )^;
2540 R := SrcColor and $F800 + Color and $F800;
2541 G := SrcColor and $07C0 + Color and $07C0;
2542 B := SrcColor and $001F + Color and $001F;
2543 if R > $F800 then
2544 R := $F800;
2545 if G > $07C0 then
2546 G := $07C0;
2547 if B > $001F then
2548 B := $001F;
2549 PUInt16( Addr )^ := R or G or B;
2550 inc( UInt32( Addr ), BPP );
2551 end;
2552 inc( UInt32( Addr ), ModX );
2553 end;
2554 end;
2555 24 :
2556 begin
2557 for y := 0 to RealRect.h - 1 do
2558 begin
2559 for x := 0 to RealRect.w - 1 do
2560 begin
2561 SrcColor := PUInt32( Addr )^;
2562 R := SrcColor and $00FF0000 + Color and $00FF0000;
2563 G := SrcColor and $0000FF00 + Color and $0000FF00;
2564 B := SrcColor and $000000FF + Color and $000000FF;
2565 if R > $FF0000 then
2566 R := $FF0000;
2567 if G > $00FF00 then
2568 G := $00FF00;
2569 if B > $0000FF then
2570 B := $0000FF;
2571 PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
2572 inc( UInt32( Addr ), BPP );
2573 end;
2574 inc( UInt32( Addr ), ModX );
2575 end;
2576 end;
2577 32 :
2578 begin
2579 for y := 0 to RealRect.h - 1 do
2580 begin
2581 for x := 0 to RealRect.w - 1 do
2582 begin
2583 SrcColor := PUInt32( Addr )^;
2584 R := SrcColor and $00FF0000 + Color and $00FF0000;
2585 G := SrcColor and $0000FF00 + Color and $0000FF00;
2586 B := SrcColor and $000000FF + Color and $000000FF;
2587 if R > $FF0000 then
2588 R := $FF0000;
2589 if G > $00FF00 then
2590 G := $00FF00;
2591 if B > $0000FF then
2592 B := $0000FF;
2593 PUInt32( Addr )^ := R or G or B;
2594 inc( UInt32( Addr ), BPP );
2595 end;
2596 inc( UInt32( Addr ), ModX );
2597 end;
2598 end;
2599 end;
2600 SDL_UnlockSurface( DstSurface );
2601 end;
2602 end;
2603
2604 procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
2605 var
2606 RealRect : TSDL_Rect;
2607 Addr : pointer;
2608 ModX, BPP : cardinal;
2609 x, y, R, G, B, SrcColor : cardinal;
2610 begin
2611 RealRect := ValidateSurfaceRect( DstSurface, DstRect );
2612 if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
2613 begin
2614 SDL_LockSurface( DstSurface );
2615 BPP := DstSurface.format.BytesPerPixel;
2616 with DstSurface^ do
2617 begin
2618 Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
2619 ModX := Pitch - UInt32( RealRect.w ) * BPP;
2620 end;
2621 case DstSurface.format.BitsPerPixel of
2622 8 :
2623 begin
2624 for y := 0 to RealRect.h - 1 do
2625 begin
2626 for x := 0 to RealRect.w - 1 do
2627 begin
2628 SrcColor := PUInt32( Addr )^;
2629 R := SrcColor and $E0 - Color and $E0;
2630 G := SrcColor and $1C - Color and $1C;
2631 B := SrcColor and $03 - Color and $03;
2632 if R > $E0 then
2633 R := 0;
2634 if G > $1C then
2635 G := 0;
2636 if B > $03 then
2637 B := 0;
2638 PUInt8( Addr )^ := R or G or B;
2639 inc( UInt32( Addr ), BPP );
2640 end;
2641 inc( UInt32( Addr ), ModX );
2642 end;
2643 end;
2644 15 :
2645 begin
2646 for y := 0 to RealRect.h - 1 do
2647 begin
2648 for x := 0 to RealRect.w - 1 do
2649 begin
2650 SrcColor := PUInt32( Addr )^;
2651 R := SrcColor and $7C00 - Color and $7C00;
2652 G := SrcColor and $03E0 - Color and $03E0;
2653 B := SrcColor and $001F - Color and $001F;
2654 if R > $7C00 then
2655 R := 0;
2656 if G > $03E0 then
2657 G := 0;
2658 if B > $001F then
2659 B := 0;
2660 PUInt16( Addr )^ := R or G or B;
2661 inc( UInt32( Addr ), BPP );
2662 end;
2663 inc( UInt32( Addr ), ModX );
2664 end;
2665 end;
2666 16 :
2667 begin
2668 for y := 0 to RealRect.h - 1 do
2669 begin
2670 for x := 0 to RealRect.w - 1 do
2671 begin
2672 SrcColor := PUInt32( Addr )^;
2673 R := SrcColor and $F800 - Color and $F800;
2674 G := SrcColor and $07C0 - Color and $07C0;
2675 B := SrcColor and $001F - Color and $001F;
2676 if R > $F800 then
2677 R := 0;
2678 if G > $07C0 then
2679 G := 0;
2680 if B > $001F then
2681 B := 0;
2682 PUInt16( Addr )^ := R or G or B;
2683 inc( UInt32( Addr ), BPP );
2684 end;
2685 inc( UInt32( Addr ), ModX );
2686 end;
2687 end;
2688 24 :
2689 begin
2690 for y := 0 to RealRect.h - 1 do
2691 begin
2692 for x := 0 to RealRect.w - 1 do
2693 begin
2694 SrcColor := PUInt32( Addr )^;
2695 R := SrcColor and $00FF0000 - Color and $00FF0000;
2696 G := SrcColor and $0000FF00 - Color and $0000FF00;
2697 B := SrcColor and $000000FF - Color and $000000FF;
2698 if R > $FF0000 then
2699 R := 0;
2700 if G > $00FF00 then
2701 G := 0;
2702 if B > $0000FF then
2703 B := 0;
2704 PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
2705 inc( UInt32( Addr ), BPP );
2706 end;
2707 inc( UInt32( Addr ), ModX );
2708 end;
2709 end;
2710 32 :
2711 begin
2712 for y := 0 to RealRect.h - 1 do
2713 begin
2714 for x := 0 to RealRect.w - 1 do
2715 begin
2716 SrcColor := PUInt32( Addr )^;
2717 R := SrcColor and $00FF0000 - Color and $00FF0000;
2718 G := SrcColor and $0000FF00 - Color and $0000FF00;
2719 B := SrcColor and $000000FF - Color and $000000FF;
2720 if R > $FF0000 then
2721 R := 0;
2722 if G > $00FF00 then
2723 G := 0;
2724 if B > $0000FF then
2725 B := 0;
2726 PUInt32( Addr )^ := R or G or B;
2727 inc( UInt32( Addr ), BPP );
2728 end;
2729 inc( UInt32( Addr ), ModX );
2730 end;
2731 end;
2732 end;
2733 SDL_UnlockSurface( DstSurface );
2734 end;
2735 end;
2736
2737 procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
2738 var
2739 FBC : array[ 0..255 ] of Cardinal;
2740 // temp vars
2741 i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;
2742
2743 TempStepV, TempStepH : Single;
2744 TempLeft, TempTop, TempHeight, TempWidth : integer;
2745 TempRect : TSDL_Rect;
2746
2747 begin
2748 // calc FBC
2749 YR := StartColor.r;
2750 YG := StartColor.g;
2751 YB := StartColor.b;
2752 SR := YR;
2753 SG := YG;
2754 SB := YB;
2755 DR := EndColor.r - SR;
2756 DG := EndColor.g - SG;
2757 DB := EndColor.b - SB;
2758
2759 for i := 0 to 255 do
2760 begin
2761 FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );
2762 YR := SR + round( DR / 255 * i );
2763 YG := SG + round( DG / 255 * i );
2764 YB := SB + round( DB / 255 * i );
2765 end;
2766
2767 // if aStyle = 1 then begin
2768 TempStepH := Rect.w / 255;
2769 TempStepV := Rect.h / 255;
2770 TempHeight := Trunc( TempStepV + 1 );
2771 TempWidth := Trunc( TempStepH + 1 );
2772 TempTop := 0;
2773 TempLeft := 0;
2774 TempRect.x := Rect.x;
2775 TempRect.y := Rect.y;
2776 TempRect.h := Rect.h;
2777 TempRect.w := Rect.w;
2778
2779 case Style of
2780 gsHorizontal :
2781 begin
2782 TempRect.h := TempHeight;
2783 for i := 0 to 255 do
2784 begin
2785 TempRect.y := Rect.y + TempTop;
2786 SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
2787 TempTop := Trunc( TempStepV * i );
2788 end;
2789 end;
2790 gsVertical :
2791 begin
2792 TempRect.w := TempWidth;
2793 for i := 0 to 255 do
2794 begin
2795 TempRect.x := Rect.x + TempLeft;
2796 SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
2797 TempLeft := Trunc( TempStepH * i );
2798 end;
2799 end;
2800 end;
2801 end;
2802
2803 procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
2804 var
2805 ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
2806 SrcPitch, DestPitch, x, y : UInt32;
2807 begin
2808 if ( Src = nil ) or ( Dest = nil ) then
2809 exit;
2810 if ( Src.w shl 1 ) < Dest.w then
2811 exit;
2812 if ( Src.h shl 1 ) < Dest.h then
2813 exit;
2814
2815 if SDL_MustLock( Src ) then
2816 SDL_LockSurface( Src );
2817 if SDL_MustLock( Dest ) then
2818 SDL_LockSurface( Dest );
2819
2820 ReadRow := UInt32( Src.Pixels );
2821 WriteRow := UInt32( Dest.Pixels );
2822
2823 SrcPitch := Src.pitch;
2824 DestPitch := Dest.pitch;
2825
2826 case Src.format.BytesPerPixel of
2827 1 : for y := 1 to Src.h do
2828 begin
2829 ReadAddr := ReadRow;
2830 WriteAddr := WriteRow;
2831 for x := 1 to Src.w do
2832 begin
2833 PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
2834 PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
2835 PUInt8( WriteAddr + DestPitch )^ := PUInt8( ReadAddr )^;
2836 PUInt8( WriteAddr + DestPitch + 1 )^ := PUInt8( ReadAddr )^;
2837 inc( ReadAddr );
2838 inc( WriteAddr, 2 );
2839 end;
2840 inc( UInt32( ReadRow ), SrcPitch );
2841 inc( UInt32( WriteRow ), DestPitch * 2 );
2842 end;
2843 2 : for y := 1 to Src.h do
2844 begin
2845 ReadAddr := ReadRow;
2846 WriteAddr := WriteRow;
2847 for x := 1 to Src.w do
2848 begin
2849 PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
2850 PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
2851 PUInt16( WriteAddr + DestPitch )^ := PUInt16( ReadAddr )^;
2852 PUInt16( WriteAddr + DestPitch + 2 )^ := PUInt16( ReadAddr )^;
2853 inc( ReadAddr, 2 );
2854 inc( WriteAddr, 4 );
2855 end;
2856 inc( UInt32( ReadRow ), SrcPitch );
2857 inc( UInt32( WriteRow ), DestPitch * 2 );
2858 end;
2859 3 : for y := 1 to Src.h do
2860 begin
2861 ReadAddr := ReadRow;
2862 WriteAddr := WriteRow;
2863 for x := 1 to Src.w do
2864 begin
2865 PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
2866 PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
2867 PUInt32( WriteAddr + DestPitch )^ := ( PUInt32( WriteAddr + DestPitch )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
2868 PUInt32( WriteAddr + DestPitch + 3 )^ := ( PUInt32( WriteAddr + DestPitch + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
2869 inc( ReadAddr, 3 );
2870 inc( WriteAddr, 6 );
2871 end;
2872 inc( UInt32( ReadRow ), SrcPitch );
2873 inc( UInt32( WriteRow ), DestPitch * 2 );
2874 end;
2875 4 : for y := 1 to Src.h do
2876 begin
2877 ReadAddr := ReadRow;
2878 WriteAddr := WriteRow;
2879 for x := 1 to Src.w do
2880 begin
2881 PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
2882 PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
2883 PUInt32( WriteAddr + DestPitch )^ := PUInt32( ReadAddr )^;
2884 PUInt32( WriteAddr + DestPitch + 4 )^ := PUInt32( ReadAddr )^;
2885 inc( ReadAddr, 4 );
2886 inc( WriteAddr, 8 );
2887 end;
2888 inc( UInt32( ReadRow ), SrcPitch );
2889 inc( UInt32( WriteRow ), DestPitch * 2 );
2890 end;
2891 end;
2892
2893 if SDL_MustLock( Src ) then
2894 SDL_UnlockSurface( Src );
2895 if SDL_MustLock( Dest ) then
2896 SDL_UnlockSurface( Dest );
2897 end;
2898
2899 procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
2900 var
2901 ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
2902 SrcPitch, DestPitch, x, y : UInt32;
2903 begin
2904 if ( Src = nil ) or ( Dest = nil ) then
2905 exit;
2906 if ( Src.w shl 1 ) < Dest.w then
2907 exit;
2908 if ( Src.h shl 1 ) < Dest.h then
2909 exit;
2910
2911 if SDL_MustLock( Src ) then
2912 SDL_LockSurface( Src );
2913 if SDL_MustLock( Dest ) then
2914 SDL_LockSurface( Dest );
2915
2916 ReadRow := UInt32( Src.Pixels );
2917 WriteRow := UInt32( Dest.Pixels );
2918
2919 SrcPitch := Src.pitch;
2920 DestPitch := Dest.pitch;
2921
2922 case Src.format.BytesPerPixel of
2923 1 : for y := 1 to Src.h do
2924 begin
2925 ReadAddr := ReadRow;
2926 WriteAddr := WriteRow;
2927 for x := 1 to Src.w do
2928 begin
2929 PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
2930 PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
2931 inc( ReadAddr );
2932 inc( WriteAddr, 2 );
2933 end;
2934 inc( UInt32( ReadRow ), SrcPitch );
2935 inc( UInt32( WriteRow ), DestPitch * 2 );
2936 end;
2937 2 : for y := 1 to Src.h do
2938 begin
2939 ReadAddr := ReadRow;
2940 WriteAddr := WriteRow;
2941 for x := 1 to Src.w do
2942 begin
2943 PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
2944 PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
2945 inc( ReadAddr, 2 );
2946 inc( WriteAddr, 4 );
2947 end;
2948 inc( UInt32( ReadRow ), SrcPitch );
2949 inc( UInt32( WriteRow ), DestPitch * 2 );
2950 end;
2951 3 : for y := 1 to Src.h do
2952 begin
2953 ReadAddr := ReadRow;
2954 WriteAddr := WriteRow;
2955 for x := 1 to Src.w do
2956 begin
2957 PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
2958 PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
2959 inc( ReadAddr, 3 );
2960 inc( WriteAddr, 6 );
2961 end;
2962 inc( UInt32( ReadRow ), SrcPitch );
2963 inc( UInt32( WriteRow ), DestPitch * 2 );
2964 end;
2965 4 : for y := 1 to Src.h do
2966 begin
2967 ReadAddr := ReadRow;
2968 WriteAddr := WriteRow;
2969 for x := 1 to Src.w do
2970 begin
2971 PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
2972 PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
2973 inc( ReadAddr, 4 );
2974 inc( WriteAddr, 8 );
2975 end;
2976 inc( UInt32( ReadRow ), SrcPitch );
2977 inc( UInt32( WriteRow ), DestPitch * 2 );
2978 end;
2979 end;
2980
2981 if SDL_MustLock( Src ) then
2982 SDL_UnlockSurface( Src );
2983 if SDL_MustLock( Dest ) then
2984 SDL_UnlockSurface( Dest );
2985 end;
2986
2987 procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
2988 var
2989 ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
2990 SrcPitch, DestPitch, x, y, Color : UInt32;
2991 begin
2992 if ( Src = nil ) or ( Dest = nil ) then
2993 exit;
2994 if ( Src.w shl 1 ) < Dest.w then
2995 exit;
2996 if ( Src.h shl 1 ) < Dest.h then
2997 exit;
2998
2999 if SDL_MustLock( Src ) then
3000 SDL_LockSurface( Src );
3001 if SDL_MustLock( Dest ) then
3002 SDL_LockSurface( Dest );
3003
3004 ReadRow := UInt32( Src.Pixels );
3005 WriteRow := UInt32( Dest.Pixels );
3006
3007 SrcPitch := Src.pitch;
3008 DestPitch := Dest.pitch;
3009
3010 case Src.format.BitsPerPixel of
3011 8 : for y := 1 to Src.h do
3012 begin
3013 ReadAddr := ReadRow;
3014 WriteAddr := WriteRow;
3015 for x := 1 to Src.w do
3016 begin
3017 Color := PUInt8( ReadAddr )^;
3018 PUInt8( WriteAddr )^ := Color;
3019 PUInt8( WriteAddr + 1 )^ := Color;
3020 Color := ( Color shr 1 ) and $6D; {%01101101}
3021 PUInt8( WriteAddr + DestPitch )^ := Color;
3022 PUInt8( WriteAddr + DestPitch + 1 )^ := Color;
3023 inc( ReadAddr );
3024 inc( WriteAddr, 2 );
3025 end;
3026 inc( UInt32( ReadRow ), SrcPitch );
3027 inc( UInt32( WriteRow ), DestPitch * 2 );
3028 end;
3029 15 : for y := 1 to Src.h do
3030 begin
3031 ReadAddr := ReadRow;
3032 WriteAddr := WriteRow;
3033 for x := 1 to Src.w do
3034 begin
3035 Color := PUInt16( ReadAddr )^;
3036 PUInt16( WriteAddr )^ := Color;
3037 PUInt16( WriteAddr + 2 )^ := Color;
3038 Color := ( Color shr 1 ) and $3DEF; {%0011110111101111}
3039 PUInt16( WriteAddr + DestPitch )^ := Color;
3040 PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
3041 inc( ReadAddr, 2 );
3042 inc( WriteAddr, 4 );
3043 end;
3044 inc( UInt32( ReadRow ), SrcPitch );
3045 inc( UInt32( WriteRow ), DestPitch * 2 );
3046 end;
3047 16 : for y := 1 to Src.h do
3048 begin
3049 ReadAddr := ReadRow;
3050 WriteAddr := WriteRow;
3051 for x := 1 to Src.w do
3052 begin
3053 Color := PUInt16( ReadAddr )^;
3054 PUInt16( WriteAddr )^ := Color;
3055 PUInt16( WriteAddr + 2 )^ := Color;
3056 Color := ( Color shr 1 ) and $7BEF; {%0111101111101111}
3057 PUInt16( WriteAddr + DestPitch )^ := Color;
3058 PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
3059 inc( ReadAddr, 2 );
3060 inc( WriteAddr, 4 );
3061 end;
3062 inc( UInt32( ReadRow ), SrcPitch );
3063 inc( UInt32( WriteRow ), DestPitch * 2 );
3064 end;
3065 24 : for y := 1 to Src.h do
3066 begin
3067 ReadAddr := ReadRow;
3068 WriteAddr := WriteRow;
3069 for x := 1 to Src.w do
3070 begin
3071 Color := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
3072 PUInt32( WriteAddr )^ := Color;
3073 PUInt32( WriteAddr + 3 )^ := Color;
3074 Color := ( Color shr 1 ) and $007F7F7F; {%011111110111111101111111}
3075 PUInt32( WriteAddr + DestPitch )^ := Color;
3076 PUInt32( WriteAddr + DestPitch + 3 )^ := Color;
3077 inc( ReadAddr, 3 );
3078 inc( WriteAddr, 6 );
3079 end;
3080 inc( UInt32( ReadRow ), SrcPitch );
3081 inc( UInt32( WriteRow ), DestPitch * 2 );
3082 end;
3083 32 : for y := 1 to Src.h do
3084 begin
3085 ReadAddr := ReadRow;
3086 WriteAddr := WriteRow;
3087 for x := 1 to Src.w do
3088 begin
3089 Color := PUInt32( ReadAddr )^;
3090 PUInt32( WriteAddr )^ := Color;
3091 PUInt32( WriteAddr + 4 )^ := Color;
3092 Color := ( Color shr 1 ) and $7F7F7F7F;
3093 PUInt32( WriteAddr + DestPitch )^ := Color;
3094 PUInt32( WriteAddr + DestPitch + 4 )^ := Color;
3095 inc( ReadAddr, 4 );
3096 inc( WriteAddr, 8 );
3097 end;
3098 inc( UInt32( ReadRow ), SrcPitch );
3099 inc( UInt32( WriteRow ), DestPitch * 2 );
3100 end;
3101 end;
3102
3103 if SDL_MustLock( Src ) then
3104 SDL_UnlockSurface( Src );
3105 if SDL_MustLock( Dest ) then
3106 SDL_UnlockSurface( Dest );
3107 end;
3108
SDL_PixelTestSurfaceVsRectnull3109 function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
3110 PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
3111 boolean;
3112 var
3113 Src_Rect1, Src_Rect2 : TSDL_Rect;
3114 right1, bottom1 : integer;
3115 right2, bottom2 : integer;
3116 Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal;
3117 Mod1 : cardinal;
3118 Addr1 : cardinal;
3119 BPP : cardinal;
3120 Pitch1 : cardinal;
3121 TransparentColor1 : cardinal;
3122 tx, ty : cardinal;
3123 StartTick : cardinal;
3124 Color1 : cardinal;
3125 begin
3126 Result := false;
3127 if SrcRect1 = nil then
3128 begin
3129 with Src_Rect1 do
3130 begin
3131 x := 0;
3132 y := 0;
3133 w := SrcSurface1.w;
3134 h := SrcSurface1.h;
3135 end;
3136 end
3137 else
3138 Src_Rect1 := SrcRect1^;
3139
3140 Src_Rect2 := SrcRect2^;
3141 with Src_Rect1 do
3142 begin
3143 Right1 := Left1 + w;
3144 Bottom1 := Top1 + h;
3145 end;
3146 with Src_Rect2 do
3147 begin
3148 Right2 := Left2 + w;
3149 Bottom2 := Top2 + h;
3150 end;
3151 if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= Top2 ) then
3152 exit;
3153 if Left1 <= Left2 then
3154 begin
3155 // 1. left, 2. right
3156 Scan1Start := Src_Rect1.x + Left2 - Left1;
3157 //Scan2Start := Src_Rect2.x;
3158 ScanWidth := Right1 - Left2;
3159 with Src_Rect2 do
3160 if ScanWidth > w then
3161 ScanWidth := w;
3162 end
3163 else
3164 begin
3165 // 1. right, 2. left
3166 Scan1Start := Src_Rect1.x;
3167 //Scan2Start := Src_Rect2.x + Left1 - Left2;
3168 ScanWidth := Right2 - Left1;
3169 with Src_Rect1 do
3170 if ScanWidth > w then
3171 ScanWidth := w;
3172 end;
3173 with SrcSurface1^ do
3174 begin
3175 Pitch1 := Pitch;
3176 Addr1 := cardinal( Pixels );
3177 inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
3178 with format^ do
3179 begin
3180 BPP := BytesPerPixel;
3181 TransparentColor1 := colorkey;
3182 end;
3183 end;
3184
3185 Mod1 := Pitch1 - ( ScanWidth * BPP );
3186
3187 inc( Addr1, BPP * Scan1Start );
3188
3189 if Top1 <= Top2 then
3190 begin
3191 // 1. up, 2. down
3192 ScanHeight := Bottom1 - Top2;
3193 if ScanHeight > Src_Rect2.h then
3194 ScanHeight := Src_Rect2.h;
3195 inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
3196 end
3197 else
3198 begin
3199 // 1. down, 2. up
3200 ScanHeight := Bottom2 - Top1;
3201 if ScanHeight > Src_Rect1.h then
3202 ScanHeight := Src_Rect1.h;
3203
3204 end;
3205 case BPP of
3206 1 :
3207 for ty := 1 to ScanHeight do
3208 begin
3209 for tx := 1 to ScanWidth do
3210 begin
3211 if ( PByte( Addr1 )^ <> TransparentColor1 ) then
3212 begin
3213 Result := true;
3214 exit;
3215 end;
3216 inc( Addr1 );
3217
3218 end;
3219 inc( Addr1, Mod1 );
3220
3221 end;
3222 2 :
3223 for ty := 1 to ScanHeight do
3224 begin
3225 for tx := 1 to ScanWidth do
3226 begin
3227 if ( PWord( Addr1 )^ <> TransparentColor1 ) then
3228 begin
3229 Result := true;
3230 exit;
3231 end;
3232 inc( Addr1, 2 );
3233
3234 end;
3235 inc( Addr1, Mod1 );
3236
3237 end;
3238 3 :
3239 for ty := 1 to ScanHeight do
3240 begin
3241 for tx := 1 to ScanWidth do
3242 begin
3243 Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
3244
3245 if ( Color1 <> TransparentColor1 )
3246 then
3247 begin
3248 Result := true;
3249 exit;
3250 end;
3251 inc( Addr1, 3 );
3252
3253 end;
3254 inc( Addr1, Mod1 );
3255
3256 end;
3257 4 :
3258 for ty := 1 to ScanHeight do
3259 begin
3260 for tx := 1 to ScanWidth do
3261 begin
3262 if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then
3263 begin
3264 Result := true;
3265 exit;
3266 end;
3267 inc( Addr1, 4 );
3268
3269 end;
3270 inc( Addr1, Mod1 );
3271
3272 end;
3273 end;
3274 end;
3275
3276 procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
3277 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
3278 var
3279 R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
3280 Src, Dest : TSDL_Rect;
3281 Diff : integer;
3282 SrcAddr, DestAddr : cardinal;
3283 WorkX, WorkY : word;
3284 SrcMod, DestMod : cardinal;
3285 Bits : cardinal;
3286 begin
3287 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
3288 exit; // Remove this to make it faster
3289 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
3290 exit; // Remove this to make it faster
3291 if SrcRect = nil then
3292 begin
3293 with Src do
3294 begin
3295 x := 0;
3296 y := 0;
3297 w := SrcSurface.w;
3298 h := SrcSurface.h;
3299 end;
3300 end
3301 else
3302 Src := SrcRect^;
3303 if DestRect = nil then
3304 begin
3305 Dest.x := 0;
3306 Dest.y := 0;
3307 end
3308 else
3309 Dest := DestRect^;
3310 Dest.w := Src.w;
3311 Dest.h := Src.h;
3312 with DestSurface.Clip_Rect do
3313 begin
3314 // Source's right side is greater than the dest.cliprect
3315 if Dest.x + Src.w > x + w then
3316 begin
3317 smallint( Src.w ) := x + w - Dest.x;
3318 smallint( Dest.w ) := x + w - Dest.x;
3319 if smallint( Dest.w ) < 1 then
3320 exit;
3321 end;
3322 // Source's bottom side is greater than the dest.clip
3323 if Dest.y + Src.h > y + h then
3324 begin
3325 smallint( Src.h ) := y + h - Dest.y;
3326 smallint( Dest.h ) := y + h - Dest.y;
3327 if smallint( Dest.h ) < 1 then
3328 exit;
3329 end;
3330 // Source's left side is less than the dest.clip
3331 if Dest.x < x then
3332 begin
3333 Diff := x - Dest.x;
3334 Src.x := Src.x + Diff;
3335 smallint( Src.w ) := smallint( Src.w ) - Diff;
3336 Dest.x := x;
3337 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
3338 if smallint( Dest.w ) < 1 then
3339 exit;
3340 end;
3341 // Source's Top side is less than the dest.clip
3342 if Dest.y < y then
3343 begin
3344 Diff := y - Dest.y;
3345 Src.y := Src.y + Diff;
3346 smallint( Src.h ) := smallint( Src.h ) - Diff;
3347 Dest.y := y;
3348 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
3349 if smallint( Dest.h ) < 1 then
3350 exit;
3351 end;
3352 end;
3353 with SrcSurface^ do
3354 begin
3355 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
3356 Format.BytesPerPixel;
3357 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
3358 TransparentColor := Format.colorkey;
3359 end;
3360 with DestSurface^ do
3361 begin
3362 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
3363 Format.BytesPerPixel;
3364 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
3365 Bits := Format.BitsPerPixel;
3366 end;
3367 SDL_LockSurface( SrcSurface );
3368 SDL_LockSurface( DestSurface );
3369 WorkY := Src.h;
3370 case bits of
3371 8 :
3372 begin
3373 repeat
3374 WorkX := Src.w;
3375 repeat
3376 Pixel1 := PUInt8( SrcAddr )^;
3377 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3378 begin
3379 Pixel2 := PUInt8( DestAddr )^;
3380 PUInt8( DestAddr )^ := Pixel2 or Pixel1;
3381 end;
3382 inc( SrcAddr );
3383 inc( DestAddr );
3384 dec( WorkX );
3385 until WorkX = 0;
3386 inc( SrcAddr, SrcMod );
3387 inc( DestAddr, DestMod );
3388 dec( WorkY );
3389 until WorkY = 0;
3390 end;
3391 15 :
3392 begin
3393 repeat
3394 WorkX := Src.w;
3395 repeat
3396 Pixel1 := PUInt16( SrcAddr )^;
3397 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3398 begin
3399 Pixel2 := PUInt16( DestAddr )^;
3400
3401 PUInt16( DestAddr )^ := Pixel2 or Pixel1;
3402
3403 end;
3404 inc( SrcAddr, 2 );
3405 inc( DestAddr, 2 );
3406 dec( WorkX );
3407 until WorkX = 0;
3408 inc( SrcAddr, SrcMod );
3409 inc( DestAddr, DestMod );
3410 dec( WorkY );
3411 until WorkY = 0;
3412 end;
3413 16 :
3414 begin
3415 repeat
3416 WorkX := Src.w;
3417 repeat
3418 Pixel1 := PUInt16( SrcAddr )^;
3419 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3420 begin
3421 Pixel2 := PUInt16( DestAddr )^;
3422
3423 PUInt16( DestAddr )^ := Pixel2 or Pixel1;
3424
3425 end;
3426 inc( SrcAddr, 2 );
3427 inc( DestAddr, 2 );
3428 dec( WorkX );
3429 until WorkX = 0;
3430 inc( SrcAddr, SrcMod );
3431 inc( DestAddr, DestMod );
3432 dec( WorkY );
3433 until WorkY = 0;
3434 end;
3435 24 :
3436 begin
3437 repeat
3438 WorkX := Src.w;
3439 repeat
3440 Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
3441 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3442 begin
3443 Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
3444
3445 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 or Pixel1;
3446 end;
3447 inc( SrcAddr, 3 );
3448 inc( DestAddr, 3 );
3449 dec( WorkX );
3450 until WorkX = 0;
3451 inc( SrcAddr, SrcMod );
3452 inc( DestAddr, DestMod );
3453 dec( WorkY );
3454 until WorkY = 0;
3455 end;
3456 32 :
3457 begin
3458 repeat
3459 WorkX := Src.w;
3460 repeat
3461 Pixel1 := PUInt32( SrcAddr )^;
3462 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3463 begin
3464 Pixel2 := PUInt32( DestAddr )^;
3465
3466 PUInt32( DestAddr )^ := Pixel2 or Pixel1;
3467 end;
3468 inc( SrcAddr, 4 );
3469 inc( DestAddr, 4 );
3470 dec( WorkX );
3471 until WorkX = 0;
3472 inc( SrcAddr, SrcMod );
3473 inc( DestAddr, DestMod );
3474 dec( WorkY );
3475 until WorkY = 0;
3476 end;
3477 end;
3478 SDL_UnlockSurface( SrcSurface );
3479 SDL_UnlockSurface( DestSurface );
3480 end;
3481
3482 procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
3483 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
3484 var
3485 R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
3486 Src, Dest : TSDL_Rect;
3487 Diff : integer;
3488 SrcAddr, DestAddr : cardinal;
3489 WorkX, WorkY : word;
3490 SrcMod, DestMod : cardinal;
3491 Bits : cardinal;
3492 begin
3493 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
3494 exit; // Remove this to make it faster
3495 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
3496 exit; // Remove this to make it faster
3497 if SrcRect = nil then
3498 begin
3499 with Src do
3500 begin
3501 x := 0;
3502 y := 0;
3503 w := SrcSurface.w;
3504 h := SrcSurface.h;
3505 end;
3506 end
3507 else
3508 Src := SrcRect^;
3509 if DestRect = nil then
3510 begin
3511 Dest.x := 0;
3512 Dest.y := 0;
3513 end
3514 else
3515 Dest := DestRect^;
3516 Dest.w := Src.w;
3517 Dest.h := Src.h;
3518 with DestSurface.Clip_Rect do
3519 begin
3520 // Source's right side is greater than the dest.cliprect
3521 if Dest.x + Src.w > x + w then
3522 begin
3523 smallint( Src.w ) := x + w - Dest.x;
3524 smallint( Dest.w ) := x + w - Dest.x;
3525 if smallint( Dest.w ) < 1 then
3526 exit;
3527 end;
3528 // Source's bottom side is greater than the dest.clip
3529 if Dest.y + Src.h > y + h then
3530 begin
3531 smallint( Src.h ) := y + h - Dest.y;
3532 smallint( Dest.h ) := y + h - Dest.y;
3533 if smallint( Dest.h ) < 1 then
3534 exit;
3535 end;
3536 // Source's left side is less than the dest.clip
3537 if Dest.x < x then
3538 begin
3539 Diff := x - Dest.x;
3540 Src.x := Src.x + Diff;
3541 smallint( Src.w ) := smallint( Src.w ) - Diff;
3542 Dest.x := x;
3543 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
3544 if smallint( Dest.w ) < 1 then
3545 exit;
3546 end;
3547 // Source's Top side is less than the dest.clip
3548 if Dest.y < y then
3549 begin
3550 Diff := y - Dest.y;
3551 Src.y := Src.y + Diff;
3552 smallint( Src.h ) := smallint( Src.h ) - Diff;
3553 Dest.y := y;
3554 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
3555 if smallint( Dest.h ) < 1 then
3556 exit;
3557 end;
3558 end;
3559 with SrcSurface^ do
3560 begin
3561 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
3562 Format.BytesPerPixel;
3563 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
3564 TransparentColor := Format.colorkey;
3565 end;
3566 with DestSurface^ do
3567 begin
3568 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
3569 Format.BytesPerPixel;
3570 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
3571 Bits := Format.BitsPerPixel;
3572 end;
3573 SDL_LockSurface( SrcSurface );
3574 SDL_LockSurface( DestSurface );
3575 WorkY := Src.h;
3576 case bits of
3577 8 :
3578 begin
3579 repeat
3580 WorkX := Src.w;
3581 repeat
3582 Pixel1 := PUInt8( SrcAddr )^;
3583 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3584 begin
3585 Pixel2 := PUInt8( DestAddr )^;
3586 PUInt8( DestAddr )^ := Pixel2 and Pixel1;
3587 end;
3588 inc( SrcAddr );
3589 inc( DestAddr );
3590 dec( WorkX );
3591 until WorkX = 0;
3592 inc( SrcAddr, SrcMod );
3593 inc( DestAddr, DestMod );
3594 dec( WorkY );
3595 until WorkY = 0;
3596 end;
3597 15 :
3598 begin
3599 repeat
3600 WorkX := Src.w;
3601 repeat
3602 Pixel1 := PUInt16( SrcAddr )^;
3603 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3604 begin
3605 Pixel2 := PUInt16( DestAddr )^;
3606
3607 PUInt16( DestAddr )^ := Pixel2 and Pixel1;
3608
3609 end;
3610 inc( SrcAddr, 2 );
3611 inc( DestAddr, 2 );
3612 dec( WorkX );
3613 until WorkX = 0;
3614 inc( SrcAddr, SrcMod );
3615 inc( DestAddr, DestMod );
3616 dec( WorkY );
3617 until WorkY = 0;
3618 end;
3619 16 :
3620 begin
3621 repeat
3622 WorkX := Src.w;
3623 repeat
3624 Pixel1 := PUInt16( SrcAddr )^;
3625 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3626 begin
3627 Pixel2 := PUInt16( DestAddr )^;
3628
3629 PUInt16( DestAddr )^ := Pixel2 and Pixel1;
3630
3631 end;
3632 inc( SrcAddr, 2 );
3633 inc( DestAddr, 2 );
3634 dec( WorkX );
3635 until WorkX = 0;
3636 inc( SrcAddr, SrcMod );
3637 inc( DestAddr, DestMod );
3638 dec( WorkY );
3639 until WorkY = 0;
3640 end;
3641 24 :
3642 begin
3643 repeat
3644 WorkX := Src.w;
3645 repeat
3646 Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
3647 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3648 begin
3649 Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
3650
3651 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 and Pixel1;
3652 end;
3653 inc( SrcAddr, 3 );
3654 inc( DestAddr, 3 );
3655 dec( WorkX );
3656 until WorkX = 0;
3657 inc( SrcAddr, SrcMod );
3658 inc( DestAddr, DestMod );
3659 dec( WorkY );
3660 until WorkY = 0;
3661 end;
3662 32 :
3663 begin
3664 repeat
3665 WorkX := Src.w;
3666 repeat
3667 Pixel1 := PUInt32( SrcAddr )^;
3668 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3669 begin
3670 Pixel2 := PUInt32( DestAddr )^;
3671
3672 PUInt32( DestAddr )^ := Pixel2 and Pixel1;
3673 end;
3674 inc( SrcAddr, 4 );
3675 inc( DestAddr, 4 );
3676 dec( WorkX );
3677 until WorkX = 0;
3678 inc( SrcAddr, SrcMod );
3679 inc( DestAddr, DestMod );
3680 dec( WorkY );
3681 until WorkY = 0;
3682 end;
3683 end;
3684 SDL_UnlockSurface( SrcSurface );
3685 SDL_UnlockSurface( DestSurface );
3686 end;
3687
3688
3689
3690 procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
3691 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
3692 var
3693 R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
3694 Src, Dest : TSDL_Rect;
3695 Diff : integer;
3696 SrcAddr, DestAddr : cardinal;
3697 WorkX, WorkY : word;
3698 SrcMod, DestMod : cardinal;
3699 Bits : cardinal;
3700 begin
3701 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
3702 exit; // Remove this to make it faster
3703 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
3704 exit; // Remove this to make it faster
3705 if SrcRect = nil then
3706 begin
3707 with Src do
3708 begin
3709 x := 0;
3710 y := 0;
3711 w := SrcSurface.w;
3712 h := SrcSurface.h;
3713 end;
3714 end
3715 else
3716 Src := SrcRect^;
3717 if DestRect = nil then
3718 begin
3719 Dest.x := 0;
3720 Dest.y := 0;
3721 end
3722 else
3723 Dest := DestRect^;
3724 Dest.w := Src.w;
3725 Dest.h := Src.h;
3726 with DestSurface.Clip_Rect do
3727 begin
3728 // Source's right side is greater than the dest.cliprect
3729 if Dest.x + Src.w > x + w then
3730 begin
3731 smallint( Src.w ) := x + w - Dest.x;
3732 smallint( Dest.w ) := x + w - Dest.x;
3733 if smallint( Dest.w ) < 1 then
3734 exit;
3735 end;
3736 // Source's bottom side is greater than the dest.clip
3737 if Dest.y + Src.h > y + h then
3738 begin
3739 smallint( Src.h ) := y + h - Dest.y;
3740 smallint( Dest.h ) := y + h - Dest.y;
3741 if smallint( Dest.h ) < 1 then
3742 exit;
3743 end;
3744 // Source's left side is less than the dest.clip
3745 if Dest.x < x then
3746 begin
3747 Diff := x - Dest.x;
3748 Src.x := Src.x + Diff;
3749 smallint( Src.w ) := smallint( Src.w ) - Diff;
3750 Dest.x := x;
3751 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
3752 if smallint( Dest.w ) < 1 then
3753 exit;
3754 end;
3755 // Source's Top side is less than the dest.clip
3756 if Dest.y < y then
3757 begin
3758 Diff := y - Dest.y;
3759 Src.y := Src.y + Diff;
3760 smallint( Src.h ) := smallint( Src.h ) - Diff;
3761 Dest.y := y;
3762 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
3763 if smallint( Dest.h ) < 1 then
3764 exit;
3765 end;
3766 end;
3767 with SrcSurface^ do
3768 begin
3769 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
3770 Format.BytesPerPixel;
3771 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
3772 TransparentColor := Format.colorkey;
3773 end;
3774 with DestSurface^ do
3775 begin
3776 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
3777 Format.BytesPerPixel;
3778 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
3779 Bits := Format.BitsPerPixel;
3780 end;
3781 SDL_LockSurface( SrcSurface );
3782 SDL_LockSurface( DestSurface );
3783 WorkY := Src.h;
3784 case bits of
3785 8 :
3786 begin
3787 repeat
3788 WorkX := Src.w;
3789 repeat
3790 Pixel1 := PUInt8( SrcAddr )^;
3791 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3792 begin
3793 Pixel2 := PUInt8( DestAddr )^;
3794 if Pixel2 > 0 then
3795 begin
3796 if Pixel2 and $E0 > Pixel1 and $E0 then
3797 R := Pixel2 and $E0
3798 else
3799 R := Pixel1 and $E0;
3800 if Pixel2 and $1C > Pixel1 and $1C then
3801 G := Pixel2 and $1C
3802 else
3803 G := Pixel1 and $1C;
3804 if Pixel2 and $03 > Pixel1 and $03 then
3805 B := Pixel2 and $03
3806 else
3807 B := Pixel1 and $03;
3808
3809 if R > $E0 then
3810 R := $E0;
3811 if G > $1C then
3812 G := $1C;
3813 if B > $03 then
3814 B := $03;
3815 PUInt8( DestAddr )^ := R or G or B;
3816 end
3817 else
3818 PUInt8( DestAddr )^ := Pixel1;
3819 end;
3820 inc( SrcAddr );
3821 inc( DestAddr );
3822 dec( WorkX );
3823 until WorkX = 0;
3824 inc( SrcAddr, SrcMod );
3825 inc( DestAddr, DestMod );
3826 dec( WorkY );
3827 until WorkY = 0;
3828 end;
3829 15 :
3830 begin
3831 repeat
3832 WorkX := Src.w;
3833 repeat
3834 Pixel1 := PUInt16( SrcAddr )^;
3835 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3836 begin
3837 Pixel2 := PUInt16( DestAddr )^;
3838 if Pixel2 > 0 then
3839 begin
3840
3841 if Pixel2 and $7C00 > Pixel1 and $7C00 then
3842 R := Pixel2 and $7C00
3843 else
3844 R := Pixel1 and $7C00;
3845 if Pixel2 and $03E0 > Pixel1 and $03E0 then
3846 G := Pixel2 and $03E0
3847 else
3848 G := Pixel1 and $03E0;
3849 if Pixel2 and $001F > Pixel1 and $001F then
3850 B := Pixel2 and $001F
3851 else
3852 B := Pixel1 and $001F;
3853
3854 PUInt16( DestAddr )^ := R or G or B;
3855 end
3856 else
3857 PUInt16( DestAddr )^ := Pixel1;
3858 end;
3859 inc( SrcAddr, 2 );
3860 inc( DestAddr, 2 );
3861 dec( WorkX );
3862 until WorkX = 0;
3863 inc( SrcAddr, SrcMod );
3864 inc( DestAddr, DestMod );
3865 dec( WorkY );
3866 until WorkY = 0;
3867 end;
3868 16 :
3869 begin
3870 repeat
3871 WorkX := Src.w;
3872 repeat
3873 Pixel1 := PUInt16( SrcAddr )^;
3874 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3875 begin
3876 Pixel2 := PUInt16( DestAddr )^;
3877 if Pixel2 > 0 then
3878 begin
3879
3880 if Pixel2 and $F800 > Pixel1 and $F800 then
3881 R := Pixel2 and $F800
3882 else
3883 R := Pixel1 and $F800;
3884 if Pixel2 and $07E0 > Pixel1 and $07E0 then
3885 G := Pixel2 and $07E0
3886 else
3887 G := Pixel1 and $07E0;
3888 if Pixel2 and $001F > Pixel1 and $001F then
3889 B := Pixel2 and $001F
3890 else
3891 B := Pixel1 and $001F;
3892
3893 PUInt16( DestAddr )^ := R or G or B;
3894 end
3895 else
3896 PUInt16( DestAddr )^ := Pixel1;
3897 end;
3898 inc( SrcAddr, 2 );
3899 inc( DestAddr, 2 );
3900 dec( WorkX );
3901 until WorkX = 0;
3902 inc( SrcAddr, SrcMod );
3903 inc( DestAddr, DestMod );
3904 dec( WorkY );
3905 until WorkY = 0;
3906 end;
3907 24 :
3908 begin
3909 repeat
3910 WorkX := Src.w;
3911 repeat
3912 Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
3913 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3914 begin
3915 Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
3916 if Pixel2 > 0 then
3917 begin
3918
3919 if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
3920 R := Pixel2 and $FF0000
3921 else
3922 R := Pixel1 and $FF0000;
3923 if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
3924 G := Pixel2 and $00FF00
3925 else
3926 G := Pixel1 and $00FF00;
3927 if Pixel2 and $0000FF > Pixel1 and $0000FF then
3928 B := Pixel2 and $0000FF
3929 else
3930 B := Pixel1 and $0000FF;
3931
3932 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
3933 end
3934 else
3935 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
3936 end;
3937 inc( SrcAddr, 3 );
3938 inc( DestAddr, 3 );
3939 dec( WorkX );
3940 until WorkX = 0;
3941 inc( SrcAddr, SrcMod );
3942 inc( DestAddr, DestMod );
3943 dec( WorkY );
3944 until WorkY = 0;
3945 end;
3946 32 :
3947 begin
3948 repeat
3949 WorkX := Src.w;
3950 repeat
3951 Pixel1 := PUInt32( SrcAddr )^;
3952 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
3953 begin
3954 Pixel2 := PUInt32( DestAddr )^;
3955 if Pixel2 > 0 then
3956 begin
3957
3958 if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
3959 R := Pixel2 and $FF0000
3960 else
3961 R := Pixel1 and $FF0000;
3962 if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
3963 G := Pixel2 and $00FF00
3964 else
3965 G := Pixel1 and $00FF00;
3966 if Pixel2 and $0000FF > Pixel1 and $0000FF then
3967 B := Pixel2 and $0000FF
3968 else
3969 B := Pixel1 and $0000FF;
3970
3971 PUInt32( DestAddr )^ := R or G or B;
3972 end
3973 else
3974 PUInt32( DestAddr )^ := Pixel1;
3975 end;
3976 inc( SrcAddr, 4 );
3977 inc( DestAddr, 4 );
3978 dec( WorkX );
3979 until WorkX = 0;
3980 inc( SrcAddr, SrcMod );
3981 inc( DestAddr, DestMod );
3982 dec( WorkY );
3983 until WorkY = 0;
3984 end;
3985 end;
3986 SDL_UnlockSurface( SrcSurface );
3987 SDL_UnlockSurface( DestSurface );
3988 end;
3989
3990
3991 procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
3992 DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
3993 var
3994 R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
3995 Src, Dest : TSDL_Rect;
3996 Diff : integer;
3997 SrcAddr, DestAddr : cardinal;
3998 WorkX, WorkY : word;
3999 SrcMod, DestMod : cardinal;
4000 Bits : cardinal;
4001 begin
4002 if ( SrcSurface = nil ) or ( DestSurface = nil ) then
4003 exit; // Remove this to make it faster
4004 if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
4005 exit; // Remove this to make it faster
4006 if SrcRect = nil then
4007 begin
4008 with Src do
4009 begin
4010 x := 0;
4011 y := 0;
4012 w := SrcSurface.w;
4013 h := SrcSurface.h;
4014 end;
4015 end
4016 else
4017 Src := SrcRect^;
4018 if DestRect = nil then
4019 begin
4020 Dest.x := 0;
4021 Dest.y := 0;
4022 end
4023 else
4024 Dest := DestRect^;
4025 Dest.w := Src.w;
4026 Dest.h := Src.h;
4027 with DestSurface.Clip_Rect do
4028 begin
4029 // Source's right side is greater than the dest.cliprect
4030 if Dest.x + Src.w > x + w then
4031 begin
4032 smallint( Src.w ) := x + w - Dest.x;
4033 smallint( Dest.w ) := x + w - Dest.x;
4034 if smallint( Dest.w ) < 1 then
4035 exit;
4036 end;
4037 // Source's bottom side is greater than the dest.clip
4038 if Dest.y + Src.h > y + h then
4039 begin
4040 smallint( Src.h ) := y + h - Dest.y;
4041 smallint( Dest.h ) := y + h - Dest.y;
4042 if smallint( Dest.h ) < 1 then
4043 exit;
4044 end;
4045 // Source's left side is less than the dest.clip
4046 if Dest.x < x then
4047 begin
4048 Diff := x - Dest.x;
4049 Src.x := Src.x + Diff;
4050 smallint( Src.w ) := smallint( Src.w ) - Diff;
4051 Dest.x := x;
4052 smallint( Dest.w ) := smallint( Dest.w ) - Diff;
4053 if smallint( Dest.w ) < 1 then
4054 exit;
4055 end;
4056 // Source's Top side is less than the dest.clip
4057 if Dest.y < y then
4058 begin
4059 Diff := y - Dest.y;
4060 Src.y := Src.y + Diff;
4061 smallint( Src.h ) := smallint( Src.h ) - Diff;
4062 Dest.y := y;
4063 smallint( Dest.h ) := smallint( Dest.h ) - Diff;
4064 if smallint( Dest.h ) < 1 then
4065 exit;
4066 end;
4067 end;
4068 with SrcSurface^ do
4069 begin
4070 SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
4071 Format.BytesPerPixel;
4072 SrcMod := Pitch - Src.w * Format.BytesPerPixel;
4073 TransparentColor := Format.colorkey;
4074 end;
4075 with DestSurface^ do
4076 begin
4077 DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
4078 Format.BytesPerPixel;
4079 DestMod := Pitch - Dest.w * Format.BytesPerPixel;
4080 Bits := Format.BitsPerPixel;
4081 end;
4082 SDL_LockSurface( SrcSurface );
4083 SDL_LockSurface( DestSurface );
4084 WorkY := Src.h;
4085 case bits of
4086 8 :
4087 begin
4088 repeat
4089 WorkX := Src.w;
4090 repeat
4091 Pixel1 := PUInt8( SrcAddr )^;
4092 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
4093 begin
4094 Pixel2 := PUInt8( DestAddr )^;
4095 if Pixel2 > 0 then
4096 begin
4097 if Pixel2 and $E0 < Pixel1 and $E0 then
4098 R := Pixel2 and $E0
4099 else
4100 R := Pixel1 and $E0;
4101 if Pixel2 and $1C < Pixel1 and $1C then
4102 G := Pixel2 and $1C
4103 else
4104 G := Pixel1 and $1C;
4105 if Pixel2 and $03 < Pixel1 and $03 then
4106 B := Pixel2 and $03
4107 else
4108 B := Pixel1 and $03;
4109
4110 if R > $E0 then
4111 R := $E0;
4112 if G > $1C then
4113 G := $1C;
4114 if B > $03 then
4115 B := $03;
4116 PUInt8( DestAddr )^ := R or G or B;
4117 end
4118 else
4119 PUInt8( DestAddr )^ := Pixel1;
4120 end;
4121 inc( SrcAddr );
4122 inc( DestAddr );
4123 dec( WorkX );
4124 until WorkX = 0;
4125 inc( SrcAddr, SrcMod );
4126 inc( DestAddr, DestMod );
4127 dec( WorkY );
4128 until WorkY = 0;
4129 end;
4130 15 :
4131 begin
4132 repeat
4133 WorkX := Src.w;
4134 repeat
4135 Pixel1 := PUInt16( SrcAddr )^;
4136 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
4137 begin
4138 Pixel2 := PUInt16( DestAddr )^;
4139 if Pixel2 > 0 then
4140 begin
4141
4142 if Pixel2 and $7C00 < Pixel1 and $7C00 then
4143 R := Pixel2 and $7C00
4144 else
4145 R := Pixel1 and $7C00;
4146 if Pixel2 and $03E0 < Pixel1 and $03E0 then
4147 G := Pixel2 and $03E0
4148 else
4149 G := Pixel1 and $03E0;
4150 if Pixel2 and $001F < Pixel1 and $001F then
4151 B := Pixel2 and $001F
4152 else
4153 B := Pixel1 and $001F;
4154
4155 PUInt16( DestAddr )^ := R or G or B;
4156 end
4157 else
4158 PUInt16( DestAddr )^ := Pixel1;
4159 end;
4160 inc( SrcAddr, 2 );
4161 inc( DestAddr, 2 );
4162 dec( WorkX );
4163 until WorkX = 0;
4164 inc( SrcAddr, SrcMod );
4165 inc( DestAddr, DestMod );
4166 dec( WorkY );
4167 until WorkY = 0;
4168 end;
4169 16 :
4170 begin
4171 repeat
4172 WorkX := Src.w;
4173 repeat
4174 Pixel1 := PUInt16( SrcAddr )^;
4175 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
4176 begin
4177 Pixel2 := PUInt16( DestAddr )^;
4178 if Pixel2 > 0 then
4179 begin
4180
4181 if Pixel2 and $F800 < Pixel1 and $F800 then
4182 R := Pixel2 and $F800
4183 else
4184 R := Pixel1 and $F800;
4185 if Pixel2 and $07E0 < Pixel1 and $07E0 then
4186 G := Pixel2 and $07E0
4187 else
4188 G := Pixel1 and $07E0;
4189 if Pixel2 and $001F < Pixel1 and $001F then
4190 B := Pixel2 and $001F
4191 else
4192 B := Pixel1 and $001F;
4193
4194 PUInt16( DestAddr )^ := R or G or B;
4195 end
4196 else
4197 PUInt16( DestAddr )^ := Pixel1;
4198 end;
4199 inc( SrcAddr, 2 );
4200 inc( DestAddr, 2 );
4201 dec( WorkX );
4202 until WorkX = 0;
4203 inc( SrcAddr, SrcMod );
4204 inc( DestAddr, DestMod );
4205 dec( WorkY );
4206 until WorkY = 0;
4207 end;
4208 24 :
4209 begin
4210 repeat
4211 WorkX := Src.w;
4212 repeat
4213 Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
4214 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
4215 begin
4216 Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
4217 if Pixel2 > 0 then
4218 begin
4219
4220 if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
4221 R := Pixel2 and $FF0000
4222 else
4223 R := Pixel1 and $FF0000;
4224 if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
4225 G := Pixel2 and $00FF00
4226 else
4227 G := Pixel1 and $00FF00;
4228 if Pixel2 and $0000FF < Pixel1 and $0000FF then
4229 B := Pixel2 and $0000FF
4230 else
4231 B := Pixel1 and $0000FF;
4232
4233 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
4234 end
4235 else
4236 PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
4237 end;
4238 inc( SrcAddr, 3 );
4239 inc( DestAddr, 3 );
4240 dec( WorkX );
4241 until WorkX = 0;
4242 inc( SrcAddr, SrcMod );
4243 inc( DestAddr, DestMod );
4244 dec( WorkY );
4245 until WorkY = 0;
4246 end;
4247 32 :
4248 begin
4249 repeat
4250 WorkX := Src.w;
4251 repeat
4252 Pixel1 := PUInt32( SrcAddr )^;
4253 if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
4254 begin
4255 Pixel2 := PUInt32( DestAddr )^;
4256 if Pixel2 > 0 then
4257 begin
4258
4259 if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
4260 R := Pixel2 and $FF0000
4261 else
4262 R := Pixel1 and $FF0000;
4263 if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
4264 G := Pixel2 and $00FF00
4265 else
4266 G := Pixel1 and $00FF00;
4267 if Pixel2 and $0000FF < Pixel1 and $0000FF then
4268 B := Pixel2 and $0000FF
4269 else
4270 B := Pixel1 and $0000FF;
4271
4272 PUInt32( DestAddr )^ := R or G or B;
4273 end
4274 else
4275 PUInt32( DestAddr )^ := Pixel1;
4276 end;
4277 inc( SrcAddr, 4 );
4278 inc( DestAddr, 4 );
4279 dec( WorkX );
4280 until WorkX = 0;
4281 inc( SrcAddr, SrcMod );
4282 inc( DestAddr, DestMod );
4283 dec( WorkY );
4284 until WorkY = 0;
4285 end;
4286 end;
4287 SDL_UnlockSurface( SrcSurface );
4288 SDL_UnlockSurface( DestSurface );
4289 end;
4290
4291 // Will clip the x1,x2,y1,x2 params to the ClipRect provided
4292
SDL_ClipLinenull4293 function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
4294 var
4295 tflag, flag1, flag2 : word;
4296 txy, xedge, yedge : Integer;
4297 slope : single;
4298
ClipCodenull4299 function ClipCode( x, y : Integer ) : word;
4300 begin
4301 Result := 0;
4302 if x < ClipRect.x then
4303 Result := 1;
4304 if x >= ClipRect.w + ClipRect.x then
4305 Result := Result or 2;
4306 if y < ClipRect.y then
4307 Result := Result or 4;
4308 if y >= ClipRect.h + ClipRect.y then
4309 Result := Result or 8;
4310 end;
4311
4312 begin
4313 flag1 := ClipCode( x1, y1 );
4314 flag2 := ClipCode( x2, y2 );
4315 result := true;
4316
4317 while true do
4318 begin
4319 if ( flag1 or flag2 ) = 0 then
4320 Exit; // all in
4321
4322 if ( flag1 and flag2 ) <> 0 then
4323 begin
4324 result := false;
4325 Exit; // all out
4326 end;
4327
4328 if flag2 = 0 then
4329 begin
4330 txy := x1; x1 := x2; x2 := txy;
4331 txy := y1; y1 := y2; y2 := txy;
4332 tflag := flag1; flag1 := flag2; flag2 := tflag;
4333 end;
4334
4335 if ( flag2 and 3 ) <> 0 then
4336 begin
4337 if ( flag2 and 1 ) <> 0 then
4338 xedge := ClipRect.x
4339 else
4340 xedge := ClipRect.w + ClipRect.x - 1; // back 1 pixel otherwise we end up in a loop
4341
4342 slope := ( y2 - y1 ) / ( x2 - x1 );
4343 y2 := y1 + Round( slope * ( xedge - x1 ) );
4344 x2 := xedge;
4345 end
4346 else
4347 begin
4348 if ( flag2 and 4 ) <> 0 then
4349 yedge := ClipRect.y
4350 else
4351 yedge := ClipRect.h + ClipRect.y - 1; // up 1 pixel otherwise we end up in a loop
4352
4353 slope := ( x2 - x1 ) / ( y2 - y1 );
4354 x2 := x1 + Round( slope * ( yedge - y1 ) );
4355 y2 := yedge;
4356 end;
4357
4358 flag2 := ClipCode( x2, y2 );
4359 end;
4360 end;
4361
4362 end.
4363
4364