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.
[pbcode]
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
[/pbcode]
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.
[pbcode]
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
[/pbcode]
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.
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.
[pbcode]
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
// the image buffer.
Psub Fill_Image_Version4(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)
d=GetImageDepth(ThisIMage)
if d=32
RendertoIMage ThisImage
lockbuffer
//
ImagePtr=GetIMagePtr(ThisIMage)
Dim RowPtr as integer pointer
; Manual Pixel Rendering
For ylp=0 to h-1
RowPtr=ImagePtr+(GetImagePitch(ThisIMage)*ylp)
For xlp=0 to w-1
// Store integer value at this location in memory
*RowPtr=Colour
// bump the pointer to the next location in memory
RowPtr=RowPtr+1
next
next
unlockbuffer
endif
; restore existing state on exit
rendertoimage oldsurface
ink oldink
EndPsub
// This Version uses pointers to write directly into
// the image buffer.
Psub Fill_Image_Version5(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)
d=GetImageDepth(ThisIMage)
if d=32
RendertoIMage ThisImage
lockbuffer
//
ImagePtr =GetIMagePtr(ThisIMage)
ImagePitch =GetImagePitch(ThisIMage)
; Manual Pixel Rendering
For ylp=0 to h-1
For Address=IMagePtr to IMagePtr+(w*4)
PokeInt Address,Colour
next
ImagePtr+=ImagePitch
next
unlockbuffer
endif
; restore existing state on exit
rendertoimage oldsurface
ink oldink
EndPsub
// This Version uses fill memory tp blast the data into the
// the image.
Psub Fill_Image_Version6(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)
d=GetImageDepth(ThisIMage)
if d=32
RendertoIMage ThisImage
lockbuffer
//
ImagePtr=GetIMagePtr(ThisIMage)
ImagePitch=GetIMagePitch(ThisIMage)
For ylp=0 to h-1
// Fill this row of pixel memory directly
FillMemory ImagePtr,W,Colour,4
// Bump the Address to the next row
ImagePtr+=ImagePitch
next
unlockbuffer
endif
; restore existing state on exit
rendertoimage oldsurface
ink oldink
EndPsub
[/pbcode]
* A Crash Course In BASIC Program Optimization (http://www.underwaredesign.com/forums/index.php?topic=2548.0)
* PlayBASIC V1.64O supports loading image resources from pack files and bound internally into the exe (http://www.underwaredesign.com/?l=PlayBASIC-V164O-WIP-GALLERY)