sdlutils.pas 127 KB

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