Recent posts

Pages 1 2 3 4 5 6 7 8 9 10
#91
Purebasic-Code / Purebasic Procedures for Image...
Last post by Theo Gottwald - September 03, 2023, 06:16:05 AM
The Art of Programming with Purebasic and GPT-4: A Tale of Images, Masks, and Computational Elegance

In the realm of programming, one often encounters a plethora of paradigms and languages, each with its own idiosyncrasies and philosophies. Let's consider Purebasic, a language that finds itself at the crossroads of BASIC and C.

Traditionally, in languages like Powerbasic, handling data—be it textual or binary—is a straightforward affair, often managed through strings. However, Purebasic diverges from this simplicity. It employs a C-like string engine, which, alas, is not designed to handle binary data, such as images.

The Conundrum of Binary Data
In Purebasic, one must resort to a more "C-esque" approach: allocating blocks of memory and manipulating them through pointers. This is not a task that a BASIC aficionado would relish, but it's a necessary evil given the language's architecture.

The GPT-4 Revolution
Enter GPT-4, a transformative force in the landscape of programming. This AI marvel can generate complete Purebasic procedure code, handling the intricacies of pointers, memory allocation, and deallocation. It's as if GPT-4 has bestowed upon Purebasic the computational elegance often reserved for languages like C.

The Virtues of Purebasic
Despite its quirks, Purebasic offers rapid compilation—a feature that should not be underestimated. However, it's worth noting that it operates as a one-pass compiler. This necessitates careful ordering of procedures, lest one wishes to delve into the labyrinthine world of extra-declares.

The GPT-4 Advantage
With GPT-4 at your disposal, Purebasic becomes a compelling alternative. It may have its limitations, but it's as fast as C and comes equipped with an extensive library for image manipulation, drawing, and internet access. It's akin to having a "genie in a bottle," ready to grant your programming wishes.

So, dear programmers, let us embrace the synergies between Purebasic and GPT-4, and venture forth into a new era of computational elegance.

Code Select
; --------------------------------------------------------------
; Procedure: GenerateTempFilename
; Description: Generates a unique temporary filename using Windows API.
; Returns: Unique temporary filename or empty string on failure.
; --------------------------------------------------------------
;Declare GetTempFileNameA Lib "kernel32.dll" (lpPathName.s, lpPrefixString.s, uUnique.l, lpTempFileName.s) As Long
;Declare GetTempPathA Lib "kernel32.dll" (nBufferLength.l, lpBuffer.s) As Long
; --------------------------------------------------------------
; --------------------------------------------------------------
; This procedure generates a unique temporary filename.
; It uses the Windows API functions GetTempPathA and GetTempFileNameA to achieve this.
; Returns: Unique temporary filename with path as a string.
; --------------------------------------------------------------
Procedure.s GenerateTempFilename()
  Protected tempBuffer.s = Space(256)
  Protected tempPath.s = Space(256)
  Protected UniqueTempFilePath.s
 
  ; Call the Windows API function to get the temporary file path
  If GetTempPath_(256, @tempPath) = 0
    Set_Error("Failed to get temporary path.")
    ProcedureReturn ""
  EndIf
 
  tempPath = PeekS(@tempPath, StringByteLength(PeekS(@tempPath)), #PB_Ascii)
 
  ; Call the Windows API function to get a unique temporary filename
  If GetTempFileName_(tempPath, "TMP", 0, @tempBuffer) <> 0
    UniqueTempFilePath = PeekS(@tempBuffer, StringByteLength(PeekS(@tempBuffer)), #PB_Ascii)
  Else
    ; Set error message if the API call fails
    Set_Error("Failed to generate a unique temporary filename.")
    UniqueTempFilePath = ""
  EndIf
 
  ; Return the unique temporary filename
  ProcedureReturn UniqueTempFilePath
EndProcedure


; --------------------------------------------------------------
; Function to generate a unique temporary filename with a given extension
;
Procedure.s GenerateUniqueTempFilename(TempFilePath.s, Extension.s)
  Protected UniqueTempFilename.s
  Protected Counter.l = 1
  Protected MaxAttempts = 100000  ; Set a maximum limit for attempts
 
  ; Validate inputs
  If Len(TempFilePath) = 0 Or Len(Extension) = 0
    Set_Error("Invalid input: Either TempFilePath or Extension is empty.")
    ProcedureReturn ""
  EndIf
 
  ; Append the extension to the filename
  UniqueTempFilename = TempFilePath + "." + Extension
 
  ; Check if the file already exists
  While FileSize(UniqueTempFilename) <> -1
    ; Break if maximum attempts reached
    If Counter >= MaxAttempts
      Set_Error("Maximum attempts reached. Could not generate a unique filename.")
      ProcedureReturn ""
    EndIf
   
    ; If the file exists, append a counter to the filename and check again
    UniqueTempFilename = TempFilePath + "_" + Str(Counter) + "." + Extension
    Counter = Counter + 1
  Wend
 
  ; At this point, UniqueTempFilename should be unique
  ProcedureReturn UniqueTempFilename
EndProcedure

; --------------------------------------------------------------
; Sample usage
;tempFile = GetTempFileNameWithExtension("png")
;Debug "Temporary file with .png extension: " + tempFile
;
; Procedure to get a temporary filename with a specific extension using the Windows API
Procedure.s GetTempFileNameWithExtension(Extension.s = "")
  Protected tempBuffer.s = Space(256)
  Protected tempPath.s = Space(256)
  Protected tempFileName.s
 
  ; Get the temp path
  GetTempPath_(256, @tempPath)
  tempPath = PeekS(@tempPath, StringByteLength(PeekS(@tempPath)), #PB_Ascii)
 
  ; Get a temporary file name
  GetTempFileName_(tempPath, "TMP", 0, @tempBuffer)
  tempFileName = PeekS(@tempBuffer, StringByteLength(PeekS(@tempBuffer)), #PB_Ascii)
 
  ; If an extension is provided, rename the file to have that extension
  If Extension <> ""
    tempFileName = GenerateUniqueTempFilename(tempFileName, Extension)
    RenameFile(PeekS(@tempBuffer), tempFileName)
  EndIf
 
  ProcedureReturn tempFileName
EndProcedure
; --------------------------------------------------------------
;----------------------------------------------------------------

; Procedure: GenerateUniqueFilename
; Description: Generates a unique filename based on the given file path.
;              If unable to generate a unique name in the same folder,
;              it uses Windows API to generate a temporary file.
; --------------------------------------------------------------
; Generate a unique filename based on the original file path.
; If unable to do so, it will generate a unique temporary filename.
ProcedureDLL.s GenerateUniqueFilename(OriginalFilePath.s)
  Protected UniqueFilePath.s, FileBase.s, FileExtension.s, Counter.l, Pos.l
  Protected MaxAttempts = 100000
  Protected ErrorMessage.s
  Protected.l Attempt
 
  ; Extract base filename and extension
  FileBase = GetFilePart(OriginalFilePath, #PB_FileSystem_NoExtension)
  FileExtension = ExtractFileExtension(OriginalFilePath)
 
  ; Validate file extension
  If Len(FileExtension) = 0
    ErrorMessage = "Invalid file extension."
    Goto enx
  EndIf
 
  ; Extract counter from FileBase if present
  Pos = FindString(FileBase, "_", -1)
  If Pos > 0
    Counter = Val(Right(FileBase, Len(FileBase) - Pos))
    If Counter > 0
      FileBase = Left(FileBase, Pos - 1)
    Else
      Counter = 1
    EndIf
  Else
    Counter = 1
  EndIf
 
  ; Try to generate a unique filename by appending a counter
  For Attempt = 1 To MaxAttempts
    UniqueFilePath = GetPathPart(OriginalFilePath) + FileBase + "_" + Str(Counter) + "." + FileExtension
    If FileSize(UniqueFilePath) = -1
      ErrorMessage = ""
      Goto enx
    EndIf
    Counter = Counter + 1
  Next Attempt
 
  ; If a unique name could not be generated, use GenerateUniqueTempFilename() to get a temp file
  UniqueFilePath = GenerateUniqueTempFilename(GetTempFileNameWithExtension(FileExtension), FileExtension)
  If Len(UniqueFilePath) = 0
    ErrorMessage = "Failed to generate a unique filename."
  Else
    ErrorMessage = ""
  EndIf
 
  enx:
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    UniqueFilePath = ""
  EndIf
 
  ProcedureReturn UniqueFilePath
EndProcedure
;-------------------------------------------------------------------- 
Procedure.s GetImageDimensions(FilePath.s)
  Protected.l ImageID, Width, Height
  Protected.s Dimensions, ErrorMessage.s
 
  ; Load the image
  ImageID = LoadImage(#PB_Any, FilePath)
 
  ; Check if the image was loaded successfully
  If ImageID = 0
    ErrorMessage = "Failed to load image: " + FilePath
    Goto enx
  EndIf
 
  ; Get the dimensions of the image
  Width  = ImageWidth(ImageID)
  Height = ImageHeight(ImageID)
 
  ; Validate the dimensions
  If Width <= 0 Or Height <= 0
    ErrorMessage = "Invalid image dimensions."
    Goto enx
  EndIf
 
  ; Concatenate the dimensions into a string
  Dimensions = Str(Width) + "x" + Str(Height)
 
  ; Free the loaded image
  FreeImage(ImageID)
 
  enx:
  ; If there is an error message, set the error and return an empty string
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    Dimensions = ""
  EndIf
  SD_Return=Dimensions
  ProcedureReturn Dimensions
EndProcedure

;-------------------------------------------------------------------- 
; Returns Width from String "512x768"
; Returns Width from String "512x768"
Procedure.l GetWidthFromDimensions(Dimensions.s)
  Protected.s WidthString
  Protected.l Width, Pos, i
  Protected Separators.s = "x,;"
  Protected Separator.s
  Protected ErrorMessage.s
 
  ; Trim the input string to remove any leading or trailing spaces
  Dimensions = Trim(Dimensions)
 
  ; Loop through each possible separator
  For i = 1 To Len(Separators)
    Separator = Mid(Separators, i, 1)
    Pos = FindString(Dimensions, Separator, 1)
    If Pos > 0
      Goto FoundSeparator
    EndIf
  Next i
 
  ; If no valid separator is found, set error message
  ErrorMessage = "Invalid dimensions format: " + Dimensions
  Goto enx
 
  FoundSeparator:
  ; Extract the width substring from the dimensions string
  WidthString = Left(Dimensions, Pos - 1)
 
  ; Check if the extracted string is numeric
  If Not IsNumeric(WidthString)
    ErrorMessage = "Invalid width value: " + WidthString
    Goto enx
  EndIf
 
  ; Convert the width substring to a long integer
  Width = Val(WidthString)
 
  ; Validate if the width is a positive number
  If Width <= 0
    ErrorMessage = "Width must be a positive number."
    Goto enx
  EndIf
 
  enx:
  ; If there is an error message, set the error and return 0
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    Width = 0
  EndIf
  ProcedureReturn Width
EndProcedure


;-------------------------------------------------------------------- 
; Returns Height from String "512x768"
Procedure.l GetHeightFromDimensions(Dimensions.s)
  Protected.s HeightString
  Protected.l Height, Pos, i
  Protected Separators.s = "x,;"
  Protected Separator.s
  Protected ErrorMessage.s
 
  ; Trim the input string to remove any leading or trailing spaces
  Dimensions = Trim(Dimensions)
 
  ; Loop through each possible separator
  For i = 1 To Len(Separators)
    Separator = Mid(Separators, i, 1)
    Pos = FindString(Dimensions, Separator, 1)
    If Pos > 0
      Goto FoundSeparator
    EndIf
  Next i
 
  ; If no valid separator is found, set error message
  ErrorMessage = "Invalid dimensions format: " + Dimensions
  Goto enx
 
  FoundSeparator:
  ; Extract the height substring from the dimensions string
  HeightString = Right(Dimensions, Len(Dimensions) - Pos)
 
  ; Check if the extracted string is numeric
  If Not IsNumeric(HeightString)
    ErrorMessage = "Invalid height value: " + HeightString
    Goto enx
  EndIf
 
  ; Convert the height substring to a long integer
  Height = Val(HeightString)
 
  ; Validate if the height is a positive number
  If Height <= 0
    ErrorMessage = "Height must be a positive number."
    Goto enx
  EndIf
 
  enx:
  ; If there is an error message, set the error and return 0
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    Height = 0
  EndIf
 
  ProcedureReturn Height
EndProcedure

;-------------------------------------------------------------------- 
; Checks if the file is already a PNG and, if so, simply returns the file path.
; Otherwise, it loads the image And optionally resizes it If XS And YS are specified.
; It generates a unique filename For the new PNG file.
; It saves the image As a PNG.
; Finally, it frees the image And returns the path To the new PNG file.
;
ProcedureDLL.s EnsurePNGFile(FilePath.s, XS.l = 0, YS.l = 0)
  Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
  Protected.l ImageID, SaveResult, ResizeResult
 
  ; Extract the file extension
  FileExtension = ExtractFileExtension(FilePath)
 
  ; If it's already a PNG, just return the file path
  If LCase(FileExtension) = "png"
    ProcedureReturn FilePath
  EndIf
 
  ; Load the image
  ImageID = LoadImage(#PB_Any, FilePath)
  If ImageID = 0
    ErrorMessage = "Failed to load image: " + FilePath
    Goto enx
  EndIf
 
  ; Optional: Resize the image to a specific resolution if XS and YS are not zero
  If XS <> 0 And YS <> 0
    ResizeResult = ResizeImage(ImageID, XS, YS, #PB_Image_Smooth)
    If ResizeResult = 0
      ErrorMessage = "Failed to resize image."
      Goto enx
    EndIf
  EndIf
 
  ; Generate a unique file name for the temporary PNG file
  TempFileName = GenerateUniqueFilename(FilePath)
  If Len(TempFileName) = 0
    ErrorMessage = "Failed to generate a unique filename."
    Goto enx
  EndIf
 
  ; Construct the temporary file path
  TempFilePath = TempFileName + ".png"
 
  ; Save the image as a PNG
  SaveResult = SaveImage(ImageID, TempFilePath, #PB_ImagePlugin_PNG)
  If SaveResult = 0
    ErrorMessage = "Failed to save temporary PNG file: " + TempFilePath
    Goto enx
  EndIf
 
  ; Free the loaded image
  FreeImage(ImageID)
 
  ; No errors encountered
  ErrorMessage = ""
 
  enx:
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    TempFilePath = ""
  EndIf
  SD_Return=TempFilePath
  ; Single exit point
  ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------

ProcedureDLL.s EnsureFormat(FilePath.s, DesiredFormat.s, XS.l = 0, YS.l = 0)
  Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
  Protected.l ImageID, SaveResult, ResizeResult, ImagePlugin
 
  ; Validate the desired format
  DesiredFormat = LCase(DesiredFormat)
  If DesiredFormat <> "png" And DesiredFormat <> "jpg" And DesiredFormat <> "bmp"
    ErrorMessage = "Invalid desired format specified: " + DesiredFormat
    Goto enx
  EndIf
 
  ; Extract the file extension
  FileExtension = LCase(ExtractFileExtension(FilePath))
 
  ; If it's already in the desired format, just return the file path
  If FileExtension = DesiredFormat
    ProcedureReturn FilePath
  EndIf
 
  ; Load the image
  ImageID = LoadImage(#PB_Any, FilePath)
  If ImageID = 0
    ErrorMessage = "Failed to load image: " + FilePath
    Goto enx
  EndIf
 
  ; Optional: Resize the image to a specific resolution if XS and YS are not zero
  If XS <> 0 And YS <> 0
    ResizeResult = ResizeImage(ImageID, XS, YS, #PB_Image_Smooth)
    If ResizeResult = 0
      ErrorMessage = "Failed to resize image."
      Goto enx
    EndIf
  EndIf
 
  ; Generate a unique file name for the temporary file in the desired format
  TempFileName = GenerateUniqueFilename(FilePath)
  If Len(TempFileName) = 0
    ErrorMessage = "Failed to generate a unique filename."
    Goto enx
  EndIf
 
  ; Map the desired format to the corresponding image plugin constant
  ImagePlugin = DetermineImagePlugin(DesiredFormat)
 
  ; Construct the temporary file path
  TempFilePath = TempFileName + "." + DesiredFormat
 
  ; Save the image in the desired format
  SaveResult = SaveImage(ImageID, TempFilePath, ImagePlugin)
  If SaveResult = 0
    ErrorMessage = "Failed to save temporary " + DesiredFormat + " file: " + TempFilePath
    Goto enx
  EndIf
 
  ; Free the loaded image
  FreeImage(ImageID)
 
  ; No errors encountered
  ErrorMessage = ""
 
  enx:
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    TempFilePath = ""
  EndIf
  SD_Return=TempFilePath
  ; Single exit point
  ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------
; Enshures that the Image Dimensions from the returned Temp-Image-File  are equal to those in Filepath.s
; U01 - Mask Image to resize eventually
; U02 - Original Image to get DImensions from
; This Variant will bot return an image path if the Reference Image is invalid
;
ProcedureDLL.s EnsureEqualDimensionIfpossible(FilePath.s, ReferenceFilePath.s)
  Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
  Protected.s RefDimensions, Dimensions
  Protected.l ImageID, SaveResult, ResizeResult
  Protected.l RefXS, RefYS, XS, YS
 
  ; Validate the input file paths
  If FileSize(FilePath) = -1 Or FileSize(ReferenceFilePath) = -1
    ErrorMessage = "One or both of the provided file paths are invalid or do not exist."
    Goto enx
  EndIf
 
  ; Extract the file extension
  FileExtension = ExtractFileExtension(FilePath)
 
  ; If it's already a PNG, just return the file path
  If LCase(FileExtension) = "png"
    ErrorMessage = ""
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  ; Load the image
  ImageID = LoadImage(#PB_Any, FilePath)
  If ImageID = 0
    ErrorMessage = "Failed to load image: " + FilePath
    Goto enx
  EndIf
 
  ; Get dimensions of the reference image
  RefDimensions = GetImageDimensions(ReferenceFilePath)
  If Len(RefDimensions) = 0
    ErrorMessage = "Failed to get dimensions of the reference image."
    Goto enx
  EndIf
 
  RefXS = GetWidthFromDimensions(RefDimensions)
  RefYS = GetHeightFromDimensions(RefDimensions)
 
  ; Validate the extracted dimensions
  If RefXS = 0 Or RefYS = 0
    ErrorMessage = "Invalid dimensions in the reference image."
    Goto enx
  EndIf
 
  ; Get dimensions of the current image
  Dimensions = GetImageDimensions(FilePath)
  If Len(Dimensions) = 0
    ErrorMessage = "Failed to get dimensions of the target image."
    Goto enx
  EndIf
 
  XS = GetWidthFromDimensions(Dimensions)
  YS = GetHeightFromDimensions(Dimensions)
 
  ; Validate the extracted dimensions
  If XS = 0 Or YS = 0
    ErrorMessage = "Invalid dimensions in the target image."
    Goto enx
  EndIf
 
  ; Optional: Resize the image to match the reference dimensions if they differ
  If XS <> RefXS Or YS <> RefYS
    ResizeResult = ResizeImage(ImageID, RefXS, RefYS, #PB_Image_Smooth)
    If ResizeResult = 0
      ErrorMessage = "Failed to resize image."
      Goto enx
    EndIf
  EndIf
 
  ; Generate a unique file name for the temporary PNG file
  TempFileName = GenerateUniqueFilename(FilePath)
  If Len(TempFileName) = 0
    ErrorMessage = "Failed to generate a unique filename."
    Goto enx
  EndIf
 
  ; Construct the temporary file path
  TempFilePath = TempFileName + ".png"
 
  ; Save the image as a PNG
  SaveResult = SaveImage(ImageID, TempFilePath, #PB_ImagePlugin_PNG)
  If SaveResult = 0
    ErrorMessage = "Failed to save temporary PNG file: " + TempFilePath
    Goto enx
  EndIf
 
  ; Free the loaded image
  FreeImage(ImageID)
 
  ; No errors encountered
  ErrorMessage = ""
 
  enx:
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    TempFilePath = ""
  EndIf
 
  ; Single exit point
  SD_Return=TempFilePath
  ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------
; U01 - Imagepath to return or generate an temp-Image with the proper size
; U02 - Reference Image, if its invalid we will return the original Path
;
ProcedureDLL.s EnsureEqualDimension(FilePath.s, ReferenceFilePath.s)
  Protected.s FileExtension, TempFileName, TempFilePath, ErrorMessage
  Protected.s RefDimensions, Dimensions
  Protected.l ImageID, SaveResult, ResizeResult
  Protected.l RefXS, RefYS, XS, YS
 
  ; Validate the input file paths
  If FileSize(FilePath) = -1 Or FileSize(ReferenceFilePath) = -1
    ErrorMessage = "One or both of the provided file paths are invalid or do not exist."
    Goto enx
  EndIf
 
  ; Extract the file extension
  FileExtension = ExtractFileExtension(FilePath)
 
  ; If it's already a PNG, just return the file path
  If LCase(FileExtension) = "png"
    ErrorMessage = ""
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  ; Load the image
  ImageID = LoadImage(#PB_Any, FilePath)
  If ImageID = 0
    ErrorMessage = "Failed to load image: " + FilePath
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  ; Get dimensions of the reference image
  RefDimensions = GetImageDimensions(ReferenceFilePath)
  If Len(RefDimensions) = 0
    ErrorMessage = "Failed to get dimensions of the reference image."
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  RefXS = GetWidthFromDimensions(RefDimensions)
  RefYS = GetHeightFromDimensions(RefDimensions)
 
  ; Validate the extracted dimensions
  If RefXS = 0 Or RefYS = 0
    ErrorMessage = "Invalid dimensions in the reference image."
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  ; Get dimensions of the current image
  Dimensions = GetImageDimensions(FilePath)
  If Len(Dimensions) = 0
    ErrorMessage = "Failed to get dimensions of the target image."
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  XS = GetWidthFromDimensions(Dimensions)
  YS = GetHeightFromDimensions(Dimensions)
 
  ; Validate the extracted dimensions
  If XS = 0 Or YS = 0
    ErrorMessage = "Invalid dimensions in the target image."
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  ; Optional: Resize the image to match the reference dimensions if they differ
  If XS <> RefXS Or YS <> RefYS
    ResizeResult = ResizeImage(ImageID, RefXS, RefYS, #PB_Image_Smooth)
    If ResizeResult = 0
      ErrorMessage = "Failed to resize image."
      TempFilePath = FilePath
      Goto enx
    EndIf
  EndIf
 
  ; Generate a unique file name for the temporary PNG file
  TempFileName = GenerateUniqueFilename(FilePath)
  If Len(TempFileName) = 0
    ErrorMessage = "Failed to generate a unique filename."
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  ; Construct the temporary file path
  TempFilePath = TempFileName + ".png"
 
  ; Save the image as a PNG
  SaveResult = SaveImage(ImageID, TempFilePath, #PB_ImagePlugin_PNG)
  If SaveResult = 0
    ErrorMessage = "Failed to save temporary PNG file: " + TempFilePath
    TempFilePath = FilePath
    Goto enx
  EndIf
 
  ; Free the loaded image
  FreeImage(ImageID)
 
  ; No errors encountered
  ErrorMessage = ""
 
  enx:
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
  EndIf
 
  ; Single exit point
  SD_Return=TempFilePath
  ProcedureReturn TempFilePath
EndProcedure
;--------------------------------------------------------------------
  Procedure.b IsBitSet(bit, value)
    Protected T01.l,T02.b
    T01=(value & (1 << bit))
    If T01<>0
      T02=1
    Else
      T02=0
    EndIf
  ProcedureReturn T02
EndProcedure
;--------------------------------------------------------------------
;######################################################################
;
;######################################################################
; Fill an image with a given color
; &HFFFFFFFF, where the first pair of "FF" bytes represents the alpha
; if you want a fully transparent image, you could set the color code to &H00FFFFFF.
;
; Fill an image with a given color
; Procedure to fill an image with a specific color
; Parameters:
;   ImageID: Image ID of the image to be filled
;   ColorCode: Color code in RGB or RGBA format
Procedure FillImageWithColor(ImageID.l, ColorCode.l)
    Protected Width, Height, y
   
    ; Get the dimensions of the image
    Width = ImageWidth(ImageID)
    Height = ImageHeight(ImageID)
   
    ; Start drawing to the image
    StartDrawing(ImageOutput(ImageID))
   
    ; Loop through each y-coordinate and draw a line from x=0 to x=Width
    For y = 0 To Height - 1
        LineXY(0, y, Width - 1, y, ColorCode)
    Next y
   
    ; Stop drawing to the image
    StopDrawing()
EndProcedure
;--------------------------------------------------------------------
; Place one image onto another based on a position code
; ----------------------------------------------------------------------------
; Procedure PlaceImageOnImage
; Description: This procedure places one image (SrcImageID) onto another (DestImageID)
; based on a position code (e.g., "LC" - Left Center).
; If the source image is larger than the destination, it will be cut to fit.
; ----------------------------------------------------------------------------
; This will not work if the Mask is larger then the Destination Image
Procedure PlaceMaskImageOnImage(DestImageID.l, SrcImageID.l, Position.s)
    Protected.l DestWidth, DestHeight, SrcWidth, SrcHeight
    Protected.l X, Y
    Protected.s ErrorMessage
   
    ; Validate Image IDs
    If ImageWidth(DestImageID) = 0 Or ImageHeight(DestImageID) = 0
        ErrorMessage = "Invalid Destination Image ID"
        Goto enx
    EndIf
   
    If ImageWidth(SrcImageID) = 0 Or ImageHeight(SrcImageID) = 0
        ErrorMessage = "Invalid Source Image ID"
        Goto enx
    EndIf
   
    ; Validate Position Parameter
    If Len(Position) <> 2
        ErrorMessage = "Invalid Position Parameter"
        Goto enx
    EndIf
   
    ; Get dimensions of both images
    DestWidth = ImageWidth(DestImageID)
    DestHeight = ImageHeight(DestImageID)
    SrcWidth = ImageWidth(SrcImageID)
    SrcHeight = ImageHeight(SrcImageID)
   
    ; Determine X coordinate based on Position
    Select Left(Position, 1)
        Case "L"
            X = 0
        Case "R"
            X = DestWidth - SrcWidth
        Case "C"
            X = (DestWidth - SrcWidth) / 2
    EndSelect
   
    ; Determine Y coordinate based on Position
    Select Right(Position, 1)
        Case "U"
            Y = 0
        Case "D"
            Y = DestHeight - SrcHeight
        Case "C"
            Y = (DestHeight - SrcHeight) / 2
    EndSelect
   
    ; Check for Dimension Compatibility
    If X < 0 Or Y < 0 Or (X + SrcWidth) > DestWidth Or (Y + SrcHeight) > DestHeight
        ErrorMessage = "Source Image Does Not Fit Into Destination Image"
        Goto enx
    EndIf
   
    ; Place SrcImageID onto DestImageID at (X, Y)
    StartDrawing(ImageOutput(DestImageID))
      DrawImage(SrcImageID, X, Y)
    StopDrawing()
   
    ; No errors encountered
    ErrorMessage = ""
   
    enx:
    If Len(ErrorMessage) > 0
        Set_Error(ErrorMessage)
    EndIf
EndProcedure

;--------------------------------------------------------------------
; Procedure to paste one image onto another at specific coordinates
; Procedure to paste one image onto another at specific coordinates
Procedure PasteImage(SrcImageID.l, DestImageID.l, X.l, Y.l)
  ; Start drawing to the destination image
  StartDrawing(ImageOutput(DestImageID))
 
  ; Draw the source image onto the destination image
  DrawImage(SrcImageID, X, Y)
 
  ; Stop drawing to the image
  StopDrawing()
 
EndProcedure

;--------------------------------------------------------------------
; Procedure to place one image onto another based on a position code
; Parameters:
;   DestImageID: Image ID of the destination image
;   SrcImageID: Image ID of the source (mask) image
;   Position: 2-letter code representing the position (e.g., 'LC' for Left-Center)
Procedure PlaceImageOnImage(DestImageID.l, SrcImageID.l, Position.s)
    Protected.l DestWidth, DestHeight, SrcWidth, SrcHeight
    Protected.l X, Y, CutX, CutY, NewSrcImageID
    Protected.s ErrorMessage
   
    ; Get the dimensions of both images
    DestWidth = ImageWidth(DestImageID)
    DestHeight = ImageHeight(DestImageID)
    SrcWidth = ImageWidth(SrcImageID)
    SrcHeight = ImageHeight(SrcImageID)
   
    ; Initial coordinates to start pasting the source image
    X = 0
    Y = 0
   
    ; Determine if the source image needs to be cut to fit into the destination image
    If SrcWidth > DestWidth Or SrcHeight > DestHeight
        ; Calculate how much to cut from the source image
        CutX = SrcWidth - DestWidth
        CutY = SrcHeight - DestHeight
       
        ; Crop the source image accordingly
        ; Create a new cropped image from the source image based on the destination dimensions
        NewSrcImageID = GrabImage(SrcImageID, #PB_Any, 0, 0, DestWidth, DestHeight)
 
       
        ; Replace the original SrcImageID with the cropped one
        FreeImage(SrcImageID)
        SrcImageID = NewSrcImageID
    EndIf
   
    ; Calculate X, Y based on Position (L=Left, R=Right, C=Center, U=Up, D=Down)
    If Left(Position, 1) = "L"
        X = 0
    ElseIf Left(Position, 1) = "R"
        X = DestWidth - SrcWidth
    ElseIf Left(Position, 1) = "C"
        X = (DestWidth - SrcWidth) / 2
    EndIf
   
    If Right(Position, 1) = "U"
        Y = 0
    ElseIf Right(Position, 1) = "D"
        Y = DestHeight - SrcHeight
    ElseIf Right(Position, 1) = "C"
        Y = (DestHeight - SrcHeight) / 2
    EndIf
   
    ; Paste SrcImageID onto DestImageID at (X, Y)
    PasteImage(SrcImageID, DestImageID, X, Y)
   
    ; No errors encountered
    ErrorMessage = ""
   
    enx:
    If Len(ErrorMessage) > 0
        Set_Error(ErrorMessage)
    EndIf
EndProcedure

;--------------------------------------------------------------------
; Save an image to a file
; Parameters:
;   ImageID: The ID of the image to save
;   FilePath: The path where to save the image
; Returns:
;   1 if the image was saved successfully, 0 otherwise
Procedure.l SaveImageToFile(ImageID.l, FilePath.s)
  Protected.l Result, SaveStatus
  Protected.s FileExtension, ErrorMessage
  Protected.l ImagePlugin

  ; Extract the file extension from the FilePath
  FileExtension = ExtractFileExtension(FilePath)

  ; Determine the image plugin to use based on the file extension
  ImagePlugin = DetermineImagePlugin(FileExtension)

  ; Check if an unsupported extension is provided
  If ImagePlugin = 0
    ErrorMessage = "Unsupported file extension: " + FileExtension
    Goto enx
  EndIf
 
  ; Save the image using the appropriate plugin
  SaveStatus = SaveImage(ImageID, FilePath, ImagePlugin)

  ; Check if the image was saved successfully
  If SaveStatus = 0
    ErrorMessage = "Failed to save image to: " + FilePath
    Goto enx
  EndIf
 
  ; Image was saved successfully
  Result = 1
 
  enx:
  If Len(ErrorMessage) > 0
    Set_Error(ErrorMessage)
    Result = 0
  EndIf
 
  ; Single exit point
  ProcedureReturn Result
EndProcedure


;--------------------------------------------------------------------
; Main Procedure
; Procedure to ensure that the dimensions of the mask image match those of the original image
Procedure.s EnsureMaskDimensions(OriginalImageFilePath.s, MaskImageFilePath.s, BorderColor.s, Position.s)
    Protected.s ErrorMessage
    Protected.l OriginalImageID, MaskImageID, NewMaskImageID
    Protected.l OriginalWidth, OriginalHeight, MaskWidth, MaskHeight
    Protected.l ColorCode
    Protected.s NewMaskFilePath
 
    ; Load the original image
    OriginalImageID = LoadImage(#PB_Any, OriginalImageFilePath)
    If OriginalImageID = 0
        ErrorMessage = "Failed to load original image: " + OriginalImageFilePath
        Goto enx
    EndIf
   
    ; Get dimensions of the original image
    OriginalWidth  = ImageWidth(OriginalImageID)
    OriginalHeight = ImageHeight(OriginalImageID)
   
    ; Load the mask image
    MaskImageID = LoadImage(#PB_Any, MaskImageFilePath)
    If MaskImageID = 0
        ErrorMessage = "Failed to load mask image: " + MaskImageFilePath
        Goto enx
    EndIf
   
    ; Get dimensions of the mask image
    MaskWidth  = ImageWidth(MaskImageID)
    MaskHeight = ImageHeight(MaskImageID)
   
    ; Check color format
    If Left(BorderColor, 2) = "&H"
        ColorCode = Val(Mid(BorderColor, 3))
    Else
        ColorCode = Val(BorderColor)
    EndIf
   
    ; Create new mask image with dimensions of the original image
    NewMaskImageID = CreateImage(#PB_Any, OriginalWidth, OriginalHeight)
    If NewMaskImageID = 0
        ErrorMessage = "Failed to create new mask image."
        Goto enx
    EndIf
   
    ; Fill new mask image with BorderColor
    FillImageWithColor(NewMaskImageID, ColorCode)
   
    ; Place the original mask image on the new mask based on the 'Position' parameter
    PlaceImageOnImage(NewMaskImageID, MaskImageID, Position)
   
    ; Generate a save file path for the new mask image
    NewMaskFilePath = GetTempFileNameWithExtension("png")
   
    ; Save the new mask image
    SaveImage(NewMaskImageID, NewMaskFilePath, #PB_ImagePlugin_PNG)
   
    ; Free loaded images
    FreeImage(OriginalImageID)
    FreeImage(MaskImageID)
    FreeImage(NewMaskImageID)
   
    ; No errors encountered
    ErrorMessage = ""
 
    enx:
    If Len(ErrorMessage) > 0
        Set_Error(ErrorMessage)
        NewMaskFilePath = ""
    EndIf
   
    ; Single exit point
    ProcedureReturn NewMaskFilePath
EndProcedure

;######################################################################
;
;######################################################################
#92
General Discussion / Syntropic Agriculture / Food F...
Last post by Charles Pegge - September 02, 2023, 11:24:30 AM
Incredible 1.5-Acre Permaculture / Syntropic Food Forest with Over 250 Plant Species
Happen Films
23 april 2021


-->

A Literal Oasis - Syntropic Agroforestry @ Lightning Ridge, NSW, Australia
Curiosity Mine
6 feb 2023
https://www.youtube.com/watch?v=llazeATdn7s

-->

Syntropic Agroforestry: 14 Months old System - Tour & Management - temperate climate (Europe)
Frieder Krug
9 july 2023
https://www.youtube.com/watch?v=ihSsnoEqIcU&t=402s

-->

The Foundations of Syntropic Agroforestry
PermaDynamics New Zealand
4 jan 2022
https://www.youtube.com/watch?v=_W7YYTyNnWc

-->
From a Dry Field to a Lush Food Forest in 18 Months
R.A.S
9 december 2022
https://www.youtube.com/watch?v=icJx01VuV6I
-->

Top 7 mistakes I've made in making my permaculture food forest.
Canadian Permaculture Legacy
4 sept 2021
https://www.youtube.com/watch?v=LaNbU3dEiRg

#93
General Discussion / 5 Most Epic Earth Healing Proj...
Last post by Charles Pegge - September 01, 2023, 10:38:17 AM

Andrew Millison
28 jan 2022

#94
Contentious discussions about anything, the world, politics and health topics. / Heart Health Tips DEBUNKED: He...
Last post by Charles Pegge - August 31, 2023, 09:58:31 PM
Heart Health Tips DEBUNKED: The TRUTH About Common Hearth-Healthy Foods & Myths | Dr. Steven Gundry

The Dr. Gundry Podcast

#95
Contentious discussions about anything, the world, politics and health topics. / Re: Who believes conspiracies ...
Last post by Zlatko Vid - August 30, 2023, 01:27:27 PM
well ...there is no real proof about any form of life
in our galaxy...yet...of course we can see just very tiny part.
right?
imagine distances ...if whole world is our galaxy we are microbe.
ouch  :D 
#96
Contentious discussions about anything, the world, politics and health topics. / Who believes conspiracies and ...
Last post by Charles Pegge - August 30, 2023, 11:22:24 AM
A visit to the Skeptic-In-Chief  :)

Scourge of mediums and UFologists alike. Actually, he is quite reasonable, and has a good sense of humour, a necessity in the light of recent revelations.

Who believes conspiracies and why? | Michael Shermer

The Institute of Art and Ideas
22 august 2023


-->

Why We Get Fooled

Skeptic
31 july 2023

#97
Contentious discussions about anything, the world, politics and health topics. / Re: Comparing life in the USA ...
Last post by José Roca - August 30, 2023, 01:59:44 AM
It's a Way of Life: Comparing American and Mediterranean Lifestyles

Americans are true go-getters who often work tirelessly – and often way too much – to achieve their goals. We're constantly on the run, juggling our too-full schedules, and we're miserable because of it. Food is seen as edible fuel to cram quickly into our temperamental tanks, unsavored and unsung. If we're not running through the drive-thru to pick up a fast food order of burgers and fries to end our day, we're eating alone, distracted by our smartphones or the latest television shows. We are more often than not disconnected from our family and friends, racing off toward the next greatest thing and worrying about the future. Unfortunately, this way of living hasn't just robbed us of joy – it's also the epicenter of the health crisis that is plaguing us such as obesity, heart disease, diabetes, hypertension, anxiety, and depression, to name a few.

On the other hand, the Mediterranean people regularly prioritize healthy food and spending time with loved ones. Eating isn't deemed a necessary evil – it's seen as a true sanctuary that shields them from the chaos of daily life: a cherished time to unwind, connect with others, and enjoy the present. They lunch leisurely, almost always in the company of others, and savor every bite that passes through their lips. Life may be busy for these people, but they always make time for relaxed meals. They are also very active people; they often follow up their lunches and dinners with a stroll around the neighborhood with their families or friends, drinking in the beauty of the world around them. It's no wonder that the Mediterranean people are among the happiest, healthiest, and longest living people on the planet.

https://www.jspitaria.us/s/stories/the-american-diet-vs-the-mediterranean-diet-which-wins
#98
Contentious discussions about anything, the world, politics and health topics. / Re: Comparing life in the USA ...
Last post by Charles Pegge - August 29, 2023, 04:58:37 PM
I'm keeping an open mind, but I think there is at least a nutrition/agri-industry problem across the States:

Europe BANNED these American foods. Here's why
Evan Edinger
29 june 2023


-->

America BANNED these European foods. Here's Why
Evan Edinger
19 february 2023

#99
Contentious discussions about anything, the world, politics and health topics. / Re: Comparing life in the USA ...
Last post by Zlatko Vid - August 28, 2023, 08:59:41 PM
and Charles ..what is your conclusion?
 i watched some of this videos and get it that here in Europe is better.
#100
Contentious discussions about anything, the world, politics and health topics. / Comparing life in the USA and ...
Last post by Charles Pegge - August 28, 2023, 03:13:20 PM
How I see the US after living in Europe for 5 years
David Wen
19 february 2023


-->

Is Life Better in the USA or Europe? (An Honest Review)
Nathaniel Drew
28 april 2023


-->

How I see the US after living in Europe for 2 Years
Dave in Portugal
22 august 2023

Pages 1 2 3 4 5 6 7 8 9 10