Image data file save-load

[XpMe_v1.2]

This has been done by people in many ways.
This is close to the way I coded it with the Brick Layer programs data file.
Use it as is or rewrite it as needed.
reLoading will get slower if you save a huge amount of images to the datafile.

PlayBASIC Code: [Select]

Global DataFile$ = "DataFile.Dat"
`--------------------------------
Global Icount = 0 ` image count
`-------------------------------- you can add images here as you go. And a count will also be kept with it.
`-------------------------------- along with each images width and height.
dim Names$(1)
inc Icount : redim Names$(Icount) : Names$(Icount) = "Trees" + Str$(Icount) + ".png"
inc Icount : redim Names$(Icount) : Names$(Icount) = "Trees" + Str$(Icount) + ".png"
inc Icount : redim Names$(Icount) : Names$(Icount) = "Trees" + Str$(Icount) + ".png"
inc Icount : redim Names$(Icount) : Names$(Icount) = "Trees" + Str$(Icount) + ".png"
inc Icount : redim Names$(Icount) : Names$(Icount) = "Stump.png"
SaveInfo()
`=====================================
Function SaveInfo()
img = NewFXImage(1,1)
`-------
                      fff = GetFreeFile() 
WriteFile DataFile$ , fff
`-------
WriteInt fff,Icount
`-------
for n = 1 to Icount
`-------
LoadFxImage Names$(n), img
             DrawImage img ,0,0, False `solid image
                                                 w =  GetImageWidth(img)
                                                 h = GetImageHeight(img)
                                  WriteInt fff , w 
                                  WriteInt fff , h 
For y = 0 To h : For x = 0 To w : WriteInt fff , Point(x,y) : Next:Next ` writes newfximages dot by dot
`-------
next
CloseFile fff
`-------
DeleteImage img
endFunction
`*======================================*
`*======================================*
`*== The below is the datafile loader ==*
`*======================================*
`*======================================*
Dim IMGs(1)
`-------
LoadInfo()
`------- shows all of the images
Cls RGB(245,251,181)
For n = 1 To Icount : DrawImage IMGs(n),RndRange(11,700),RndRange(11,500), True : Next ` transparent image
Ink RGB(255,5,8)    : Print "" : Print " Image count = " + str$(Icount) ` show image count
`-------
Sync
WaitKey
`=====================================
Function LoadInfo()
                     fff = GetFreeFile() 
ReadFile DataFile$ , fff
`------- gets the count of stored images
           Icount = ReadInt(fff)
`------- redims newfximages array to correct size
ReDim IMGs(Icount)
`------- builds newfximages dot by dot
For n=1 To Icount
                    w = ReadInt(fff)
                    h = ReadInt(fff)
              IMGs(n) = NewFXImage(w,h)
RenderToImage IMGs(n) : LockBuffer : For y = 0 To h : For x = 0 To w :  DotC x,y, ReadInt(fff)  : Next:Next
UnLockBuffer : RenderToScreen
Next
`-------
CloseFile fff
EndFunction

[kevin]

  Here's a bit of a tweaked version, the main conceptual changes are found in reloading routine, but there's a few in the saver routine also.

 In the original loader there's a couple of bottlenecks, the first is that file is being nibbled away at (integer by integer) and the second is that result is being plotted pixel by pixel.   A better solution in terms of speed, is to fetch bigger chunks from the disk in one hit, then render these pixel groups in batches.   We can do this by creating a temp FX buffer that's the width of the image data and only 1 row high.  Next we read the 32bit pixel data directly into the buffer.  This single row fragment is then drawn to the output image.  So rather than us brute force rendering the image pixel by pixel, we're using PlayBASIC's rendering and disc interface to do most of work for us.

 Only briefly tested this on a set of images totaling over 32 meg (on disc) and the reload is able to fetch them in about 350 milliseconds.      The saver could also have much the same treatment, but I didn't bother.  

PlayBASIC Code: [Select]

Global DataFile$ = "C:\DataFile.Dat"
`--------------------------------
Global Icount = 0 ` image count
`-------------------------------- you can add images here as you go. And a count will also be kept with it.
`-------------------------------- along with each images width and height.
dim Names$(1)
inc Icount : redim Names$(Icount) : Names$(Icount) = "C:\SheetMusic1.bmp"
inc Icount : redim Names$(Icount) : Names$(Icount) = "C:\SheetMusic2.bmp"
inc Icount : redim Names$(Icount) : Names$(Icount) = "C:\SheetMusic3.bmp"
inc Icount : redim Names$(Icount) : Names$(Icount) = "C:\SheetMusic4.bmp"
SaveInfo()
`=====================================
Function SaveInfo()
img = NewFXImage(1,1)
`-------
   fff=WriteNewFile(DataFile$)
   `-------
   WriteInt fff,Icount
`-------
   for n = 1 to Icount
   `-------
         LoadFxImage Names$(n), img
;             DrawImage img ,0,0, False `solid image
             w =  GetImageWidth(img)
             h = GetImageHeight(img)
             WriteInt fff , w 
             WriteInt fff , h 
      oldsurface=getsurface()
      rendertoimage img
      For y = 0 To h-1
         lockbuffer
          NullPixel=POint(0,0)
          For x = 0 To w-1
              WriteInt fff , FastPoint(x,y) 
          Next
         unlockbuffer
      Next ` writes newfximages dot by dot
      rendertoimage oldsurface
      
`-------
next
CloseFile fff
`-------
DeleteImage img
endFunction
`*======================================*
`*======================================*
`*== The below is the datafile loader ==*
`*======================================*
`*======================================*
Dim IMGs(1)
`-------
t=timer()
LoadInfo()
LoadTime=timer()-t
`------- shows all of the images
Cls RGB(245,251,181)
For n = 1 To Icount 
    DrawImage IMGs(n),RndRange(11,700),RndRange(11,500), True 
Next ` transparent image
Ink RGB(255,5,8)    
Print "" : Print " Image count = " + str$(Icount) ` show image count
print "LoadTime:"+Str$(LoadTime)+" Milliseconds"
`-------
Sync
WaitKey





Function LoadInfo()
   OldSurface=getSurface()

   fff=ReadNewFile(DataFile$)
`------- gets the count of stored images
           Icount = ReadInt(fff)
   `------- redims newfximages array to correct size
   ReDim IMGs(Icount)


`------- builds newfximages dot by dot
   For n=1 To Icount
          w = ReadInt(fff)
          h = ReadInt(fff)

            // Alloc a bank the size of 1 row of 32bit pixels
            RowWidthInBytes=(W*4)
            TempBank=NewBank(RowWidthInBytes+16)
            
            If TempImage=0
               TempImage=GetFreeIMage()
               ; create a 32bit FX image that's 1 row
               ; of pixels high
               CreateFxImageEx TempIMage,w,1,32 
            endif                        
            
            IMGs(n) = NewFXImage(w,h)
            rendertoimage IMGs(n)            
           For y = 0 To h-1 

               // Read row of pixels into temp image memory directly         
               ReadMemory fff,GetImagePtr(TempIMage),RowWidthInBytes

               // draw this row onto the output image
               drawimage TempIMage,0,y,false

            next

            // Kill the temp buffers
            DeleteImage TempImage
            DeleteBank TempBank
            TempImage=0

      Next
    Rendertoimage OldSurface
 
   `-------
   CloseFile fff
EndFunction

[XpMe_v1.2]

Just now had time to tested your code.
It works for my images and is faster.
I had not tried memory banks before.
I read the new code and what the help screen describes for the
commands and see now how it was done.
I'm behind using memory commands. Will have to look at it more.
I do think that you have(way back) posted an example before.
Will use your way to load image files in any future programs.
thanks.

[kevin]

 yes, there's a number of examples sprinkled throughout the forums/docs that deal with images at a lower level.  In it's simplest form, an image is nothing more than a 2D grid (array if you like) of colour values.  

  Depending upon the depth, determines what kind of colour format/value they are.  15/16 bit depths are 16bit Words,  24 bit images are 3 bytes per colour (1 byte per R,1 byte per Green and 1 Byte per Blue), and 32bit images are 4 bytes per colour (ARGB).   Which is a 32bit Integer.  So we can poke/peek directly into 32bit image buffers as integer directly.  Other formats, we'd have to convert our 32bit colour  value to the format of the image surface.    

  We can actually read/write pixel data directly into images using the GetIMagePtr(), GetImagePitch() and GetImageDepth() functions.  


  GetIMagePtr()  = Returns the address in memory of pixel (0,0) of this surface

  GetImagePitch()  = Return the pitch of the surface.  This is the number of bytes a row of pixels takes.  The pitch width often be aligned to 32/64 bit boundaries by the driver.  So we need to pitch for calculating y coordinate on the surface.

  GetImageDepth() = returns the pixel format of the surface.   15= rgb555,  16=565, 24=888, 32=8888   (numbers are bits per channel)

   
  Using these we can write our own manual drawing routines for our surface.  Bellow are a few progressions of a colour fill routine ( Cls emulation in other words).   The first version is using the  built in commands DotC/FastDot to do the translation work for us.  After that we get into some routines that use pointers to directly write 32bit pixels into the image buffer. All these are pretty slow, since they're brute forcing the process.   The last routine uses the FillMemory function for the job, which is substantial quicker and less work on the VM.  

PlayBASIC Code: [Select]

   OpenScreen 700,700,32,1
   Width      =200
   Height   =100

   // Make an AFX image, these are 32BIT always
   Image=NewImage(Width,Height,8)

   CurrentFunction=1

   // an array to store the total number of times each
   // fill function has been called.  The higher the number
   // the faster the routine
   Dim Tally(100)

   // Max number of milliseconds the test routine should
   // try and fill the buffer
   MaxTime=20

   //-----------------------------------------------
   Do
      Cls 255

      For CurrentFunction=1 to 6

         FunctionName$="Fill_Image_Version"+Str$(CurrentFunction)
         ThisFUnction=FunctionIndex(FUnctionName$)

         // run this test for a fixed time
         Tally(CurrentFunction)+=RunTest(ThisFUnction,Image,MaxTime)

         // Get the total number of time the filler has completed
         RenderCount=Tally(CurrentFunction)
         x=10
         y=10+((CurrentFunction-1)*(Height+5))   
         s$=FunctionName$+" ="+str$(RenderCount)
         Text x,y,s$
         drawimage image,400,y,false

      next
   
      Sync
   loop   
   


Psub RunTest(ThisFUnction,Image,MaxTime)
      colour=rndrgb()
      t=timer()
      EndTime=T+MaxTime
      TotalDraws=0
      repeat
         CallFUnction ThisFunction,IMage,COlour
         TotalDRaws++
      until Timer()>EndTime
EndPsub TotalDRaws
   
   

Psub Fill_Image_Version1(ThisIMage,COlour)
   ; read existing state, so our function doesn't
   ; change anything we might not expect
   oldsurface   =getsurface()
   oldink      =getink()

   ; Get the size of thsi surface
   W=GetImageWidth(ThisIMage)
   h=GetImageHeight(ThisIMage)

   RendertoIMage ThisImage

   ; Manual Pixel Rendering   
   For ylp=0 to h-1
      For xlp=0 to w-1
         Dotc xlp,ylp,colour       
      next
   next      

   ; restore existing state on exit
   rendertoimage oldsurface
   ink oldink
EndPsub



   // This Version Locks the buffers/before each row

Psub Fill_Image_Version2(ThisIMage,COlour)
   ; read existing state, so our function doesn't
   ; change anything we might not expect
   oldsurface   =getsurface()
   oldink      =getink()

   ; Get the size of thsi surface
   W=GetImageWidth(ThisIMage)
   h=GetImageHeight(ThisIMage)

   RendertoIMage ThisImage

   ; Manual Pixel Rendering   
   For ylp=0 to h-1
      lockbuffer
         For xlp=0 to w-1
            Dotc xlp,ylp,colour       
         next
      unlockbuffer
   next      

   ; restore existing state on exit
   rendertoimage oldsurface
   ink oldink
EndPsub




   // This Version using FastDot.
   
Psub Fill_Image_Version3(ThisIMage,COlour)
   ; read existing state, so our function doesn't
   ; change anything we might not expect
   oldsurface   =getsurface()
   oldink      =getink()

   ; Get the size of thsi surface
   W=GetImageWidth(ThisIMage)
   h=GetImageHeight(ThisIMage)

   RendertoIMage ThisImage

   ; read pixel from the surface, this seeds the graphic enghines
   ; internal points for commands fastdot,fast point.

   NullPixel=Point(0,0)
   ; Manual Pixel Rendering   
   For ylp=0 to h-1
      lockbuffer
         For xlp=0 to w-1
            FastDot xlp,ylp,colour       
         next
      unlockbuffer
   next      

   ; restore existing state on exit
   rendertoimage oldsurface
   ink oldink
EndPsub


   // This Version uses pointers to write directly into

Login required to view complete source code

  * A Crash Course In BASIC Program Optimization

  * PlayBASIC V1.64O supports loading image resources from pack files and bound internally into the exe