'
'                           ___________________________________________
'         _______ _ _ _     \___           ___________________________/
'    /\  (_______) (_) |       /  //  //  /  
'   /  \  _  __  | |_| | _    /  //  //  / << 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( __buffer__ ) iif( __buffer__ <> 0, *cast( Integer Ptr, __buffer__ ) = 7, 0 )
#define cc4_to_Str(c) Chr$(c And &h000000FF,(c And &h0000FF00) Shr 8,(c And &h00FF0000) Shr 16,(c And &hFF000000) Shr 24)

#define fs(x) (Sin(x) * ((90 * (4 * Atn(1)) / 180)))


Declare Sub AFlibIII_PP256_SetupSpritePal ( Byref PP256PalFile as string )

Declare Sub AFlibIII_PP256_LoadSpriteSet ( Byref FileName as string, _
                                           Byval SpriteSet_Slot as byte )

Declare Sub AFlibIII_PP256_RemoveSpriteSet ( Byval SpriteSet_Slot as byte )

Declare Sub AFlibIII_PP256_RemoveSpriteSet_CleanSweep

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

Declare Sub AFlibIII_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 AFlibIII_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 AFlibIII_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 AFlibIII_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 AFlibIII_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 AFlibIII_SprBlit_greyscale ( Byval x1 as Integer, Byval y1 as Integer, _
                                         Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_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 AFlibIII_SprBlit_inverse ( Byval x1 as integer, Byval y1 as integer, _
                                       Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_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 AFlibIII_SprBlit_inversegrey ( Byval x1 as Integer, Byval y1 as Integer, _
                                           Byval image as any ptr, Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_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 AFlibIII_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 AFlibIII_SprBlit_Plus ( Byval sx as Integer, _
                                    Byval sy as Integer, _
                                    Byval image as Any Ptr, _
                                    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 AFlibIII_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 AFlibIII_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 AFlibIII_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 AFlibIII_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 AFlibIII_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 AFlibIII_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 AFlibIII_PP256_SprBlit ( Byval x1 as Integer, Byval y1 as Integer, _
                                     Byval SpriteSet_Slot as Byte, _
                                     Byval SpriteSet_Image as Integer, _
                                     Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_alpha ( Byval x1 as Integer, Byval y1 as Integer, _
                                           Byval alpha as Integer, _
                                           Byval SpriteSet_Slot as Byte, _
                                           Byval SpriteSet_Image as Integer, _
                                           Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_add ( Byval x1 as Integer, Byval y1 as Integer, _
                                         Byval add_blend as Integer, _
                                         Byval SpriteSet_Slot as Byte, _
                                         Byval SpriteSet_Image as Integer, _
                                         Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_firefly ( Byval x1 as Integer, Byval y1 as Integer, _
                                             Byval brightness_level as Integer, _
                                             Byval SpriteSet_Slot as Byte, _
                                             Byval SpriteSet_Image as Integer, _
                                             Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_color ( Byval x1 as Integer, Byval y1 as Integer, _
                                           Byval col as Integer, _
                                           Byval SpriteSet_Slot as Byte, _
                                           Byval SpriteSet_Image as Integer, _
                                           Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_tint ( Byval x1 as Integer, Byval y1 as Integer, _
                                          Byval col_to_tint as Integer, Byval alpha_level as Integer, _
                                          Byval SpriteSet_Slot as Byte, _
                                          Byval SpriteSet_Image as Integer, _
                                          Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_greyscale ( Byval x1 as Integer, Byval y1 as Integer, _
                                               Byval SpriteSet_Slot as Byte, _
                                               Byval SpriteSet_Image as Integer, _
                                               Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_greytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                              Byval alpha_tinting as Integer, _
                                              Byval SpriteSet_Slot as Byte, _
                                              Byval SpriteSet_Image as Integer, _
                                              Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_inverse ( Byval x1 as Integer, Byval y1 as Integer, _
                                             Byval SpriteSet_Slot as Byte, _
                                             Byval SpriteSet_Image as Integer, _
                                             Byval buffer as any Ptr = 0 )
 
Declare Sub AFlibIII_PP256_SprBlit_invtint ( Byval x1 as Integer, Byval y1 as Integer, _
                                             Byval alpha_tinting as Integer, _
                                             Byval SpriteSet_Slot as Byte, _
                                             Byval SpriteSet_Image as Integer, _
                                             Byval buffer as any Ptr = 0 )
                                             
Declare Sub AFlibIII_PP256_SprBlit_inversegrey ( Byval x1 as Integer, Byval y1 as Integer, _
                                                 Byval SpriteSet_Slot as Byte, _
                                                 Byval SpriteSet_Image as Integer, _
                                                 Byval buffer as any Ptr = 0 )
 
Declare Sub AFlibIII_PP256_SprBlit_invgreytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                                 Byval alpha_tinting as Integer, _
                                                 Byval SpriteSet_Slot as Byte, _
                                                 Byval SpriteSet_Image as Integer, _
                                                 Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_overlay ( Byval x1 as Integer, Byval y1 as Integer, _
                                             Byval overlay_col as Integer, _
                                             Byval SpriteSet_Slot as Byte, _
                                             Byval SpriteSet_Image as Integer, _
                                             Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_PP256_SprBlit_rotate ( Byval sx_midpos as Integer, _
                                            Byval sy_midpos as Integer, _
                                            Byval SpriteSet_Slot as Byte, _
                                            Byval SpriteSet_Image as Integer, _
                                            Byval rotation_angle as Single, _
                                            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 AFlibIII_PP256_SprBlit_scale ( Byval sx_midpos as Integer, _
                                           Byval sy_midpos as Integer, _
                                           Byval SpriteSet_Slot as Byte, _
                                           Byval SpriteSet_Image as Integer, _
                                           Byval scale_x as Single, _
                                           Byval scale_y as Single, _
                                           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 AFlibIII_PP256_SprBlit_scalerotate ( Byval sx_midpos as Integer, _
                                                 Byval sy_midpos as Integer, _
                                                 Byval SpriteSet_Slot as Byte, _
                                                 Byval SpriteSet_Image as Integer, _
                                                 Byval scale_x as Single, _
                                                 Byval scale_y as Single, _
                                                 Byval rotation_angle as Single, _
                                                 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 Function AFlibIII_SprCollide ( 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

Declare Function AFlibIII_SprCollide_BB ( 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 ) as integer

Declare Function AFlibIII_SprCollide_PP256 ( Byval x1 as integer, _
                                             Byval y1 as integer, _
                                             Byval PP256spr_1stSet_Slot as Byte, _
                                             Byval PP256spr_1stSet_Image as Integer, _
                                             Byval x2 as integer, _
                                             Byval y2 as integer, _
                                             Byval PP256spr_2ndSet_Slot as Byte, _
                                             Byval PP256spr_2ndSet_Image as Integer, _
                                             Byval EnableAlpha as integer = 0 ) as integer

Declare Function AFlibIII_SprCollide_PP256_BB ( Byval x1 as integer, _
                                                Byval y1 as integer, _
                                                Byval PP256spr_1stSet_Slot as Byte, _
                                                Byval PP256spr_1stSet_Image as Integer, _
                                                Byval x2 as integer, _
                                                Byval y2 as integer, _
                                                Byval PP256spr_2ndSet_Slot as Byte, _
                                                Byval PP256spr_2ndSet_Image as Integer ) as integer

Declare Function AFlibIII_SprCollide_NormalToPP256 ( Byval x1 as integer, _
                                                     Byval y1 as integer, _
                                                     Byval CollideSpr as any ptr, _
                                                     Byval x2 as integer, _
                                                     Byval y2 as integer, _
                                                     Byval PP256spr_Set_Slot as Byte, _
                                                     Byval PP256spr_Set_Image as Integer, _
                                                     Byval EnableAlpha as integer = 0 ) as integer

Declare Function AFlibIII_SprCollide_NormalToPP256_BB ( Byval x1 as integer, _
                                                        Byval y1 as integer, _
                                                        Byval CollideSpr as any ptr, _
                                                        Byval x2 as integer, _
                                                        Byval y2 as integer, _
                                                        Byval PP256spr_Set_Slot as Byte, _
                                                        Byval PP256spr_Set_Image as Integer ) as integer

Declare Sub AFlibIII_Mode7_top ( Byval scalex as integer, Byval scaley as integer, _
                                 Byval scalez as integer, Byval horz as integer, _
                                 Byval angle as integer, _
                                 Byval camx as single, Byval camy as single, _
                                 Byval heightstart as integer, _
                                 Byval heightstop as integer, _
                                 Byval image as ushort ptr, _
                                 Byval SpriteSizeType as integer, _
                                 Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_Mode7_bottom ( Byval scalex as integer, Byval scaley as integer, _
                                    Byval scalez as integer, Byval horz as integer, _
                                    Byval angle as integer, _
                                    Byval camx as single, Byval camy as single, _
                                    Byval heightstart as integer, _
                                    Byval heightstop as integer, _
                                    Byval image as ushort ptr, _
                                    Byval SpriteSizeType as integer, _
                                    Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_Waterfall ( Byval scale_falls as integer, Byval horz as integer, _
                                 Byval flowcontrol as integer, _
                                 Byval flowmovement as single, _
                                 Byval heightstart as integer, _
                                 Byval heightstop as integer, _
                                 Byval image as ushort ptr, _
                                 Byval SpriteSizeType as integer, _
                                 Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_FlowingSea_bottom ( Byval scalex as integer, Byval scaley as integer, _
                                         Byval scalez as integer, Byval horz as integer, _
                                         Byval angle as integer, _
                                         Byval camx as single, Byval camy as single, _
                                         Byval heightstart as integer, _
                                         Byval heightstop as integer, _
                                         Byval image_2048x2048 as any ptr, _
                                         Byval SineFlowControl as integer = 1, _
                                         Byval PlasmaEffect as integer = 0, _
                                         Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_FlowingSea_top ( Byval scalex as integer, Byval scaley as integer, _
                                      Byval scalez as integer, Byval horz as integer, _
                                      Byval angle as integer, _
                                      Byval camx as single, Byval camy as single, _
                                      Byval heightstart as integer, _
                                      Byval heightstop as integer, _
                                      Byval image_2048x2048 as any ptr, _
                                      Byval SineFlowControl as integer = 1, _
                                      Byval PlasmaEffect as integer = 0, _
                                      Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_Jellify ( Byval scale_jelly as integer, Byval horz as integer, _
                               Byval flowcontrol as integer, _
                               Byval flowmovement as single, _
                               Byval heightstart as integer, _
                               Byval heightstop as integer, _
                               Byval image_2048x2048 as ushort ptr, _
                               Byval SineFlowControl as integer = 1, _
                               Byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_TiledSineWave ( Byval magnitude as single, _
                                     Byval waves_control as single, _
                                     Byval tile_scroll as integer, _
                                     Byval sine_start as integer, _
                                     Byval image as any ptr, _
                                     Byval SpriteSizeType as integer )

Declare Sub AFlibIII_Lens ( byval x as integer, byval y as integer, _
                            byval radius as integer, byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_SphereMap ( byval x as integer, byval y as integer, _
                                 byval sphere_x as integer, _
                                 byval sphere_y as integer, _
                                 byval radius as integer, byval image as any ptr, _
                                 byval SpriteSizeType as integer, _
                                 byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_Plasma( byval x as integer, byval y as integer, _
                             byval wid as integer, byval hei as integer, _ 
                             byval flow_a as integer, byval flow_b as integer, _
                             byval density as integer, _
                             byval image as ushort ptr, _
                             byval SpriteSizeType as integer, _
                             byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_Liquefy ( byval x as integer, byval y as integer, _
                               byval wid as integer, byval hei as integer, _ 
                               byval flow_a as integer, byval flow_b as integer, _
                               byval density as integer, _
                               byval liquefy_lvl as integer, _
                               byval image as ushort ptr, _
                               byval SpriteSizeType as integer, _
                               byval buffer as Any Ptr = 0 )

Declare Sub AFlibIII_Tunnel_Init

Declare Sub AFlibIII_Tunnel_GrabImage ( Byval ImageName as String )

Declare Sub AFlibIII_Tunnel_Tweak ( Byval TunnelSize_x as Integer, _
                                    Byval TunnelSize_y as Integer, _
                                    Byval TunnelPos_x as Integer, _
                                    Byval TunnelPos_y as Integer, _
                                    Byval TunnelStretch as Integer, _
                                    Byval TunnelZoomer as Integer, _
                                    Byval Pucker_FX as Integer )

Declare Sub AFlibIII_Tunnel_Blit ( Byval sx as Integer, _
                                   Byval sy as Integer, _
                                   Byval speed as Integer, _
                                   Byval rotate as Integer, _
                                   Byval TunnelSize_x as Integer, _
                                   Byval TunnelSize_y as Integer, _
                                   Byval alpha_blend as Integer = 255, _
                                   Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_Tunnel_Blit_add ( Byval sx as Integer, _
                                       Byval sy as Integer, _
                                       Byval speed as Integer, _
                                       Byval rotate as Integer, _
                                       Byval TunnelSize_x as Integer, _
                                       Byval TunnelSize_y as Integer, _
                                       Byval add_blend as Integer = 255, _
                                       Byval buffer as any Ptr = 0 )

Declare Sub AFlibIII_Tunnel_Destroy

Declare Sub AFlibIII_CreatePixelCraft ( Byval x as integer, _
                                        Byval y as integer, _
                                        Byval ColR as integer, _
                                        Byval ColG as integer, _
                                        Byval ColB as integer, _
                                        Byval Size_x as integer, _
                                        Byval Size_y as integer, _
                                        Byval buffer as Any PTR = 0 )

Declare Function AFlibIII_checkBMPsize_x (Byref filename as String) as Integer
Declare Function AFlibIII_checkBMPsize_y (Byref filename as String) as Integer

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

Declare Function customcolor( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function inverse( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function shadow( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function grayscale( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function greyscale( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function grayscaleinverse( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function greyscaleinverse( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function monochrome( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function monochrome_amber( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger
Declare Function overlay( Byval src As Uinteger, Byval dest As Uinteger, Byval param As Any Ptr ) As Uinteger

Declare Sub AFlibIII_ClearDisplay ( Byval col as Uinteger = RGB(0, 0, 0), Byval buffer as any ptr = 0 )
Declare Sub AFlibIII_MakeMonochrome ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_MakeMonochrome2x ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_MakeMonochrome4x ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )
Declare Sub AFlibIII_MakeMonochrome8x ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )

Dim Shared FlowingSea_Lsin1(0 to 2048*3) as integer
Dim Shared FlowingSea_Lsin2(0 to 2048*3) as integer
Dim Shared FlowingSea_Lsin3(0 to 2048*3) as integer

For i as Integer = 0 to 2048 * 3
    FlowingSea_Lsin1(i) = sin(i/25) * 25
    FlowingSea_Lsin2(i) = sin(i/15) * 32
    FlowingSea_Lsin3(i) = cos(750) * (640)
Next

Dim Shared as integer   AF3_TunnMap_TexturePitch, AF3_TunnMap_BufferPitch, AF3_TunnMap_TablePitch
Dim Shared as ulong ptr AF3_TunnMap_pTexture, AF3_TunnMap_pBuffer, AF3_TunnMap_pTable
Dim Shared as any ptr   AF3_TunnMap_imgBuffer, AF3_TunnMap_imgTable, AF3_TunnMap_imgTexture, AF3_TunnelBlitter

Type AF3_PP256_spr
    xe as Integer
    ye as Integer
    pic as any ptr
    used as byte
    id as byte
End Type

Type AF3_PP256_img
    id(1 to 64) as byte
    image(255) as AF3_PP256_spr
    max as Integer
End Type

Type AF3_PP256_colorarray
    R as ubyte
    G as ubyte
    B as ubyte
End Type

Dim shared AF3_PP256_palette_colors(255, 64) as AF3_PP256_colorarray, index(256) as Integer
Dim shared AF3_PP256_ImageSlot(1 to 64) as AF3_PP256_img

Declare Sub Private_Pixel ( byval sx as integer, byval sy as integer, byval col as integer, _
                            byval alphablending as integer, byval buffer as Any Ptr = 0 )

Declare Function PrivatePP256_ExtractSpriteColor ( byval col as ubyte ) as longint

Declare Function AFlibIII_rawcollision ( 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_PP256_SetupSpritePal ( Byref PP256PalFile as string )

  Dim FR as Integer
  Dim as Integer B, G, R, C

  FR = FREEFILE
  Open PP256PalFile for Binary as #FR
    For n as Integer = 0 TO 255
      Get #FR, , C
      B = C \ 65536: C = C - B * 65536
      G = C \ 256: C = C - G * 256
      R = C
      AF3_PP256_palette_colors(n, 0).r=r * 4.05
      AF3_PP256_palette_colors(n, 0).g=g * 4.05
      AF3_PP256_palette_colors(n, 0).b=b * 4.05
    NEXT
  Close #FR
End Sub


'_________________________________________________________________________
Sub AFlibIII_PP256_LoadSpriteSet ( Byref FileName as string, _
                                   Byval SpriteSet_Slot as byte )

  If FileName <> "" then
      '***** Read image data from file *****
      'thanks to pp256 format
    Dim as Integer X, ints, fileno, im, xp, yp, a, yy
    Dim as string * 1 st
    im = 1
       
    FileNo = FREEFILE
    Open FileName for Binary as #FileNo
       Ints = (LOF(FileNo) - 7) \ 2
    Close #FileNo
    
    Dim imagearray(1 to Ints) as short
    
    BLoad FileName, @imagearray(1)

    Dim temp(1 TO 1000) as Integer
    Dim as Integer pptr, lastint, indexno, n, lastimage, tt, xxl, yyl, re
    
    pptr = 1: indexNo = 1
    
    Open FileName for Binary as #FileNo
      'Ints = (LOF(FileNo) - 7) \ 2
      Do
        temp(indexNo) = pptr
        xp= (imagearray(pptr) \ 8)
        yp= (imagearray(pptr+1)) + 4
        re=((pptr+7)*2)-4
        If re<lof(fileno) then seek #fileno,re'*indexno
        AF3_PP256_ImageSlot(SpriteSet_Slot).image(indexno).xe=xp
        AF3_PP256_ImageSlot(SpriteSet_Slot).image(indexno).ye=yp
        AF3_PP256_ImageSlot(SpriteSet_Slot).image(indexno).pic=imagecreate(xp, yp-4)
        For yyl = 0 to yp
          For xxl = 0 to xp -1
            Get #fileno,,St
            If xxl<xp and yyl<yp-4 and asc(st)>0 then Pset AF3_PP256_ImageSlot(SpriteSet_Slot).image(indexno).pic,(xxl, yyl),PrivatePP256_ExtractSpriteColor(asc(st))
          Next
        Next
        x = (imagearray(pptr) \ 8) * (imagearray(pptr+1)) + 4
        If x MOD 2 then x = x + 1
        pptr += (x \ 2)
        indexNo += 1
      Loop while pptr < ints
    Close #FileNo
    
    LastImage = indexNo - 1
    AF3_PP256_ImageSlot(SpriteSet_Slot).max=lastimage
   
    Exit Sub
  End if
End Sub


'_________________________________________________________________________
Sub AFlibIII_PP256_RemoveSpriteSet ( Byval SpriteSet_Slot as byte )

  For indexno as Integer = 0 to AF3_PP256_ImageSlot(SpriteSet_Slot).max
    AF3_PP256_ImageSlot(SpriteSet_Slot).image(indexno).pic = 0
    ImageDestroy AF3_PP256_ImageSlot(SpriteSet_Slot).image(indexno).pic
    AF3_PP256_ImageSlot(SpriteSet_Slot).image(indexno).pic = 0
  Next
End Sub


'__________________________________________________________________________
Sub AFlibIII_PP256_RemoveSpriteSet_CleanSweep

  For SpriteSet_AllSlots as Integer = 1 to 64
    For indexno as Integer = 0 to AF3_PP256_ImageSlot(SpriteSet_AllSlots).max
      If AF3_PP256_ImageSlot(SpriteSet_AllSlots).image(indexno).pic > 0 then
        AF3_PP256_ImageSlot(SpriteSet_AllSlots).image(indexno).pic = 0
        ImageDestroy AF3_PP256_ImageSlot(SpriteSet_AllSlots).image(indexno).pic
        AF3_PP256_ImageSlot(SpriteSet_AllSlots).image(indexno).pic = 0
      End if
    Next
  Next
End Sub


'_________________________________________________________________________
Sub AFlibIII_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


'_________________________________________________________________________
Sub AFlibIII_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 < 0 then alpha = 0
If alpha > 255 then alpha = 255
Put buffer, (x1, y1), image, alpha, alpha

End Sub


'_________________________________________________________________________
Sub AFlibIII_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


'_________________________________________________________________________
Sub AFlibIII_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, @shadow, @trans_brightness

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @customcolor, @col

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @customcolor, @col_to_tint
Put buffer, (x1, y1), image, alpha, alpha_level

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @grayscale

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @grayscale
Put buffer, (x1, y1), image, alpha, alpha_tinting

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @inverse

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @inverse
Put buffer, (x1, y1), image, alpha, alpha_tinting

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @greyscaleinverse

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @greyscaleinverse
Put buffer, (x1, y1), image, alpha, alpha_tinting

End Sub


'_________________________________________________________________________
Sub AFlibIII_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, @overlay, @overlay_col

End Sub


'__________________________________________________________________________
Sub AFlibIII_SprBlit_Plus ( Byval sx as Integer, _
                            Byval sy as Integer, _
                            Byval image as Any Ptr, _
                            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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' routine, and also to counting_pine for fully enhancing this command
' with alphablending (for 24- and 32-bit modes) and custom blender
' support as well!!!  d=^-^=b !!
'
' Includes FULL support for .PNG images/sprites, and full-blown
' alpha-channels for them are added here, also!!!
'
'----------------------------------------------------------------------
   
   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
   AFlibIII_check_buffersize image, Img_x, Img_y
   sx += (Img_x / 2)
   sy += (Img_y / 2)

   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 * 1.001
   points(1,xs)= SourceWidth/2 * 1.001
   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
   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)
     points(i,ys)=Int(points(i,ys)+sy)
     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
                 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
                 If (*s4 And &HFFFFFF)<>&HFF00FF 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
                 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
               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 AFlibIII_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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' rotation routine, and also to counting_pine for fully enhancing this
' command with alphablending (for 24- and 32-bit modes) and custom
' blender support!!!   d=^-^=b !!
'
' Includes FULL support for .PNG images/sprites, and full-blown
' alpha-channels for them are added here, also!!!
'
'----------------------------------------------------------------------
   
   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
   AFlibIII_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
                 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
                 If (*s4 And &HFFFFFF)<>&HFF00FF 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
                 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
               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 AFlibIII_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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' rotation routine, and also to counting_pine for fully enhancing this
' command with alphablending (for 24- and 32-bit modes) and custom
' blender support!!!   d=^-^=b !!
'
' Includes FULL support for .PNG images/sprites, and full-blown
' alpha-channels for them are added here, also!!!
'
'----------------------------------------------------------------------

  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
  AFlibIII_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 AFlibIII_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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' scaling routine, and also to counting_pine for fully enhancing this
' command with alphablending (for 24- and 32-bit modes) and custom
' blender support!!!   d=^-^=b !!
'
' Includes FULL support for .PNG images/sprites, and full-blown
' alpha-channels for them are added here, also!!!
'
' Default scale ratio parameters for a normal-sized sprite
' (for "scale_x" and "scale_y"): ---- 1, 1 ----
'
'----------------------------------------------------------------------
   
   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
   AFlibIII_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
                 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
                 If (*s4 And &HFFFFFF)<>&HFF00FF 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
                 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
               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 AFlibIII_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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' scaling routine, and also to counting_pine for fully enhancing this
' command with alphablending (for 24- and 32-bit modes) and custom
' blender support!!!   d=^-^=b !!
'
' Includes FULL support for .PNG images/sprites, and full-blown
' alpha-channels for them are added here, also!!!
'
' Default scale ratio parameters for a normal-sized sprite
' (for "scale_x" and "scale_y"): ---- 1, 1 ----
'
'----------------------------------------------------------------------


  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
  AFlibIII_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 AFlibIII_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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' scaling/rotation routine, and also to counting_pine for fully
' enhancing this command with alphablending (for 24- and 32-bit modes)
' and custom blender support!!!   d=^-^=b !!
'
' Includes FULL support for .PNG images/sprites, and full-blown
' alpha-channels for them are added here, also!!!
'
' Default scale ratio parameters for a normal-sized sprite
' (for "scale_x" and "scale_y"): ---- 1, 1 ----
'
'----------------------------------------------------------------------
   
   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
   AFlibIII_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
                 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
                 If (*s4 And &HFFFFFF)<>&HFF00FF 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
                 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
               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 AFlibIII_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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' scaling/rotation routine, and also to counting_pine for fully
' enhancing this command with alphablending (for 24- and 32-bit modes)
' and custom blender support!!!   d=^-^=b !!
'
' Includes FULL support for .PNG images/sprites, and full-blown
' alpha-channels for them are added here, also!!!
'
' Default scale ratio parameters for a normal-sized sprite
' (for "scale_x" and "scale_y"): ---- 1, 1 ----
'
'----------------------------------------------------------------------

  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
  AFlibIII_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 AFlibIII_PP256_SprBlit ( Byval x1 as Integer, Byval y1 as Integer, _
                             Byval SpriteSet_Slot as Byte, _
                             Byval SpriteSet_Image as Integer, _
                             Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit x1, y1, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_alpha ( Byval x1 as Integer, Byval y1 as Integer, _
                                   Byval alpha as Integer, _
                                   Byval SpriteSet_Slot as Byte, _
                                   Byval SpriteSet_Image as Integer, _
                                   Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_alpha x1, y1, alpha, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_add ( Byval x1 as Integer, Byval y1 as Integer, _
                                 Byval add_blend as Integer, _
                                 Byval SpriteSet_Slot as Byte, _
                                 Byval SpriteSet_Image as Integer, _
                                 Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_add x1, y1, add_blend, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_firefly ( Byval x1 as Integer, Byval y1 as Integer, _
                                     Byval brightness_level as Integer, _
                                     Byval SpriteSet_Slot as Byte, _
                                     Byval SpriteSet_Image as Integer, _
                                     Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_firefly x1, y1, brightness_level, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_color ( Byval x1 as Integer, Byval y1 as Integer, _
                                   Byval col as Integer, _
                                   Byval SpriteSet_Slot as Byte, _
                                   Byval SpriteSet_Image as Integer, _
                                   Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_color x1, y1, col, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_tint ( Byval x1 as Integer, Byval y1 as Integer, _
                                  Byval col_to_tint as Integer, Byval alpha_level as Integer, _
                                  Byval SpriteSet_Slot as Byte, _
                                  Byval SpriteSet_Image as Integer, _
                                  Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_tint x1, y1, col_to_tint, alpha_level, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_greyscale ( Byval x1 as Integer, Byval y1 as Integer, _
                                       Byval SpriteSet_Slot as Byte, _
                                       Byval SpriteSet_Image as Integer, _
                                       Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_greyscale x1, y1, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_greytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                      Byval alpha_tinting as Integer, _
                                      Byval SpriteSet_Slot as Byte, _
                                      Byval SpriteSet_Image as Integer, _
                                      Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_greytint x1, y1, alpha_tinting, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_inverse ( Byval x1 as Integer, Byval y1 as Integer, _
                                     Byval SpriteSet_Slot as Byte, _
                                     Byval SpriteSet_Image as Integer, _
                                     Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_inverse x1, y1, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_invtint ( Byval x1 as Integer, Byval y1 as Integer, _
                                     Byval alpha_tinting as Integer, _
                                     Byval SpriteSet_Slot as Byte, _
                                     Byval SpriteSet_Image as Integer, _
                                     Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_invtint x1, y1, alpha_tinting, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_inversegrey ( Byval x1 as Integer, Byval y1 as Integer, _
                                         Byval SpriteSet_Slot as Byte, _
                                         Byval SpriteSet_Image as Integer, _
                                         Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_inversegrey x1, y1, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_invgreytint ( Byval x1 as Integer, Byval y1 as Integer, _
                                         Byval alpha_tinting as Integer, _
                                         Byval SpriteSet_Slot as Byte, _
                                         Byval SpriteSet_Image as Integer, _
                                         Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_invgreytint x1, y1, alpha_tinting, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'_________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_overlay ( Byval x1 as Integer, Byval y1 as Integer, _
                                     Byval overlay_col as Integer, _
                                     Byval SpriteSet_Slot as Byte, _
                                     Byval SpriteSet_Image as Integer, _
                                     Byval buffer as any Ptr = 0 )
 
  AFlibIII_SprBlit_overlay x1, y1, overlay_col, AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic, buffer
End Sub



'__________________________________________________________________________
Sub AFlibIII_PP256_SprBlit_rotate ( Byval sx_midpos as Integer, _
                                    Byval sy_midpos as Integer, _
                                    Byval SpriteSet_Slot as Byte, _
                                    Byval SpriteSet_Image as Integer, _
                                    Byval rotation_angle as Single, _
                                    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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' rotation routine that supports all PP256 (or PixelPlus 256) sprites
' of ANY size up to 100x100!!!  ;)
'
'----------------------------------------------------------------------
   
   Dim as any Ptr image = AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic
   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
   AFlibIII_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
   
   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)
   
   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
                 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
                 If (*s4 And &HFFFFFF)<>&HFF00FF 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
                 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
               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 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
                   '***** 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 AFlibIII_PP256_SprBlit_scale ( Byval sx_midpos as Integer, _
                                   Byval sy_midpos as Integer, _
                                   Byval SpriteSet_Slot as Byte, _
                                   Byval SpriteSet_Image as Integer, _
                                   Byval scale_x as Single, _
                                   Byval scale_y as Single, _
                                   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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' scaling routine that supports all PP256 (or PixelPlus 256) sprites of
' ANY size up to 100x100!!!  ;)
'
' Default scale ratio parameters for a normal-sized sprite
' (for "scale_x" and "scale_y"): ---- 1, 1 ----
'
'----------------------------------------------------------------------
   
   Dim as any Ptr image = AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic
   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
   AFlibIII_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)
   
   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
                 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
                 If (*s4 And &HFFFFFF)<>&HFF00FF 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
                 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
               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 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'/
                   '***** 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 AFlibIII_PP256_SprBlit_scalerotate ( Byval sx_midpos as Integer, _
                                         Byval sy_midpos as Integer, _
                                         Byval SpriteSet_Slot as Byte, _
                                         Byval SpriteSet_Image as Integer, _
                                         Byval scale_x as Single, _
                                         Byval scale_y as Single, _
                                         Byval rotation_angle as Single, _
                                         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)

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME sprite
' scaling/rotation routine that supports all PP256 (or PixelPlus 256)
' sprites of ANY size up to 100x100!!!  ;)
'
' Default scale ratio parameters for a normal-sized sprite
' (for "scale_x" and "scale_y"): ---- 1, 1 ----
'
'----------------------------------------------------------------------
   
   Dim as any Ptr image = AF3_PP256_ImageSlot(SpriteSet_Slot).image(SpriteSet_Image).pic
   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
   AFlibIII_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)
   
   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
                 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
                 If (*s4 And &HFFFFFF)<>&HFF00FF 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
                 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
               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 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
                   '***** 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



'__________________________________________________________________________
Function AFlibIII_SprCollide ( 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

Dim Collided as Integer
If AFlibIII_rawcollision (x1, y1, CollideSpr1, x2, y2, CollideSpr2, EnableAlpha) > 0 then
  Collided = 1
End if
Return Collided

End Function



'__________________________________________________________________________
Function AFlibIII_SprCollide_BB ( 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 ) as integer

Dim Collided as Integer
If not AFlibIII_rawcollision (x1, y1, CollideSpr1, x2, y2, CollideSpr2, 0) = 0 then
  Collided = 1
End if
Return Collided

End Function



'__________________________________________________________________________
Function AFlibIII_SprCollide_PP256 ( Byval x1 as integer, _
                                     Byval y1 as integer, _
                                     Byval PP256spr_1stSet_Slot as Byte, _
                                     Byval PP256spr_1stSet_Image as Integer, _
                                     Byval x2 as integer, _
                                     Byval y2 as integer, _
                                     Byval PP256spr_2ndSet_Slot as Byte, _
                                     Byval PP256spr_2ndSet_Image as Integer, _
                                     Byval EnableAlpha as integer = 0 ) as integer

Dim Collided as Integer
If AFlibIII_rawcollision (x1, y1, AF3_PP256_ImageSlot(PP256spr_1stSet_Slot).image(PP256spr_1stSet_Image).pic, _
                          x2, y2, AF3_PP256_ImageSlot(PP256spr_2ndSet_Slot).image(PP256spr_2ndSet_Image).pic, EnableAlpha) > 0 then
  Collided = 1
End if
Return Collided

End Function



'__________________________________________________________________________
Function AFlibIII_SprCollide_PP256_BB ( Byval x1 as integer, _
                                        Byval y1 as integer, _
                                        Byval PP256spr_1stSet_Slot as Byte, _
                                        Byval PP256spr_1stSet_Image as Integer, _
                                        Byval x2 as integer, _
                                        Byval y2 as integer, _
                                        Byval PP256spr_2ndSet_Slot as Byte, _
                                        Byval PP256spr_2ndSet_Image as Integer ) as integer

Dim Collided as Integer
If not AFlibIII_rawcollision (x1, y1, AF3_PP256_ImageSlot(PP256spr_1stSet_Slot).image(PP256spr_1stSet_Image).pic, _
                              x2, y2, AF3_PP256_ImageSlot(PP256spr_2ndSet_Slot).image(PP256spr_2ndSet_Image).pic, 0) = 0 then
  Collided = 1
End if
Return Collided

End Function



'__________________________________________________________________________
Function AFlibIII_SprCollide_NormalToPP256 ( Byval x1 as integer, _
                                             Byval y1 as integer, _
                                             Byval CollideSpr as any ptr, _
                                             Byval x2 as integer, _
                                             Byval y2 as integer, _
                                             Byval PP256spr_Set_Slot as Byte, _
                                             Byval PP256spr_Set_Image as Integer, _
                                             Byval EnableAlpha as integer = 0 ) as integer

Dim Collided as Integer
If AFlibIII_rawcollision (x1, y1, CollideSpr, x2, y2, AF3_PP256_ImageSlot(PP256spr_Set_Slot).image(PP256spr_Set_Image).pic, EnableAlpha) > 0 then
  Collided = 1
End if
Return Collided

End Function



'__________________________________________________________________________
Function AFlibIII_SprCollide_NormalToPP256_BB ( Byval x1 as integer, _
                                                Byval y1 as integer, _
                                                Byval CollideSpr as any ptr, _
                                                Byval x2 as integer, _
                                                Byval y2 as integer, _
                                                Byval PP256spr_Set_Slot as Byte, _
                                                Byval PP256spr_Set_Image as Integer ) as integer

Dim Collided as Integer
If not AFlibIII_rawcollision (x1, y1, CollideSpr, x2, y2, AF3_PP256_ImageSlot(PP256spr_Set_Slot).image(PP256spr_Set_Image).pic, 0) = 0 then
  Collided = 1
End if
Return Collided

End Function



'__________________________________________________________________________
Sub AFlibIII_Mode7_bottom ( Byval scalex as integer, Byval scaley as integer, _
                            Byval scalez as integer, Byval horz as integer, _
                            Byval angle as integer, _
                            Byval camx as single, Byval camy as single, _
                            Byval heightstart as integer, _
                            Byval heightstop as integer, _
                            Byval image as ushort ptr, _
                            Byval SpriteSizeType as integer, _
                            Byval buffer as Any Ptr = 0 )

'Parameters for "SpriteSizeType":
'===================================
'0 ---> 8x8 tile support
'1 ---> 16x16 tile support
'2 ---> 32x32 tile support
'3 ---> 64x64 tile support
'4 ---> 128x128 tile support
'5 ---> 256x256 tile support
'6 ---> 512x512 tile support
'7 ---> 1024x1024 tile support
'8 ---> 2048x2048 tile support
'9 ---> 4096x4096 tile support
'===================================

Dim as Integer MID_SCREEN_WID, MID_SCREEN_HEI, Tile_size, bpp
Dim as Integer SCREEN_WID, SCREEN_HEI

If SpriteSizeType <= 0 then SpriteSizeType = 0
If SpriteSizeType >= 9 then SpriteSizeType = 9

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

Select Case as const SpriteSizeType
  Case 0: Tile_size = 8
  Case 1: Tile_size = 16
  Case 2: Tile_size = 32
  Case 3: Tile_size = 64
  Case 4: Tile_size = 128
  Case 5: Tile_size = 256
  Case 6: Tile_size = 512
  Case 7: Tile_size = 1024
  Case 8: Tile_size = 2048
  Case 9: Tile_size = 4096
End Select

MID_SCREEN_WID = (SCREEN_WID \ 2)
MID_SCREEN_HEI = (SCREEN_HEI \ 2)

If heightstart <= 0 then heightstart = 1

dim vpage_24_32bpp as uinteger ptr
dim offset_24_32bpp as uinteger ptr


dim angle_rad as single

angle_rad = angle * 3.141593 / 180.0

dim xa as integer, ya as integer
dim xv as single, yv as single
dim ldx as single, ldy as single
dim fldx as integer, fldy as integer
dim fsx as integer, fsy as integer
dim horizscale as single
dim distance as single
dim sx as single, sy as single
dim xx as integer, yy as integer
dim c as uinteger
dim prev_c as uinteger = 0

xv = cos(angle_rad)             
yv = sin(angle_rad)

If buffer = 0 then 
  vpage_24_32bpp = SCREENPTR
else
  vpage_24_32bpp = buffer
end if
vpage_24_32bpp = (vpage_24_32bpp + (heightstart * SCREEN_WID) * len(byte))
offset_24_32bpp = cptr(uinteger ptr, image)
offset_24_32bpp += 4

SCREENLOCK


for ya = 0 to heightstop
  distance = (scalez * scaley) / (ya + horz)
  horizscale = (distance / scalex)
  ldx = (-yv * horizscale)
  ldy = (xv * horizscale)
  sx = -camx + ((distance * xv)) - (MID_SCREEN_WID * ldx)
  sy = camy + ((distance * yv)) - (MID_SCREEN_HEI * ldy)
  fldx = ldx * 1024
  fldy = ldy * 1024
  fsx = sx * 1024
  fsy = sy * 1024
  for xa = 0 to SCREEN_WID - 1
    xx = (fsx \ 1024) and (Tile_Size - 1)
    yy = (fsy \ 1024) and (Tile_Size - 1)
    c = offset_24_32bpp[yy * Tile_Size + xx]
    If c = &h008600 or c = &h002000 or c = &h001000 or c = &h080000 or c = &h000800 or c = &h000000 then
      c = prev_c
    else
      prev_c = c
    end if
    If not c = RGB(255, 0, 255) then *(vpage_24_32bpp) = c
    fsx = fsx + fldx
    fsy = fsy + fldy
    vpage_24_32bpp += len(byte)
  next xa
next ya

SCREENUNLOCK

end sub


'__________________________________________________________________________
Sub AFlibIII_Mode7_top ( Byval scalex as integer, Byval scaley as integer, _
                         Byval scalez as integer, Byval horz as integer, _
                         Byval angle as integer, _
                         Byval camx as single, Byval camy as single, _
                         Byval heightstart as integer, _
                         Byval heightstop as integer, _
                         Byval image as ushort ptr, _
                         Byval SpriteSizeType as integer, _
                         Byval buffer as Any Ptr = 0 )

'Parameters for "SpriteSizeType":
'===================================
'0 ---> 8x8 tile support
'1 ---> 16x16 tile support
'2 ---> 32x32 tile support
'3 ---> 64x64 tile support
'4 ---> 128x128 tile support
'5 ---> 256x256 tile support
'6 ---> 512x512 tile support
'7 ---> 1024x1024 tile support
'8 ---> 2048x2048 tile support
'9 ---> 4096x4096 tile support
'===================================

Dim as Integer MID_SCREEN_WID, MID_SCREEN_HEI, Tile_size, bpp
Dim as Integer SCREEN_WID, SCREEN_HEI

If SpriteSizeType <= 0 then SpriteSizeType = 0
If SpriteSizeType >= 9 then SpriteSizeType = 9

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

Select Case as const SpriteSizeType
  Case 0: Tile_size = 8
  Case 1: Tile_size = 16
  Case 2: Tile_size = 32
  Case 3: Tile_size = 64
  Case 4: Tile_size = 128
  Case 5: Tile_size = 256
  Case 6: Tile_size = 512
  Case 7: Tile_size = 1024
  Case 8: Tile_size = 2048
  Case 9: Tile_size = 4096
End Select

MID_SCREEN_WID = (SCREEN_WID \ 2)
MID_SCREEN_HEI = (SCREEN_HEI \ 2)

If heightstart <= 0 then heightstart = 1

dim vpage_24_32bpp as uinteger ptr
dim offset_24_32bpp as uinteger ptr

dim angle_rad as single

angle_rad = angle * 3.141593 / 180.0

dim xa as integer, ya as integer
dim xv as single, yv as single
dim ldx as single, ldy as single
dim fldx as integer, fldy as integer
dim fsx as integer, fsy as integer
dim horizscale as single
dim distance as single
dim sx as single, sy as single
dim xx as integer, yy as integer
dim c as uinteger
dim prev_c as uinteger = 0

xv = cos(angle_rad)             
yv = sin(angle_rad)

If buffer = 0 then 
  vpage_24_32bpp = SCREENPTR
else
  vpage_24_32bpp = buffer
end if
vpage_24_32bpp = (vpage_24_32bpp + (heightstart * SCREEN_WID) * len(byte))
offset_24_32bpp = cptr(uinteger ptr, image)
offset_24_32bpp += 4

SCREENLOCK

for ya = 0 to heightstop
  distance = (scalez * scaley) / (ya + horz)
  horizscale = (distance / scalex)
  ldx = (-yv * horizscale)
  ldy = (xv * horizscale)
  sx = -camx + ((distance * xv)) - (MID_SCREEN_WID * ldx)
  sy = camy + ((distance * yv)) - (MID_SCREEN_HEI * ldy)
  fldx = ldx * 1024
  fldy = ldy * 1024
  fsx = sx * 1024
  fsy = sy * 1024
  for xa = 0 to SCREEN_WID - 1
    xx = (fsx \ 1024) and (Tile_Size - 1)
    yy = (fsy \ 1024) and (Tile_Size - 1)
    c = offset_24_32bpp[yy * Tile_Size + xx]
    If c = &h008600 or c = &h002000 or c = &h001000 or c = &h080000 or c = &h000800 or c = &h000000 then
      c = prev_c
    else
      prev_c = c
    end if
    If not c = RGB(255, 0, 255) then *(vpage_24_32bpp) = c
    fsx = fsx + fldx
    fsy = fsy + fldy
    vpage_24_32bpp += len(byte)
  next xa
  vpage_24_32bpp -= (SCREEN_WID * 2 * len(byte))
next ya

SCREENUNLOCK

end sub


'__________________________________________________________________________
Sub AFlibIII_Waterfall ( Byval scale_falls as integer, Byval horz as integer, _
                         Byval flowcontrol as integer, _
                         Byval flowmovement as single, _
                         Byval heightstart as integer, _
                         Byval heightstop as integer, _
                         Byval image as ushort ptr, _
                         Byval SpriteSizeType as integer, _
                         Byval buffer as Any Ptr = 0 )

'Parameters for "SpriteSizeType":
'===================================
'0 ---> 8x8 tile support
'1 ---> 16x16 tile support
'2 ---> 32x32 tile support
'3 ---> 64x64 tile support
'4 ---> 128x128 tile support
'5 ---> 256x256 tile support
'6 ---> 512x512 tile support
'7 ---> 1024x1024 tile support
'8 ---> 2048x2048 tile support
'9 ---> 4096x4096 tile support
'===================================

Dim as Integer MID_SCREEN_WID, MID_SCREEN_HEI, Tile_size, bpp
Dim as Integer SCREEN_WID, SCREEN_HEI

If SpriteSizeType <= 0 then SpriteSizeType = 0
If SpriteSizeType >= 9 then SpriteSizeType = 9

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

Select Case as const SpriteSizeType
  Case 0: Tile_size = 8
  Case 1: Tile_size = 16
  Case 2: Tile_size = 32
  Case 3: Tile_size = 64
  Case 4: Tile_size = 128
  Case 5: Tile_size = 256
  Case 6: Tile_size = 512
  Case 7: Tile_size = 1024
  Case 8: Tile_size = 2048
  Case 9: Tile_size = 4096
End Select

MID_SCREEN_WID = (SCREEN_WID \ 2)
MID_SCREEN_HEI = (SCREEN_HEI \ 2)

If heightstart <= 0 then heightstart = 1

dim vpage_24_32bpp as uinteger ptr
dim offset_24_32bpp as uinteger ptr

dim angle_rad as single

angle_rad = flowcontrol * 3.141593 / 180.0

dim xa as integer, ya as integer
dim xv as single, yv as single
dim ldx as single, ldy as single
dim fldx as integer, fldy as integer
dim fsx as integer, fsy as integer
dim horizscale as single
dim distance as single
dim sx as single, sy as single
dim xx as integer, yy as integer
dim c as uinteger
dim prev_c as uinteger = 0

xv = cos(angle_rad)             
yv = sin(angle_rad)

If buffer = 0 then 
  vpage_24_32bpp = SCREENPTR
else
  vpage_24_32bpp = buffer
end if
vpage_24_32bpp = (vpage_24_32bpp + (heightstart * SCREEN_WID) * len(byte))
offset_24_32bpp = cptr(uinteger ptr, image)
offset_24_32bpp += 4

SCREENLOCK

for ya = 0 to heightstop
  distance = (scale_falls * 2) / (ya + horz)
  ldx = -yv
  ldy = xv
  sx = -flowmovement + (distance * xv) - (MID_SCREEN_WID * ldx)
  sy = (distance * yv) - (MID_SCREEN_HEI * ldy)
  fldx = ldx * 1024
  fldy = ldy * 1024
  fsx = sx * 1024
  fsy = sy * 1024
  for xa = 0 to SCREEN_WID - 1
    xx = (fsx \ 1024) and (Tile_Size - 1)
    yy = (fsy \ 1024) and (Tile_Size - 1)
    c = offset_24_32bpp[(yy * Tile_Size + xx) * 1]
    If c = &h008600 or c = &h002000 or c = &h001000 or c = &h080000 or c = &h000800 or c = &h000000 then
      c = prev_c
    else
      prev_c = c
    end if
    If not c = RGB(255, 0, 255) then *(vpage_24_32bpp) = c
    fsx = fsx + fldx
    fsy = fsy + fldy
    vpage_24_32bpp += len(byte)
  next xa
next ya


SCREENUNLOCK

end sub


'__________________________________________________________________________
Sub AFlibIII_FlowingSea_bottom ( Byval scalex as integer, Byval scaley as integer, _
                                 Byval scalez as integer, Byval horz as integer, _
                                 Byval angle as integer, _
                                 Byval camx as single, Byval camy as single, _
                                 Byval heightstart as integer, _
                                 Byval heightstop as integer, _
                                 Byval image_2048x2048 as any ptr, _
                                 Byval SineFlowControl as integer = 1, _
                                 Byval PlasmaEffect as integer = 0, _
                                 Byval buffer as Any Ptr = 0 )

Dim as Integer MID_SCREEN_WID, MID_SCREEN_HEI, bpp
Dim as Integer SCREEN_WID, SCREEN_HEI

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

MID_SCREEN_WID = (SCREEN_WID \ 2)
MID_SCREEN_HEI = (SCREEN_HEI \ 2)

If heightstart <= 0 then heightstart = 1

dim vpage_15_16bpp as ushort ptr
dim offset_15_16bpp as ushort ptr
dim vpage_24_32bpp as uinteger ptr
dim offset_24_32bpp as uinteger ptr


dim angle_rad as single

angle_rad = angle * 3.141593 / 180.0

dim xa as integer, ya as integer
dim xv as single, yv as single
dim ldx as single, ldy as single
dim fldx as integer, fldy as integer
dim fsx as integer, fsy as integer
dim horizscale as single
dim distance as single
dim sx as single, sy as single
dim xx as integer, yy as integer
dim c as uinteger
dim prev_c as uinteger = 0

static as integer a = 0, b = 0, ct = 0
    
a = (a + SineFlowControl) mod 158
b = (b + SineFlowControl) mod 95
ct = (ct + SineFlowControl) mod 472

xv = cos(angle_rad)             
yv = sin(angle_rad)

If buffer = 0 then 
  vpage_24_32bpp = SCREENPTR
else
  vpage_24_32bpp = buffer
end if
vpage_24_32bpp = (vpage_24_32bpp + (heightstart * SCREEN_WID) * len(byte))
offset_24_32bpp = cptr(uinteger ptr, image_2048x2048)
offset_24_32bpp += 4

SCREENLOCK


for ya = 0 to heightstop
  distance = (scalez * scaley) / (ya + horz)
  horizscale = (distance / scalex)
  ldx = (-yv * horizscale)
  ldy = (xv * horizscale)
  sx = -camx + ((distance * xv)) - (MID_SCREEN_WID * ldx)
  sy = camy + ((distance * yv)) - (MID_SCREEN_HEI * ldy)
  fldx = ldx * 1024
  fldy = ldy * 1024
  fsx = sx * 1024
  fsy = sy * 1024 
  for xa = 0 to SCREEN_WID - 1
    
    xx = ((((FlowingSea_Lsin1(xx + a) * (2048)) - FlowingSea_Lsin3(xx + yy + (ct / 2048))) + (fsx \ 2048)) * 1.00008) and 2047
    yy = ((((FlowingSea_Lsin2(yy + b) * (2048)) + FlowingSea_Lsin1(xx + yy + (2047))) + (fsy \ 2048)) * 1.00008) and 2047

    If PlasmaEffect >= 1 then
      c = offset_24_32bpp[((yy * (2048 / 2) + xa) + 1) / 128]
    else
      c = offset_24_32bpp[(yy * 2048 + xx) * 1]
    end if
    If c = &h008600 or c = &h002000 or c = &h001000 or c = &h080000 or c = &h000800 or c = &h000000 then
      c = prev_c
    else
      prev_c = c
    end if
    If not c = RGB(255, 0, 255) then *(vpage_24_32bpp) = c
    fsx = fsx + fldx
    fsy = fsy + fldy
    vpage_24_32bpp += len(byte)
  next xa
next ya

SCREENUNLOCK

end sub


'__________________________________________________________________________
Sub AFlibIII_FlowingSea_top ( Byval scalex as integer, Byval scaley as integer, _
                              Byval scalez as integer, Byval horz as integer, _
                              Byval angle as integer, _
                              Byval camx as single, Byval camy as single, _
                              Byval heightstart as integer, _
                              Byval heightstop as integer, _
                              Byval image_2048x2048 as any ptr, _
                              Byval SineFlowControl as integer = 1, _
                              Byval PlasmaEffect as integer = 0, _
                              Byval buffer as Any Ptr = 0 )

Dim as Integer MID_SCREEN_WID, MID_SCREEN_HEI, bpp
Dim as Integer SCREEN_WID, SCREEN_HEI

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

MID_SCREEN_WID = (SCREEN_WID \ 2)
MID_SCREEN_HEI = (SCREEN_HEI \ 2)

If heightstart <= 0 then heightstart = 1

dim vpage_24_32bpp as uinteger ptr
dim offset_24_32bpp as uinteger ptr

dim angle_rad as single

angle_rad = angle * 3.141593 / 180.0

dim xa as integer, ya as integer
dim xv as single, yv as single
dim ldx as single, ldy as single
dim fldx as integer, fldy as integer
dim fsx as integer, fsy as integer
dim horizscale as single
dim distance as single
dim sx as single, sy as single
dim xx as integer, yy as integer
dim c as uinteger
dim prev_c as uinteger = 0

static as integer a = 0, b = 0, ct = 0
    
a = (a + SineFlowControl) mod 158
b = (b + SineFlowControl) mod 95
ct = (ct + SineFlowControl) mod 472

xv = cos(angle_rad)             
yv = sin(angle_rad)

If buffer = 0 then 
  vpage_24_32bpp = SCREENPTR
else
  vpage_24_32bpp = buffer
end if
vpage_24_32bpp = (vpage_24_32bpp + (heightstart * SCREEN_WID) * len(byte))
offset_24_32bpp = cptr(uinteger ptr, image_2048x2048)
offset_24_32bpp += 4

SCREENLOCK

for ya = 0 to heightstop
  distance = (scalez * scaley) / (ya + horz)
  horizscale = (distance / scalex)
  ldx = (-yv * horizscale)
  ldy = (xv * horizscale)
  sx = -camx + ((distance * xv)) - (MID_SCREEN_WID * ldx)
  sy = camy + ((distance * yv)) - (MID_SCREEN_HEI * ldy)
  fldx = ldx * 1024
  fldy = ldy * 1024
  fsx = sx * 1024
  fsy = sy * 1024
  for xa = 0 to SCREEN_WID - 1

    xx = ((((FlowingSea_Lsin1(xx + a) * (2048)) - FlowingSea_Lsin3(xx + yy + (ct / 2048))) + (fsx \ 2048)) * 1.00008) and 2047
    yy = ((((FlowingSea_Lsin2(yy + b) * (2048)) + FlowingSea_Lsin1(xx + yy + (2047))) + (fsy \ 2048)) * 1.00008) and 2047

    If PlasmaEffect >= 1 then
      c = offset_24_32bpp[((yy * (2048 / 2) + xa) + 1) / 128]
    else
      c = offset_24_32bpp[yy * 2048 + xx]
    end if
    If c = &h008600 or c = &h002000 or c = &h001000 or c = &h080000 or c = &h000800 or c = &h000000 then
      c = prev_c
    else
      prev_c = c
    end if
    If not c = RGB(255, 0, 255) then *(vpage_24_32bpp) = c
    fsx = fsx + fldx
    fsy = fsy + fldy
    vpage_24_32bpp += len(byte)
  next xa
  vpage_24_32bpp -= (SCREEN_WID * 2 * len(byte))
next ya

SCREENUNLOCK

end sub


'__________________________________________________________________________
Sub AFlibIII_Jellify ( Byval scale_jelly as integer, Byval horz as integer, _
                       Byval flowcontrol as integer, _
                       Byval flowmovement as single, _
                       Byval heightstart as integer, _
                       Byval heightstop as integer, _
                       Byval image_2048x2048 as ushort ptr, _
                       Byval SineFlowControl as integer = 1, _
                       Byval buffer as Any Ptr = 0 )

Dim as Integer MID_SCREEN_WID, MID_SCREEN_HEI, bpp
Dim as Integer SCREEN_WID, SCREEN_HEI

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

MID_SCREEN_WID = (SCREEN_WID \ 2)
MID_SCREEN_HEI = (SCREEN_HEI \ 2)

If heightstart <= 0 then heightstart = 1

dim vpage_24_32bpp as uinteger ptr
dim offset_24_32bpp as uinteger ptr

dim angle_rad as single

angle_rad = flowcontrol * 3.141593 / 180.0

dim xa as integer, ya as integer
dim xv as single, yv as single
dim ldx as single, ldy as single
dim fldx as integer, fldy as integer
dim fsx as integer, fsy as integer
dim horizscale as single
dim distance as single
dim sx as single, sy as single
dim xx as integer, yy as integer
dim c as uinteger
dim prev_c as uinteger = 0

static as integer a = 0, b = 0, ct = 0
    
a = (a + SineFlowControl) mod 158
b = (b + SineFlowControl) mod 95
ct = (ct + SineFlowControl) mod 472

xv = cos(angle_rad)             
yv = sin(angle_rad)

If buffer = 0 then 
  vpage_24_32bpp = SCREENPTR
else
  vpage_24_32bpp = buffer
end if
vpage_24_32bpp = (vpage_24_32bpp + (heightstart * SCREEN_WID) * len(byte))
offset_24_32bpp = cptr(uinteger ptr, image_2048x2048)
offset_24_32bpp += 4

SCREENLOCK

for ya = 0 to heightstop
  distance = (scale_jelly * 128) / (ya + horz)
  ldx = -yv
  ldy = xv
  sx = -flowmovement + (distance * xv) - (MID_SCREEN_WID * ldx)
  sy = (distance * yv) - (MID_SCREEN_HEI * ldy)
  fldx = ldx * 1024
  fldy = ldy * 1024
  fsx = sx * 1024
  fsy = sy * 1024
  for xa = 0 to SCREEN_WID - 1
    
    xx = ((((FlowingSea_Lsin1(xx + a) * (2048)) + FlowingSea_Lsin3(yy + xx + (ct / 2048))) + (fsx \ 3072)) * 1.00008) and 2047
    yy = ((((FlowingSea_Lsin2(yy + b) * (2048)) + FlowingSea_Lsin1(xx + yy + (2047))) + (fsy \ 3072)) * 1.00008) and 2047

    c = offset_24_32bpp[(yy * 2048 + xx) * 1]
    If c = &h008600 or c = &h002000 or c = &h001000 or c = &h080000 or c = &h000800 or c = &h000000 then
      c = prev_c
    else
      prev_c = c
    end if
    If not c = RGB(255, 0, 255) then *(vpage_24_32bpp) = c
    fsx = fsx + fldx
    fsy = fsy + fldy
    vpage_24_32bpp += len(byte)
  next xa
next ya

SCREENUNLOCK

end sub


'__________________________________________________________________________
Sub AFlibIII_TiledSineWave ( Byval magnitude as single, _
                             Byval waves_control as single, _
                             Byval tile_scroll as integer, _
                             Byval sine_start as integer, _
                             Byval image as any ptr, _
                             Byval SpriteSizeType as integer )
                        
'Parameters for "SpriteSizeType":
'===================================
'0 ---> 8x8 tile support
'1 ---> 16x16 tile support
'2 ---> 32x32 tile support
'3 ---> 64x64 tile support
'4 ---> 128x128 tile support
'5 ---> 256x256 tile support
'6 ---> 512x512 tile support
'7 ---> 1024x1024 tile support
'8 ---> 2048x2048 tile support
'9 ---> 4096x4096 tile support
'===================================

Dim as Integer SCREEN_WID, SCREEN_HEI, Tile_size, bpp


If SpriteSizeType <= 0 then SpriteSizeType = 0
If SpriteSizeType >= 9 then SpriteSizeType = 9

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

Select Case as const SpriteSizeType
  Case 0: Tile_size = 8
  Case 1: Tile_size = 16
  Case 2: Tile_size = 32
  Case 3: Tile_size = 64
  Case 4: Tile_size = 128
  Case 5: Tile_size = 256
  Case 6: Tile_size = 512
  Case 7: Tile_size = 1024
  Case 8: Tile_size = 2048
  Case 9: Tile_size = 4096
End Select

dim adder as single
dim freq as single
dim ys as integer
dim Lsin(1024) as integer
dim yss as single
dim a as integer

dim as uinteger ptr vpage_24_32bpp, image_ptr_24_32bpp, image_off_24_32bpp

Static xs as integer, xsin as integer
Static xss as single
Static xmag as single
dim x as integer, y as integer, xx as integer, yy as integer

waves_control = (waves_control mod 1024)
	
If sine_start = 1 or sine_start = -1 then
  Freq = 1 * 1024
else
  Freq = 0
End if
    
Ys = -1
FOR A = 0 TO 1024
  Ys = (Ys + 1) MOD 360             ' Move Downwards
  Yss = Ys * 3.141593 / 180.0       ' Convert to rad
  Lsin(A) = SIN(Yss + A / Freq) * 1024
NEXT A

image_ptr_24_32bpp = cptr (uinteger ptr, image)
image_ptr_24_32bpp += 4
vpage_24_32bpp = SCREENPTR
	
screenlock

xss = waves_control  '<--- This is the Sine Control setting!  ;)
xs = (xss)           ' speed
xmag = magnitude     ' mag

for y = 0 to SCREEN_HEI - 1
  xsin = lsin((xs + y) and 1023) * xmag \ 1024
  xmag = xmag + .05    
  yy = (y and (Tile_Size - 1)) * Tile_Size
  image_off_24_32bpp = image_ptr_24_32bpp + yy
  for x = 0 to SCREEN_WID - 1
    xx = ((x + xsin + (xs * tile_scroll))) and (Tile_Size - 1)  'moving left
    *vpage_24_32bpp = *(image_off_24_32bpp + xx)
    vpage_24_32bpp += 1
  next x
next y

screenunlock

End Sub


'__________________________________________________________________________
Sub AFlibIII_Lens ( byval x as integer, byval y as integer, _
                    byval radius as integer, byval buffer as Any Ptr = 0 )

  Dim as Integer SCREEN_WID, SCREEN_HEI, SCR_X_MAX, SCR_Y_MAX, bpp

  ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
  If bpp < 15 then Exit Sub

  If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI
  
  SCR_X_MAX = (SCREEN_WID - 1)
	SCR_Y_MAX = (SCREEN_HEI - 1)

  dim as integer wid, hei
  dim as integer hypotsquared, radiussquared, h
  dim as integer sx, sy, x1, y1, yt, xt
  dim as integer px, py 
  dim as integer minx, miny 
  dim as integer pixel 
  dim as integer wtemp, htemp
  dim as integer sphereheight, cleaner
  dim as uinteger ptr page_24_32bpp, offset_24_32bpp
  dim as ushort ptr page_15_16bpp, offset_15_16bpp

  If Radius > 200 then Radius = 200
  
  sphereheight = (radius shr 1)
  cleaner = sphereheight
 
  RadiusSquared = Radius * Radius

  wid = Radius shl 1
  hei = wid


  minx = 0
  miny = 0

  if y < 0 then
		y = -y
		miny = y
		hei = hei - y
		if hei <= -20 then exit sub
		y = 0
	end if

	if  (y + hei) > SCR_Y_MAX then
		htemp = (y + hei) - (SCREEN_HEI + 100)
		hei = hei - htemp
		if hei <= -20 then exit sub
	end if

	if x < 0 then
		x = -x
		minx = x
		wid = wid - x
		if wid <= -20 then exit sub
		x = 0
	end if
	if  (x + wid) > SCR_X_MAX then
		wtemp = (x + wid) - (SCREEN_WID + 100)
		wid = wid - wtemp
		if (wid <= -20) then exit sub
	end if
        
    
    'line p_vpage,(x,y)-(x+wid,y+hei), , b
    
  If bpp >= 24 then
    If buffer = 0 then 
      page_24_32bpp = (SCREENPTR + 4)
    else
      page_24_32bpp = (buffer + 4)
    end if
    If buffer = 0 then 
      offset_24_32bpp = (SCREENPTR + 4)
    else
      offset_24_32bpp = (buffer + 4)
    end if
  else
    If buffer = 0 then 
      page_15_16bpp = (SCREENPTR + 4)
    else
      page_15_16bpp = (buffer + 4)
    end if
    If buffer = 0 then 
      offset_15_16bpp = (SCREENPTR + 4)
    else
      offset_15_16bpp = (buffer + 4)
    end if
  end if

    FOR yt = 0 TO hei - 1
      FOR xt = 0 TO wid - 1
        x1 = (xt - Radius) + minx
        y1 = (yt - Radius) + miny

        HypotSquared = (x1 * x1) + (y1 * y1)
        IF HypotSquared < (RadiusSquared - Cleaner) THEN
          H = (Sqr(RadiusSquared - HypotSquared))
          Sx = (SphereHeight - H)
          Sy = (SphereHeight - H)
          Sx = Sx * ((x1 shl 16) \ H)
          Sy = Sy * ((y1 shl 16) \ H)
          py = ((Sy shr 16) + yt + y)
          px = ((Sx shr 16) + xt + x)
          sx = (x+(xt / 1.2))
          sy = (y+(yt / 1.2))

          if px > -1 and px < SCREEN_WID and py > -1 and py < SCREEN_HEI then                  
            If bpp >= 24 then
              page_24_32bpp[sy * SCREEN_WID + sx] = offset_24_32bpp[py * SCREEN_WID + px]              
            else
              page_15_16bpp[sy * SCREEN_WID + sx] = offset_15_16bpp[py * SCREEN_WID + px]              
            end if
          end if                
        END IF                                    
      NEXT xt          
    NEXT yt


end sub


'__________________________________________________________________________
Sub AFlibIII_SphereMap ( byval x as integer, byval y as integer, _
                         byval sphere_x as integer, byval sphere_y as integer, _
                         byval radius as integer, byval image as any ptr, _
                         byval SpriteSizeType as integer, _
                         byval buffer as Any Ptr = 0 )

'Parameters for "SpriteSizeType":
'===================================
'0 ---> 8x8 tile support
'1 ---> 16x16 tile support
'2 ---> 32x32 tile support
'3 ---> 64x64 tile support
'4 ---> 128x128 tile support
'5 ---> 256x256 tile support
'6 ---> 512x512 tile support
'7 ---> 1024x1024 tile support
'8 ---> 2048x2048 tile support
'9 ---> 4096x4096 tile support
'===================================

If SpriteSizeType <= 0 then SpriteSizeType = 0
If SpriteSizeType >= 9 then SpriteSizeType = 9

Dim as Integer SCREEN_WID, SCREEN_HEI, SCR_X_MAX, SCR_Y_MAX, bpp
Dim as Integer TEX_WID, TEX_HEI, TEXW, TEXH
Dim col as uinteger
Dim prev_col as uinteger = 0

ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
If bpp < 24 then Exit Sub

If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

Select Case as const SpriteSizeType
  Case 0: TEX_WID = 8: TEX_HEI = 8
  Case 1: TEX_WID = 16: TEX_HEI = 16
  Case 2: TEX_WID = 32: TEX_HEI = 32
  Case 3: TEX_WID = 64: TEX_HEI = 64
  Case 4: TEX_WID = 128: TEX_HEI = 128
  Case 5: TEX_WID = 256: TEX_HEI = 256
  Case 6: TEX_WID = 512: TEX_HEI = 512
  Case 7: TEX_WID = 1024: TEX_HEI = 1024
  Case 8: TEX_WID = 2048: TEX_HEI = 2048
  Case 9: TEX_WID = 4096: TEX_HEI = 4096
End Select

SCR_X_MAX = (SCREEN_WID - 1)
SCR_Y_MAX = (SCREEN_HEI - 1)

dim as integer wid, hei
dim as integer hypotsquared, radiussquared, h
dim as integer sx, sy, x1, y1, yt, xt
dim as integer px, py
dim as integer minx, miny
dim as integer pixel
dim as integer wtemp, htemp
dim as integer sphereheight, cleaner
dim as uinteger ptr page_24_32bpp, offset_24_32bpp

TEXW = TEX_WID - 1 
TEXH = TEX_HEI - 1 

sphereheight = (radius shr 1)
cleaner = sphereheight * 10

RadiusSquared = Radius * Radius

wid = Radius shl 1
hei = wid


minx = 0
miny = 0

if y < 0 then
y = -y
miny = y
hei = hei - y
if hei <= 0 then exit sub
y = 0
end if

if  (y + hei) > SCR_Y_MAX then
htemp = (y + hei) - SCREEN_HEI
hei = hei - htemp
if hei <= 0 then exit sub
end if

if x < 0 then
x = -x
minx = x
wid = wid - x
if wid <= 0 then exit sub
x = 0
end if
if  (x + wid) > SCR_X_MAX then
wtemp = (x + wid) - SCREEN_WID
wid = wid - wtemp
if (wid <= 0) then exit sub
end if
    

If buffer = 0 then 
  page_24_32bpp = (SCREENPTR + 4)
else
  page_24_32bpp = (buffer + 4)
end if
offset_24_32bpp = cptr(uinteger ptr, image)
offset_24_32bpp += 4

FOR yt = 0 TO hei - 1
  FOR xt = 0 TO wid - 1
    x1 = (xt - Radius) + minx
    y1 = (yt - Radius) + miny

    HypotSquared = (x1 * x1) + (y1 * y1)
    IF HypotSquared < (RadiusSquared - Cleaner) THEN
      H = (Sqr(RadiusSquared - HypotSquared))
      Sx = (SphereHeight - H)
      Sy = (SphereHeight - H)
      Sx = Sx * ((x1 shl 16) \ H)
      Sy = Sy * ((y1 shl 16) \ H)
      py = ((Sy shr 16) + yt + sphere_y) and TEXH
      px = ((Sx shr 16) + xt + sphere_x) and TEXW 
      sx = (x+xt)
      sy = (y+yt)           
      col = offset_24_32bpp[py * TEX_WID + px]                         
      If col = &h008600 or col = &h002000 or col = &h001000 or col = &h080000 or col = &h000800 or col = &h000000 then col = prev_col else prev_col = col
      If not col = RGB(255, 0, 255) then page_24_32bpp[sy * SCREEN_WID + sx] = col
    END IF                                    
  NEXT xt          
NEXT yt

end sub


'__________________________________________________________________________
Sub AFlibIII_Plasma( byval x as integer, byval y as integer, _
                     byval wid as integer, byval hei as integer, _ 
                     byval flow_a as integer, byval flow_b as integer, _
                     byval density as integer, _
                     byval image as ushort ptr, _
                     byval SpriteSizeType as integer, _
                     byval buffer as Any Ptr = 0 )

    'Parameters for "SpriteSizeType":
    '===================================
    '0 ---> 8x8 tile support
    '1 ---> 16x16 tile support
    '2 ---> 32x32 tile support
    '3 ---> 64x64 tile support
    '4 ---> 128x128 tile support
    '5 ---> 256x256 tile support
    '6 ---> 512x512 tile support
    '7 ---> 1024x1024 tile support
    '8 ---> 2048x2048 tile support
    '9 ---> 4096x4096 tile support
    '===================================
    
    dim as Integer SCREEN_WID, SCREEN_HEI, bpp
    dim as integer TEX_WID, TEX_HEI, TEXH, TEXW
    dim col as uinteger
    dim prev_col as uinteger = 0
    
    If SpriteSizeType <= 0 then SpriteSizeType = 0
    If SpriteSizeType >= 9 then SpriteSizeType = 9
    
    ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
    If bpp < 15 then Exit Sub

    if density < 1 then density = 1
    if density > 2048 then density = 2048

    If bpp < 24 then
      if density > 512 then density = 512
    end if

    If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

    Select Case as const SpriteSizeType
      Case 0: TEX_WID = 8: TEX_HEI = 8
      Case 1: TEX_WID = 16: TEX_HEI = 16
      Case 2: TEX_WID = 32: TEX_HEI = 32
      Case 3: TEX_WID = 64: TEX_HEI = 64
      Case 4: TEX_WID = 128: TEX_HEI = 128
      Case 5: TEX_WID = 256: TEX_HEI = 256
      Case 6: TEX_WID = 512: TEX_HEI = 512
      Case 7: TEX_WID = 1024: TEX_HEI = 1024
      Case 8: TEX_WID = 2048: TEX_HEI = 2048
      Case 9: TEX_WID = 4096: TEX_HEI = 4096
    End Select
        
    dim vpage_15_16bpp as ushort ptr
    dim offset_15_16bpp as ushort ptr
    dim yadder_15_16bpp as ushort
    dim vpage_24_32bpp as uinteger ptr
    dim offset_24_32bpp as uinteger ptr
    dim yadder_24_32bpp as uinteger
    
    TEXW = TEX_WID - 1 
    TEXH = TEX_HEI - 1 

    dim as integer xa, ya, xx,yy, yadder, c
    static as integer a = 0, b = 0, ct = 0    
    
    x -= 1
    If bpp < 24 then x -= 1
    a = (a + flow_a) mod 220
    b = (b + flow_b) mod 114
    ct = (c + 4) mod 4096

    If bpp >= 24 then
      offset_24_32bpp = cptr(uinteger ptr, image)
      offset_24_32bpp += 4
      If buffer = 0 then 
        vpage_24_32bpp = (SCREENPTR + 4)
      else
        vpage_24_32bpp = buffer + 4
      end if
      vpage_24_32bpp += y * SCREEN_WID + x
      yadder_24_32bpp = SCREEN_WID - wid
    else
      offset_15_16bpp = cptr(ushort ptr, image)
      offset_15_16bpp += 4
      If buffer = 0 then 
        vpage_15_16bpp = (SCREENPTR + 4)
      else
        vpage_15_16bpp = buffer + 4
      end if
      vpage_15_16bpp += y * SCREEN_WID + x
      yadder_15_16bpp = SCREEN_WID - wid
    end if

    dim as integer ptr lsin1, lsin2, lsin3

    lsin1 = callocate(len(integer) * 2048 * 3)
    lsin2 = callocate(len(integer) * 2048 * 3)
    lsin3 = callocate(len(integer) * 2048 * 3)        

    for i as integer = 0 to (2048 * 3) - 1
      lsin1[i] = sin(i/35) * 25 + cos(i/35) * 116
      lsin2[i] = sin(i/18) * 32 + cos(i/18) * 112
      lsin3[i] = sin(i/50) * 64 + cos(i/50) * 128
    next i

    for ya = 0 to hei -1
        for xa = 0 to wid - 1                
                xx = (lsin1[xa + a + 2048] + lsin2[ya + b + 2048] + lsin3[xa + ya + ct + 2048]) and TEXW
                yy = (lsin3[xa + ya + ct + 2048] + lsin1[xx] + lsin1[xa + a + 2048] + lsin1[ya + a + 2048]+ lsin2[xa + b + 2048]) and TEXH
                If bpp >= 24 then
                  col = offset_24_32bpp[(density / 2) * (yy + xx)] 
                  If col = &h008600 or col = &h002000 or col = &h001000 or col = &h080000 or col = &h000800 or col = &h000000 then
                    col = prev_col
                  else
                    prev_col = col
                  end if
                  If not col = RGB(255, 0, 255) then *(vpage_24_32bpp) = col
                  vpage_24_32bpp +=1
                else
                  col = offset_15_16bpp[(density / 2) * (yy + xx)]    
                  If not col = &hf81f then *vpage_15_16bpp = col
                  vpage_15_16bpp +=1
                end if
        next xa             
        If bpp >= 24 then
          vpage_24_32bpp += yadder_24_32bpp
        else
          vpage_15_16bpp += yadder_15_16bpp
        end if
    next ya

    deallocate lsin1
    deallocate lsin2
    deallocate lsin3

end sub


'__________________________________________________________________________
Sub AFlibIII_Liquefy ( byval x as integer, byval y as integer, _
                       byval wid as integer, byval hei as integer, _ 
                       byval flow_a as integer, byval flow_b as integer, _
                       byval density as integer, _
                       byval liquefy_lvl as integer, _
                       byval image as ushort ptr, _
                       byval SpriteSizeType as integer, _
                       byval buffer as Any Ptr = 0 )

    'Parameters for "SpriteSizeType":
    '===================================
    '0 ---> 8x8 tile support
    '1 ---> 16x16 tile support
    '2 ---> 32x32 tile support
    '3 ---> 64x64 tile support
    '4 ---> 128x128 tile support
    '5 ---> 256x256 tile support
    '6 ---> 512x512 tile support
    '7 ---> 1024x1024 tile support
    '8 ---> 2048x2048 tile support
    '9 ---> 4096x4096 tile support
    '===================================
    
    dim as Integer SCREEN_WID, SCREEN_HEI, bpp
    dim as integer TEX_WID, TEX_HEI, TEXH, TEXW
    dim col as uinteger
    dim prev_col as uinteger = 0
    
    If SpriteSizeType <= 0 then SpriteSizeType = 0
    If SpriteSizeType >= 9 then SpriteSizeType = 9
    
    ScreenInfo SCREEN_WID, SCREEN_HEI, bpp
    If bpp < 15 then Exit Sub
    
    if density < 1 then density = 1
    if density > 2048 then density = 2048

    if liquefy_lvl < 1 then liquefy_lvl = 1
    if liquefy_lvl > 512 then liquefy_lvl = 512
    liquefy_lvl += 1
    
    If bpp < 24 then
      if density > 512 then density = 512
    end if

    If not buffer = 0 then AFlibIII_check_buffersize buffer, SCREEN_WID, SCREEN_HEI

    Select Case as const SpriteSizeType
      Case 0: TEX_WID = 8: TEX_HEI = 8
      Case 1: TEX_WID = 16: TEX_HEI = 16
      Case 2: TEX_WID = 32: TEX_HEI = 32
      Case 3: TEX_WID = 64: TEX_HEI = 64
      Case 4: TEX_WID = 128: TEX_HEI = 128
      Case 5: TEX_WID = 256: TEX_HEI = 256
      Case 6: TEX_WID = 512: TEX_HEI = 512
      Case 7: TEX_WID = 1024: TEX_HEI = 1024
      Case 8: TEX_WID = 2048: TEX_HEI = 2048
      Case 9: TEX_WID = 4096: TEX_HEI = 4096
    End Select
        
    dim vpage_15_16bpp as ushort ptr
    dim offset_15_16bpp as ushort ptr
    dim yadder_15_16bpp as ushort
    dim vpage_24_32bpp as uinteger ptr
    dim offset_24_32bpp as uinteger ptr
    dim yadder_24_32bpp as uinteger
    
    TEXW = TEX_WID - 1 
    TEXH = TEX_HEI - 1 

    dim as integer xa, ya, xx,yy, yadder, c
    static as integer a = 0, b = 0, ct = 0    
    
    x -= 1
    If bpp < 24 then x -= 1
    a = (a + flow_a) mod 220
    b = (b + flow_b) mod 114
    ct = (c + 4) mod 4096

    If bpp >= 24 then
      offset_24_32bpp = cptr(uinteger ptr, image)
      offset_24_32bpp += 4
      If buffer = 0 then 
        vpage_24_32bpp = (SCREENPTR + 4)
      else
        vpage_24_32bpp = buffer + 4
      end if
      vpage_24_32bpp += y * SCREEN_WID + x
      yadder_24_32bpp = SCREEN_WID - wid
    else
      offset_15_16bpp = cptr(ushort ptr, image)
      offset_15_16bpp += 4
      If buffer = 0 then 
        vpage_15_16bpp = (SCREENPTR + 4)
      else
        vpage_15_16bpp = buffer + 4
      end if
      vpage_15_16bpp += y * SCREEN_WID + x
      yadder_15_16bpp = SCREEN_WID - wid
    end if

    dim as integer ptr lsin1, lsin2, lsin3

    lsin1 = callocate(len(integer) * 2048 * 50)
    lsin2 = callocate(len(integer) * 2048 * 50)
    lsin3 = callocate(len(integer) * 2048 * 50)        

    for i as integer = 0 to (2048 * 3) - 1
      lsin1[i] = sin(i/35) * 25 + cos(i/35) * ((116 * liquefy_lvl) / 2)
      lsin2[i] = sin(i/18) * 32 + cos(i/18) * ((112 * liquefy_lvl) / 2)
      lsin3[i] = sin(i/50) * 64 + cos(i/50) * ((128 * liquefy_lvl) / 2)
    next i

    for ya = 0 to hei -1
        for xa = 0 to wid - 1                
                xx = (lsin1[xa + a + 1024] + lsin2[ya + b + 1024] + lsin3[xa + ya + ct + 1024]) and TEXW
                yy = (lsin3[xa + ya + ct + 1024] + lsin1[xx] + lsin1[xa + a + 1024] + lsin1[ya + a + 1024]+ lsin2[xa + b + 1024]) and TEXH
                If bpp >= 24 then
                  col = offset_24_32bpp[(density / 2) * (yy + xx)] 
                  If col = &h008600 or col = &h002000 or col = &h001000 or col = &h080000 or col = &h000800 or col = &h000000 then
                    col = prev_col
                  else
                    prev_col = col
                  end if
                  If not col = RGB(255, 0, 255) then *(vpage_24_32bpp) = col
                  vpage_24_32bpp +=1
                else
                  col = offset_15_16bpp[(density / 2) * (yy + xx)]    
                  If not col = &hf81f then *vpage_15_16bpp = col
                  vpage_15_16bpp +=1
                end if
        next xa             
        If bpp >= 24 then
          vpage_24_32bpp += yadder_24_32bpp
        else
          vpage_15_16bpp += yadder_15_16bpp
        end if
    next ya

    deallocate lsin1
    deallocate lsin2
    deallocate lsin3

end sub



'__________________________________________________________________________
Sub AFlibIII_Tunnel_Init

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME tunnel
' routine that fully supports any 256x256 image!!!
'
'----------------------------------------------------------------------

  AF3_TunnMap_imgBuffer  = imagecreate(2048, 2048, RGB(255, 0, 255))
  AF3_TunnMap_imgTable   = imagecreate(2048, 2048, RGB(255, 0, 255))
  AF3_TunnMap_imgTexture = imagecreate(256, 256, RGB(255, 0, 255))
  AF3_TunnelBlitter      = imagecreate(256, 256, RGB(255, 0, 255))

  ' get pixel pointers and pitch of the images
  imageinfo AF3_TunnMap_imgBuffer ,,,,AF3_TunnMap_BufferPitch ,AF3_TunnMap_pBuffer
  imageinfo AF3_TunnMap_imgTable  ,,,,AF3_TunnMap_TablePitch  ,AF3_TunnMap_pTable
  imageinfo AF3_TunnMap_imgTexture,,,,AF3_TunnMap_TexturePitch,AF3_TunnMap_pTexture

  ' convert bytes per row to pixels per row
  AF3_TunnMap_TexturePitch shr=2
  AF3_TunnMap_BufferPitch  shr=2
  AF3_TunnMap_TablePitch   shr=2
End Sub



'__________________________________________________________________________
Sub AFlibIII_Tunnel_GrabImage ( Byval ImageName as String )

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME tunnel
' routine that fully supports any 256x256 image!!!
'
'----------------------------------------------------------------------

  Bload ImageName, AF3_TunnelBlitter
End Sub



'__________________________________________________________________________
Sub AFlibIII_Tunnel_Tweak ( Byval TunnelSize_x as Integer, _
                            Byval TunnelSize_y as Integer, _
                            Byval TunnelPos_x as Integer, _
                            Byval TunnelPos_y as Integer, _
                            Byval TunnelStretch as Integer, _
                            Byval TunnelZoomer as Integer, _
                            Byval Pucker_FX as Integer )

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME tunnel
' routine that fully supports any 256x256 image!!!
'
'----------------------------------------------------------------------

  TunnelPos_x /= 96
  TunnelPos_y /= 96

  If TunnelSize_x > 2048 then TunnelSize_x = 2048
  If TunnelSize_y > 2048 then TunnelSize_y = 2048

  If TunnelStretch < -256 then TunnelStretch = -256
  If TunnelStretch > 256 then TunnelStretch = 256
  for j as integer = 0 to (TunnelSize_y - 1)
    dim as single tunnelFX_sy = (1 + TunnelPos_y) - (j * (2 / TunnelSize_y))
    for i as integer = 0 to (TunnelSize_x - 1)
      dim as single tunnelFX_sx = (-1 + -TunnelPos_x) + (i * (2 / TunnelSize_x))
      dim as single sr = sqr(tunnelFX_sx * tunnelFX_sx + tunnelFX_sy * tunnelFX_sy)
      dim as single sa = atan2(tunnelFX_sy, tunnelFX_sx)
      dim as single su

      If Pucker_FX > 0 or Pucker_FX = -1 then 
        su = (TunnelZoomer * sr) '<------- 'pucker' effect.
      else
        su = (TunnelZoomer / sr)
      End if
      
      dim as single sv = sa * (.502/3.14159) * TunnelStretch
      dim as single sw = sr * sr
      if ( sw>1 ) then sw=1
      dim as long iu = su*255
      dim as long iv = sv*255
      dim as long iw = sw*255
   
      AF3_TunnMap_pTable[j*AF3_TunnMap_TablePitch+i] = (&HFF shl 16) or ((iv and &HFF) shl 8) or (iu and &HFF)
    next
  next
End Sub



'__________________________________________________________________________
Sub AFlibIII_Tunnel_Blit ( Byval sx as Integer, _
                           Byval sy as Integer, _
                           Byval speed as Integer, _
                           Byval rotate as Integer, _
                           Byval TunnelSize_x as Integer, _
                           Byval TunnelSize_y as Integer, _
                           Byval alpha_blend as Integer = 255, _
                           Byval buffer as any Ptr = 0 )

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME tunnel
' routine that fully supports any 256x256 image!!!
'
'----------------------------------------------------------------------

  Dim as Single tunnel_s
  Dim as Single tunnel_offset
  Dim as Integer RotateCtrl

  If TunnelSize_x > 2048 then TunnelSize_x = 2048
  If TunnelSize_y > 2048 then TunnelSize_y = 2048

  If Speed > 0 then tunnel_s = .1
  RotateCtrl += -rotate
  RotateCtrl = RotateCtrl mod 256
  Put AF3_TunnMap_imgTexture, (0, RotateCtrl + 256), AF3_TunnelBlitter, pset
  Put AF3_TunnMap_imgTexture, (0, RotateCtrl), AF3_TunnelBlitter, pset
  Put AF3_TunnMap_imgTexture, (0, RotateCtrl - 256), AF3_TunnelBlitter, pset
  
  tunnel_offset += (Speed + tunnel_s)
  for j as integer = 0 to (TunnelSize_y - 1)
    for i as integer = 0 to (TunnelSize_x - 1)
      dim as const Ulong ival = AF3_TunnMap_pTable[j*AF3_TunnMap_TablePitch+i]
      dim as const Ulong icol = AF3_TunnMap_pTexture[ ( (ival and (256 ^ 2 - 1)) + tunnel_offset) and (256 ^ 2 - 1) ]
      dim as const Ulong isca = ival shr 16
      AF3_TunnMap_pBuffer[j*AF3_TunnMap_BufferPitch+i] = ((((icol and &HFF00FF)*(isca+1)) shr 8) and &HFF00FF)  _
                         + ((((icol and &H00FF00)*(isca+1)) shr 8) and &H00FF00)
    next
  next
  Put buffer, (sx, sy), AF3_TunnMap_imgBuffer, alpha, alpha_blend
End Sub  



'__________________________________________________________________________
Sub AFlibIII_Tunnel_Blit_add ( Byval sx as Integer, _
                               Byval sy as Integer, _
                               Byval speed as Integer, _
                               Byval rotate as Integer, _
                               Byval TunnelSize_x as Integer, _
                               Byval TunnelSize_y as Integer, _
                               Byval add_blend as Integer = 255, _
                               Byval buffer as any Ptr = 0 )

'----------------------------------------------------------------------
' Special thanks to D.J.Peters for this ABSOLUTELY AWESOME tunnel
' routine that fully supports any 256x256 image!!!
'
'----------------------------------------------------------------------

  Dim as Single tunnel_s
  Dim as Single tunnel_offset
  Dim as Integer RotateCtrl

  If TunnelSize_x > 2048 then TunnelSize_x = 2048
  If TunnelSize_y > 2048 then TunnelSize_y = 2048

  If Speed > 0 then tunnel_s = .1
  RotateCtrl += -rotate
  RotateCtrl = RotateCtrl mod 256
  Put AF3_TunnMap_imgTexture, (0, RotateCtrl + 256), AF3_TunnelBlitter, pset
  Put AF3_TunnMap_imgTexture, (0, RotateCtrl), AF3_TunnelBlitter, pset
  Put AF3_TunnMap_imgTexture, (0, RotateCtrl - 256), AF3_TunnelBlitter, pset
  
  tunnel_offset += (Speed + tunnel_s)
  for j as integer = 0 to (TunnelSize_y - 1)
    for i as integer = 0 to (TunnelSize_x - 1)
      dim as const Ulong ival = AF3_TunnMap_pTable[j*AF3_TunnMap_TablePitch+i]
      dim as const Ulong icol = AF3_TunnMap_pTexture[ ( (ival and (256 ^ 2 - 1)) + tunnel_offset) and (256 ^ 2 - 1) ]
      dim as const Ulong isca = ival shr 16
      AF3_TunnMap_pBuffer[j*AF3_TunnMap_BufferPitch+i] = ((((icol and &HFF00FF)*(isca+1)) shr 8) and &HFF00FF)  _
                         + ((((icol and &H00FF00)*(isca+1)) shr 8) and &H00FF00)
    next
  next
  Put buffer, (sx, sy), AF3_TunnMap_imgBuffer, add, add_blend
End Sub  



'__________________________________________________________________________
Sub AFlibIII_Tunnel_Destroy
  
  ImageDestroy AF3_TunnMap_imgBuffer
  ImageDestroy AF3_TunnMap_imgTable
  ImageDestroy AF3_TunnMap_imgTexture
  ImageDestroy AF3_TunnelBlitter
End Sub



'__________________________________________________________________________
Sub AFlibIII_CreatePixelCraft ( Byval x as integer, _
                                Byval y as integer, _
                                Byval ColR as integer, _
                                Byval ColG as integer, _
                                Byval ColB as integer, _
                                Byval Size_x as integer, _
                                Byval Size_y as integer, _
                                Byval buffer as Any PTR = 0 )
                                
If Size_x < 2 then Size_x = 2
If Size_y < 2 then Size_y = 2
If Size_x > 17 then Size_x = 17
If Size_y > 17 then Size_y = 17

Size_x /= 2
Size_y += 11

x -= 1
y -= 2

Dim as Integer ColRandom, OuterShell, Start

Start = (Size_x + 2)
For Vert as Integer = 0 to Size_y
  Outershell = 1
  If Vert < (Size_y / 2.1) then
    Start -= 1: If Start < 0 then Start = 0
  else
    Start += 2
  End if
  For Horiz as Integer = Start to Size_x
    If OuterShell > 0 then
      If (int(rnd(1) * 70) + (1 + Vert)) > 35 - (Vert \ 2) or Vert = 0 and Horiz = (Size_x) or Horiz = (Size_x - 1) then
        Pset buffer, (Horiz + x, Vert + y), 0
        Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 0
        Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 100, buffer
        OuterShell = 0
      End if
    Else
      ColRandom = int(rnd(1) * 7) + 1
      ColRandom += 1
      If ColRandom > 8 then ColRandom = int(rnd(1) * 4) + int(rnd(1) * 4)
      Select Case as const ColRandom
        Case 1:
          Pset buffer, (Horiz + x, Vert + y), RGB(ColR / 3.5, ColG / 3.5, ColB / 3.5)
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), RGB(ColR / 3.5, ColG / 3.5, ColB / 3.5)
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
        Case 2:
          Pset buffer, (Horiz + x, Vert + y), RGB(ColR / 3, ColG / 3, ColB / 3)
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), RGB(ColR / 3, ColG / 3, ColB / 3)
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
        Case 3:
          Pset buffer, (Horiz + x, Vert + y), RGB(ColR / 2.5, ColG / 2.5, ColB / 2.5)
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), RGB(ColR / 2.5, ColG / 2.5, ColB / 2.5)
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
        Case 4:
          Pset buffer, (Horiz + x, Vert + y), RGB(ColR / 2, ColG / 2, ColB / 2)
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), RGB(ColR / 2, ColG / 2, ColB / 2)
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
        Case 5:
          Pset buffer, (Horiz + x, Vert + y), RGB(ColR / 1.5, ColG / 1.5, ColB / 1.5)
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), RGB(ColR / 1.5, ColG / 1.5, ColB / 1.5)
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
        Case 6:
          Pset buffer, (Horiz + x, Vert + y), RGB(ColR, ColG, ColB)
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), RGB(ColR, ColG, ColB)
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
        Case 7:
          Pset buffer, (Horiz + x, Vert + y), RGB(ColR / 1.25, ColG / 1.25, ColB / 1.25)
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), RGB(ColR / 1.25, ColG / 1.25, ColB / 1.25)
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
        Case 8:
          Pset buffer, (Horiz + x, Vert + y), 0
          Pset buffer, (((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y), 0
          Private_Pixel ((Size_x - Horiz) + (Size_x + 1)) + x, Vert + y, 0, 144, buffer
      End Select
    End if
  Next
Next

End Sub



'__________________________________________________________________________
Function AFlibIII_checkBMPsize_x (Byref filename as String) as Integer

'----------------------------------------------------------------------
' Special Thanks to Deleter for this BMP Size Checking Routine!!!
'----------------------------------------------------------------------

Dim As Integer ff, BMPsize_x, BMPsize_y
ff=Freefile
   
If Open(filename For Binary Access Read As #ff ) Then 
    Close #ff
    Exit Function
  End If
     
  Get #ff,19,BMPsize_x
  Get #ff,23,BMPsize_y
Close #ff
Return BMPsize_x
End Function


'__________________________________________________________________________
Function AFlibIII_checkBMPsize_y (Byref filename as String) as Integer

'----------------------------------------------------------------------
' Special Thanks to Deleter for this BMP Size Checking Routine!!!
'----------------------------------------------------------------------

Dim As Integer ff, BMPsize_x, BMPsize_y
ff=Freefile
 
If Open(filename For Binary Access Read As #ff ) Then 
    Close #ff
    Exit Function
  End If
     
  Get #ff,19,BMPsize_x
  Get #ff,23,BMPsize_y
Close #ff
Return BMPsize_y
End Function


'__________________________________________________________________________
Sub AFlibIII_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( 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



'__________________________________________________________________________
Function 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

Function 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

Function 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

Function 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

Function greyscale( 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

Function grayscaleinverse( 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

Function 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

Function monochrome( 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(0,c,0)
End Function

Function monochrome_amber( 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,0)
End Function

Function 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



'_________________________________________________________________________
Sub AFlibIII_ClearDisplay ( Byval col as Uinteger = RGB(0, 0, 0), Byval buffer as any ptr = 0 )

Dim as Integer Gfx_horiz, Gfx_vert

If not buffer = 0 then 
  AFlibIII_check_buffersize buffer, Gfx_horiz, Gfx_vert
else
  ScreenInfo Gfx_horiz, Gfx_vert
end if

Line buffer, (0, 0)-(Gfx_horiz - 1, Gfx_vert - 1), col, BF

End Sub



'__________________________________________________________________________
Sub AFlibIII_MakeMonochrome ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )
  Dim as Integer Gfx_horiz, Gfx_vert, BPP

  If not buffer = 0 then 
    AFlibIII_check_buffersize buffer, Gfx_horiz, Gfx_vert
  else
    ScreenInfo Gfx_horiz, Gfx_vert
  end if
  
  Dim Monochr_snap as any ptr = ImageCreate(Gfx_horiz, Gfx_vert)
  Get buffer, (0, 0)-(Gfx_horiz - 1, Gfx_vert - 1), Monochr_snap
  Select Case as Const ShadeType 
    Case 1: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome_amber
    Case 2: Put buffer, (0, 0), Monochr_snap, Custom, @greyscale
    Case Else: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome
  End Select
  
  ImageDestroy Monochr_snap
  Monochr_snap = 0
End Sub



'__________________________________________________________________________
Sub AFlibIII_MakeMonochrome2x ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )
  Dim as Integer Gfx_horiz, Gfx_vert, BPP

  If not buffer = 0 then 
    AFlibIII_check_buffersize buffer, Gfx_horiz, Gfx_vert
  else
    ScreenInfo Gfx_horiz, Gfx_vert
  end if
  
  Gfx_horiz /= 2
  Gfx_vert /= 2
  
  Dim Monochr_snap as any ptr = ImageCreate(Gfx_horiz, Gfx_vert)
  Get buffer, (0, 0)-(Gfx_horiz - 1, Gfx_vert - 1), Monochr_snap
  Select Case as Const ShadeType 
    Case 1: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome_amber
    Case 2: Put buffer, (0, 0), Monochr_snap, Custom, @greyscale
    Case Else: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome
  End Select
  
  ImageDestroy Monochr_snap
  Monochr_snap = 0
End Sub



'__________________________________________________________________________
Sub AFlibIII_MakeMonochrome4x ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )
  Dim as Integer Gfx_horiz, Gfx_vert, BPP

  If not buffer = 0 then 
    AFlibIII_check_buffersize buffer, Gfx_horiz, Gfx_vert
  else
    ScreenInfo Gfx_horiz, Gfx_vert
  end if
  
  Gfx_horiz /= 4
  Gfx_vert /= 4
  
  Dim Monochr_snap as any ptr = ImageCreate(Gfx_horiz, Gfx_vert)
  Get buffer, (0, 0)-(Gfx_horiz - 1, Gfx_vert - 1), Monochr_snap
  Select Case as Const ShadeType 
    Case 1: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome_amber
    Case 2: Put buffer, (0, 0), Monochr_snap, Custom, @greyscale
    Case Else: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome
  End Select
  
  ImageDestroy Monochr_snap
  Monochr_snap = 0
End Sub



'__________________________________________________________________________
Sub AFlibIII_MakeMonochrome8x ( Byval ShadeType as Integer = 0, Byval buffer as Any Ptr = 0 )
  Dim as Integer Gfx_horiz, Gfx_vert, BPP

  If not buffer = 0 then 
    AFlibIII_check_buffersize buffer, Gfx_horiz, Gfx_vert
  else
    ScreenInfo Gfx_horiz, Gfx_vert
  end if
  
  Gfx_horiz /= 8
  Gfx_vert /= 8
  
  Dim Monochr_snap as any ptr = ImageCreate(Gfx_horiz, Gfx_vert)
  Get buffer, (0, 0)-(Gfx_horiz - 1, Gfx_vert - 1), Monochr_snap
  Select Case as Const ShadeType 
    Case 1: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome_amber
    Case 2: Put buffer, (0, 0), Monochr_snap, Custom, @greyscale
    Case Else: Put buffer, (0, 0), Monochr_snap, Custom, @monochrome
  End Select
  
  ImageDestroy Monochr_snap
  Monochr_snap = 0
End Sub



Private Sub Private_Pixel ( byval sx as integer, byval sy as integer, byval col as integer, _
                            byval alphablending as integer, byval buffer as Any Ptr = 0 )

dim tempbuffer as any ptr = Imagecreate(1, 1, col)
ScreenLock
  Put buffer, (sx, sy), tempbuffer, alpha, alphablending
ScreenUnlock

ImageDestroy tempbuffer
tempbuffer = 0
End sub



Private Function PrivatePP256_ExtractSpriteColor ( Byval col as ubyte ) as longint

    return rgb(AF3_PP256_palette_colors(col,0).r,AF3_PP256_palette_colors(col,0).g,AF3_PP256_palette_colors(col,0).b)
End Function



Private Function AFlibIII_rawcollision ( 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
        _CPNEXTLINE16_:             'compare next 16 bit line
        mov ECX,EBX                 'ECX=EBX (intersected width)        
        _CPNEXTPIXEL16_:            'compare next 16 bit pixel        
        cmp word ptr [ESI],0xF81F   'pixel in object A is transparent?
        je _CPSKIPPIXEL16_          'yes? than no collision is possible (skip that pixel)
        cmp word ptr [EDI],0xF81F   'pixel in object B is transparent?
        je _CPSKIPPIXEL16_          'yes? than no collision is possible (skip that pixel)              
        jmp _CPENDCOLISION16_       'collision found (go to end of verification code)
        _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 _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 _CPNEXTLINE16_          'go test next line until it reaches 0
        neg dword ptr [RESULT]      'change RESULT signal (to negative)
        _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          
          _CPNEXTLINE32A_:            'compare next 32 bit line
          mov ECX,EBX                 'ECX=EBX (intersected width)        
          _CPNEXTPIXEL32A_:           'compare next 32 bit pixel        
          mov EAX,[ESI]               'EAX = Pixel in object A
          cmp EAX,0xFFFF00FF          'pixel in object A is transparent?
          je _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 _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 _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 _CPSKIPPIXEL32A_        'yes? than no collision is possible (skip that pixel)          
          jmp _CPENDCOLISION32A_      'collision found (go to end of verification code)
          _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 _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 _CPNEXTLINE32A_         'go test next line until it reaches 0     
          neg dword ptr [RESULT]      'change RESULT signal (to negative)
          _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
          _CPNEXTLINE32_:                  'compare next 32 bit line
          mov ECX,EBX                      'ECX=EBX (intersected width)        
          _CPNEXTPIXEL32_:                 'compare next 32 bit pixel        
          cmp dword ptr [ESI],0xFFFF00FF   'pixel in object A is transparent?
          je _CPSKIPPIXEL32_               'yes? than no collision is possible (skip that pixel)
          cmp dword ptr [EDI],0xFFFF00FF   'pixel in object B is transparent?
          je _CPSKIPPIXEL32_               'yes? than no collision is possible (skip that pixel)
          jmp _CPENDCOLISION32_            'collision found (go to end of verification code)
          _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 _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 _CPNEXTLINE32_               'go test next line until it reaches 0     
          neg dword ptr [RESULT]           'change RESULT signal (to negative)
          _CPENDCOLISION32_:               'end of verification
        end asm    
      end if
    end select
  end if
  
  return RESULT
  
end function
