sdlutils.pas 127 KB

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