PureBasic Forum

;- Includes

XIncludeFile "FastImage.pbi"

;- Constants

#MaxDistance = $FFFFFFF
#MaxDitherMethods = 128
#MaxDitherMatrixSize = 256

Enumeration
  #RotateImageLeft
  #RotateImageRight
EndEnumeration

Enumeration
  #FlipImageHorizontal
  #FlipImageVertical
EndEnumeration

Enumeration
  #GrayscaleImage_Mean
  #GrayscaleImage_Weighted
  #GrayscaleImage_Weighted2
EndEnumeration

;- Structures

Structure hsl
  h.f
  s.f
  l.f
EndStructure

Structure hsv
  h.f
  s.f
  v.f
EndStructure

;- Macros

Macro NormalizeRGB(r, g, b)

  ; ***************************************************************************
  ;
  ; Function: Truncates RGB values to a range of 0 to 255
  ;
  ; ***************************************************************************
 
  If r > 255
    r = 255
  ElseIf r < 0
    r = 0
  EndIf
 
  If g > 255
    g = 255
  ElseIf g < 0
    g = 0
  EndIf
 
  If b > 255
    b = 255
  ElseIf b < 0
    b = 0
  EndIf
 
EndMacro

Macro ContrastStretch_CalculateThresholds(Array, min, max)


  ; ***************************************************************************
  ;
  ; Function: Calculate thresholds for performing contrast stretching
  ;
  ; Notes:    Part of the ContrastStretchImage() procedure
  ;
  ; ***************************************************************************

  color = 0
  count = 0
  Repeat
    count + Array(color)
    color + 1
  Until count > lower_target Or color > 255
  min = color - 1
  color = 255
  count = 0
  Repeat
    count + Array(color)
    color - 1
  Until count > upper_target Or color < 0
  max = color + 1
  If max = min
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
 
EndMacro

;- Procedures

Procedure.l AdjustImageBrightness(image_no.l, brightness.l = 0, r_brightness.l = 0, g_brightness.l = 0, b_brightness.l = 0)

  ; ***************************************************************************
  ;
  ; Function: Adjusts the brightness of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; Notes:    Brightness values can be between -255 and 255
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If brightness < -255 Or brightness > 255
    ProcedureReturn 0
  EndIf
 
  If r_brightness < -255 Or r_brightness > 255
    ProcedureReturn 0
  EndIf

  If g_brightness < -255 Or g_brightness > 255
    ProcedureReturn 0
  EndIf
 
  If b_brightness < -255 Or b_brightness > 255
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = FastRed(color) + r_brightness + brightness
    g = FastGreen(color) + g_brightness + brightness
    b = FastBlue(color) + b_brightness + brightness
    NormalizeRGB(r, g, b)
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1
 
EndProcedure

Procedure.l AdjustImageContrast(image_no.l, contrast.f = 0, r_contrast.f = 0, g_contrast.f = 0, b_contrast.f = 0)

  ; ***************************************************************************
  ;
  ; Function: Adjusts the contrast of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; Notes:    Contrast values can be between -255 to 255
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
  Protected contrast_correction.f
  Protected r_contrast_correction.f
  Protected g_contrast_correction.f
  Protected b_contrast_correction.f

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If contrast < -255 Or contrast > 255
    ProcedureReturn 0
  EndIf
 
  If r_contrast < -255 Or r_contrast > 255
    ProcedureReturn 0
  EndIf
 
  If g_contrast < -255 Or g_contrast > 255
    ProcedureReturn 0
  EndIf
 
  If b_contrast < -255 Or b_contrast > 255
    ProcedureReturn 0
  EndIf

  contrast_correction = (contrast + 255) * 259 / (255 * (259 - contrast)) 
  r_contrast_correction = (r_contrast + 255) * 259 / (255 * (259 - r_contrast))
  g_contrast_correction = (g_contrast + 255) * 259 / (255 * (259 - g_contrast))
  b_contrast_correction = (b_contrast + 255) * 259 / (255 * (259 - b_contrast))
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = (FastRed(color) - 128) * r_contrast_correction * contrast_correction + 128
    g = (FastGreen(color) - 128) * g_contrast_correction * contrast_correction + 128
    b = (FastBlue(color) - 128) * b_contrast_correction * contrast_correction + 128
    NormalizeRGB(r, g, b)
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1
 
EndProcedure

Procedure.l AdjustImageGamma(image_no.l, gamma.f = 1, r_gamma.f = 1, g_gamma.f = 1, b_gamma.f = 1)

  ; ***************************************************************************
  ;
  ; Function: Adjusts the gamma curve of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
  Protected gamma_correction.f
  Protected r_gamma_correction.f
  Protected g_gamma_correction.f
  Protected b_gamma_correction.f
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If gamma <= 0 Or gamma >= 8
    ProcedureReturn 0
  EndIf

  If r_gamma <= 0 Or r_gamma >= 8
    ProcedureReturn 0
  EndIf

  If g_gamma <= 0 Or g_gamma >= 8
    ProcedureReturn 0
  EndIf

  If b_gamma <= 0 Or b_gamma >= 8
    ProcedureReturn 0
  EndIf
 
  gamma_correction = 1 / gamma
  r_gamma_correction = 1 / r_gamma
  g_gamma_correction = 1 / g_gamma
  b_gamma_correction = 1 / b_gamma
   
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)
    r = 255 * Pow(r / 255, r_gamma_correction)
    r = 255 * Pow(r / 255, gamma_correction)
    g = 255 * Pow(g / 255, g_gamma_correction)
    g = 255 * Pow(g / 255, gamma_correction)
    b = 255 * Pow(b / 255, b_gamma_correction)
    b = 255 * Pow(b / 255, gamma_correction)
    NormalizeRGB(r, g, b)
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure.l CropImage(image_no.l, x.l, y.l, width.l, height.l)

  ; ***************************************************************************
  ;
  ; Function: Crops an image to given size
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected temp_image_no.l

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If width = 0 Or height = 0
    ProcedureReturn 0
  EndIf
 
  If x + width > ImageWidth(image_no) Or y + height > ImageHeight(image_no)
    ProcedureReturn 0
  EndIf

  temp_image_no = GrabImage(image_no, #PB_Any, x, y, width, height)
 
  If temp_image_no = 0
    ProcedureReturn 0
  EndIf
 
  FreeImage(image_no)
  CopyImage(temp_image_no, image_no)
 
  ProcedureReturn 1

EndProcedure

Procedure.l ScrollImage(image_no.l, scroll_x.l, scroll_y.l, wrap.l = 0)

  ; ***************************************************************************
  ;
  ; Function: Scrolls an image about with optional wrapping
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem_source.l, *mem_target.l, mem_size.l
  Protected x.l, y.l, target_x.l, target_y.l
  Protected width.l, height.l

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  width = ImageWidth(0)
  height = ImageHeight(0)
 
  If scroll_x > width Or scroll_y > height
    ProcedureReturn 0
  EndIf

  mem_size = width * height << 2
  *mem_source = AllocateMemory(mem_size)
  If *mem_source = 0
    ProcedureReturn 0
  EndIf
 
  CopyImageToMemory(image_no, *mem_source)
  FreeImage(image_no)
 
  *mem_target = AllocateMemory(mem_size)
  If *mem_target = 0
 
    ; Attempt to restore source image when memory allocation fails
 
    If CreateImage(image_no, width, height, 32)
      CopyMemoryToImage(*mem_source, image_no)
    EndIf
    FreeMemory(*mem_source)
    ProcedureReturn 0
  EndIf
   
  For y = 0 To height - 1
    For x = 0 To width - 1
      Select wrap
        Case 1
          target_x = (x + scroll_x) % width
          target_y = (y + scroll_y) % height       
          If target_x < 0
            target_x = width + target_x
          EndIf
          If target_y < 0
            target_y = height + target_y
          EndIf
          PokeL(*mem_target + (target_y * width + target_x) << 2, PeekL(*mem_source + (y * width + x) << 2))
        Default
          target_x = (x + scroll_x)
          target_y = (y + scroll_y)
          If target_x >= 0 And target_x < width And target_y >= 0 And target_y < height
            PokeL(*mem_target + (target_y * width + target_x) << 2, PeekL(*mem_source + (y * width + x) << 2))
          EndIf
      EndSelect
    Next
  Next
 
  FreeMemory(*mem_source)
 
  If CreateImage(image_no, width, height, 32) = 0
    FreeMemory(*mem_target)
    ProcedureReturn 0
  EndIf
 
  CopyMemoryToImage(*mem_target, image_no)
  FreeMemory(*mem_target)
 
  ProcedureReturn 1

EndProcedure

Procedure.l EnhanceEdges(image_no.l, strength.l = 0, outline.l = 0)

  ; ***************************************************************************
  ;
  ; Function: Enhances the edges of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, *mem2.l
  Protected r.l, g.l, b.l
  Protected r1.l, r2.l, g1.l, g2.l, b1.l, b2.l
  Protected image_info.FASTIMAGEINFO
  Protected image_info2.FASTIMAGEINFO
  Protected x.l, y.l, i.l
  Protected threshold.l
  Protected Dim matrix.l(2, 2, 2), Dim color1.l(2), Dim color2.l(2)

  If strength < 0 Or strength > 100
    ProcedureReturn 0
  EndIf

  threshold = (100 - strength) * (254 - 64) / 100 + 64
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf

  *mem2 = AllocateMemory(mem_size)
  If *mem2 = 0
    FreeMemory(*mem)
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  image_info\ptrImageBuffer  = *mem
  image_info\imgWidth        = ImageWidth(image_no)
  image_info\imgHeight       = ImageHeight(image_no)
  image_info\imgDepth        = ImageDepth(image_no)

  CopyImageToMemory(image_no, *mem2)
  image_info2\ptrImageBuffer  = *mem2
  image_info2\imgWidth        = ImageWidth(image_no)
  image_info2\imgHeight       = ImageHeight(image_no)
  image_info2\imgDepth        = ImageDepth(image_no)

  For y = 0 To image_info\imgHeight - 1
    For x = 0 To image_info\imgWidth - 1
   
      If x <= 0 Or y <= 0 Or x >= image_info\imgWidth Or y >= image_info\imgHeight
        matrix(0, 0, 0) = FastRed(FastPoint(image_info, x, y))
        matrix(1, 0, 0) = FastGreen(FastPoint(image_info, x, y))
        matrix(2, 0, 0) = FastBlue(FastPoint(image_info, x, y))
      EndIf
   
      If x > 0 And y > 0     
        matrix(0, 0, 0) = FastRed(FastPoint(image_info, x - 1, y - 1))
        matrix(1, 0, 0) = FastGreen(FastPoint(image_info, x - 1, y - 1))
        matrix(2, 0, 0) = FastBlue(FastPoint(image_info, x - 1, y - 1))
      EndIf
   
      If y > 0     
        matrix(0, 1, 0) = FastRed(FastPoint(image_info, x, y - 1))
        matrix(1, 1, 0) = FastGreen(FastPoint(image_info, x, y - 1))
        matrix(2, 1, 0) = FastBlue(FastPoint(image_info, x, y - 1))
      EndIf

      If x < image_info\imgWidth - 1 And y > 0
        matrix(0, 2, 0) = FastRed(FastPoint(image_info, x + 1, y - 1))
        matrix(1, 2, 0) = FastGreen(FastPoint(image_info, x + 1, y - 1))
        matrix(2, 2, 0) = FastBlue(FastPoint(image_info, x + 1, y - 1))
      EndIf
     
      If x > 0
        matrix(0, 0, 1) = FastRed(FastPoint(image_info, x - 1, y))
        matrix(1, 0, 1) = FastGreen(FastPoint(image_info, x - 1, y))
        matrix(2, 0, 1) = FastBlue(FastPoint(image_info, x - 1, y))
      EndIf
     
      If x < image_info\imgWidth - 1
        matrix(0, 2, 1) = FastRed(FastPoint(image_info, x + 1, y))
        matrix(1, 2, 1) = FastGreen(FastPoint(image_info, x + 1, y))
        matrix(2, 2, 1) = FastBlue(FastPoint(image_info, x + 1, y))
      EndIf 
     
      If x > 0 And y < image_info\imgHeight - 1
        matrix(0, 0, 2) = FastRed(FastPoint(image_info, x - 1, y + 1))
        matrix(1, 0, 2) = FastGreen(FastPoint(image_info, x - 1, y + 1))
        matrix(2, 0, 2) = FastBlue(FastPoint(image_info, x - 1, y + 1))
      EndIf 

      If y < image_info\imgHeight - 1
        matrix(0, 1, 2) = FastRed(FastPoint(image_info, x, y + 1))
        matrix(1, 1, 2) = FastGreen(FastPoint(image_info, x, y + 1))
        matrix(2, 1, 2) = FastBlue(FastPoint(image_info, x, y + 1))
      EndIf 
     
      If x < image_info\imgWidth - 1 And y < image_info\imgHeight - 1
        matrix(0, 2, 2) = FastRed(FastPoint(image_info, x + 1, y + 1))
        matrix(1, 2, 2) = FastGreen(FastPoint(image_info, x + 1, y + 1))
        matrix(2, 2, 2) = FastBlue(FastPoint(image_info, x + 1, y + 1))
      EndIf 
     
      For i = 0 To 2
        color1(i) = - matrix(i, 0, 0) + matrix(i, 2, 0) - matrix(i, 0, 1) << 1 + matrix(i, 2, 1) << 1 - matrix(i, 0, 2) + matrix(i, 2, 2)
        color2(i) = matrix(i, 0, 0) + matrix(i, 1, 0) << 1 + matrix(i, 2, 0) - matrix(i, 0, 2) - matrix(i, 1, 2) << 1 - matrix(i, 2, 2)
      Next
                     
      r = Abs(color1(0)) + Abs(color2(0))
      g = Abs(color1(1)) + Abs(color2(1))
      b = Abs(color1(2)) + Abs(color2(2))
     
      If r > threshold Or g > threshold Or b > threshold
        FastPlot(image_info2, x, y, 0)
      ElseIf outline
        FastPlot(image_info2, x, y, $FFFFFF)
      Else
        FastPlot(image_info2, x, y, FastPoint(image_info, x, y))
      EndIf
     
    Next
  Next
  CopyMemoryToImage(*mem2, image_no)
  FreeMemory(*mem)
  FreeMemory(*mem2)
 
  ProcedureReturn 1

EndProcedure

Procedure.l RotateImage180(image_no.l)

  ; ***************************************************************************
  ;
  ; Function: Rotates an image by 180 degrees
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l, temp.l

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
 
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size >> 1 - 1 Step 4
    temp = PeekL(*mem + mem_size - mem_pos - 4)
    PokeL(*mem + mem_size - mem_pos - 4, PeekL(*mem + mem_pos))
    PokeL(*mem + mem_pos, temp)
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure.l RotateImage90(image_no.l, direction.l = #RotateImageLeft)

  ; ***************************************************************************
  ;
  ; Function: Rotates an image by 90 degrees either left or right
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem_source.l, *mem_target.l, mem_size.l
  Protected target.l, width.l, height.l, x.l, y.l
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  If direction <> #RotateImageLeft And direction <> #RotateImageRight
    ProcedureReturn 0
  EndIf
 
  width = ImageWidth(image_no)
  height = ImageHeight(image_no)
 
  mem_size = width * height << 2
  *mem_source = AllocateMemory(mem_size)
  If *mem_source = 0
    ProcedureReturn 0
  EndIf
 
  CopyImageToMemory(image_no, *mem_source)
  FreeImage(image_no)
 
  *mem_target = AllocateMemory(mem_size)
  If *mem_target = 0
 
    ; Attempt to restore source image when memory allocation fails
 
    If CreateImage(image_no, width, height, 32)
      CopyMemoryToImage(*mem_source, image_no)
    EndIf
    FreeMemory(*mem_source)
    ProcedureReturn 0
  EndIf
 
  For y = 0 To height - 1
    For x = 0 To width - 1
      Select direction
        Case #RotateImageLeft
          target = (y + ((width - x - 1) * height)) << 2
        Case #RotateImageRight
          target = ((height - y - 1) + (x * height)) << 2
      EndSelect
      PokeL(*mem_target + target, PeekL(*mem_source + (y * width + x) << 2))
    Next
  Next
 
  FreeMemory(*mem_source)
 
  If CreateImage(image_no, height, width, 32) = 0
    FreeMemory(*mem_target)
    ProcedureReturn 0
  EndIf
 
  CopyMemoryToImage(*mem_target, image_no)
  FreeMemory(*mem_target)
 
  ProcedureReturn 1

EndProcedure

Procedure.l FlipImage(image_no.l, direction.l = #FlipImageHorizontal)

  ; ***************************************************************************
  ;
  ; Function: Flips an image either horizontally or vertically
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, temp.l
  Protected source.l, target.l, width.l, height.l, x.l, y.l
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  If direction <> #FlipImageHorizontal And direction <> #FlipImageVertical
    ProcedureReturn 0
  EndIf
 
  width = ImageWidth(image_no)
  height = ImageHeight(image_no)
 
  mem_size = width * height << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
 
  CopyImageToMemory(image_no, *mem)
  Select direction
    Case #FlipImageHorizontal
      For y = 0 To height - 1
        For x = 0 To width >> 1 - 1
          source = (y * width + x) << 2
          target = ((width - x) + (y * width - 1)) << 2
          temp = PeekL(*mem + target)
          PokeL(*mem + target, PeekL(*mem + source))
          PokeL(*mem + source, temp)
        Next
      Next
    Case #FlipImageVertical
      For y = 0 To height >> 1 - 1
        For x = 0 To width - 1
          source = (y * width + x) << 2
          target = ((height - y - 1) * width + x) << 2
          temp = PeekL(*mem + target)
          PokeL(*mem + target, PeekL(*mem + source))
          PokeL(*mem + source, temp)
        Next
      Next
  EndSelect
 
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure.l GrayscaleImage(image_no.l, method.l = #GrayscaleImage_Weighted)

  ; ***************************************************************************
  ;
  ; Function: Converts an image to grayscale
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
 
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)
    Select method
      Case #GrayscaleImage_Mean
        color = (r + g + b) / 3
      Case #GrayscaleImage_Weighted
        color = 0.299 * r + 0.587 * g + 0.114 * b
      Case #GrayscaleImage_Weighted2
        color = 0.3086 * r + 0.6094 * g + 0.0820 * b
      Default
        ProcedureReturn 0
    EndSelect
    PokeL(*mem + mem_pos, FastRGB(color, color, color))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1
 
EndProcedure

Procedure.l InvertImage(image_no.l)

  ; ***************************************************************************
  ;
  ; Function: Inverts the color of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem, mem_size, mem_pos

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
 
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    PokeL(*mem + mem_pos, ~PeekL(*mem + mem_pos))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure.l SolarizeImage(image_no.l, lower_threshold.l = 0, upper_threshold.l = 128)

  ; ***************************************************************************
  ;
  ; Function: Produces a solarize effect of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem, mem_size, mem_pos
  Protected color, r.c, g.c, b.c

  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  If lower_threshold < 0 Or lower_threshold > upper_threshold Or upper_threshold > 255
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
 
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)
    If r >= lower_threshold And r <= upper_threshold
      r = ~r
    EndIf
    If g >= lower_threshold And g <= upper_threshold
      g = ~g
    EndIf
    If b >= lower_threshold And b <= upper_threshold
      b = ~b
    EndIf
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure.l EqualizeImage(image_no.l)

  ; ***************************************************************************
  ;
  ; Function: Equalizes the histogram of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************
 
  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l, count.l, i.l, j.l
  Protected Dim f_r.l(255)
  Protected Dim f_g.l(255)
  Protected Dim f_b.l(255)
  Protected Dim cuf_r.l(255)
  Protected Dim cuf_g.l(255)
  Protected Dim cuf_b.l(255)
  Protected Dim feq.l(255)
  Protected Dim cufeq.l(255)
  Protected nearest_value.l, nearest_intensity.l
  Protected Dim output_r.l(255)
  Protected Dim output_g.l(255)
  Protected Dim output_b.l(255)
   
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
 
  ; Calculate frequency of intensities
 
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    f_r(FastRed(color)) + 1
    f_g(FastGreen(color)) + 1
    f_b(FastBlue(color)) + 1
  Next
 
  ; Calculate cumulative frequency distribution
 
  cuf_r(0) = f_r(0)
  cuf_g(0) = f_g(0)
  cuf_b(0) = f_b(0)
 
  For i = 1 To 255
    cuf_r(i) = cuf_r(i - 1) + f_r(i)
    cuf_g(i) = cuf_g(i - 1) + f_g(i)
    cuf_b(i) = cuf_b(i - 1) + f_b(i)
  Next

  ; Calculate equalized frequency distribution
 
  For i = 0 To 255
    feq(i) = mem_size >> 10
  Next
 
  For i = 0 To mem_size >> 2 - mem_size >> 10 << 8 - 1
    feq(i) + 1
  Next
 
  ; Calculate equalized cumulative frequency distribution
 
  cufeq(0) = feq(0)
 
  For i = 1 To 255
    cufeq(i) = cufeq(i - 1) + feq(i)
  Next
 
  ; Map the insensities
 
  i = 0
  Repeat
    nearest_value = cuf_r(255)
    j = 0
    Repeat
      If Abs(cuf_r(i) - cufeq(j)) < nearest_value
        nearest_value = Abs(cuf_r(i) - cufeq(j))
        nearest_intensity = j
      EndIf
      j + 1
    Until j > 255
    output_r(i) = nearest_intensity
    i + 1
  Until i > 255
 
  i = 0
  Repeat
    nearest_value = cuf_g(255)
    j = 0
    Repeat
      If Abs(cuf_g(i) - cufeq(j)) < nearest_value
        nearest_value = Abs(cuf_g(i) - cufeq(j))
        nearest_intensity = j
      EndIf
      j + 1
    Until j > 255
    output_g(i) = nearest_intensity
    i + 1
  Until i > 255
 
  i = 0
  Repeat
    nearest_value = cuf_b(255)
    j = 0
    Repeat
      If Abs(cuf_b(i) - cufeq(j)) < nearest_value
        nearest_value = Abs(cuf_b(i) - cufeq(j))
        nearest_intensity = j
      EndIf
      j + 1
    Until j > 255
    output_b(i) = nearest_intensity
    i + 1
  Until i > 255
 
  ; Transform the image
 
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = output_r(FastRed(color))
    g = output_g(FastGreen(color))
    b = output_b(FastBlue(color))
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
 
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1
 
EndProcedure

Procedure.l ContrastStretchImage(image_no.l, lower_threshold.f = 0.5, upper_threshold.f = 0.5)

  ; ***************************************************************************
  ;
  ; Function: Performs contrast stretching on an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************
 
  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l, count.l
  Protected r_min.l = 256, r_max.l = 0
  Protected g_min.l = 256, g_max.l = 0
  Protected b_min.l = 256, b_max.l = 0
  Protected Dim r_histogram.l(255)
  Protected Dim g_histogram.l(255)
  Protected Dim b_histogram.l(255)
  Protected scale.f, lower_target.l, upper_target.l
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r_histogram(FastRed(color)) + 1
    g_histogram(FastGreen(color)) + 1
    b_histogram(FastBlue(color)) + 1
  Next

  lower_target = ImageWidth(image_no) * ImageHeight(image_no) * (lower_threshold / 100)
  upper_target = ImageWidth(image_no) * ImageHeight(image_no) * (upper_threshold / 100)
 
  ContrastStretch_CalculateThresholds(r_histogram, r_min, r_max)
  ContrastStretch_CalculateThresholds(g_histogram, g_min, g_max)
  ContrastStretch_CalculateThresholds(b_histogram, b_min, b_max)
   
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = 255 * (FastRed(color) - r_min) / (r_max - r_min)
    g = 255 * (FastGreen(color) - g_min) / (g_max - g_min)
    b = 255 * (FastBlue(color) - b_min) / (b_max - b_min)
    NormalizeRGB(r, g, b)
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)

  ProcedureReturn 1

EndProcedure

Procedure.l NormalizeImage(image_no.l)

  Protected result.l
 
  result = ContrastStretchImage(image_no, 0.02, 0.01)
 
  ProcedureReturn result

EndProcedure

Procedure.l PosterizeImage(image_no.l, levels.l = 256)

  ; ***************************************************************************
  ;
  ; Function: Produces a posterize effect of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
  Protected factor.f, correction.f
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  If levels < 2 Or levels > 256
    ProcedureReturn 0
  EndIf
 
  factor = 256 / levels
  correction = 255 / (levels - 1)

  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)
    r = Int(r / factor) * correction
    g = Int(g / factor) * correction
    b = Int(b / factor) * correction
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure RGBToHSV(color, *colorspace.hsv)

  ; ***************************************************************************
  ;
  ; Function: Converts an RGB color space to HSV
  ;
  ; Returns:  A structure containing the HSV values
  ;
  ; ***************************************************************************

  Protected r.f, g.f, b.f
  Protected r_temp.l, g_temp.l, b_temp.l
  Protected delta.f, min.f

  r_temp = FastRed(color)
  g_temp = FastGreen(color)
  b_temp = FastBlue(color)

  r = r_temp / 255
  g = g_temp / 255
  b = b_temp / 255
 
  If r < g
    min = r
  Else
    min = g
  EndIf
  If b < min
    b = min
  EndIf
 
  If r > g
    *colorspace\v = r
  Else
    *colorspace\v = g
  EndIf
  If b > *colorspace\v
    *colorspace\v = b
  EndIf
 
  delta = *colorspace\v - min

  If *colorspace\v = 0
    *colorspace\s = 0
  Else
    *colorspace\s = delta / *colorspace\v
  EndIf

  If *colorspace\s = 0
    *colorspace\h = 0
  Else
    If r = *colorspace\v
      *colorspace\h = 60 * (g - b) / delta
    ElseIf g = *colorspace\v
      *colorspace\h = 120 + 60 * (b - r) / delta
    ElseIf b = *colorspace\v
      *colorspace\h = 240 + 60 * (r - g) / delta
    EndIf
    If *colorspace\h < 0
      *colorspace\h + 360
    EndIf
  EndIf
   
EndProcedure

Procedure.l HSLToRGB(*colorspace.hsl)

  ; ***************************************************************************
  ;
  ; Function: Converts HSL color space to RGB
  ;
  ; Returns:  The value of RGB
  ;
  ; ***************************************************************************

  Protected r.f, g.f, b.f
  Protected temp1.f, temp2.f
  Protected r_temp.f, g_temp.f, b_temp.f
  Protected h_temp.f
 
  If *colorspace\s = 0
    r = *colorspace\l
    g = *colorspace\l
    b = *colorspace\l
  Else
    If *colorspace\l < 0.5
      temp2 = *colorspace\l * (1 + *colorspace\s)
    Else
      temp2 = *colorspace\l + *colorspace\s - *colorspace\l * *colorspace\s
    EndIf
   
    temp1 = 2 * *colorspace\l - temp2
   
    h_temp = *colorspace\h / 360
   
    r_temp = h_temp + 1 / 3
    g_temp = h_temp
    b_temp = h_temp - 1 / 3
   
    If r_temp < 0
      r_temp + 1
    ElseIf r_temp > 1
      r_temp - 1
    EndIf
   
    If g_temp < 0
      g_temp + 1
    ElseIf g_temp > 1
      g_temp - 1
    EndIf
   
    If b_temp < 0
      b_temp + 1
    ElseIf b_temp > 1
      b_temp - 1
    EndIf
   
    If 6 * r_temp < 1
      r = temp1 + (temp2 - temp1) * 6 * r_temp
    ElseIf 2 * r_temp < 1
      r = temp2
    ElseIf 3 * r_temp < 2
      r = temp1 + (temp2 - temp1) * ((2 / 3) - r_temp) * 6
    Else
      r = temp1
    EndIf
   
    If 6 * g_temp < 1
      g = temp1 + (temp2 - temp1) * 6 * g_temp
    ElseIf 2 * g_temp < 1
      g = temp2
    ElseIf 3 * g_temp < 2
      g = temp1 + (temp2 - temp1) * ((2 / 3) - g_temp) * 6
    Else
      g = temp1
    EndIf
   
    If 6 * b_temp < 1
      b = temp1 + (temp2 - temp1) * 6 * b_temp
    ElseIf 2 * b_temp < 1
      b = temp2
    ElseIf 3 * b_temp < 2
      b = temp1 + (temp2 - temp1) * ((2 / 3) - b_temp) * 6
    Else
      b = temp1
    EndIf
  EndIf
   
  ProcedureReturn FastRGB(Int(r * 255), Int(g * 255), Int(b * 255))

EndProcedure

Procedure.l HSVToRGB(*colorspace.hsv)

  ; ***************************************************************************
  ;
  ; Function: Converts HSV color space to RGB
  ;
  ; Returns:  The value of RGB
  ;
  ; ***************************************************************************

  Protected f.f, i.l, aa.f, bb.f, cc.f
  Protected r.f, g.f, b.f
  Protected h_temp.f
 
  If *colorspace\s = 0
    r = *colorspace\v
    g = *colorspace\v
    b = *colorspace\v
  Else
    If *colorspace\h = 360
      *colorspace\h = 0
    EndIf
   
    h_temp = *colorspace\h / 60
    i = Int(h_temp)
    f = h_temp - i
   
    aa = *colorspace\v * (1 - *colorspace\s)
    bb = *colorspace\v * (1 - (*colorspace\s * f))
    cc = *colorspace\v * (1 - (*colorspace\s * (1 - f)))
   
    Select i
      Case 0
        r = *colorspace\v
        g = cc
        b = aa
      Case 1
        r = bb
        g = *colorspace\v
        b = aa
      Case 2
        r = aa
        g = *colorspace\v
        b = cc
      Case 3
        r = aa
        g = bb
        b = *colorspace\v
      Case 4
        r = cc
        g = aa
        b = *colorspace\v
      Case 5
        r = *colorspace\v
        g = aa
        b = bb
    EndSelect
  EndIf
 
  ProcedureReturn FastRGB(Int(r * 255), Int(g * 255), Int(b * 255))

EndProcedure

Procedure.l AdjustImageHue(image_no.l, value.l = 0)

  ; ***************************************************************************
  ;
  ; Function: Adjusts the hue of an image
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; Notes:    Hue value can be between -180 and 180
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l
  Protected colorspace.HSV
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf

  If value < -180 Or value > 180
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)
    RGBToHSV(color, @colorspace)
    colorspace\h + value
    If colorspace\h > 360
      colorspace\h - 360
    ElseIf colorspace\h < 0
      colorspace\h + 360
    EndIf
    PokeL(*mem + mem_pos, HSVToRGB(colorspace))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure.l ColorizeImage(image_no.l, *colorspace.hsl)

  ; ***************************************************************************
  ;
  ; Function: Colorizes an image to a particular hue
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l, hsl.hsl
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf

  hsl\h = *colorspace\h
  hsl\s = *colorspace\s
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)

    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)

    color = 0.299 * r + 0.587 * g + 0.114 * b
       
    hsl\l = *colorspace\l * 2 - 1

    If hsl\l < 0
      hsl\l = color / 255 * (hsl\l + 1)
    Else
      hsl\l = color / 255 * (1 - hsl\l) + hsl\l
    EndIf
       
    PokeL(*mem + mem_pos, HSLToRGB(hsl))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

Procedure.l TintImage(image_no.l, tint_color.l, tint_amount.f)

  ; ***************************************************************************
  ;
  ; Function: Tints an image to a particular color
  ;
  ; Returns:  '1' if successful, otherwise '0'
  ;
  ; ***************************************************************************

  Protected *mem.l, mem_size.l, mem_pos.l
  Protected color.l, r.l, g.l, b.l, r_tint.l, g_tint.l, b_tint.l
 
  If IsImage(image_no) = 0
    ProcedureReturn 0
  EndIf
 
  If tint_amount < 0 Or tint_amount > 100
    ProcedureReturn 0
  EndIf
 
  mem_size = ImageWidth(image_no) * ImageHeight(image_no) << 2
  *mem = AllocateMemory(mem_size)
  If *mem = 0
    ProcedureReturn 0
  EndIf
   
  r_tint = FastRed(tint_color)
  g_tint = FastGreen(tint_color)
  b_tint = FastBlue(tint_color)
  tint_amount / 100
   
  CopyImageToMemory(image_no, *mem)
  For mem_pos = 0 To mem_size - 1 Step 4
    color = PeekL(*mem + mem_pos)

    r = FastRed(color)
    g = FastGreen(color)
    b = FastBlue(color)

    r * (1 - tint_amount) + r_tint * tint_amount
    g * (1 - tint_amount) + g_tint * tint_amount
    b * (1 - tint_amount) + b_tint * tint_amount
       
    PokeL(*mem + mem_pos, FastRGB(r, g, b))
  Next
  CopyMemoryToImage(*mem, image_no)
  FreeMemory(*mem)
 
  ProcedureReturn 1

EndProcedure

;- Structures

Structure FASTIMAGEINFO
  ptrImageBuffer.l
  imgWidth.w
  imgHeight.w
  imgDepth.b
EndStructure

;- Macros

Macro FastRGB(r, g, b)

  ; Faster equivalent of RGB(), although only suitable for integers

  (((r << 8 + g) << 8 ) + b)
 
EndMacro

Macro FastRed(color)
 
  ; Faster equivalent of Red(), although only suitable for integers

  ((color & $FF0000) >> 16)
 
EndMacro

Macro FastGreen(color)

  ; Faster equivalent of Green(), although only suitable for integers

  ((color & $FF00) >> 8)
 
EndMacro

Macro FastBlue(color)

  ; Faster equivalent of Blue(), although only suitable for integers

  (color & $FF)
 
EndMacro

Macro ReverseRGB(color)

  ; Changes RGB to BGR or vice versa

  ((color & $FF) << 16 | (color & $FF00) | (color & $FF0000) >> 16)
 
EndMacro

Macro FastPlot(image_info, x, y, color)
  PokeL(image_info\ptrImageBuffer + (image_info\imgWidth * (y) + x) << 2, color)
EndMacro

Macro FastPoint(image_info, x, y)
  (PeekL(image_info\ptrImageBuffer + (image_info\imgWidth * (y) + x) << 2) & $FFFFFF)
EndMacro

;- Procedures

Procedure CopyImageToMemory(image_no.l, *mem)
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Protected TemporaryDC.l, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
    TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
    GetObject_(ImageID(image_no), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
    TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
    TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
    TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
    TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
    TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
    TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
    GetDIBits_(TemporaryDC, ImageID(image_no), 0, TemporaryBitmap\bmHeight, *mem, TemporaryBitmapInfo, #DIB_RGB_COLORS)
    DeleteDC_(TemporaryDC)
  CompilerElse
    Protected x.l, y.l, mem_pos.l
    mem_pos = 0
    StartDrawing(ImageOutput(image_no))
    For y = 0 To ImageHeight(image_no) - 1
      For x = 0 To ImageWidth(image_no) - 1
        PokeL(*mem + mem_pos, ReverseRGB(Point(x, y)))
        mem_pos + 4
      Next
    Next
    StopDrawing()
  CompilerEndIf
EndProcedure

Procedure CopyMemoryToImage(*mem, image_no.l)
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Protected TemporaryDC.l, TemporaryBitmap.BITMAP, TemporaryBitmapInfo.BITMAPINFO
    TemporaryDC = CreateDC_("DISPLAY", #Null, #Null, #Null)
    GetObject_(ImageID(image_no), SizeOf(BITMAP), TemporaryBitmap.BITMAP)
    TemporaryBitmapInfo\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
    TemporaryBitmapInfo\bmiHeader\biWidth       = TemporaryBitmap\bmWidth
    TemporaryBitmapInfo\bmiHeader\biHeight      = -TemporaryBitmap\bmHeight
    TemporaryBitmapInfo\bmiHeader\biPlanes      = 1
    TemporaryBitmapInfo\bmiHeader\biBitCount    = 32
    TemporaryBitmapInfo\bmiHeader\biCompression = #BI_RGB
    SetDIBits_(TemporaryDC, ImageID(image_no), 0, TemporaryBitmap\bmHeight, *mem, TemporaryBitmapInfo, #DIB_RGB_COLORS)
    DeleteDC_(TemporaryDC)
  CompilerElse
    Protected x.l, y.l, mem_pos.l
    mem_pos = 0
    StartDrawing(ImageOutput(image_no))
    For y = 0 To ImageHeight(image_no) - 1
      For x = 0 To ImageWidth(image_no) - 1
        Plot(x, y, ReverseRGB(PeekL(*mem + mem_pos)))
        mem_pos + 4
      Next
    Next   
    StopDrawing()
  CompilerEndIf
EndProcedure

Macro FastBlue(color)
 
  ; Faster equivalent of Red(), although only suitable for integers

  ((color & $FF0000) >> 16)
 
EndMacro

Macro FastGreen(color)

  ; Faster equivalent of Green(), although only suitable for integers

  ((color & $FF00) >> 8)
 
EndMacro

Macro FastRed(color)

  ; Faster equivalent of Blue(), although only suitable for integers

  (color & $FF)
 
EndMacro

Macro FastRGB(r, g, b)

  ; Faster equivalent of RGB(), although only suitable for integers

  (((b << 8 + g) << 8 ) + r)
 
EndMacro

Debug FastRGB(111,122,133)
Debug RGB(111,122,133)

Debug Red(RGB(111,122,133))
Debug FastRed(RGB(111,122,133))

Debug Green(RGB(111,122,133))
Debug FastGreen(RGB(111,122,133))

Debug Blue(RGB(111,122,133))
Debug FastBlue(RGB(111,122,133))

8747631
8747631
111
111
122
122
133
133

   
 a = Alpha(color)
 r = Red(color) + r_brightness + brightness
 g = Green(color) + g_brightness + brightness
 b = Blue(color) + b_brightness + brightness
 NormalizeRGB(r, g, b)
 PokeL(*mem + mem_pos, RGBA(r, g, b, a))

;Rotate image
;***********************************************
;Titre  :*rotate image
;Auteur  : Dobro
;Date  :30/09/2013
;Heure  :11:31:58
;Version Purebasic :  PureBasic 5.20 LTS (Windows - x8
;Version de l'editeur :EPB V2.46
; Libairies necessaire : Aucune
;***********************************************


Declare  rotate_image(id,x2,y2,degres)
Declare.l RotateImageEx2(ImageID, Angle.f)



UseJPEGImageDecoder () :UsePNGImageDecoder()
InitSprite ()

#dobro =1
#Police =1
#Sprite =1
#image1 =1
#image2 =2



; ***********************************
FontID = LoadFont ( #Police , "arial" , 50, #PB_Font_Bold )
EcranX = GetSystemMetrics_ ( #SM_CXSCREEN )
;=largeur de l'ecran
EcranY = GetSystemMetrics_ ( #SM_CYSCREEN )
;=hauteur de l'ecran
WindowID = OpenWindow (1, 0, 0, EcranX, EcranY, "hello" , #PB_Window_BorderLess |#PB_Window_ScreenCentered )

WindowID = WindowID (1)
Result = OpenWindowedScreen ( WindowID ,0,0, EcranX, EcranY, 1, 0,0)


; principe de rotation
;x1 = coordonée x du point rotationé
;Y1= coordonée y du point rotationé
; a = angle de rotation
; x1 = x * Cos(a) + Y * Sin(a);
; y1 = -x * Sin(a) + Y * Cos(a)
im$=OpenFileRequester("open jpg","c:\","*.jpg",0)
LoadImage ( #image1 , im$ ) ;<----- path of the picture

largeur = ImageWidth(#image1)
hauteur = ImageHeight(#image1)

;
if largeur>1024 or hauteur>768
   ResizeImage(#image1,1024,768)
   largeur = 1024
   hauteur =768
Endif

;


CreateImage ( #image2 ,largeur,hauteur )


; ******* mise en tableau de l'image **********
Global Dim tabl1(largeur ,hauteur )
StartDrawing ( ImageOutput ( #image1) )
   For Y=1 To hauteur-1
      For x=1 To largeur-1
         tabl1(x,Y)= Point (x,Y)
      Next x
   Next Y
StopDrawing ()
;*****************************************************



Resultat = InitMouse ()
TempsDepart = ElapsedMilliseconds()
Repeat
   ExamineMouse ()
   Event= WindowEvent ()
   Delay (2)
   angle_degres=angle_degres+5
   If angle_degres>360
      Event= #PB_Event_CloseWindow
      TempsEcoule = ElapsedMilliseconds()-TempsDepart
      break
   EndIf
   rotate_image(#image2,largeur, hauteur,  angle_degres)  ; rotate a Dobro
   
   ; ****** **on affiche l'image ********
   StartDrawing ( ScreenOutput ())
      DrawImage ( ImageID ( #image2 ), 100, 100)
   StopDrawing ()
   ; *******************************
   FlipBuffers ()
   ; affiche l'ecran
   ClearScreen ( RGB (0, 0, 0))
   ;efface l'ecran
   Event= WindowEvent ()
   ;}
   
   If MouseButton (2)
      End
   EndIf
   
Until Event= #PB_Event_CloseWindow
MessageRequester("info","temps="+str(tempsecoule))

Procedure rotate_image(id,x2,y2,degres)
   ; By Dobro
   ; Rotate_image(id ,with,height,degres )
   Structure image
      x.l
      Y.l
   EndStructure
   Dim image.image(1)
   
   ;; codé par Dobro
   ;id = id picture
   ;x2=Width
   ;y2=Height
   ;degres=rotation in degres
   
   x3=x2/2 ; le milieu x de l'image
   y3=y2/2 ; le milieu y de l'image
   StartDrawing ( ImageOutput ( id ) )
      For Y=1 To y2-1
         For x=1 To x2-1
            ; ********* voici la formule de la rotation d'image *********
            image(1)\x= x3+(x-x3) * Cos (degres* #PI /180) +( Y-y3)* Sin (degres* #PI /180)
            image(1)\Y= y3-(x-x3) * Sin (degres* #PI /180) + (Y-y3)* Cos (degres* #PI /180)
            ;*****************************************************
            ; *** on evite que les coordonée sorte du tableau dim ****
            If image(1) \Y <0 : image(1) \Y=0 : EndIf
            If image(1)\Y>y2 : image(1) \Y =y2: EndIf
            If image(1)\x>x2 : image(1)\x=x2: EndIf
            If image(1)\x<0 : image(1)\x=0: EndIf
            ; *****************************************
            Plot (x,Y,tabl1( image(1)\x,image(1)\Y)) ; on dessine l'image rotaté a l'aide du tableau de points : D
         Next x
      Next Y
   StopDrawing ()
EndProcedure

;




; EPB