sdlutils.pas 125 KB

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