'
'                           ___________________________________________
'         _______ _ _ _     \___           ___________________________/
'    /\  (_______) (_) |       /  //  //  /  
'   /  \  _  __  | |_| | _    /  //  //  / << version 0.86 alpha test >>
'  / /\ \| |(__| | | | || \  /  //  //  /  For FreeBASIC (v0.20b or later).
' | |__| | |     | | | |_) )/  //  //  /     
' |_|  |_|_|     |_|_|____//  //  //  /   Original Development by
'  _______________________/  //  //  /___ Adigun Azikiwe Polack for Aura Flow.
' /_____________________________________/
'
'  A  u  r  a      F  l  o  w      L  i  b  r  a  r  y      3
'_________________________________________________________________________
'
' (c)2005-2016 Adigun Azikiwe Polack/Aura Flow.  All Rights Reserved.
'
'
'
'   _____                              __  ___          __      __   
'  / ___/_____________  ___  ____     /  |/  /___  ____/ /_  __/ /__ 
'  \__ \/ ___/ ___/ _ \/ _ \/ __ \   / /|_/ / __ \/ __  / / / / / _ \
' ___/ / /__/ /  /  __/  __/ / / /  / /  / / /_/ / /_/ / /_/ / /  __/
'/____/\___/_/   \___/\___/_/ /_/  /_/  /_/\____/\__,_/\__,_/_/\___/ 
'                                                                              
'
'_________________________________________________________________________
'                        ----- N O T I C E -----
'_________________________________________________________________________
' The following is this piece of source code to this version of AFlib III.
' You are free to look at it to give you some inspiring ideas in your own
' programming in FreeBASIC, but you are *never* to even change or adjust
' any of this source code whatsoever in any way, shape, or form at all.
' EVER.  ;)
'
' The reason for this is to ensure that all of the routines in this source
' code are working as properly as they should in FreeBASIC v0.20b or
' newer.  That is all.
'
' With that said, do enjoy the library and be inspired even more
' greatly than ever!!!  (^-^)//
'_________________________________________________________________________



'$profile
'$stop_scan

#include once "fbgfx.bi"
ScreenControl(FB.SET_DRIVER_NAME, "GDI")

#define isBufferNew_d( __buffer__ ) iif( __buffer__ <> 0, *cast( Integer Ptr, __buffer__ ) = 7, 0 )

Dim shared as any ptr AF3_ScreenCapture_to_Screen(1 to 128)
Dim shared as any ptr AF3_ScreenZoom_Display
Dim shared as any ptr AF3_ScreenZoom_Capture




'
'Declare Sub AFlibIII_VertScreenFlip (Byval buffer as Any Ptr = 0 )
'Declare Sub AFlibIII_HorizScreenFlip (Byval buffer as Any Ptr = 0 )
'

Declare Sub AFlibIII_LowRes2X ( Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_LowRes4X ( Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_LowRes8X ( Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_CustomZoom2X ( Byval sx as Integer, Byval sy as Integer, _
                                    Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_CustomZoom4X ( Byval sx as Integer, Byval sy as Integer, _
                                    Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_CustomZoom8X ( Byval sx as Integer, Byval sy as Integer, _
                                    Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_LowRes_vert ( Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_LowRes_horiz ( Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_PrepareScreenTrans ( Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_CaptureScreen ( Byval screen_id as Integer )

Declare Sub AFlibIII_UpdateScreen ( Byval screen_id as Integer )
Declare Sub AFlibIII_UpdateScreen_half_size ( Byval screen_id as Integer )
Declare Sub AFlibIII_UpdateScreen_quarter_size ( Byval screen_id as Integer )
Declare Sub AFlibIII_UpdateScreen_eighth_size ( Byval screen_id as Integer )

Declare Sub AFlibIII_BlitScreen ( Byval x as Integer, Byval y as Integer, _
                                  Byval screen_id as Integer, _
                                  Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_alpha ( Byval x as Integer, Byval y as Integer, _
                                        Byval alpha as Integer, _
                                        Byval screen_id as Integer, _
                                        Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_add ( Byval x as Integer, Byval y as Integer, _
                                      Byval add_blend as Integer, _
                                      Byval screen_id as Integer, _
                                      Byval buffer as any ptr = 0 )
                                      
Declare Sub AFlibIII_BlitScreen_firefly ( Byval x as Integer, Byval y as Integer, _
                                          Byval brightness_level as Integer, _
                                          Byval screen_id as Integer, _
                                          Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_color ( Byval x as Integer, Byval y as Integer, _
                                        Byval col as Integer, _
                                        Byval screen_id as Integer, _
                                        Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_tint ( Byval x as Integer, Byval y as Integer, _
                                       Byval col_to_tint as Integer, _
                                       Byval alpha_level as Integer, _
                                       Byval screen_id as Integer, _
                                       Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_greyscale ( Byval x as Integer, Byval y as Integer, _
                                            Byval screen_id as Integer, _
                                            Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_greytint ( Byval x as Integer, Byval y as Integer, _
                                           Byval alpha_tinting as Integer, _
                                           Byval screen_id as Integer, _
                                           Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_inverse ( Byval x as Integer, Byval y as Integer, _
                                          Byval screen_id as Integer, _
                                          Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_invtint ( Byval x as Integer, Byval y as Integer, _
                                          Byval alpha_tinting as Integer, _
                                          Byval screen_id as Integer, _
                                          Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_inversegrey ( Byval x as Integer, Byval y as Integer, _
                                              Byval screen_id as Integer, _
                                              Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_invgreytint ( Byval x as Integer, Byval y as Integer, _
                                              Byval alpha_tinting as Integer, _
                                              Byval screen_id as Integer, _
                                              Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_overlay ( Byval x as Integer, Byval y as Integer, _
                                          Byval overlay_col as Integer, _
                                          Byval screen_id as Integer, _
                                          Byval buffer as any ptr = 0 )

Declare Sub AFlibIII_BlitScreen_rotate ( Byval x as Integer, _
                                         Byval y as Integer, _
                                         Byval screen_id as Integer, _
                                         Byval rotation_angle as double, _
                                         Byval H_flip as Integer = 0, _
                                         Byval V_flip as Integer = 0, _
                                         Byval alpha as Integer = 255, _
                                         Byval alphachannel as Integer = 1, _
                                         Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_BlitScreen_rotate_solid ( Byval x as Integer, _
                                               Byval y as Integer, _
                                               Byval screen_id as Integer, _
                                               Byval rotation_angle as double, _
                                               Byval H_flip as Integer = 0, _
                                               Byval V_flip as Integer = 0, _
                                               Byval alpha as Integer = 255, _
                                               Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_BlitScreen_scale ( Byval x as Integer, _
                                        Byval y as Integer, _
                                        Byval screen_id as Integer, _
                                        Byval scale_x as single, _
                                        Byval scale_y as single, _
                                        Byval H_flip as Integer = 0, _
                                        Byval V_flip as Integer = 0, _
                                        Byval alpha as Integer = 255, _
                                        Byval alphachannel as Integer = 1, _
                                        Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_BlitScreen_scale_solid ( Byval x as Integer, _
                                              Byval y as Integer, _
                                              Byval screen_id as Integer, _
                                              Byval scale_x as single, _
                                              Byval scale_y as single, _
                                              Byval H_flip as Integer = 0, _
                                              Byval V_flip as Integer = 0, _
                                              Byval alpha as Integer = 255, _
                                              Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_BlitScreen_scalerotate ( Byval x as Integer, _
                                              Byval y as Integer, _
                                              Byval screen_id as Integer, _
                                              Byval scale_x as single, _
                                              Byval scale_y as single, _
                                              Byval rotation_angle as double, _
                                              Byval H_flip as Integer = 0, _
                                              Byval V_flip as Integer = 0, _
                                              Byval alpha as Integer = 255, _
                                              Byval alphachannel as Integer = 1, _
                                              Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_BlitScreen_scalerotate_solid ( Byval x as Integer, _
                                                    Byval y as Integer, _
                                                    Byval screen_id as Integer, _
                                                    Byval scale_x as single, _
                                                    Byval scale_y as single, _
                                                    Byval rotation_angle as double, _
                                                    Byval H_flip as Integer = 0, _
                                                    Byval V_flip as Integer = 0, _
                                                    Byval alpha as Integer = 255, _
                                                    Byval buffer as Any Ptr = 0 )

Declare Function AFlibIII_ScreenCollide ( Byval screen_x1 as Integer, _
                                          Byval screen_y1 as Integer, _
                                          Byval screen_id1 as Integer, _
                                          Byval screen_x2 as Integer, _
                                          Byval screen_y2 as Integer, _
                                          Byval screen_id2 as Integer, _
                                          Byval EnableAlpha as integer = 0 ) as integer


Declare Function AFlibIII_ScreenCollide_Spr ( Byval screen_x as Integer, _
                                              Byval screen_y as Integer, _
                                              Byval screen_id as Integer, _
                                              Byval spr_x as Integer, _
                                              Byval spr_y as Integer, _
                                              Byval image as Any Ptr, _
                                              Byval EnableAlpha as integer = 0 ) as integer

Declare Sub AFlibIII_RemoveScreen ( Byval screen_id as Integer )
Declare Sub AFlibIII_RemoveScreen_CleanSweep








Declare Function AFlibIII_resizeFBImage ( Byval _width_ As Integer, _
                                          Byval _height_ As Integer, _
                                          Byval img As fb.Image Ptr ) As fb.Image Ptr

Declare Sub Private3_check_buffersize ( Byval buffer As Any Ptr, Byref x As Integer, _
                                        Byref y As Integer )

Declare Sub Private3_SprBlit ( Byval x1 as Integer, Byval y1 as Integer, _
                               Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_alpha ( Byval x1 as Integer, Byval y1 as Integer, _
                                     Byval alpha as integer, Byval image as any ptr, _
                                     Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_add ( Byval x1 as Integer, Byval y1 as Integer, _
                                   Byval add_blend as integer, Byval image as any ptr, _
                                   Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_firefly ( Byval x1 as integer, Byval y1 as integer, _
                                       Byval brightness_level as integer, Byval image as any ptr, _
                                       Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_color ( Byval x1 as integer, Byval y1 as integer, _
                                     Byval col as integer, Byval image as any ptr, _
                                     Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_tint ( Byval x1 as integer, Byval y1 as integer, _
                                    Byval col_to_tint as integer, Byval alpha_level as integer, _
                                    Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_greyscale ( Byval x1 as Integer, Byval y1 as Integer, _
                                         Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_greytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                        Byval alpha_tinting as integer, Byval image as any ptr, _
                                        Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_inverse ( Byval x1 as integer, Byval y1 as integer, _
                                       Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_invtint ( Byval x1 as Integer, Byval y1 as Integer, _
                                       Byval alpha_tinting as integer, Byval image as any ptr, _
                                       Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_inversegrey ( Byval x1 as Integer, Byval y1 as Integer, _
                                           Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_invgreytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                           Byval alpha_tinting as integer, Byval image as any ptr, _
                                           Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_overlay ( Byval x1 as Integer, Byval y1 as Integer, _
                                       Byval overlay_col as integer, Byval image as any ptr, _
                                       Byval buffer as Any Ptr = 0 )

Declare Sub Private3_SprBlit_rotate ( Byval sx_midpos as Integer, _
                                      Byval sy_midpos as Integer, _
                                      Byval image as Any Ptr, _
                                      Byval rotation_angle as Single, _
                                      Byval H_flip as Integer = 0, _
                                      Byval V_flip as Integer = 0, _
                                      Byval alpha as Integer = 255, _
                                      Byval alphachannel as Integer = 1, _
                                      Byval buffer as Any Ptr = 0, _
                                      Byval Custom as Function ( Byval Src As Uinteger, _
                                                                 Byval Dest As Uinteger, _
                                                                 Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                      Byval Param as Any Ptr = 0)

Declare Sub Private3_SprBlit_rotate_solid ( Byval sx_midpos as Integer, _
                                            Byval sy_midpos as Integer, _
                                            Byval image as Any Ptr, _
                                            Byval rotation_angle as Single, _
                                            Byval H_flip as Integer = 0, _
                                            Byval V_flip as Integer = 0, _
                                            Byval alpha as Integer = 255, _
                                            Byval buffer as Any Ptr = 0, _
                                            Byval Custom as Function ( Byval Src As Uinteger, _
                                                                       Byval Dest As Uinteger, _
                                                                       Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                            Byval Param as Any Ptr = 0)

Declare Sub Private3_SprBlit_scale ( Byval sx_midpos as Integer, _
                                     Byval sy_midpos as Integer, _
                                     Byval image as Any Ptr, _
                                     Byval scale_x as Single, _
                                     Byval scale_y as Single, _
                                     Byval H_flip as Integer = 0, _
                                     Byval V_flip as Integer = 0, _
                                     Byval alpha as Integer = 255, _
                                     Byval alphachannel as Integer = 1, _
                                     Byval buffer as Any Ptr = 0, _
                                     Byval Custom as Function ( Byval Src As Uinteger, _
                                                                Byval Dest As Uinteger, _
                                                                Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                     Byval Param as Any Ptr = 0)

Declare Sub Private3_SprBlit_scale_solid ( Byval sx_midpos as Integer, _
                                           Byval sy_midpos as Integer, _
                                           Byval image as Any Ptr, _
                                           Byval scale_x as Single, _
                                           Byval scale_y as Single, _
                                           Byval H_flip as Integer = 0, _
                                           Byval V_flip as Integer = 0, _
                                           Byval alpha as Integer = 255, _
                                           Byval buffer as Any Ptr = 0, _
                                           Byval Custom as Function ( Byval Src As Uinteger, _
                                                                      Byval Dest As Uinteger, _
                                                                      Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                           Byval Param as Any Ptr = 0)

Declare Sub Private3_SprBlit_scalerotate ( Byval sx_midpos as Integer, _
                                           Byval sy_midpos as Integer, _
                                           Byval image as Any Ptr, _
                                           Byval scale_x as Single, _
                                           Byval scale_y as Single, _
                                           Byval rotation_angle as Single, _
                                           Byval H_flip as Integer = 0, _
                                           Byval V_flip as Integer = 0, _
                                           Byval alpha as Integer = 255, _
                                           Byval alphachannel as Integer = 1, _
                                           Byval buffer as Any Ptr = 0, _
                                           Byval Custom as Function ( Byval Src As Uinteger, _
                                                                      Byval Dest As Uinteger, _
                                                                      Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                           Byval Param as Any Ptr = 0)

Declare Sub Private3_SprBlit_scalerotate_solid ( Byval sx_midpos as Integer, _
                                                 Byval sy_midpos as Integer, _
                                                 Byval image as Any Ptr, _
                                                 Byval scale_x as Single, _
                                                 Byval scale_y as Single, _
                                                 Byval rotation_angle as Single, _
                                                 Byval H_flip as Integer = 0, _
                                                 Byval V_flip as Integer = 0, _
                                                 Byval alpha as Integer = 255, _
                                                 Byval buffer as Any Ptr = 0, _
                                                 Byval Custom as Function ( Byval Src As Uinteger, _
                                                                            Byval Dest As Uinteger, _
                                                                            Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                                 Byval Param as Any Ptr = 0)

Declare Sub Private3_LowRes_scaler ( Byval sx_midpos as Integer, _
                                     Byval sy_midpos as Integer, _
                                     Byval image as Any Ptr, _
                                     Byval scale_x as Single, _
                                     Byval scale_y as Single, _
                                     Byval H_flip as Integer = 0, _
                                     Byval V_flip as Integer = 0, _
                                     Byval alpha as Integer = 255, _
                                     Byval alphachannel as Integer = 1, _
                                     Byval buffer as Any Ptr = 0, _
                                     Byval Custom as Function ( Byval Src As Uinteger, _
                                                                Byval Dest As Uinteger, _
                                                                Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                     Byval Param as Any Ptr = 0)
                             
Declare Function Private3_customcolor( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function Private3_inverse( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function Private3_shadow( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function Private3_grayscale( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function Private3_greyscaleinverse( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function Private3_overlay( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger

Declare Function Rawcollision_screen ( Byval x1 as integer, _
                                       Byval y1 as integer, _
                                       Byval CollideSpr1 as any ptr, _
                                       Byval x2 as integer, _
                                       Byval y2 as integer, _
                                       Byval CollideSpr2 as any ptr, _
                                       Byval EnableAlpha as integer = 0 ) as integer






'__________________________________________________________________________
Sub AFlibIII_LowRes2X ( Byval buffer as Any Ptr = 0 )
'----------------------------------------------------------------------
' Special thanks to Pritchard for helping me optimize this GREAT
' low-res creation routine for any hi-res mode!!!   ^-^=b !
'
'----------------------------------------------------------------------
  Dim as integer GFX_x, GFX_y
  
  If not buffer = 0 then 
    Private3_check_buffersize buffer, GFX_x, GFX_y
  else
    ScreenInfo GFX_x, GFX_y
  End if

  Dim As fb.Image Ptr OldImg = imagecreate(GFX_x, GFX_y, 0)
  Get buffer, (0, 0)-((GFX_x / 2) - 1, (GFX_y / 2) - 1), OldImg
  
  Private3_check_buffersize OldImg, GFX_x, GFX_y

  Private3_LowRes_scaler 0 + GFX_x, 0 + GFX_y, OldImg, _
                         2.0005, 2.000, _
                         0, 0, _
                         255, 0, _
                         buffer

  ImageDestroy (OldImg)
End Sub


'__________________________________________________________________________
Sub AFlibIII_LowRes4X ( Byval buffer as Any Ptr = 0 )
'----------------------------------------------------------------------
' Special thanks to Pritchard for helping me optimize this GREAT
' low-res creation routine for any hi-res mode!!!   ^-^=b !
'
'----------------------------------------------------------------------
  Dim as integer GFX_x, GFX_y
  
  If not buffer = 0 then 
    Private3_check_buffersize buffer, GFX_x, GFX_y
  else
    ScreenInfo GFX_x, GFX_y
  End if
  
  Dim As fb.Image Ptr OldImg = imagecreate(GFX_x, GFX_y)
  Dim As fb.Image Ptr NewImg
  Get buffer, (0, 0)-((GFX_x / 4) - 1, (GFX_y / 4) - 1), OldImg
  Line buffer, (0, 0)-(GFX_x, GFX_y), 0, BF

  NewImg = AFlibIII_resizeFBImage( GFX_x, GFX_y, OldImg )
  Put buffer, (0, 0), NewImg, pset
  
  ImageDestroy (OldImg)
  ImageDestroy (NewImg)
End Sub


'__________________________________________________________________________
Sub AFlibIII_LowRes8X ( Byval buffer as Any Ptr = 0 )
'----------------------------------------------------------------------
' Special thanks to Pritchard for helping me optimize this GREAT
' low-res creation routine for any hi-res mode!!!   ^-^=b !
'
'----------------------------------------------------------------------
  Dim as integer GFX_x, GFX_y
  
  If not buffer = 0 then 
    Private3_check_buffersize buffer, GFX_x, GFX_y
  else
    ScreenInfo GFX_x, GFX_y
  End if

  Dim As fb.Image Ptr OldImg = imagecreate(GFX_x, GFX_y)
  Dim As fb.Image Ptr NewImg
  Get buffer, (0, 0)-((GFX_x / 8) - 1, (GFX_y / 8) - 1), OldImg
  Line buffer, (0, 0)-(GFX_x, GFX_y), 0, BF

  NewImg = AFlibIII_resizeFBImage( GFX_x, GFX_y, OldImg )
  Put buffer, (0, 0), NewImg, pset
  
  ImageDestroy (OldImg)
  ImageDestroy (NewImg)
End Sub


'___________________________________________________________________________
Sub AFlibIII_CustomZoom2X ( Byval sx as Integer, Byval sy as Integer, _
                            Byval buffer as Any Ptr = 0 )

Dim as integer GFX_x, GFX_y

If not buffer = 0 then 
  Private3_check_buffersize buffer, GFX_x, GFX_y
else
  ScreenInfo GFX_x, GFX_y
End if

If sx < 0 then sx = 0
If sy < 0 then sy = 0
If sx > (GFX_x - (GFX_x / 2)) then sx = (GFX_x - (GFX_x / 2))
If sy > (GFX_y - (GFX_y / 2)) then sy = (GFX_y - (GFX_y / 2))

GFX_x /= 2: GFX_y /= 2
AF3_ScreenZoom_Capture = ImageCreate(GFX_x, GFX_y)
Get buffer, (sx + 0, sy + 0)-(sx + (GFX_x - 1), sy + (GFX_y - 1)), AF3_ScreenZoom_Capture

Put buffer, (0, 0), AF3_ScreenZoom_Capture, Pset
AFlibIII_LowRes2X buffer

ImageDestroy (AF3_ScreenZoom_Capture)

End Sub


'___________________________________________________________________________
Sub AFlibIII_CustomZoom4X ( Byval sx as Integer, Byval sy as Integer, _
                            Byval buffer as Any Ptr = 0 )

Dim as integer GFX_x, GFX_y
ScreenInfo GFX_x, GFX_y

If not buffer = 0 then 
  Private3_check_buffersize buffer, GFX_x, GFX_y
else
  ScreenInfo GFX_x, GFX_y
End if

If sx < 0 then sx = 0
If sy < 0 then sy = 0
If sx > (GFX_x - (GFX_x / 4)) then sx = (GFX_x - (GFX_x / 4))
If sy > (GFX_y - (GFX_y / 4)) then sy = (GFX_y - (GFX_y / 4))

GFX_x /= 4: GFX_y /= 4
AF3_ScreenZoom_Capture = ImageCreate(GFX_x, GFX_y)
Get buffer, (sx + 0, sy + 0)-(sx + (GFX_x - 1), sy + (GFX_y - 1)), AF3_ScreenZoom_Capture

Put buffer, (0, 0), AF3_ScreenZoom_Capture, Pset
AFlibIII_LowRes4X buffer

ImageDestroy (AF3_ScreenZoom_Capture)

End Sub


'___________________________________________________________________________
Sub AFlibIII_CustomZoom8X ( Byval sx as Integer, Byval sy as Integer, _
                            Byval buffer as Any Ptr = 0 )

Dim as integer GFX_x, GFX_y
ScreenInfo GFX_x, GFX_y

If not buffer = 0 then 
  Private3_check_buffersize buffer, GFX_x, GFX_y
else
  ScreenInfo GFX_x, GFX_y
End if

If sx < 0 then sx = 0
If sy < 0 then sy = 0
If sx > (GFX_x - (GFX_x / 8)) then sx = (GFX_x - (GFX_x / 8))
If sy > (GFX_y - (GFX_y / 8)) then sy = (GFX_y - (GFX_y / 8))

GFX_x /= 8: GFX_y /= 8
AF3_ScreenZoom_Capture = ImageCreate(GFX_x, GFX_y)
Get buffer, (sx + 0, sy + 0)-(sx + (GFX_x - 1), sy + (GFX_y - 1)), AF3_ScreenZoom_Capture

Put buffer, (0, 0), AF3_ScreenZoom_Capture, Pset
AFlibIII_LowRes8X buffer

ImageDestroy (AF3_ScreenZoom_Capture)

End Sub


'__________________________________________________________________________
Sub AFlibIII_LowRes_vert ( Byval buffer as Any Ptr = 0 )

Dim as Integer GFX_x, GFX_y

If not buffer = 0 then 
  Private3_check_buffersize buffer, GFX_x, GFX_y
else
  ScreenInfo GFX_x, GFX_y
End if
  
Dim As fb.Image Ptr OldImg = imagecreate(GFX_x, GFX_y)
Get buffer, (0, 0)-(GFX_x - 1, (GFX_y / 2) - 1), OldImg
Line buffer, (0, 0)-(GFX_x, GFX_y), 0, BF

Private3_check_buffersize OldImg, GFX_x, GFX_y

Private3_LowRes_scaler (GFX_x / 2), GFX_y, OldImg, _
                       1.0005, 2.000, _
                       0, 0, _
                       255, 0, _
                       buffer

ImageDestroy (OldImg)
End Sub


'__________________________________________________________________________
Sub AFlibIII_LowRes_horiz ( Byval buffer as Any Ptr = 0 )

Dim as Integer GFX_x, GFX_y

If not buffer = 0 then 
  Private3_check_buffersize buffer, GFX_x, GFX_y
else
  ScreenInfo GFX_x, GFX_y
End if
  
Dim As fb.Image Ptr OldImg = imagecreate(GFX_x, GFX_y)
Get buffer, (0, 0)-((GFX_x / 2) - 1, GFX_y - 1), OldImg
Line buffer, (0, 0)-(GFX_x, GFX_y), 0, BF

Private3_check_buffersize OldImg, GFX_x, GFX_y

Private3_LowRes_scaler GFX_x, (GFX_y / 2), OldImg, _
                       2.0005, 1.000, _
                       0, 0, _
                       255, 0, _
                       buffer

ImageDestroy (OldImg)

End Sub


'__________________________________________________________________________
Sub AFlibIII_PrepareScreenTrans ( Byval buffer as Any Ptr = 0 )

Dim as Integer GFX_width, GFX_height

If not buffer = 0 then 
  Private3_check_buffersize buffer, GFX_width, GFX_height
else
  ScreenInfo GFX_width, GFX_height
End if

Line buffer, (0,0)-(GFX_width - 1, GFX_height - 1), RGB(255, 0, 255), bf

End Sub


'__________________________________________________________________________
Sub AFlibIII_CaptureScreen ( Byval screen_id as Integer )

Dim as Integer GFX_width, GFX_height
ScreenInfo GFX_width, GFX_height

If screen_id < 1 or screen_id > 128 then Exit Sub
AF3_ScreenCapture_to_Screen(screen_id) = ImageCreate(GFX_width, GFX_height)
Get (0,0)-(GFX_width - 1, GFX_height - 1), AF3_ScreenCapture_to_Screen(screen_id) 

End Sub


'__________________________________________________________________________
Sub AFlibIII_UpdateScreen ( Byval screen_id as Integer )

Dim as Integer GFX_width, GFX_height
ScreenInfo GFX_width, GFX_height

If screen_id < 1 or screen_id > 128 then Exit Sub
Get (0,0)-(GFX_width - 1, GFX_height - 1), AF3_ScreenCapture_to_Screen(screen_id) 

End Sub


'__________________________________________________________________________
Sub AFlibIII_UpdateScreen_half_size ( Byval screen_id as Integer )

'-------------------------------------------------------------------------
' This command -- when applied to any captured screen -- will update the
' screen at half of the graphics resolution that you are currently in.
' For instance, if you are in a 640x480 graphics mode and you use this
' command on any captured screen indeed, then that screen will be updated
' *only* in a 320x240 uppermost "top-left" corner for blitting.
'-------------------------------------------------------------------------

Dim as Integer GFX_width, GFX_height
ScreenInfo GFX_width, GFX_height
GFX_width /= 2: GFX_height /= 2

If screen_id < 1 or screen_id > 128 then Exit Sub
Get (0,0)-(GFX_width - 1, GFX_height - 1), AF3_ScreenCapture_to_Screen(screen_id) 

End Sub


'__________________________________________________________________________
Sub AFlibIII_UpdateScreen_quarter_size ( Byval screen_id as Integer )

'-------------------------------------------------------------------------
' This command -- when applied to any captured screen -- will update the
' screen at 1/4 of the graphics resolution that you are currently in.
' For instance, if you are in a 800x600 graphics mode and you use this
' command on any captured screen indeed, then that screen will be updated
' *only* in a 200x150 uppermost "top-left" corner for blitting.
'-------------------------------------------------------------------------

Dim as Integer GFX_width, GFX_height
ScreenInfo GFX_width, GFX_height
GFX_width /= 4: GFX_height /= 4

If screen_id < 1 or screen_id > 128 then Exit Sub
Get (0,0)-(GFX_width - 1, GFX_height - 1), AF3_ScreenCapture_to_Screen(screen_id) 

End Sub


'__________________________________________________________________________
Sub AFlibIII_UpdateScreen_eighth_size ( Byval screen_id as Integer )

'-------------------------------------------------------------------------
' This command -- when applied to any captured screen -- will update the
' screen at 1/8 of the graphics resolution that you are currently in.
'-------------------------------------------------------------------------

Dim as Integer GFX_width, GFX_height
ScreenInfo GFX_width, GFX_height
GFX_width /= 8: GFX_height /= 8

If screen_id < 1 or screen_id > 128 then Exit Sub
Get (0,0)-(GFX_width - 1, GFX_height - 1), AF3_ScreenCapture_to_Screen(screen_id) 

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen ( Byval x as Integer, Byval y as Integer, _
                          Byval screen_id as Integer, _
                          Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit x, y, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_alpha ( Byval x as Integer, Byval y as Integer, _
                                Byval alpha as Integer, _
                                Byval screen_id as Integer, _
                                Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_alpha x, y, alpha, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_add ( Byval x as Integer, Byval y as Integer, _
                              Byval add_blend as Integer, _
                              Byval screen_id as Integer, _
                              Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_add x, y, add_blend, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_firefly ( Byval x as Integer, Byval y as Integer, _
                                  Byval brightness_level as Integer, _
                                  Byval screen_id as Integer, _
                                  Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_firefly x, y, brightness_level, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_color ( Byval x as Integer, Byval y as Integer, _
                                Byval col as Integer, _
                                Byval screen_id as Integer, _
                                Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_color x, y, col, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_tint ( Byval x as Integer, Byval y as Integer, _
                               Byval col_to_tint as Integer, _
                               Byval alpha_level as Integer, _
                               Byval screen_id as Integer, _
                               Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_tint x, y, col_to_tint, alpha_level, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_greyscale ( Byval x as Integer, Byval y as Integer, _
                                    Byval screen_id as Integer, _
                                    Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_greyscale x, y, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_greytint ( Byval x as Integer, Byval y as Integer, _
                                   Byval alpha_tinting as Integer, _
                                   Byval screen_id as Integer, _
                                   Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_greytint x, y, alpha_tinting, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_inverse ( Byval x as Integer, Byval y as Integer, _
                                  Byval screen_id as Integer, _
                                  Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_inverse x, y, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_invtint ( Byval x as Integer, Byval y as Integer, _
                                  Byval alpha_tinting as Integer, _
                                  Byval screen_id as Integer, _
                                  Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_invtint x, y, alpha_tinting, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_inversegrey ( Byval x as Integer, Byval y as Integer, _
                                      Byval screen_id as Integer, _
                                      Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_inversegrey x, y, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_invgreytint ( Byval x as Integer, Byval y as Integer, _
                                      Byval alpha_tinting as Integer, _
                                      Byval screen_id as Integer, _
                                      Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_invgreytint x, y, alpha_tinting, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_overlay ( Byval x as Integer, Byval y as Integer, _
                                  Byval overlay_col as Integer, _
                                  Byval screen_id as Integer, _
                                  Byval buffer as any ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_overlay x, y, overlay_col, AF3_ScreenCapture_to_Screen(screen_id), buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_rotate ( Byval x as Integer, Byval y as Integer, _
                                 Byval screen_id as Integer, _
                                 Byval rotation_angle as double, _
                                 Byval H_flip as Integer = 0, _
                                 Byval V_flip as Integer = 0, _
                                 Byval alpha as Integer = 255, _
                                 Byval alphachannel as Integer = 1, _
                                 Byval buffer as Any Ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_rotate x, y, AF3_ScreenCapture_to_Screen(screen_id), rotation_angle, H_flip, V_flip, alpha, alphachannel, buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_rotate_solid ( Byval x as Integer, Byval y as Integer, _
                                       Byval screen_id as Integer, _
                                       Byval rotation_angle as double, _
                                       Byval H_flip as Integer = 0, _
                                       Byval V_flip as Integer = 0, _
                                       Byval alpha as Integer = 255, _
                                       Byval buffer as Any Ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_rotate_solid x, y, AF3_ScreenCapture_to_Screen(screen_id), rotation_angle, H_flip, V_flip, alpha, buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_scale ( Byval x as Integer, Byval y as Integer, _
                                Byval screen_id as Integer, _
                                Byval scale_x as single, _
                                Byval scale_y as single, _
                                Byval H_flip as Integer = 0, _
                                Byval V_flip as Integer = 0, _
                                Byval alpha as Integer = 255, _
                                Byval alphachannel as Integer = 1, _
                                Byval buffer as Any Ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_scale x, y, AF3_ScreenCapture_to_Screen(screen_id), scale_x, scale_y, H_flip, V_flip, alpha, alphachannel, buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_scale_solid ( Byval x as Integer, Byval y as Integer, _
                                      Byval screen_id as Integer, _
                                      Byval scale_x as single, _
                                      Byval scale_y as single, _
                                      Byval H_flip as Integer = 0, _
                                      Byval V_flip as Integer = 0, _
                                      Byval alpha as Integer = 255, _
                                      Byval buffer as Any Ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_scale_solid x, y, AF3_ScreenCapture_to_Screen(screen_id), scale_x, scale_y, H_flip, V_flip, alpha, buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_scalerotate ( Byval x as Integer, _
                                      Byval y as Integer, _
                                      Byval screen_id as Integer, _
                                      Byval scale_x as single, _
                                      Byval scale_y as single, _
                                      Byval rotation_angle as double, _
                                      Byval H_flip as Integer = 0, _
                                      Byval V_flip as Integer = 0, _
                                      Byval alpha as Integer = 255, _
                                      Byval alphachannel as Integer = 1, _
                                      Byval buffer as Any Ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_scalerotate x, y, AF3_ScreenCapture_to_Screen(screen_id), scale_x, scale_y, rotation_angle, H_flip, V_flip, alpha, alphachannel, buffer

End Sub


'__________________________________________________________________________
Sub AFlibIII_BlitScreen_scalerotate_solid ( Byval x as Integer, _
                                            Byval y as Integer, _
                                            Byval screen_id as Integer, _
                                            Byval scale_x as single, _
                                            Byval scale_y as single, _
                                            Byval rotation_angle as double, _
                                            Byval H_flip as Integer = 0, _
                                            Byval V_flip as Integer = 0, _
                                            Byval alpha as Integer = 255, _
                                            Byval buffer as Any Ptr = 0 )

If screen_id < 1 or screen_id > 128 then Exit Sub
Private3_SprBlit_scalerotate_solid x, y, AF3_ScreenCapture_to_Screen(screen_id), scale_x, scale_y, rotation_angle, H_flip, V_flip, alpha, buffer

End Sub


'__________________________________________________________________________
Function AFlibIII_ScreenCollide ( Byval screen_x1 as Integer, _
                                  Byval screen_y1 as Integer, _
                                  Byval screen_id1 as Integer, _
                                  Byval screen_x2 as Integer, _
                                  Byval screen_y2 as Integer, _
                                  Byval screen_id2 as Integer, _
                                  Byval EnableAlpha as integer = 0 ) as integer

If screen_id1 < 1 or screen_id1 > 128 then Exit Function
If screen_id2 < 1 or screen_id2 > 128 then Exit Function

Dim Collided as Integer
If Rawcollision_screen (screen_x1, screen_y1, AF3_ScreenCapture_to_Screen(screen_id1), _
                        screen_x2, screen_y2, AF3_ScreenCapture_to_Screen(screen_id2), EnableAlpha) > 0 then
  Collided = 1
End if
Return Collided

End Function


'__________________________________________________________________________
Function AFlibIII_ScreenCollide_Spr ( Byval screen_x as Integer, _
                                      Byval screen_y as Integer, _
                                      Byval screen_id as Integer, _
                                      Byval spr_x as Integer, _
                                      Byval spr_y as Integer, _
                                      Byval image as Any Ptr, _
                                      Byval EnableAlpha as integer = 0 ) as integer

If screen_id < 1 or screen_id > 128 then Exit Function

Dim Collided as Integer
If Rawcollision_screen (spr_x, spr_y, image, _
                        screen_x, screen_y, AF3_ScreenCapture_to_Screen(screen_id), EnableAlpha) > 0 then
  Collided = 1
End if
Return Collided

End Function


'__________________________________________________________________________
Sub AFlibIII_RemoveScreen ( Byval screen_id as Integer )

If screen_id < 1 or screen_id > 128 then Exit Sub
AF3_ScreenCapture_to_Screen(screen_id) = 0
ImageDestroy AF3_ScreenCapture_to_Screen(screen_id)
AF3_ScreenCapture_to_Screen(screen_id) = 0

End Sub


'__________________________________________________________________________
Sub AFlibIII_RemoveScreen_CleanSweep

For screen_id as integer = 1 to 128 step 1
  If AF3_ScreenCapture_to_Screen(screen_id) > 0 then
    AF3_ScreenCapture_to_Screen(screen_id) = 0
    ImageDestroy AF3_ScreenCapture_to_Screen(screen_id)
    AF3_ScreenCapture_to_Screen(screen_id) = 0
  End if
Next

End Sub


Private Function AFlibIII_resizeFBImage ( Byval _width_ As Integer, _
                                          Byval _height_ As Integer, _
                                          Byval img As fb.Image Ptr ) As fb.Image Ptr

'Special Thanks to my AWESOME man Pritchard for this great routine!!  ;)

  Dim As Double wSize = (img->width / _width_)
  Dim As Double hSize = (img->height / _height_)

  Dim As Double xPos = 0
  Dim As Double yPos = 0
  
  Dim As Integer curX, curY, curNewX, curNewY

  Dim As fb.Image Ptr newImg = imagecreate(_width_,_height_)

  Dim As Ubyte Ptr newImgPixels = cast(Ubyte Ptr, newImg + 1)
  Dim As Ubyte Ptr imgPixels = cast(Ubyte Ptr, img + 1)
  
  For yVar As Integer = 0 To _height_ - 1
  
    yPos = Int(yVar * hSize)
    
    curY = (yPos * img->pitch)
    curNewY = (yVar * newImg->pitch)
   
   
    For xVar As Integer = 0 To _width_ - 1
      xPos = Int(xVar * wSize)
      
      curX = (xPos * img->bpp)
      curNewX = (xVar * newImg->bpp)
            
      *cast( Integer Ptr, ( newImgPixels + curNewX + curNewY ) ) = *cast( Integer Ptr, ( imgPixels + curX + curY ) )
    Next
  Next

  Return newImg
  ImageDestroy newImg
End Function

Private Sub Private3_check_buffersize ( Byval buffer As Any Ptr, Byref x As Integer, _
                                        Byref y As Integer )

'----------------------------------------------------------------------
' BIG special thanks to cha0s on this *excellent* buffer detection
' routine!!!  d=^-^=b !!
'----------------------------------------------------------------------

x = 0: y = 0
If buffer = 0 Then Exit Sub

If isBufferNew_d( buffer ) Then
  x = cast( Uinteger Ptr, buffer )[2]
  y = cast( Uinteger Ptr, buffer )[3]
else
  x = cast( Ushort Ptr, buffer )[0] Shr 3
  y = cast( Ushort Ptr, buffer )[1]
end If
        
end sub

Private Sub Private3_SprBlit ( Byval x1 as Integer, Byval y1 as Integer, _
                               Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Put buffer, (x1, y1), image, trans

End Sub

Private Sub Private3_SprBlit_alpha ( Byval x1 as Integer, Byval y1 as Integer, _
                                     Byval alpha as integer, Byval image as any ptr, _
                                     Byval buffer as Any Ptr = 0 )

If alpha = -1 then
  Put buffer, (x1, y1), image, alpha
  Exit Sub
End if

If alpha < 0 then alpha = 0
If alpha > 255 then alpha = 255
Put buffer, (x1, y1), image, alpha, alpha

End Sub

Private Sub Private3_SprBlit_add ( Byval x1 as Integer, Byval y1 as Integer, _
                                   Byval add_blend as integer, Byval image as any ptr, _
                                   Byval buffer as Any Ptr = 0 )

If add_blend < 0 then add_blend = 0
If add_blend > 255 then add_blend = 255
Put buffer, (x1, y1), image, add, add_blend

End Sub

Private Sub Private3_SprBlit_firefly ( Byval x1 as integer, Byval y1 as integer, _
                                       Byval brightness_level as integer, Byval image as any ptr, _
                                       Byval buffer as Any Ptr = 0 )

Dim trans_brightness as Single
If brightness_level < 0 then brightness_level = 0
If brightness_level > 255 then brightness_level = 255

trans_brightness = ((brightness_level / 18) + .5)
Put buffer, (x1, y1), image, Custom, @Private3_shadow, @trans_brightness

End Sub

Private Sub Private3_SprBlit_color ( Byval x1 as integer, Byval y1 as integer, _
                                     Byval col as integer, Byval image as any ptr, _
                                     Byval buffer as Any Ptr = 0 )

Put buffer, (x1, y1), image, Custom, @Private3_customcolor, @col

End Sub

Private Sub Private3_SprBlit_tint ( Byval x1 as integer, Byval y1 as integer, _
                                    Byval col_to_tint as integer, Byval alpha_level as integer, _
                                    Byval image as any ptr, Byval buffer as Any Ptr = 0 )

If alpha_level < 0 then alpha_level = 0
If alpha_level > 255 then alpha_level = 255
Put buffer, (x1, y1), image, Custom, @Private3_customcolor, @col_to_tint
Put buffer, (x1, y1), image, alpha, alpha_level

End Sub

Private Sub Private3_SprBlit_greyscale ( Byval x1 as Integer, Byval y1 as Integer, _
                                         Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Put buffer, (x1, y1), image, Custom, @Private3_grayscale

End Sub

Private Sub Private3_SprBlit_greytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                        Byval alpha_tinting as integer, Byval image as any ptr, _
                                        Byval buffer as Any Ptr = 0 )

If alpha_tinting < 0 then alpha_tinting = 0
If alpha_tinting > 255 then alpha_tinting = 255
Put buffer, (x1, y1), image, Custom, @Private3_grayscale
Put buffer, (x1, y1), image, alpha, alpha_tinting

End Sub

Private Sub Private3_SprBlit_inverse ( Byval x1 as Integer, Byval y1 as Integer, _
                                       Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Put buffer, (x1, y1), image, Custom, @Private3_inverse

End Sub

Private Sub Private3_SprBlit_invtint ( Byval x1 as Integer, Byval y1 as Integer, _
                                       Byval alpha_tinting as integer, Byval image as any ptr, _
                                       Byval buffer as Any Ptr = 0 )

If alpha_tinting < 0 then alpha_tinting = 0
If alpha_tinting > 255 then alpha_tinting = 255
Put buffer, (x1, y1), image, Custom, @Private3_inverse
Put buffer, (x1, y1), image, alpha, alpha_tinting

End Sub

Private Sub Private3_SprBlit_inversegrey ( Byval x1 as Integer, Byval y1 as Integer, _
                                           Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Put buffer, (x1, y1), image, Custom, @Private3_greyscaleinverse

End Sub

Private Sub Private3_SprBlit_invgreytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                           Byval alpha_tinting as integer, Byval image as any ptr, _
                                           Byval buffer as Any Ptr = 0 )

If alpha_tinting < 0 then alpha_tinting = 0
If alpha_tinting > 255 then alpha_tinting = 255
Put buffer, (x1, y1), image, Custom, @Private3_greyscaleinverse
Put buffer, (x1, y1), image, alpha, alpha_tinting

End Sub

Private Sub Private3_SprBlit_overlay ( Byval x1 as Integer, Byval y1 as Integer, _
                                       Byval overlay_col as integer, Byval image as any ptr, _
                                       Byval buffer as Any Ptr = 0 )

Put buffer, (x1, y1), image, Custom, @Private3_overlay, @overlay_col

End Sub

Sub Private3_SprBlit_rotate ( Byval sx_midpos as Integer, _
                              Byval sy_midpos as Integer, _
                              Byval image as Any Ptr, _
                              Byval rotation_angle as Single, _
                              Byval H_flip as Integer = 0, _
                              Byval V_flip as Integer = 0, _
                              Byval alpha as Integer = 255, _
                              Byval alphachannel as Integer = 1, _
                              Byval buffer as Any Ptr = 0, _
                              Byval Custom as Function ( Byval Src As Uinteger, _
                                                         Byval Dest As Uinteger, _
                                                         Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                              Byval Param as Any Ptr = 0)

   If (screenptr=0) Or (image=0) Then Exit Sub
   Dim as Integer BPP
   ScreenInfo ,,BPP
   If BPP < 15 then Exit Sub
   
   Dim as Integer Img_x, Img_y
   Private3_check_buffersize image, Img_x, Img_y
   sx_midpos += (Img_x / 2)
   sy_midpos += (Img_y / 2)

   Dim As Integer MustLock,Mustrotation_angle
   
   'variables for the alpha blending
      Dim As Uinteger srb = Any
      Dim As Uinteger drb = Any
      Dim As Uinteger  rb = Any
      Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
      Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
      Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any
      Dim As Uinteger sc = Any 'source (alpha) channel
   
   If buffer= 0 Then MustLock   =1
   If rotation_angle <> 0 Then Mustrotation_angle=1
   
   Dim As Integer   TargetWidth,TargetHeight,TargetBytes,TargetPitch
   If MustLock Then
     screeninfo      _
     TargetWidth , _
     TargetHeight, _
     TargetBytes ,,_
     TargetPitch
     TargetBytes Shr=3
      
     buffer=screenptr
   Else
     TargetBytes  = cptr(Uinteger Ptr,buffer)[1]
     TargetWidth  = cptr(Uinteger Ptr,buffer)[2]
     TargetHeight = cptr(Uinteger Ptr,buffer)[3]
     TargetPitch  = cptr(Uinteger Ptr,buffer)[4]
     buffer      += 32
   End If
   If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub
   
   Dim As Integer    SourceWidth,SourceHeight,SourceBytes,SourcePitch
   If cptr(Integer Ptr,image)[0] = 7 Then
     SourceBytes  = cptr(Uinteger Ptr,image)[1]
     SourceWidth  = cptr(Uinteger Ptr,image)[2]
     SourceHeight = cptr(Uinteger Ptr,image)[3]
     SourcePitch  = cptr(Uinteger Ptr,image)[4]
      image      += 32
   Else
     SourceBytes  = cptr(Ushort Ptr,image)[0] And 7
     SourceWidth  = cptr(Ushort Ptr,image)[0] Shr 3
     SourceHeight = cptr(Ushort Ptr,image)[1]
     SourcePitch  = SourceWidth * SourceBytes
     image       += 4
   End If
   
   If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
   If (TargetBytes<>SourceBytes) Then Exit Sub
   
#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
   Dim As Single Points(3,3)
   points(0,xs)=-SourceWidth/2
   points(1,xs)= SourceWidth/2
   points(2,xs)= points(1,xs)
   points(3,xs)= points(0,xs)
   
   points(0,ys)=-SourceHeight/2
   points(1,ys)= points(0,ys)
   points(2,ys)= SourceHeight/2
   points(3,ys)= points(2,ys)
   
   points(1,xt)= SourceWidth-1
   points(2,xt)= points(1,xt)
   points(2,yt)= SourceHeight-1
   points(3,yt)= points(2,yt)
   
   If H_flip Then Swap points(0,xt),points(1,xt): Swap points(2,xt),points(3,xt)
   If V_flip Then Swap points(0,yt),points(3,yt): Swap points(2,yt),points(1,yt)
   
   Dim As Uinteger i
   Dim As Single x,y
   If Mustrotation_angle Then
     rotation_angle*=0.017453292 'degre 2 rad
     While rotation_angle< 0        :rotation_angle+=6.2831853:Wend
     While rotation_angle>=6.2831853:rotation_angle-=6.2831853:Wend
     For i=0 To 3
       x=points(i,xs)*Cos(rotation_angle) - points(i,ys)*Sin(rotation_angle)
       y=points(i,xs)*Sin(rotation_angle) + points(i,ys)*Cos(rotation_angle)
       points(i,xs)=x:points(i,ys)=y
     Next
   End If   
   Dim As Integer yStart,yEnd,xStart,xEnd
   yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd
   
#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
   Dim As Integer CNS(1,1) 'Counters
   
   For i=0 To 3
     points(i,xs)=Int(points(i,xs)+sx_midpos)
     points(i,ys)=Int(points(i,ys)+sy_midpos)
     If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
     If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
     If points(i,xs)<xStart Then xStart=points(i,xs)
     If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
   Next
   If yStart =yEnd         Then Exit Sub
   If yStart>=TargetHeight Then Exit Sub
   If yEnd   <0            Then Exit Sub
   If xStart = xEnd        Then Exit Sub
   If xStart>=TargetWidth  Then Exit Sub
   If xEnd   <0            Then Exit Sub
   
   Dim As Ubyte    Ptr t1,s1
   Dim As Ushort   Ptr t2,s2
   Dim As Uinteger     t2c, s2c
   Dim As Uinteger Ptr t4,s4
   
   
#define ADD 0
#define CMP 1
#define SET 2
   Dim As Integer ACS(1,2) 'add compare and set
   ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
   ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0
   
   
#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
   Dim As Single E(2,6),S(6),Length,uSlope,vSlope
   Dim As Integer U,UV,UA,UN,V,VV,VA,VN
   
   ' share the same highest point
   CNS(RI,IND)=CNS(LI,IND)
   If MustLock Then screenlock
   ' loop from Top to Bottom
   While yStart<yEnd
     'Scan Left and Right sides together
     For i=LI To RI
       ' bad to read but fast and short ;-)
       If yStart=points(CNS(i,IND),ys) Then
         CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
         If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
           CNS(i, IND)=CNS(i,NIND)
           CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
           If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         Wend
         E(i,EX) = points(CNS(i, IND),xs)
         E(i,EU) = points(CNS(i, IND),xt)
         E(i,EV) = points(CNS(i, IND),yt)
         Length  = points(CNS(i,NIND),ys)
         Length -= points(CNS(i, IND),ys)
         If Length <> 0.0 Then
           E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
           E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
           E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
         End If
         CNS(i,IND)=CNS(i,NIND)
       End If
     Next
      
     If (yStart<0)                              Then Goto SkipScanLine
     xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine
     xEnd  =E(RI,EX)-0.5:If xEnd < 0            Then Goto SkipScanLine
     If (xStart=xEnd)                           Then Goto SkipScanLine
     'if xEnd  <xStart                           then goto SkipScanLine
     Length=xEnd-xStart
     uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
     vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
     If xstart<0 Then
       Length=Abs(xStart)
       U=Int(E(LI,EU)+uSlope*Length)
       V=Int(E(LI,EV)+vSlope*Length)
       xStart = 0
     Else
       U=Int(E(LI,EU)):V=Int(E(LI,EV))
     End If
     If xEnd>=TargetWidth Then xEnd=TargetWidth
     UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
     VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
     xEnd-=xStart
     Select Case TargetBytes
       Case 1
         t1=cptr(Ubyte Ptr,buffer)
         t1+=yStart*TargetPitch+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             *t1=Custom(*s1,*t1,Param)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             If *s1 Then *t1=*s1
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
         End If
       Case 2
        t2=cptr(Short Ptr,buffer)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             s2c=*s2
             t2c=*t2
             s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=Custom(s2c,t2c,Param)
             *t2=(t2c Shr 3 And &H001F) Or _
                 (t2c Shr 5 And &H07E0) Or _
                 (t2c Shr 8 And &HF800)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         else
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             If *s2<>&HF81F Then *t2=*s2
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         End if
       Case 4
         t4=cptr(Integer Ptr,buffer)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
             '***** start alpha blending
             'this set of if...elseif...end if conditions applies alpha blending
             'these 43 lines can be replaced with '*t4 = *s4' to remove blending
             If alpha = 0 Then
               'no change needed *t4 = *t4
               Elseif alpha = 255 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 0 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 255 Then
                 srb = *s4 And &h00ff00ff
                 sg   = *s4 Xor srb
                 sa   = alpha
                   
                 drb = *t4 And &h00ff00ff
                 dg   = *t4 Xor drb
                 da   = 256 - sa
                   
                 rb = (drb * da + srb * sa) And &hff00ff00
                 g  = (dg  * da + sg  * sa) And &h00ff0000
                   
                 *t4 = (rb Or g) Shr 8 Or &hff000000
               Else
                 sr = (*s4 Shr 16) And 255
                 sg = (*s4 Shr  8) And 255
                 sb = (*s4       ) And 255
                 sa = (alpha)
                 
                 dr = (*t4 Shr 16) And 255
                 dg = (*t4 Shr  8) And 255
                 db = (*t4       ) And 255
                 da = (*t4 Shr 24)
                 
                 sa2 = sa Shl 8
                 da2 = da Shl 8 - da * sa
                 a = (sa2 + da2)
                 
                 r = (dr * da2 + sr * sa2) \ a
                 g = (dg * da2 + sg * sa2) \ a
                 b = (db * da2 + sb * sa2) \ a
                 *t4 = Rgba(r, g, b, a Shr 8)
               End If
               U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
               V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
               If u<0 Then u=0
               If v<0 Then v=0
               xStart+=1:t4+=1
             Wend
             Else
               While xStart<xEnd
                 's4=cptr(Integer Ptr,image):s4+=V*(SourcePitch shr 2):s4+=U
                 s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
                 If (*s4 And &HFFFFFF)<>&HFF00FF Then
                   '***** start alpha blending
                   'this set of if...elseif...end if conditions applies alpha blending
                   'these 43 lines can be replaced with '*t4 = *s4' to remove blending
                   If alpha = 0 Then
                     'no change needed *t4 = *t4
                   Elseif alpha = 255 And alphachannel = 0 Then
                     *t4 = *s4
                   Elseif alpha = 255 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (*s4 Shr 24)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   ElseIf alpha > 0 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sc = (*s4 Shr 24)
                     sa = sc * (alpha / 255)
                     
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                     
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   Elseif *t4 Shr 24 = 0 Then'/
                     *t4 = *s4
                   Elseif *t4 Shr 24 = 255 Then
                     srb = *s4 And &h00ff00ff
                     sg   = *s4 Xor srb
                     sa   = alpha
                        
                     drb = *t4 And &h00ff00ff
                     dg   = *t4 Xor drb
                     da   = 256 - sa
                        
                     rb = (drb * da + srb * sa) And &hff00ff00
                     g  = (dg  * da + sg  * sa) And &h00ff0000
                        
                     *t4 = (rb Or g) Shr 8 Or &hff000000
                   Else
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (alpha)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     
                     r = (dr * da2 + sr * sa2) \ a
                     g = (dg * da2 + sg * sa2) \ a
                     b = (db * da2 + sb * sa2) \ a
                     *t4 = Rgba(r, g, b, a Shr 8)
                   End If
                   '***** end alpha blending
                 End If
                 U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
                 V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
                 If u<0 Then u=0
                 If v<0 Then v=0
                 xStart+=1:t4+=1
               Wend
             End If
      End Select

SkipScanLine:
      E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
      E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
      yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
   Wend
   If MustLock Then screenunlock
End Sub

'__________________________________________________________________________
Sub Private3_SprBlit_rotate_solid ( Byval sx_midpos as Integer, _
                                    Byval sy_midpos as Integer, _
                                    Byval image as Any Ptr, _
                                    Byval rotation_angle as Single, _
                                    Byval H_flip as Integer = 0, _
                                    Byval V_flip as Integer = 0, _
                                    Byval alpha as Integer = 255, _
                                    Byval buffer as Any Ptr = 0, _
                                    Byval Custom as Function ( Byval Src As Uinteger, _
                                                               Byval Dest As Uinteger, _
                                                               Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                    Byval Param as Any Ptr = 0)

  If (screenptr=0) Or (image=0) Then Exit Sub
  Dim as Integer BPP
  ScreenInfo ,,BPP
  If BPP < 15 then Exit Sub

  Dim as Integer Img_x, Img_y
  Private3_check_buffersize image, Img_x, Img_y
  sx_midpos += (Img_x / 2)
  sy_midpos += (Img_y / 2)

  If alpha < 0 then alpha = 0
  If alpha > 255 then alpha = 255

  Dim As Integer MustLock,Mustrotation_angle
  
 'variables for the alpha blending
  Dim As Uinteger srb = Any
  Dim As Uinteger drb = Any
  Dim As Uinteger  rb = Any
  Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
  Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
  Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any

  If buffer= 0 Then MustLock  =1
  If rotation_angle  <>0 Then Mustrotation_angle=1

  Dim As Integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch
  If MustLock Then
    ScreenInfo    _
    TargetWidth , _
    TargetHeight, _
    TargetBytes ,,_
    TargetPitch
    TargetBytes Shr=3

    buffer=ScreenPtr
  Else
    TargetBytes  = cptr(Uinteger Ptr,buffer)[1]
    TargetWidth  = cptr(Uinteger Ptr,buffer)[2]
    TargetHeight = cptr(Uinteger Ptr,buffer)[3]
    TargetPitch  = cptr(Uinteger Ptr,buffer)[4]
    buffer    += 32
  End If
  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

  Dim As Integer   SourceWidth,SourceHeight,SourceBytes,SourcePitch
  If cptr(Integer Ptr,image)[0] = 7 Then
    SourceBytes  = cptr(Uinteger Ptr,image)[1]
    SourceWidth  = cptr(Uinteger Ptr,image)[2]
    SourceHeight = cptr(Uinteger Ptr,image)[3]
    SourcePitch  = cptr(Uinteger Ptr,image)[4]
    image    += 32
  Else
    SourceBytes  = 1
    SourceWidth  = cptr(Ushort Ptr,image)[0] Shr 3
    SourceHeight = cptr(Ushort Ptr,image)[1]
    SourcePitch  = SourceWidth
    image    += 4
  End If

  If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
  If (TargetBytes<>SourceBytes) Then Exit Sub

#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
  Dim As Single Points(3,3)
  points(0,xs)=-SourceWidth/2
  points(1,xs)= SourceWidth/2
  points(2,xs)= points(1,xs)
  points(3,xs)= points(0,xs)

  points(0,ys)=-SourceHeight/2
  points(1,ys)= points(0,ys)
  points(2,ys)= SourceHeight/2
  points(3,ys)= points(2,ys)

  points(1,xt)= SourceWidth-1
  points(2,xt)= points(1,xt)
  points(2,yt)= SourceHeight-1
  points(3,yt)= points(2,yt)
  
  If H_flip >= 1 then Swap points(0,xt),points(1,xt): Swap points(2,xt),points(3,xt)
  If V_flip >= 1 then Swap points(0,yt),points(3,yt): Swap points(2,yt),points(1,yt)

  Dim As Uinteger i
  Dim As Single x,y
  If Mustrotation_angle Then
    rotation_angle*=0.017453292 'degre 2 rad
    While rotation_angle< 0        :rotation_angle+=6.2831853:Wend
    While rotation_angle>=6.2831853:rotation_angle-=6.2831853:Wend
    For i=0 To 3
      x=points(i,xs)*Cos(rotation_angle) - points(i,ys)*Sin(rotation_angle)
      y=points(i,xs)*Sin(rotation_angle) + points(i,ys)*Cos(rotation_angle)
      points(i,xs)=x:points(i,ys)=y
    Next
  End If

  Dim As Integer yStart,yEnd,xStart,xEnd
  yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd

#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
  Dim As Integer CNS(1,1) 'Counters

  For i=0 To 3
    points(i,xs)=Int(points(i,xs)+sx_midpos)
    points(i,ys)=Int(points(i,ys)+sy_midpos)
    If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
    If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
    If points(i,xs)<xStart Then xStart=points(i,xs)
    If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
  Next
  If yStart =yEnd         Then Exit Sub
  If yStart>=TargetHeight Then Exit Sub
  If yEnd   <0            Then Exit Sub
  If xStart = xEnd        Then Exit Sub
  If xStart>=TargetWidth  Then Exit Sub
  If xEnd   <0            Then Exit Sub

  Dim As Ubyte    Ptr t1,s1
  Dim As Ushort   Ptr t2,s2
  Dim As Uinteger     t2c, s2c
  Dim As Uinteger Ptr t4,s4


#define ADD 0
#define CMP 1
#define SET 2
  Dim As Integer ACS(1,2) 'add compare and set
  ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
  ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0

#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
  Dim As Single E(2,6),S(6),Length,uSlope,vSlope
  Dim As Integer U,UV,UA,UN,V,VV,VA,VN

  ' share the same highest point
  CNS(RI,IND)=CNS(LI,IND)
  If MustLock Then ScreenLock
  ' loop from Top to Bottom
  While yStart<yEnd
    'Scan Left and Right sides together
    For i=LI To RI
      ' bad to read but fast and short ;-)
      If yStart=points(CNS(i,IND),ys) Then
        CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
        If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
          CNS(i, IND)=CNS(i,NIND)
          CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
          If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        Wend
        E(i,EX) = points(CNS(i, IND),xs)
        E(i,EU) = points(CNS(i, IND),xt)
        E(i,EV) = points(CNS(i, IND),yt)
        Length  = points(CNS(i,NIND),ys)
        Length -= points(CNS(i, IND),ys)
        If Length <> 0.0 Then
          E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
          E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
          E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
        End If
        CNS(i,IND)=CNS(i,NIND)
      End If
    Next

    If (yStart<0)                              Then Goto SRs_SkipScanLine
    xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SRs_SkipScanLine
    xEnd  =E(RI,EX)-0.5:If xEnd  < 0           Then Goto SRs_SkipScanLine
    If (xStart=xEnd)                           Then Goto SRs_SkipScanLine
    'if xEnd  <xStart                           then goto SRs_SkipScanLine
    Length=xEnd-xStart
    uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
    vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
    If xstart<0 Then
      Length=Abs(xStart)
      U=Int(E(LI,EU)+uSlope*Length)
      V=Int(E(LI,EV)+vSlope*Length)
      xStart = 0
    Else
      U=Int(E(LI,EU)):V=Int(E(LI,EV))
    End If
    If xEnd>=TargetWidth Then xEnd=TargetWidth
    UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
    VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
    xEnd-=xStart
    Select Case TargetBytes
      Case 2
        t2=cptr(Short Ptr,buffer)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
            s2c=*s2
            t2c=*t2
            s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=Custom(s2c,t2c,Param)
            *t2=(t2c Shr 3 And &H001F) Or _
                (t2c Shr 5 And &H07E0) Or _
                (t2c Shr 8 And &HF800)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        else
          While xStart<xEnd
            s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
            *t2=*s2
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        End if
      Case 4
        t4=cptr(Integer Ptr,buffer)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
          While xStart<xEnd
            's4=cptr(Integer Ptr,image):s4+=V*(SourcePitch shr 2):s4+=U
            s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
            '***** start alpha blending
            'this set of if...elseif...end if conditions applies alpha blending
            'these 43 lines can be replaced with '*t4 = *s4' to remove blending
            If alpha = 0 Then
              'no change needed *t4 = *t4
            Elseif alpha = 255 Then
              If Custom then 
                *t4=Custom(*s4, *t4, Param)
              else
                *t4 = *s4
              End if
            Elseif *t4 Shr 24 = 0 Then
              If Custom then 
                *t4=Custom(*s4, *t4, Param)
              else
                *t4 = *s4
              End if
            Elseif *t4 Shr 24 = 255 Then
              srb = *s4 And &h00ff00ff
              sg  = *s4 Xor srb
              sa  = alpha

              drb = *t4 And &h00ff00ff
              dg  = *t4 Xor drb
              da  = 256 - sa

              rb = (drb * da + srb * sa) And &hff00ff00
              g  = (dg  * da + sg  * sa) And &h00ff0000
              If Custom then 
                *t4=Custom((rb Or g) Shr 8 Or &hff000000, *t4, Param)
              else
                *t4 = (rb Or g) Shr 8 Or &hff000000
              End if
            Else
              sr = (*s4 Shr 16) And 255
              sg = (*s4 Shr  8) And 255
              sb = (*s4       ) And 255
              sa = (alpha)
             
              dr = (*t4 Shr 16) And 255
              dg = (*t4 Shr  8) And 255
              db = (*t4       ) And 255
              da = (*t4 Shr 24)

              sa2 = sa Shl 8
              da2 = da Shl 8 - da * sa
              a = (sa2 + da2)

              r = (dr * da2 + sr * sa2) \ a
              g = (dg * da2 + sg * sa2) \ a
              b = (db * da2 + sb * sa2) \ a
              *t4 = Rgba(r, g, b, a Shr 8)
              If Custom then 
                *t4=Custom(Rgba(r, g, b, a Shr 8), *t4, Param)
              else
                *t4 = Rgba(r, g, b, a Shr 8)
              End if
            End If
            '***** end alpha blending
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
    End Select

SRs_SkipScanLine:
    E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
    E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
    yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
  Wend
If MustLock Then ScreenUnlock
End Sub

'__________________________________________________________________________
Sub Private3_SprBlit_scale ( Byval sx_midpos as Integer, _
                             Byval sy_midpos as Integer, _
                             Byval image as Any Ptr, _
                             Byval scale_x as Single, _
                             Byval scale_y as Single, _
                             Byval H_flip as Integer = 0, _
                             Byval V_flip as Integer = 0, _
                             Byval alpha as Integer = 255, _
                             Byval alphachannel as Integer = 1, _
                             Byval buffer as Any Ptr = 0, _
                             Byval Custom as Function ( Byval Src As Uinteger, _
                                                        Byval Dest As Uinteger, _
                                                        Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                             Byval Param as Any Ptr = 0)

   If (screenptr=0) Or (image=0) Then Exit Sub
   Dim as Integer BPP
   ScreenInfo ,,BPP
   If BPP < 15 then Exit Sub

   Dim as Integer Img_x, Img_y
   Private3_check_buffersize image, Img_x, Img_y
   sx_midpos += (Img_x / 2)
   sy_midpos += (Img_y / 2)

   If scale_x < 0.001 Then scale_x=0.001
   If scale_y < 0.001 Then scale_y=0.001
   
   Dim As Integer MustLock
   
   'variables for the alpha blending
      Dim As Uinteger srb = Any
      Dim As Uinteger drb = Any
      Dim As Uinteger  rb = Any
      Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
      Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
      Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any
      Dim As Uinteger sc = Any 'source (alpha) channel
   
   If buffer= 0 Then MustLock   =1
   
   Dim As Integer   TargetWidth,TargetHeight,TargetBytes,TargetPitch
   If MustLock Then
     screeninfo      _
     TargetWidth , _
     TargetHeight, _
     TargetBytes ,,_
     TargetPitch
     TargetBytes Shr=3
      
     buffer=screenptr
   Else
     TargetBytes  = cptr(Uinteger Ptr,buffer)[1]
     TargetWidth  = cptr(Uinteger Ptr,buffer)[2]
     TargetHeight = cptr(Uinteger Ptr,buffer)[3]
     TargetPitch  = cptr(Uinteger Ptr,buffer)[4]
     buffer      += 32
   End If
   If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub
   
   Dim As Integer    SourceWidth,SourceHeight,SourceBytes,SourcePitch
   If cptr(Integer Ptr,image)[0] = 7 Then
     SourceBytes  = cptr(Uinteger Ptr,image)[1]
     SourceWidth  = cptr(Uinteger Ptr,image)[2]
     SourceHeight = cptr(Uinteger Ptr,image)[3]
     SourcePitch  = cptr(Uinteger Ptr,image)[4]
      image      += 32
   Else
     SourceBytes  = cptr(Ushort Ptr,image)[0] And 7
     SourceWidth  = cptr(Ushort Ptr,image)[0] Shr 3
     SourceHeight = cptr(Ushort Ptr,image)[1]
     SourcePitch  = SourceWidth * SourceBytes
     image       += 4
   End If
   
   If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
   If (TargetBytes<>SourceBytes) Then Exit Sub
   
#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
   Dim As Single Points(3,3)
   points(0,xs)=-SourceWidth/2 * scale_x
   points(1,xs)= SourceWidth/2 * scale_x
   points(2,xs)= points(1,xs)
   points(3,xs)= points(0,xs)
   
   points(0,ys)=-SourceHeight/2 * scale_y
   points(1,ys)= points(0,ys)
   points(2,ys)= SourceHeight/2 * scale_y
   points(3,ys)= points(2,ys)
   
   points(1,xt)= SourceWidth
   points(2,xt)= points(1,xt)
   points(2,yt)= SourceHeight
   points(3,yt)= points(2,yt)
   
   If H_flip Then Swap points(0,xt),points(1,xt): Swap points(2,xt),points(3,xt)
   If V_flip Then Swap points(0,yt),points(3,yt): Swap points(2,yt),points(1,yt)
   
   Dim As Uinteger i
   Dim As Single x,y
   Dim As Integer yStart,yEnd,xStart,xEnd
   yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd
   
#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
   Dim As Integer CNS(1,1) 'Counters
   
   For i=0 To 3
     points(i,xs)=Int(points(i,xs)+sx_midpos)
     points(i,ys)=Int(points(i,ys)+sy_midpos)
     If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
     If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
     If points(i,xs)<xStart Then xStart=points(i,xs)
     If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
   Next
   If yStart =yEnd         Then Exit Sub
   If yStart>=TargetHeight Then Exit Sub
   If yEnd   <0            Then Exit Sub
   If xStart = xEnd        Then Exit Sub
   If xStart>=TargetWidth  Then Exit Sub
   If xEnd   <0            Then Exit Sub
   
   Dim As Ubyte    Ptr t1,s1
   Dim As Ushort   Ptr t2,s2
   Dim As Uinteger     t2c, s2c
   Dim As Uinteger Ptr t4,s4
   
   
#define ADD 0
#define CMP 1
#define SET 2
   Dim As Integer ACS(1,2) 'add compare and set
   ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
   ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0
   
   
#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
   Dim As Single E(2,6),S(6),Length,uSlope,vSlope
   Dim As Integer U,UV,UA,UN,V,VV,VA,VN
   
   ' share the same highest point
   CNS(RI,IND)=CNS(LI,IND)
   If MustLock Then screenlock
   ' loop from Top to Bottom
   While yStart<yEnd
     'Scan Left and Right sides together
     For i=LI To RI
       ' bad to read but fast and short ;-)
       If yStart=points(CNS(i,IND),ys) Then
         CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
         If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
           CNS(i, IND)=CNS(i,NIND)
           CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
           If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         Wend
         E(i,EX) = points(CNS(i, IND),xs)
         E(i,EU) = points(CNS(i, IND),xt)
         E(i,EV) = points(CNS(i, IND),yt)
         Length  = points(CNS(i,NIND),ys)
         Length -= points(CNS(i, IND),ys)
         If Length <> 0.0 Then
           E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
           E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
           E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
         End If
         CNS(i,IND)=CNS(i,NIND)
       End If
     Next
      
     If (yStart<0)                              Then Goto SkipScanLine
     xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine
     xEnd  =E(RI,EX)-0.5:If xEnd < 0            Then Goto SkipScanLine
     If (xStart=xEnd)                           Then Goto SkipScanLine
     'if xEnd  <xStart                           then goto SkipScanLine
     Length=xEnd-xStart
     uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
     vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
     If xstart<0 Then
       Length=Abs(xStart)
       U=Int(E(LI,EU)+uSlope*Length)
       V=Int(E(LI,EV)+vSlope*Length)
       xStart = 0
     Else
       U=Int(E(LI,EU)):V=Int(E(LI,EV))
     End If
     If xEnd>=TargetWidth Then xEnd=TargetWidth
     UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
     VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
     xEnd-=xStart
     Select Case TargetBytes
       Case 1
         t1=cptr(Ubyte Ptr,buffer)
         t1+=yStart*TargetPitch+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             *t1=Custom(*s1,*t1,Param)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             If *s1 Then *t1=*s1
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
         End If
       Case 2
        t2=cptr(Short Ptr,buffer)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             s2c=*s2
             t2c=*t2
             s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=Custom(s2c,t2c,Param)
             *t2=(t2c Shr 3 And &H001F) Or _
                 (t2c Shr 5 And &H07E0) Or _
                 (t2c Shr 8 And &HF800)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         else
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             If *s2<>&HF81F Then *t2=*s2
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         End if
       Case 4
         t4=cptr(Integer Ptr,buffer)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
             '***** start alpha blending
             'this set of if...elseif...end if conditions applies alpha blending
             'these 43 lines can be replaced with '*t4 = *s4' to remove blending
             If alpha = 0 Then
               'no change needed *t4 = *t4
               Elseif alpha = 255 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 0 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 255 Then
                 srb = *s4 And &h00ff00ff
                 sg   = *s4 Xor srb
                 sa   = alpha
                   
                 drb = *t4 And &h00ff00ff
                 dg   = *t4 Xor drb
                 da   = 256 - sa
                   
                 rb = (drb * da + srb * sa) And &hff00ff00
                 g  = (dg  * da + sg  * sa) And &h00ff0000
                   
                 *t4 = (rb Or g) Shr 8 Or &hff000000
               Else
                 sr = (*s4 Shr 16) And 255
                 sg = (*s4 Shr  8) And 255
                 sb = (*s4       ) And 255
                 sa = (alpha)
                 
                 dr = (*t4 Shr 16) And 255
                 dg = (*t4 Shr  8) And 255
                 db = (*t4       ) And 255
                 da = (*t4 Shr 24)
                 
                 sa2 = sa Shl 8
                 da2 = da Shl 8 - da * sa
                 a = (sa2 + da2)
                 
                 r = (dr * da2 + sr * sa2) \ a
                 g = (dg * da2 + sg * sa2) \ a
                 b = (db * da2 + sb * sa2) \ a
                 *t4 = Rgba(r, g, b, a Shr 8)
               End If
               U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
               V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
               If u<0 Then u=0
               If v<0 Then v=0
               xStart+=1:t4+=1
             Wend
             Else
               While xStart<xEnd
                 's4=cptr(Integer Ptr,image):s4+=V*(SourcePitch shr 2):s4+=U
                 s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
                 If (*s4 And &HFFFFFF)<>&HFF00FF Then
                   '***** start alpha blending
                   'this set of if...elseif...end if conditions applies alpha blending
                   'these 43 lines can be replaced with '*t4 = *s4' to remove blending
                   If alpha = 0 Then
                     'no change needed *t4 = *t4
                   Elseif alpha = 255 And alphachannel = 0 Then
                     *t4 = *s4
                   Elseif alpha = 255 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (*s4 Shr 24)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   ElseIf alpha > 0 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sc = (*s4 Shr 24)
                     sa = sc * (alpha / 255)
                     
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                     
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   Elseif *t4 Shr 24 = 0 Then'/
                     *t4 = *s4
                   Elseif *t4 Shr 24 = 255 Then
                     srb = *s4 And &h00ff00ff
                     sg   = *s4 Xor srb
                     sa   = alpha
                        
                     drb = *t4 And &h00ff00ff
                     dg   = *t4 Xor drb
                     da   = 256 - sa
                        
                     rb = (drb * da + srb * sa) And &hff00ff00
                     g  = (dg  * da + sg  * sa) And &h00ff0000
                        
                     *t4 = (rb Or g) Shr 8 Or &hff000000
                   Else
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (alpha)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     
                     r = (dr * da2 + sr * sa2) \ a
                     g = (dg * da2 + sg * sa2) \ a
                     b = (db * da2 + sb * sa2) \ a
                     *t4 = Rgba(r, g, b, a Shr 8)
                   End If
                   '***** end alpha blending
                 End If
                 U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
                 V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
                 If u<0 Then u=0
                 If v<0 Then v=0
                 xStart+=1:t4+=1
               Wend
             End If
      End Select

SkipScanLine:
      E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
      E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
      yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
   Wend
   If MustLock Then screenunlock
End Sub

'__________________________________________________________________________
Sub Private3_SprBlit_scale_solid ( Byval sx_midpos as Integer, _
                                   Byval sy_midpos as Integer, _
                                   Byval image as Any Ptr, _
                                   Byval scale_x as Single, _
                                   Byval scale_y as Single, _
                                   Byval H_flip as Integer = 0, _
                                   Byval V_flip as Integer = 0, _
                                   Byval alpha as Integer = 255, _
                                   Byval buffer as Any Ptr = 0, _
                                   Byval Custom as Function ( Byval Src As Uinteger, _
                                                              Byval Dest As Uinteger, _
                                                              Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                   Byval Param as Any Ptr = 0)

  If (screenptr=0) Or (image=0) Then Exit Sub
  Dim as Integer BPP
  ScreenInfo ,,BPP
  If BPP < 15 then Exit Sub

  Dim as Integer Img_x, Img_y
  Private3_check_buffersize image, Img_x, Img_y
  sx_midpos += (Img_x / 2)
  sy_midpos += (Img_y / 2)

  If scale_x < 0.001 Then scale_x=0.001
  If scale_y < 0.001 Then scale_y=0.001
  
  If alpha < 0 then alpha = 0
  If alpha > 255 then alpha = 255

  Dim As Integer MustLock
  
 'variables for the alpha blending
  Dim As Uinteger srb = Any
  Dim As Uinteger drb = Any
  Dim As Uinteger  rb = Any
  Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
  Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
  Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any

  If buffer= 0 Then MustLock  =1
  
  Dim As Integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch
  If MustLock Then
    ScreenInfo    _
    TargetWidth , _
    TargetHeight, _
    TargetBytes ,,_
    TargetPitch
    TargetBytes Shr=3

    buffer=ScreenPtr
  Else
    TargetBytes  = cptr(Uinteger Ptr,buffer)[1]
    TargetWidth  = cptr(Uinteger Ptr,buffer)[2]
    TargetHeight = cptr(Uinteger Ptr,buffer)[3]
    TargetPitch  = cptr(Uinteger Ptr,buffer)[4]
    buffer    += 32
  End If
  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

  Dim As Integer   SourceWidth,SourceHeight,SourceBytes,SourcePitch
  If cptr(Integer Ptr,image)[0] = 7 Then
    SourceBytes  = cptr(Uinteger Ptr,image)[1]
    SourceWidth  = cptr(Uinteger Ptr,image)[2]
    SourceHeight = cptr(Uinteger Ptr,image)[3]
    SourcePitch  = cptr(Uinteger Ptr,image)[4]
    image    += 32
  Else
    SourceBytes  = 1
    SourceWidth  = cptr(Ushort Ptr,image)[0] Shr 3
    SourceHeight = cptr(Ushort Ptr,image)[1]
    SourcePitch  = SourceWidth
    image    += 4
  End If

  If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
  If (TargetBytes<>SourceBytes) Then Exit Sub

#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
  Dim As Single Points(3,3)
  points(0,xs)=-SourceWidth/2 * scale_x
  points(1,xs)= SourceWidth/2 * scale_x
  points(2,xs)= points(1,xs)
  points(3,xs)= points(0,xs)

  points(0,ys)=-SourceHeight/2 * scale_y
  points(1,ys)= points(0,ys)
  points(2,ys)= SourceHeight/2 * scale_y
  points(3,ys)= points(2,ys)

  points(1,xt)= SourceWidth
  points(2,xt)= points(1,xt)
  points(2,yt)= SourceHeight
  points(3,yt)= points(2,yt)
  
  If H_flip >= 1 then Swap points(0,xt),points(1,xt): Swap points(2,xt),points(3,xt)
  If V_flip >= 1 then Swap points(0,yt),points(3,yt): Swap points(2,yt),points(1,yt)

  Dim As Uinteger i
  Dim As Single x,y

  Dim As Integer yStart,yEnd,xStart,xEnd
  yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd

#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
  Dim As Integer CNS(1,1) 'Counters

  For i=0 To 3
    points(i,xs)=Int(points(i,xs)+sx_midpos)
    points(i,ys)=Int(points(i,ys)+sy_midpos)
    If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
    If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
    If points(i,xs)<xStart Then xStart=points(i,xs)
    If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
  Next
  If yStart =yEnd         Then Exit Sub
  If yStart>=TargetHeight Then Exit Sub
  If yEnd   <0            Then Exit Sub
  If xStart = xEnd        Then Exit Sub
  If xStart>=TargetWidth  Then Exit Sub
  If xEnd   <0            Then Exit Sub

  Dim As Ubyte    Ptr t1,s1
  Dim As Ushort   Ptr t2,s2
  Dim As Uinteger     t2c, s2c
  Dim As Uinteger Ptr t4,s4


#define ADD 0
#define CMP 1
#define SET 2
  Dim As Integer ACS(1,2) 'add compare and set
  ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
  ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0

#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
  Dim As Single E(2,6),S(6),Length,uSlope,vSlope
  Dim As Integer U,UV,UA,UN,V,VV,VA,VN

  ' share the same highest point
  CNS(RI,IND)=CNS(LI,IND)
  If MustLock Then ScreenLock
  ' loop from Top to Bottom
  While yStart<yEnd
    'Scan Left and Right sides together
    For i=LI To RI
      ' bad to read but fast and short ;-)
      If yStart=points(CNS(i,IND),ys) Then
        CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
        If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
          CNS(i, IND)=CNS(i,NIND)
          CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
          If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        Wend
        E(i,EX) = points(CNS(i, IND),xs)
        E(i,EU) = points(CNS(i, IND),xt)
        E(i,EV) = points(CNS(i, IND),yt)
        Length  = points(CNS(i,NIND),ys)
        Length -= points(CNS(i, IND),ys)
        If Length <> 0.0 Then
          E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
          E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
          E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
        End If
        CNS(i,IND)=CNS(i,NIND)
      End If
    Next

    If (yStart<0)                              Then Goto SRs_SkipScanLine
    xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SRs_SkipScanLine
    xEnd  =E(RI,EX)-0.5:If xEnd  < 0           Then Goto SRs_SkipScanLine
    If (xStart=xEnd)                           Then Goto SRs_SkipScanLine
    'if xEnd  <xStart                           then goto SRs_SkipScanLine
    Length=xEnd-xStart
    uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
    vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
    If xstart<0 Then
      Length=Abs(xStart)
      U=Int(E(LI,EU)+uSlope*Length)
      V=Int(E(LI,EV)+vSlope*Length)
      xStart = 0
    Else
      U=Int(E(LI,EU)):V=Int(E(LI,EV))
    End If
    If xEnd>=TargetWidth Then xEnd=TargetWidth
    UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
    VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
    xEnd-=xStart
    Select Case TargetBytes
      Case 2
        t2=cptr(Short Ptr,buffer)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
            s2c=*s2
            t2c=*t2
            s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=Custom(s2c,t2c,Param)
            *t2=(t2c Shr 3 And &H001F) Or _
                (t2c Shr 5 And &H07E0) Or _
                (t2c Shr 8 And &HF800)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        else
          While xStart<xEnd
            s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
            *t2=*s2
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        End if
      Case 4
        t4=cptr(Integer Ptr,buffer)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
          While xStart<xEnd
            's4=cptr(Integer Ptr,image):s4+=V*(SourcePitch shr 2):s4+=U
            s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
            '***** start alpha blending
            'this set of if...elseif...end if conditions applies alpha blending
            'these 43 lines can be replaced with '*t4 = *s4' to remove blending
            If alpha = 0 Then
              'no change needed *t4 = *t4
            Elseif alpha = 255 Then
              If Custom then 
                *t4=Custom(*s4, *t4, Param)
              else
                *t4 = *s4
              End if
            Elseif *t4 Shr 24 = 0 Then
              If Custom then 
                *t4=Custom(*s4, *t4, Param)
              else
                *t4 = *s4
              End if
            Elseif *t4 Shr 24 = 255 Then
              srb = *s4 And &h00ff00ff
              sg  = *s4 Xor srb
              sa  = alpha

              drb = *t4 And &h00ff00ff
              dg  = *t4 Xor drb
              da  = 256 - sa

              rb = (drb * da + srb * sa) And &hff00ff00
              g  = (dg  * da + sg  * sa) And &h00ff0000
              If Custom then 
                *t4=Custom((rb Or g) Shr 8 Or &hff000000, *t4, Param)
              else
                *t4 = (rb Or g) Shr 8 Or &hff000000
              End if
            Else
              sr = (*s4 Shr 16) And 255
              sg = (*s4 Shr  8) And 255
              sb = (*s4       ) And 255
              sa = (alpha)
             
              dr = (*t4 Shr 16) And 255
              dg = (*t4 Shr  8) And 255
              db = (*t4       ) And 255
              da = (*t4 Shr 24)

              sa2 = sa Shl 8
              da2 = da Shl 8 - da * sa
              a = (sa2 + da2)

              r = (dr * da2 + sr * sa2) \ a
              g = (dg * da2 + sg * sa2) \ a
              b = (db * da2 + sb * sa2) \ a
              *t4 = Rgba(r, g, b, a Shr 8)
              If Custom then 
                *t4=Custom(Rgba(r, g, b, a Shr 8), *t4, Param)
              else
                *t4 = Rgba(r, g, b, a Shr 8)
              End if
            End If
            '***** end alpha blending
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
    End Select

SRs_SkipScanLine:
    E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
    E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
    yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
  Wend
If MustLock Then ScreenUnlock
End Sub

Sub Private3_SprBlit_scalerotate ( Byval sx_midpos as Integer, _
                                   Byval sy_midpos as Integer, _
                                   Byval image as Any Ptr, _
                                   Byval scale_x as Single, _
                                   Byval scale_y as Single, _
                                   Byval rotation_angle as Single, _
                                   Byval H_flip as Integer = 0, _
                                   Byval V_flip as Integer = 0, _
                                   Byval alpha as Integer = 255, _
                                   Byval alphachannel as Integer = 1, _
                                   Byval buffer as Any Ptr = 0, _
                                   Byval Custom as Function ( Byval Src As Uinteger, _
                                                              Byval Dest As Uinteger, _
                                                              Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                   Byval Param as Any Ptr = 0)

   If (screenptr=0) Or (image=0) Then Exit Sub
   Dim as Integer BPP
   ScreenInfo ,,BPP
   If BPP < 15 then Exit Sub

   Dim as Integer Img_x, Img_y
   Private3_check_buffersize image, Img_x, Img_y
   sx_midpos += (Img_x / 2)
   sy_midpos += (Img_y / 2)

   If scale_x < 0.001 Then scale_x=0.001
   If scale_y < 0.001 Then scale_y=0.001
   
   Dim As Integer MustLock,Mustrotation_angle
   
   'variables for the alpha blending
      Dim As Uinteger srb = Any
      Dim As Uinteger drb = Any
      Dim As Uinteger  rb = Any
      Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
      Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
      Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any
      Dim As Uinteger sc = Any 'source (alpha) channel
   
   If buffer= 0 Then MustLock   =1
   If rotation_angle <> 0 Then Mustrotation_angle=1
   
   Dim As Integer   TargetWidth,TargetHeight,TargetBytes,TargetPitch
   If MustLock Then
     screeninfo      _
     TargetWidth , _
     TargetHeight, _
     TargetBytes ,,_
     TargetPitch
     TargetBytes Shr=3
      
     buffer=screenptr
   Else
     TargetBytes  = cptr(Uinteger Ptr,buffer)[1]
     TargetWidth  = cptr(Uinteger Ptr,buffer)[2]
     TargetHeight = cptr(Uinteger Ptr,buffer)[3]
     TargetPitch  = cptr(Uinteger Ptr,buffer)[4]
     buffer      += 32
   End If
   If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub
   
   Dim As Integer    SourceWidth,SourceHeight,SourceBytes,SourcePitch
   If cptr(Integer Ptr,image)[0] = 7 Then
     SourceBytes  = cptr(Uinteger Ptr,image)[1]
     SourceWidth  = cptr(Uinteger Ptr,image)[2]
     SourceHeight = cptr(Uinteger Ptr,image)[3]
     SourcePitch  = cptr(Uinteger Ptr,image)[4]
      image      += 32
   Else
     SourceBytes  = cptr(Ushort Ptr,image)[0] And 7
     SourceWidth  = cptr(Ushort Ptr,image)[0] Shr 3
     SourceHeight = cptr(Ushort Ptr,image)[1]
     SourcePitch  = SourceWidth * SourceBytes
     image       += 4
   End If
   
   If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
   If (TargetBytes<>SourceBytes) Then Exit Sub
   
#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
   Dim As Single Points(3,3)
   points(0,xs)=-SourceWidth/2 * scale_x
   points(1,xs)= SourceWidth/2 * scale_x
   points(2,xs)= points(1,xs)
   points(3,xs)= points(0,xs)
   
   points(0,ys)=-SourceHeight/2 * scale_y
   points(1,ys)= points(0,ys)
   points(2,ys)= SourceHeight/2 * scale_y
   points(3,ys)= points(2,ys)
   
   points(1,xt)= SourceWidth-1
   points(2,xt)= points(1,xt)
   points(2,yt)= SourceHeight-1
   points(3,yt)= points(2,yt)
   
   If H_flip Then Swap points(0,xt),points(1,xt): Swap points(2,xt),points(3,xt)
   If V_flip Then Swap points(0,yt),points(3,yt): Swap points(2,yt),points(1,yt)
   
   Dim As Uinteger i
   Dim As Single x,y
   If Mustrotation_angle Then
     rotation_angle*=0.017453292 'degre 2 rad
     While rotation_angle< 0        :rotation_angle+=6.2831853:Wend
     While rotation_angle>=6.2831853:rotation_angle-=6.2831853:Wend
     For i=0 To 3
       x=points(i,xs)*Cos(rotation_angle) - points(i,ys)*Sin(rotation_angle)
       y=points(i,xs)*Sin(rotation_angle) + points(i,ys)*Cos(rotation_angle)
       points(i,xs)=x:points(i,ys)=y
     Next
   End If   
   Dim As Integer yStart,yEnd,xStart,xEnd
   yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd
   
#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
   Dim As Integer CNS(1,1) 'Counters
   
   For i=0 To 3
     points(i,xs)=Int(points(i,xs)+sx_midpos)
     points(i,ys)=Int(points(i,ys)+sy_midpos)
     If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
     If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
     If points(i,xs)<xStart Then xStart=points(i,xs)
     If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
   Next
   If yStart =yEnd         Then Exit Sub
   If yStart>=TargetHeight Then Exit Sub
   If yEnd   <0            Then Exit Sub
   If xStart = xEnd        Then Exit Sub
   If xStart>=TargetWidth  Then Exit Sub
   If xEnd   <0            Then Exit Sub
   
   Dim As Ubyte    Ptr t1,s1
   Dim As Ushort   Ptr t2,s2
   Dim As Uinteger     t2c, s2c
   Dim As Uinteger Ptr t4,s4
   
   
#define ADD 0
#define CMP 1
#define SET 2
   Dim As Integer ACS(1,2) 'add compare and set
   ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
   ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0
   
   
#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
   Dim As Single E(2,6),S(6),Length,uSlope,vSlope
   Dim As Integer U,UV,UA,UN,V,VV,VA,VN
   
   ' share the same highest point
   CNS(RI,IND)=CNS(LI,IND)
   If MustLock Then screenlock
   ' loop from Top to Bottom
   While yStart<yEnd
     'Scan Left and Right sides together
     For i=LI To RI
       ' bad to read but fast and short ;-)
       If yStart=points(CNS(i,IND),ys) Then
         CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
         If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
           CNS(i, IND)=CNS(i,NIND)
           CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
           If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         Wend
         E(i,EX) = points(CNS(i, IND),xs)
         E(i,EU) = points(CNS(i, IND),xt)
         E(i,EV) = points(CNS(i, IND),yt)
         Length  = points(CNS(i,NIND),ys)
         Length -= points(CNS(i, IND),ys)
         If Length <> 0.0 Then
           E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
           E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
           E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
         End If
         CNS(i,IND)=CNS(i,NIND)
       End If
     Next
      
     If (yStart<0)                              Then Goto SkipScanLine
     xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine
     xEnd  =E(RI,EX)-0.5:If xEnd < 0            Then Goto SkipScanLine
     If (xStart=xEnd)                           Then Goto SkipScanLine
     'if xEnd  <xStart                           then goto SkipScanLine
     Length=xEnd-xStart
     uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
     vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
     If xstart<0 Then
       Length=Abs(xStart)
       U=Int(E(LI,EU)+uSlope*Length)
       V=Int(E(LI,EV)+vSlope*Length)
       xStart = 0
     Else
       U=Int(E(LI,EU)):V=Int(E(LI,EV))
     End If
     If xEnd>=TargetWidth Then xEnd=TargetWidth
     UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
     VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
     xEnd-=xStart
     Select Case TargetBytes
       Case 1
         t1=cptr(Ubyte Ptr,buffer)
         t1+=yStart*TargetPitch+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             *t1=Custom(*s1,*t1,Param)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             If *s1 Then *t1=*s1
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
         End If
       Case 2
        t2=cptr(Short Ptr,buffer)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             s2c=*s2
             t2c=*t2
             s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=Custom(s2c,t2c,Param)
             *t2=(t2c Shr 3 And &H001F) Or _
                 (t2c Shr 5 And &H07E0) Or _
                 (t2c Shr 8 And &HF800)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         else
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             If *s2<>&HF81F Then *t2=*s2
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         End if
       Case 4
         t4=cptr(Integer Ptr,buffer)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
             '***** start alpha blending
             'this set of if...elseif...end if conditions applies alpha blending
             'these 43 lines can be replaced with '*t4 = *s4' to remove blending
             If alpha = 0 Then
               'no change needed *t4 = *t4
               Elseif alpha = 255 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 0 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 255 Then
                 srb = *s4 And &h00ff00ff
                 sg   = *s4 Xor srb
                 sa   = alpha
                   
                 drb = *t4 And &h00ff00ff
                 dg   = *t4 Xor drb
                 da   = 256 - sa
                   
                 rb = (drb * da + srb * sa) And &hff00ff00
                 g  = (dg  * da + sg  * sa) And &h00ff0000
                   
                 *t4 = (rb Or g) Shr 8 Or &hff000000
               Else
                 sr = (*s4 Shr 16) And 255
                 sg = (*s4 Shr  8) And 255
                 sb = (*s4       ) And 255
                 sa = (alpha)
                 
                 dr = (*t4 Shr 16) And 255
                 dg = (*t4 Shr  8) And 255
                 db = (*t4       ) And 255
                 da = (*t4 Shr 24)
                 
                 sa2 = sa Shl 8
                 da2 = da Shl 8 - da * sa
                 a = (sa2 + da2)
                 
                 r = (dr * da2 + sr * sa2) \ a
                 g = (dg * da2 + sg * sa2) \ a
                 b = (db * da2 + sb * sa2) \ a
                 *t4 = Rgba(r, g, b, a Shr 8)
               End If
               U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
               V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
               If u<0 Then u=0
               If v<0 Then v=0
               xStart+=1:t4+=1
             Wend
             Else
               While xStart<xEnd
                 's4=cptr(Integer Ptr,image):s4+=V*(SourcePitch shr 2):s4+=U
                 s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
                 If (*s4 And &HFFFFFF)<>&HFF00FF Then
                   '***** start alpha blending
                   'this set of if...elseif...end if conditions applies alpha blending
                   'these 43 lines can be replaced with '*t4 = *s4' to remove blending
                   If alpha = 0 Then
                     'no change needed *t4 = *t4
                   Elseif alpha = 255 And alphachannel = 0 Then
                     *t4 = *s4
                   Elseif alpha = 255 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (*s4 Shr 24)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   ElseIf alpha > 0 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sc = (*s4 Shr 24)
                     sa = sc * (alpha / 255)
                     
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                     
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   Elseif *t4 Shr 24 = 0 Then'/
                     *t4 = *s4
                   Elseif *t4 Shr 24 = 255 Then
                     srb = *s4 And &h00ff00ff
                     sg   = *s4 Xor srb
                     sa   = alpha
                        
                     drb = *t4 And &h00ff00ff
                     dg   = *t4 Xor drb
                     da   = 256 - sa
                        
                     rb = (drb * da + srb * sa) And &hff00ff00
                     g  = (dg  * da + sg  * sa) And &h00ff0000
                        
                     *t4 = (rb Or g) Shr 8 Or &hff000000
                   Else
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (alpha)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     
                     r = (dr * da2 + sr * sa2) \ a
                     g = (dg * da2 + sg * sa2) \ a
                     b = (db * da2 + sb * sa2) \ a
                     *t4 = Rgba(r, g, b, a Shr 8)
                   End If
                   '***** end alpha blending
                 End If
                 U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
                 V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
                 If u<0 Then u=0
                 If v<0 Then v=0
                 xStart+=1:t4+=1
               Wend
             End If
      End Select

SkipScanLine:
      E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
      E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
      yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
   Wend
   If MustLock Then screenunlock
End Sub

'__________________________________________________________________________
Sub Private3_SprBlit_scalerotate_solid ( Byval sx_midpos as Integer, _
                                         Byval sy_midpos as Integer, _
                                         Byval image as Any Ptr, _
                                         Byval scale_x as Single, _
                                         Byval scale_y as Single, _
                                         Byval rotation_angle as Single, _
                                         Byval H_flip as Integer = 0, _
                                         Byval V_flip as Integer = 0, _
                                         Byval alpha as Integer = 255, _
                                         Byval buffer as Any Ptr = 0, _
                                         Byval Custom as Function ( Byval Src As Uinteger, _
                                                                    Byval Dest As Uinteger, _
                                                                    Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                                         Byval Param as Any Ptr = 0)

  If (screenptr=0) Or (image=0) Then Exit Sub
  Dim as Integer BPP
  ScreenInfo ,,BPP
  If BPP < 15 then Exit Sub

  Dim as Integer Img_x, Img_y
  Private3_check_buffersize image, Img_x, Img_y
  sx_midpos += (Img_x / 2)
  sy_midpos += (Img_y / 2)

  If scale_x < 0.001 Then scale_x=0.001
  If scale_y < 0.001 Then scale_y=0.001
  
  If alpha < 0 then alpha = 0
  If alpha > 255 then alpha = 255

  Dim As Integer MustLock,Mustrotation_angle
  
 'variables for the alpha blending
  Dim As Uinteger srb = Any
  Dim As Uinteger drb = Any
  Dim As Uinteger  rb = Any
  Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
  Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
  Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any

  If buffer= 0 Then MustLock  =1
  If rotation_angle  <>0 Then Mustrotation_angle=1

  Dim As Integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch
  If MustLock Then
    ScreenInfo    _
    TargetWidth , _
    TargetHeight, _
    TargetBytes ,,_
    TargetPitch
    TargetBytes Shr=3

    buffer=ScreenPtr
  Else
    TargetBytes  = cptr(Uinteger Ptr,buffer)[1]
    TargetWidth  = cptr(Uinteger Ptr,buffer)[2]
    TargetHeight = cptr(Uinteger Ptr,buffer)[3]
    TargetPitch  = cptr(Uinteger Ptr,buffer)[4]
    buffer    += 32
  End If
  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

  Dim As Integer   SourceWidth,SourceHeight,SourceBytes,SourcePitch
  If cptr(Integer Ptr,image)[0] = 7 Then
    SourceBytes  = cptr(Uinteger Ptr,image)[1]
    SourceWidth  = cptr(Uinteger Ptr,image)[2]
    SourceHeight = cptr(Uinteger Ptr,image)[3]
    SourcePitch  = cptr(Uinteger Ptr,image)[4]
    image    += 32
  Else
    SourceBytes  = 1
    SourceWidth  = cptr(Ushort Ptr,image)[0] Shr 3
    SourceHeight = cptr(Ushort Ptr,image)[1]
    SourcePitch  = SourceWidth
    image    += 4
  End If

  If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
  If (TargetBytes<>SourceBytes) Then Exit Sub

#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
  Dim As Single Points(3,3)
  points(0,xs)=-SourceWidth/2 * scale_x
  points(1,xs)= SourceWidth/2 * scale_x
  points(2,xs)= points(1,xs)
  points(3,xs)= points(0,xs)

  points(0,ys)=-SourceHeight/2 * scale_y
  points(1,ys)= points(0,ys)
  points(2,ys)= SourceHeight/2 * scale_y
  points(3,ys)= points(2,ys)

  points(1,xt)= SourceWidth-1
  points(2,xt)= points(1,xt)
  points(2,yt)= SourceHeight-1
  points(3,yt)= points(2,yt)
  
  If H_flip >= 1 then Swap points(0,xt),points(1,xt): Swap points(2,xt),points(3,xt)
  If V_flip >= 1 then Swap points(0,yt),points(3,yt): Swap points(2,yt),points(1,yt)

  Dim As Uinteger i
  Dim As Single x,y
  If Mustrotation_angle Then
    rotation_angle*=0.017453292 'degre 2 rad
    While rotation_angle< 0        :rotation_angle+=6.2831853:Wend
    While rotation_angle>=6.2831853:rotation_angle-=6.2831853:Wend
    For i=0 To 3
      x=points(i,xs)*Cos(rotation_angle) - points(i,ys)*Sin(rotation_angle)
      y=points(i,xs)*Sin(rotation_angle) + points(i,ys)*Cos(rotation_angle)
      points(i,xs)=x:points(i,ys)=y
    Next
  End If

  Dim As Integer yStart,yEnd,xStart,xEnd
  yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd

#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
  Dim As Integer CNS(1,1) 'Counters

  For i=0 To 3
    points(i,xs)=Int(points(i,xs)+sx_midpos)
    points(i,ys)=Int(points(i,ys)+sy_midpos)
    If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
    If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
    If points(i,xs)<xStart Then xStart=points(i,xs)
    If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
  Next
  If yStart =yEnd         Then Exit Sub
  If yStart>=TargetHeight Then Exit Sub
  If yEnd   <0            Then Exit Sub
  If xStart = xEnd        Then Exit Sub
  If xStart>=TargetWidth  Then Exit Sub
  If xEnd   <0            Then Exit Sub

  Dim As Ubyte    Ptr t1,s1
  Dim As Ushort   Ptr t2,s2
  Dim As Uinteger     t2c, s2c
  Dim As Uinteger Ptr t4,s4


#define ADD 0
#define CMP 1
#define SET 2
  Dim As Integer ACS(1,2) 'add compare and set
  ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
  ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0

#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
  Dim As Single E(2,6),S(6),Length,uSlope,vSlope
  Dim As Integer U,UV,UA,UN,V,VV,VA,VN

  ' share the same highest point
  CNS(RI,IND)=CNS(LI,IND)
  If MustLock Then ScreenLock
  ' loop from Top to Bottom
  While yStart<yEnd
    'Scan Left and Right sides together
    For i=LI To RI
      ' bad to read but fast and short ;-)
      If yStart=points(CNS(i,IND),ys) Then
        CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
        If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
          CNS(i, IND)=CNS(i,NIND)
          CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
          If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
        Wend
        E(i,EX) = points(CNS(i, IND),xs)
        E(i,EU) = points(CNS(i, IND),xt)
        E(i,EV) = points(CNS(i, IND),yt)
        Length  = points(CNS(i,NIND),ys)
        Length -= points(CNS(i, IND),ys)
        If Length <> 0.0 Then
          E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
          E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
          E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
        End If
        CNS(i,IND)=CNS(i,NIND)
      End If
    Next

    If (yStart<0)                              Then Goto SRs_SkipScanLine
    xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SRs_SkipScanLine
    xEnd  =E(RI,EX)-0.5:If xEnd  < 0           Then Goto SRs_SkipScanLine
    If (xStart=xEnd)                           Then Goto SRs_SkipScanLine
    'if xEnd  <xStart                           then goto SRs_SkipScanLine
    Length=xEnd-xStart
    uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
    vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
    If xstart<0 Then
      Length=Abs(xStart)
      U=Int(E(LI,EU)+uSlope*Length)
      V=Int(E(LI,EV)+vSlope*Length)
      xStart = 0
    Else
      U=Int(E(LI,EU)):V=Int(E(LI,EV))
    End If
    If xEnd>=TargetWidth Then xEnd=TargetWidth
    UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
    VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
    xEnd-=xStart
    Select Case TargetBytes
      Case 2
        t2=cptr(Short Ptr,buffer)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
          While xStart<xEnd
            s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
            s2c=*s2
            t2c=*t2
            s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=Custom(s2c,t2c,Param)
            *t2=(t2c Shr 3 And &H001F) Or _
                (t2c Shr 5 And &H07E0) Or _
                (t2c Shr 8 And &HF800)
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        else
          While xStart<xEnd
            s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
            *t2=*s2
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t2+=1
          Wend
        End if
      Case 4
        t4=cptr(Integer Ptr,buffer)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
          While xStart<xEnd
            's4=cptr(Integer Ptr,image):s4+=V*(SourcePitch shr 2):s4+=U
            s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
            '***** start alpha blending
            'this set of if...elseif...end if conditions applies alpha blending
            'these 43 lines can be replaced with '*t4 = *s4' to remove blending
            If alpha = 0 Then
              'no change needed *t4 = *t4
            Elseif alpha = 255 Then
              If Custom then 
                *t4=Custom(*s4, *t4, Param)
              else
                *t4 = *s4
              End if
            Elseif *t4 Shr 24 = 0 Then
              If Custom then 
                *t4=Custom(*s4, *t4, Param)
              else
                *t4 = *s4
              End if
            Elseif *t4 Shr 24 = 255 Then
              srb = *s4 And &h00ff00ff
              sg  = *s4 Xor srb
              sa  = alpha

              drb = *t4 And &h00ff00ff
              dg  = *t4 Xor drb
              da  = 256 - sa

              rb = (drb * da + srb * sa) And &hff00ff00
              g  = (dg  * da + sg  * sa) And &h00ff0000
              If Custom then 
                *t4=Custom((rb Or g) Shr 8 Or &hff000000, *t4, Param)
              else
                *t4 = (rb Or g) Shr 8 Or &hff000000
              End if
            Else
              sr = (*s4 Shr 16) And 255
              sg = (*s4 Shr  8) And 255
              sb = (*s4       ) And 255
              sa = (alpha)
             
              dr = (*t4 Shr 16) And 255
              dg = (*t4 Shr  8) And 255
              db = (*t4       ) And 255
              da = (*t4 Shr 24)

              sa2 = sa Shl 8
              da2 = da Shl 8 - da * sa
              a = (sa2 + da2)

              r = (dr * da2 + sr * sa2) \ a
              g = (dg * da2 + sg * sa2) \ a
              b = (db * da2 + sb * sa2) \ a
              *t4 = Rgba(r, g, b, a Shr 8)
              If Custom then 
                *t4=Custom(Rgba(r, g, b, a Shr 8), *t4, Param)
              else
                *t4 = Rgba(r, g, b, a Shr 8)
              End if
            End If
            '***** end alpha blending
            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
            If u<0 Then u=0
            If v<0 Then v=0
            xStart+=1:t4+=1
          Wend
    End Select

SRs_SkipScanLine:
    E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
    E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
    yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
  Wend
If MustLock Then ScreenUnlock
End Sub

'__________________________________________________________________________
Sub Private3_LowRes_scaler ( Byval sx_midpos as Integer, _
                             Byval sy_midpos as Integer, _
                             Byval image as Any Ptr, _
                             Byval scale_x as Single, _
                             Byval scale_y as Single, _
                             Byval H_flip as Integer = 0, _
                             Byval V_flip as Integer = 0, _
                             Byval alpha as Integer = 255, _
                             Byval alphachannel as Integer = 1, _
                             Byval buffer as Any Ptr = 0, _
                             Byval Custom as Function ( Byval Src As Uinteger, _
                                                        Byval Dest As Uinteger, _
                                                        Byval Param As Any Ptr = 0 ) as Uinteger = 0, _
                             Byval Param as Any Ptr = 0)

   If (screenptr=0) Or (image=0) Then Exit Sub
   Dim as Integer BPP
   ScreenInfo ,,BPP
   If BPP < 15 then Exit Sub

   If scale_x < 0.001 Then scale_x=0.001
   If scale_y < 0.001 Then scale_y=0.001
   
   Dim As Integer MustLock
   
   'variables for the alpha blending
      Dim As Uinteger srb = Any
      Dim As Uinteger drb = Any
      Dim As Uinteger  rb = Any
      Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
      Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
      Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any
      Dim As Uinteger sc = Any 'source (alpha) channel
   
   If buffer= 0 Then MustLock   =1
   
   Dim As Integer   TargetWidth,TargetHeight,TargetBytes,TargetPitch
   If MustLock Then
     screeninfo      _
     TargetWidth , _
     TargetHeight, _
     TargetBytes ,,_
     TargetPitch
     TargetBytes Shr=3
      
     buffer=screenptr
   Else
     TargetBytes  = cptr(Uinteger Ptr,buffer)[1]
     TargetWidth  = cptr(Uinteger Ptr,buffer)[2]
     TargetHeight = cptr(Uinteger Ptr,buffer)[3]
     TargetPitch  = cptr(Uinteger Ptr,buffer)[4]
     buffer      += 32
   End If
   If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub
   
   Dim As Integer    SourceWidth,SourceHeight,SourceBytes,SourcePitch
   If cptr(Integer Ptr,image)[0] = 7 Then
     SourceBytes  = cptr(Uinteger Ptr,image)[1]
     SourceWidth  = cptr(Uinteger Ptr,image)[2]
     SourceHeight = cptr(Uinteger Ptr,image)[3]
     SourcePitch  = cptr(Uinteger Ptr,image)[4]
      image      += 32
   Else
     SourceBytes  = cptr(Ushort Ptr,image)[0] And 7
     SourceWidth  = cptr(Ushort Ptr,image)[0] Shr 3
     SourceHeight = cptr(Ushort Ptr,image)[1]
     SourcePitch  = SourceWidth * SourceBytes
     image       += 4
   End If
   
   If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
   If (TargetBytes<>SourceBytes) Then Exit Sub
   
#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
   Dim As Single Points(3,3)
   points(0,xs)=-SourceWidth/2 * scale_x
   points(1,xs)= SourceWidth/2 * scale_x
   points(2,xs)= points(1,xs)
   points(3,xs)= points(0,xs)
   
   points(0,ys)=-SourceHeight/2 * scale_y
   points(1,ys)= points(0,ys)
   points(2,ys)= SourceHeight/2 * scale_y
   points(3,ys)= points(2,ys)
   
   points(1,xt)= SourceWidth
   points(2,xt)= points(1,xt)
   points(2,yt)= SourceHeight
   points(3,yt)= points(2,yt)
   
   If H_flip Then Swap points(0,xt),points(1,xt): Swap points(2,xt),points(3,xt)
   If V_flip Then Swap points(0,yt),points(3,yt): Swap points(2,yt),points(1,yt)
   
   Dim As Uinteger i
   Dim As Single x,y
   Dim As Integer yStart,yEnd,xStart,xEnd
   yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd
   
#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
   Dim As Integer CNS(1,1) 'Counters
   
   For i=0 To 3
     points(i,xs)=Int(points(i,xs)+sx_midpos)
     points(i,ys)=Int(points(i,ys)+sy_midpos)
     If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
     If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
     If points(i,xs)<xStart Then xStart=points(i,xs)
     If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
   Next
   If yStart =yEnd         Then Exit Sub
   If yStart>=TargetHeight Then Exit Sub
   If yEnd   <0            Then Exit Sub
   If xStart = xEnd        Then Exit Sub
   If xStart>=TargetWidth  Then Exit Sub
   If xEnd   <0            Then Exit Sub
   
   Dim As Ubyte    Ptr t1,s1
   Dim As Ushort   Ptr t2,s2
   Dim As Uinteger     t2c, s2c
   Dim As Uinteger Ptr t4,s4
   
   
#define ADD 0
#define CMP 1
#define SET 2
   Dim As Integer ACS(1,2) 'add compare and set
   ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
   ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0
   
   
#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
   Dim As Single E(2,6),S(6),Length,uSlope,vSlope
   Dim As Integer U,UV,UA,UN,V,VV,VA,VN
   
   ' share the same highest point
   CNS(RI,IND)=CNS(LI,IND)
   If MustLock Then screenlock
   ' loop from Top to Bottom
   While yStart<yEnd
     'Scan Left and Right sides together
     For i=LI To RI
       ' bad to read but fast and short ;-)
       If yStart=points(CNS(i,IND),ys) Then
         CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
         If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
           CNS(i, IND)=CNS(i,NIND)
           CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
           If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
         Wend
         E(i,EX) = points(CNS(i, IND),xs)
         E(i,EU) = points(CNS(i, IND),xt)
         E(i,EV) = points(CNS(i, IND),yt)
         Length  = points(CNS(i,NIND),ys)
         Length -= points(CNS(i, IND),ys)
         If Length <> 0.0 Then
           E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
           E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
           E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
         End If
         CNS(i,IND)=CNS(i,NIND)
       End If
     Next
      
     If (yStart<0)                              Then Goto SkipScanLine
     xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine
     xEnd  =E(RI,EX)-0.5:If xEnd < 0            Then Goto SkipScanLine
     If (xStart=xEnd)                           Then Goto SkipScanLine
     'if xEnd  <xStart                           then goto SkipScanLine
     Length=xEnd-xStart
     uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
     vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
     If xstart<0 Then
       Length=Abs(xStart)
       U=Int(E(LI,EU)+uSlope*Length)
       V=Int(E(LI,EV)+vSlope*Length)
       xStart = 0
     Else
       U=Int(E(LI,EU)):V=Int(E(LI,EV))
     End If
     If xEnd>=TargetWidth Then xEnd=TargetWidth
     UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
     VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
     xEnd-=xStart
     Select Case TargetBytes
       Case 1
         t1=cptr(Ubyte Ptr,buffer)
         t1+=yStart*TargetPitch+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             *t1=Custom(*s1,*t1,Param)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
           While xStart<xEnd
             s1=image+V*SourcePitch+U
             If *s1 Then *t1=*s1
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t1+=1
           Wend
         End If
       Case 2
        t2=cptr(Short Ptr,buffer)
        t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
        If Custom Then
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             s2c=*s2
             t2c=*t2
             s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                 (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                 (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
             t2c=Custom(s2c,t2c,Param)
             *t2=(t2c Shr 3 And &H001F) Or _
                 (t2c Shr 5 And &H07E0) Or _
                 (t2c Shr 8 And &HF800)
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         else
           While xStart<xEnd
             s2=cptr(Short Ptr,image)+V*(SourcePitch Shr 1)+U
             If *s2<>&HF81F Then *t2=*s2
             U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
             V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
             If u<0 Then u=0
             If v<0 Then v=0
             xStart+=1:t2+=1
           Wend
         End if
       Case 4
         t4=cptr(Integer Ptr,buffer)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
         If Custom Then
           While xStart<xEnd
             s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
             '***** start alpha blending
             'this set of if...elseif...end if conditions applies alpha blending
             'these 43 lines can be replaced with '*t4 = *s4' to remove blending
             If alpha = 0 Then
               'no change needed *t4 = *t4
               Elseif alpha = 255 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 0 Then
                 *t4 = *s4
               Elseif *t4 Shr 24 = 255 Then
                 srb = *s4 And &h00ff00ff
                 sg   = *s4 Xor srb
                 sa   = alpha
                   
                 drb = *t4 And &h00ff00ff
                 dg   = *t4 Xor drb
                 da   = 256 - sa
                   
                 rb = (drb * da + srb * sa) And &hff00ff00
                 g  = (dg  * da + sg  * sa) And &h00ff0000
                   
                 *t4 = (rb Or g) Shr 8 Or &hff000000
               Else
                 sr = (*s4 Shr 16) And 255
                 sg = (*s4 Shr  8) And 255
                 sb = (*s4       ) And 255
                 sa = (alpha)
                 
                 dr = (*t4 Shr 16) And 255
                 dg = (*t4 Shr  8) And 255
                 db = (*t4       ) And 255
                 da = (*t4 Shr 24)
                 
                 sa2 = sa Shl 8
                 da2 = da Shl 8 - da * sa
                 a = (sa2 + da2)
                 
                 r = (dr * da2 + sr * sa2) \ a
                 g = (dg * da2 + sg * sa2) \ a
                 b = (db * da2 + sb * sa2) \ a
                 *t4 = Rgba(r, g, b, a Shr 8)
               End If
               U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
               V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
               If u<0 Then u=0
               If v<0 Then v=0
               xStart+=1:t4+=1
             Wend
             Else
               While xStart<xEnd
                 's4=cptr(Integer Ptr,image):s4+=V*(SourcePitch shr 2):s4+=U
                 s4=cptr(Integer Ptr,image)+V*(SourcePitch Shr 2)+U
                 If (*s4 And &HFFFFFF)<>&HFF00FF Then
                   '***** start alpha blending
                   'this set of if...elseif...end if conditions applies alpha blending
                   'these 43 lines can be replaced with '*t4 = *s4' to remove blending
                   If alpha = 0 Then
                     'no change needed *t4 = *t4
                   Elseif alpha = 255 And alphachannel = 0 Then
                     *t4 = *s4
                   Elseif alpha = 255 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (*s4 Shr 24)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   ElseIf alpha > 0 And alphachannel = 1 Then
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sc = (*s4 Shr 24)
                     sa = sc * (alpha / 255)
                     
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                     
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     If a > 0 Then
                       r = (dr * da2 + sr * sa2) \ a
                       g = (dg * da2 + sg * sa2) \ a
                       b = (db * da2 + sb * sa2) \ a
                       *t4 = Rgba(r, g, b, a Shr 8)
                     Else
                       *t4 = Rgba(dr, dg, db, da)
                     EndIf
                   Elseif *t4 Shr 24 = 0 Then'/
                     *t4 = *s4
                   Elseif *t4 Shr 24 = 255 Then
                     srb = *s4 And &h00ff00ff
                     sg   = *s4 Xor srb
                     sa   = alpha
                        
                     drb = *t4 And &h00ff00ff
                     dg   = *t4 Xor drb
                     da   = 256 - sa
                        
                     rb = (drb * da + srb * sa) And &hff00ff00
                     g  = (dg  * da + sg  * sa) And &h00ff0000
                        
                     *t4 = (rb Or g) Shr 8 Or &hff000000
                   Else
                     sr = (*s4 Shr 16) And 255
                     sg = (*s4 Shr  8) And 255
                     sb = (*s4       ) And 255
                     sa = (alpha)
                        
                     dr = (*t4 Shr 16) And 255
                     dg = (*t4 Shr  8) And 255
                     db = (*t4       ) And 255
                     da = (*t4 Shr 24)
                        
                     sa2 = sa Shl 8
                     da2 = da Shl 8 - da * sa
                     a = (sa2 + da2)
                     
                     r = (dr * da2 + sr * sa2) \ a
                     g = (dg * da2 + sg * sa2) \ a
                     b = (db * da2 + sb * sa2) \ a
                     *t4 = Rgba(r, g, b, a Shr 8)
                   End If
                   '***** end alpha blending
                 End If
                 U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
                 V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
                 If u<0 Then u=0
                 If v<0 Then v=0
                 xStart+=1:t4+=1
               Wend
             End If
      End Select

SkipScanLine:
      E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
      E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
      yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
   Wend
   If MustLock Then screenunlock
End Sub

Private Function Private3_customcolor( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
  If src = &hffff00ff Or src = &hff00ff Then Return dest
  
  Dim value As Integer Ptr = Cast(Integer Ptr, param)
  Dim As Integer r,g,b
  
  r = (*value Shr 16) And &hff
  g = (*value Shr 8) And &hff
  b = (*value And &hff)
  
  Return rgb(r,g,b)
End Function

Private Function Private3_inverse( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
  If src = &hffff00ff Or src = &hff00ff Then Return dest
  
  Dim As Integer r,g,b
  
  r = (src Shr 16) and &hff
  g = (src Shr 8) and &hff
  b = (src and &hff)

  r = r xor &hff
  g = g xor &h00ff
  b = b xor &h0000ff

  Return rgb(r,g,b)
End Function

Private Function Private3_shadow( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
'----------------------------------------------------------------------
'Special Thanks to axipher for this AWESOME routine!!!
'----------------------------------------------------------------------
  If src = &hffff00ff Or src = &hff00ff Then Return dest
  
  Dim value As Single Ptr = Cast(Single Ptr, param)
  Dim As Integer r1,g1,b1,r2,g2,b2,nr,ng,nb
    
  r1 = (src Shr 16) And &hff
  g1 = (src Shr 8) And &hff
  b1 = (src And &hff)
  r2 = (dest Shr 16) And &hff
  g2 = (dest Shr 8) And &hff
  b2 = (dest And &hff)
    
  'If *value < 1.9 then *value = 1.9
  
  nr = (r1 + r2) / *value
  ng = (g1 + g2) / *value
  nb = (b1 + b2) / *value
  
  If nr >= &hff then nr = &hff 
  If ng >= &h00ff then ng = &h00ff 
  If nb >= &h0000ff then nb = &h0000ff 

  Return rgb(nr,ng,nb)
End Function

Private Function Private3_grayscale( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
'----------------------------------------------------------------------
'Special Thanks to axipher for this AWESOME routine!!!
'----------------------------------------------------------------------
  If src = &hffff00ff Or src = &hff00ff Then Return dest
  
  Dim As Integer r,g,b,c
  
  r = (src Shr 16) And &hff
  g = (src Shr 8) And &hff
  b = src And &hff
  
  c = (0.1 * b) + (0.6 * g) + (0.3 * r)
  If c > 255 Then c = 255
  
  Return rgb(c,c,c)
End Function

Private Function Private3_greyscaleinverse( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
  If src = &hffff00ff Or src = &hff00ff Then Return dest
  
  Dim As Integer r,g,b,c
  
  r = (src Shr 16) and &hff
  g = (src Shr 8) and &hff
  b = (src and &hff)

  r = r xor &hff
  g = g xor &h00ff
  b = b xor &h0000ff

  c = (0.1 * b) + (0.6 * g) + (0.3 * r)
  If c > 255 Then c = 255
  
  Return rgb(c,c,c)
End Function

Private Function Private3_overlay( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
'----------------------------------------------------------------------
'Special Thanks to axipher for this AWESOME routine!!!
'----------------------------------------------------------------------
  If src = &hffff00ff Or src = &hff00ff Then Return dest
  
  Dim value As Integer Ptr = Cast(Integer Ptr, param)
  Dim As Integer r1,g1,b1,r2,g2,b2,nr,ng,nb,c
  
  r1 = (src Shr 16) And &hff
  g1 = (src Shr 8) And &hff
  b1 = src And &hff
  r2 = (*value Shr 16) And &hff
  g2 = (*value Shr 8) And &hff
  b2 = *value And &hff
  
  nr = (r1 + r2) / 2
  ng = (g1 + g2) / 2
  nb = (b1 + b2) / 2
  
  nr = nr Mod 256
  ng = ng Mod 256
  nb = nb Mod 256
  
  Return rgb(nr,ng,nb)
End Function

'__________________________________________________________________________
Private Function Rawcollision_screen ( Byval x1 as integer, _
                                       Byval y1 as integer, _
                                       Byval CollideSpr1 as any ptr, _
                                       Byval x2 as integer, _
                                       Byval y2 as integer, _
                                       Byval CollideSpr2 as any ptr, _
                                       Byval EnableAlpha as integer = 0 ) as integer

'-------------------------------------------------------------------------
' A PHENOMENAL Special Thanks to Mysoft for this spectactular sprite
' collision routine in this original game lib!!!  d=^-^=b !!
'
' This routine works in all 15- to 32-bit graphics modes, and so upon
' using it, pixel-perfect collisions will AUTOMATICALLY be done between
' any two native FB-compatible sprites (GET-PUT based) of your choice,
' regardless of any size between the two!!!
'
' Such a GREAT deal, huh!?  :D !
'-------------------------------------------------------------------------

  dim as integer COLLI,TX,TY,RESULT,IBPP
  dim as integer OASX,OASY,OBSX,OBSY
  dim as integer x1X,y1Y,x2X,y2Y
  dim as integer APIT,BPIT,XCNT,YCNT
  dim as any ptr ASTRT,BSTRT,CSTRT
  
  const MaximumAlpha = 64 'Max alpha value that will be considered transparent
  const HeaderSize = sizeof(fb.image) 'size of the image header (if any) (32 bytes for fbgfx)
  OASX = cptr(fb.image ptr,CollideSpr1)->width-1 'width of the object A minus one
  OASY = cptr(fb.image ptr,CollideSpr1)->height-1 'height of the object A minus one  
  OBSX = cptr(fb.image ptr,CollideSpr2)->width-1 'width of the object B minus one
  OBSY = cptr(fb.image ptr,CollideSpr2)->height-1 'height of the object B minus one  
  IBPP = cptr(fb.image ptr,CollideSpr1)->BPP  'BYTES per pixel (1(8), 2(16), 4(32)
  APIT = cptr(fb.image ptr,CollideSpr1)->PITCH 'width*BPP object A (16 byte granularity for fbgfx)
  BPIT = cptr(fb.image ptr,CollideSpr2)->PITCH 'width*BPP object B (16 byte granularity for fbgfx) 
  x1X = x1+OASX:y1Y = y1+OASY
  x2X = x2+OBSX:y2Y = y2+OBSY  
  
  if IBPP = 1 then 
    IBPP = 0
  elseif IBPP = 2 then
    IBPP = 1
  elseif IBPP = 4 then
    IBPP = 2
  else
    return 0
  end if
  
  do    
    if x1 >= x2 and x1 <= x2X then
      ' ********** 11 ***********
      if y1 >= y2 and y1 <= y2Y then 
        if x2X > x1X then TX = x1X else TX = x2X
        if y2Y > y1Y then TY = y1Y else TY = y2Y        
        ASTRT = CollideSpr1 + HeaderSize 
        BSTRT = CollideSpr2 + HeaderSize + _
        ((x1-x2) shl IBPP) + ((y1-y2)*BPIT)
        XCNT = (TX-x1)+1:YCNT = (TY-y1)+1
        APIT -= ((TX-x1) shl IBPP)+(1 shl IBPP)
        BPIT -= ((TX-x1) shl IBPP)+(1 shl IBPP)        
        RESULT = 11: exit do
      end if
      ' ********** >12< ***********
      if y1Y >= y2 and y1Y <= y2Y then 
        if x2X > x1X then TX = x1X else TX = x2X        
        ASTRT = CollideSpr1 + HeaderSize + ((y2-y1)*APIT)
        BSTRT = CollideSpr2 + HeaderSize + ((x1-x2) shl IBPP)
        XCNT = (TX-x1)+1:YCNT = (y1Y-y2)+1
        APIT -= ((TX-x1) shl IBPP)+(1 shl IBPP)
        BPIT -= ((TX-x1) shl IBPP)+(1 shl IBPP)        
        RESULT = 12: exit do
      end if
      ' *********** 13 *************
      if y1 <= y2 and y1Y >= y2Y then
        ASTRT = CollideSpr1 + HeaderSize + ((y2-y1)*APIT)
        BSTRT = CollideSpr2 + HeaderSize + ((x1-x2) shl IBPP)
        XCNT = (x2X-x1)+1:YCNT = OBSY+1
        APIT -= ((x2X-x1) shl IBPP)+(1 shl IBPP)
        BPIT -= ((x2X-x1) shl IBPP)+(1 shl IBPP)        
        RESULT = 13: exit do
      end if
    end if
    
    if x1X >= x2 and x1X <= x2X then
      ' *********** <21> *************
      if y1 >= y2 and y1 <= y2Y then 
        if y2Y > y1Y then TY = y1Y else TY = y2Y        
        ASTRT = CollideSpr1 + HeaderSize + ((x2-x1) shl IBPP)
        BSTRT = CollideSpr2 + HeaderSize + ((y1-y2)*BPIT)
        XCNT = (x1X-x2)+1:YCNT = (TY-y1)+1
        APIT -= ((x1X-x2) shl IBPP)+(1 shl IBPP)
        BPIT -= ((x1X-x2) shl IBPP)+(1 shl IBPP)        
        RESULT = 21: exit do
      end if
      ' *********** <22> ************
      if y1Y >= y2 and y1Y <= y2Y then
        ASTRT = CollideSpr1 + HeaderSize + _
        ((OASY-(y1Y-y2))*APIT) + _
        ((OASX-(x1X-x2)) shl IBPP)
        BSTRT = CollideSpr2 + HeaderSize
        XCNT = (x1X-x2)+1:YCNT = (y1Y-y2)+1
        APIT -= ((x1X-x2) shl IBPP)+(1 shl IBPP)
        BPIT -= ((x1X-x2) shl IBPP)+(1 shl IBPP)        
        RESULT = 22: exit do
        ' *********** <23> ************
      end if
      if y1 <= y2 and y1Y >= y2Y then
        ASTRT = CollideSpr1 + HeaderSize + _
        ((y2-y1)*APIT) + ((x2-x1) shl IBPP)
        BSTRT = CollideSpr2 + HeaderSize
        XCNT = (x1X-x2)+1:YCNT = OBSY+1
        APIT -= ((x1X-x2) shl IBPP)+(1 shl IBPP)
        BPIT -= ((x1X-x2) shl IBPP)+(1 shl IBPP)        
        RESULT = 23: exit do
      end if
    end if
    
    if x1 <= x2 and x1X >= x2X then
      ' ********** <31> *************
      if y1 >= y2 and y1 <= y2Y then
        ASTRT = CollideSpr1 + HeaderSize + ((x2-x1) shl IBPP)
        BSTRT = CollideSpr2 + HeaderSize  + ((y1-y2)*BPIT)
        XCNT = OBSX+1:YCNT = (y2Y-y1)+1
        APIT -= ((OBSX) shl IBPP)+(1 shl IBPP)
        BPIT -= ((OBSX) shl IBPP)+(1 shl IBPP)        
        RESULT = 31: exit do
      end if
      ' ********** <32> *************
      if y1Y >= y2 and y1Y <= y2Y then 
        ASTRT = CollideSpr1 + HeaderSize + _
        ((y2-y1)*APIT) + ((x2-x1) shl IBPP)
        BSTRT = CollideSpr2 + HeaderSize
        XCNT = OBSX+1:YCNT = (y1Y-y2)+1
        APIT -= ((OBSX) shl IBPP)+(1 shl IBPP)
        BPIT -= ((OBSX) shl IBPP)+(1 shl IBPP)        
        RESULT = 32: exit do
      end if
      ' ********** <33> *************
      if y1 <= y2 and y1Y >= y2Y then
        ASTRT = CollideSpr1 + HeaderSize + _
        ((y2-y1)*APIT) + ((x2-x1) shl IBPP)
        BSTRT = CollideSpr2 + HeaderSize
        XCNT = OBSX+1:YCNT = OBSY+1
        APIT -= ((OBSX) shl IBPP)+(1 shl IBPP)
        BPIT -= ((OBSX) shl IBPP)+(1 shl IBPP)        
        RESULT = 33: exit do
      end if
    end if
    return 0    
  loop 
  
  if XCNT then    
    select case IBPP
    case 1
      ' ******** 16 bpp pixel check ******
      asm      
        mov ESI,[ASTRT]             'ESI = ObjectA intersected rect pointer
        mov EDI,[BSTRT]             'EDI = ObjectB intersected rect pointer        
        mov EBX,[XCNT]              'EBX = width of intersect area
        mov EDX,[YCNT]              'EDX = height of intersect area
        mov EAX,[APIT]              'EAX = Pitch of objecta excluding intersect size
        _SCR_CPNEXTLINE16_:             'compare next 16 bit line
        mov ECX,EBX                 'ECX=EBX (intersected width)        
        _SCR_CPNEXTPIXEL16_:            'compare next 16 bit pixel        
        cmp word ptr [ESI],0xF81F   'pixel in object A is transparent?
        je _SCR_CPSKIPPIXEL16_          'yes? than no collision is possible (skip that pixel)
        cmp word ptr [EDI],0xF81F   'pixel in object B is transparent?
        je _SCR_CPSKIPPIXEL16_          'yes? than no collision is possible (skip that pixel)              
        jmp _SCR_CPENDCOLISION16_       'collision found (go to end of verification code)
        _SCR_CPSKIPPIXEL16_:            'skipped a pixel
        add ESI,2                   'point obj A to the next pixel
        add EDI,2                   'point obj B to the next pixel
        dec ECX                     'decrease the width counter (one pixel less)
        jnz _SCR_CPNEXTPIXEL16_         'go test next pixel until it reaches 0
        add ESI,EAX                 'point obj A to the next line       
        add EDI,[BPIT]              'point obj B to the next line
        dec EDX                     'decrease height counter (one line less)
        jnz _SCR_CPNEXTLINE16_          'go test next line until it reaches 0
        neg dword ptr [RESULT]      'change RESULT signal (to negative)
        _SCR_CPENDCOLISION16_:          'end of verification
      end asm
    case 2
      if EnableAlpha > 0 or EnableAlpha = -1 then
        ' ******** 32 bpp pixel check (including alhpa) ******
        asm      
          mov ESI,[ASTRT]             'ESI = ObjectA intersected rect pointer
          mov EDI,[BSTRT]             'EDI = ObjectB intersected rect pointer        
          mov EBX,[XCNT]              'EBX = width of intersect area
          mov EDX,[YCNT]              'EDX = height of intersect area          
          _SCR_CPNEXTLINE32A_:            'compare next 32 bit line
          mov ECX,EBX                 'ECX=EBX (intersected width)        
          _SCR_CPNEXTPIXEL32A_:           'compare next 32 bit pixel        
          mov EAX,[ESI]               'EAX = Pixel in object A
          cmp EAX,0xFFFF00FF          'pixel in object A is transparent?
          je _SCR_CPSKIPPIXEL32A_         'yes? than no collision is possible (skip that pixel)
          shr EAX,24                  'Getting alpha value
          cmp AL,MaximumAlpha         'Is alpha below or equal Maximum Alpha?
          jbe _SCR_CPSKIPPIXEL32A_        'yes? than no collision is possible (skip that pixel)          
          mov EAX, [EDI]              'EAX = Pixel in object B
          cmp EAX,0xFFFF00FF          'pixel in object B is transparent?
          je _SCR_CPSKIPPIXEL32A_         'yes? than no collision is possible (skip that pixel)
          shr EAX,24                  'Getting alpha value
          cmp AL,MaximumAlpha         'Is alpha below or equal Maximum Alpha?
          jbe _SCR_CPSKIPPIXEL32A_        'yes? than no collision is possible (skip that pixel)          
          jmp _SCR_CPENDCOLISION32A_      'collision found (go to end of verification code)
          _SCR_CPSKIPPIXEL32A_:           'skipped a pixel
          add ESI,4                   'point obj A to the next pixel
          add EDI,4                   'point obj B to the next line
          dec ECX                     'decrease height counter (one line less)
          jnz _SCR_CPNEXTPIXEL32A_        'go test next pixel until it reaches 0
          add ESI,[APIT]              'point obj A to the next line       
          add EDI,[BPIT]              'point obj B to the next line
          dec EDX                     'decrease height counter (one line less)
          jnz _SCR_CPNEXTLINE32A_         'go test next line until it reaches 0     
          neg dword ptr [RESULT]      'change RESULT signal (to negative)
          _SCR_CPENDCOLISION32A_:         'end of verification
        end asm
      else
        ' ******** 32 bpp pixel check ******
        asm      
          mov ESI,[ASTRT]                  'ESI = ObjectA intersected rect pointer
          mov EDI,[BSTRT]                  'EDI = ObjectB intersected rect pointer        
          mov EBX,[XCNT]                   'EBX = width of intersect area
          mov EDX,[YCNT]                   'EDX = height of intersect area
          mov EAX,[APIT]                   'EAX = Pitch of objecta excluding intersect size
          _SCR_CPNEXTLINE32_:                  'compare next 32 bit line
          mov ECX,EBX                      'ECX=EBX (intersected width)        
          _SCR_CPNEXTPIXEL32_:                 'compare next 32 bit pixel        
          cmp dword ptr [ESI],0xFFFF00FF   'pixel in object A is transparent?
          je _SCR_CPSKIPPIXEL32_               'yes? than no collision is possible (skip that pixel)
          cmp dword ptr [EDI],0xFFFF00FF   'pixel in object B is transparent?
          je _SCR_CPSKIPPIXEL32_               'yes? than no collision is possible (skip that pixel)
          jmp _SCR_CPENDCOLISION32_            'collision found (go to end of verification code)
          _SCR_CPSKIPPIXEL32_:                 'skipped a pixel
          add ESI,4                        'point obj A to the next pixel
          add EDI,4                        'point obj B to the next line
          dec ECX                          'decrease height counter (one line less)
          jnz _SCR_CPNEXTPIXEL32_              'go test next pixel until it reaches 0
          add ESI,EAX                      'point obj A to the next line       
          add EDI,[BPIT]                   'point obj B to the next line
          dec EDX                          'decrease height counter (one line less)
          jnz _SCR_CPNEXTLINE32_               'go test next line until it reaches 0     
          neg dword ptr [RESULT]           'change RESULT signal (to negative)
          _SCR_CPENDCOLISION32_:               'end of verification
        end asm    
      end if
    end select
  end if
  
  return RESULT
  
end function
