sdlutils.pas 127 KB

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