Generate bmp file in JB

[honkytonk]

Hello, good morning,
Do you happen to have something in your jewelry box to generate the bytes of a BMP and put them in a file?
If so, please make it shine right here
Thank you for.

[Rod]

Well the simplest way is to getbmp, bmpsave. Why does it need to be more complex than that. What exceptional thing are you doing. It is perfectly possible to write a .bmp header and bmp color data but it is enormously complex to do so compared with getbmp, savebmp. So why?

[honkytonk]

Nov 27, 2020 20:31:20 GMT Rod said:

Well the simplest way is to getbmp, bmpsave. Why does it need to be more complex than that. What exceptional thing are you doing. It is perfectly possible to write a .bmp header and bmp color data but it is enormously complex to do so compared with getbmp, savebmp. So why?

To use getbmp, the image must be displayed, to save the modified image, it must be re-displayed
Which pixel by pixel is very long: +/- 3h30 for 850 x 500; while processing bytes: +/- 350 ms.
In fact, I want to remove the grid from this thing before saving the bmp (the interface is in French but there is an English doc in the folder)
It's worked for fun, of course.It's here-->:  libertybasic.fr/forum/topic-595+organigramme.php

[Enzo]

I think you want to look at wiki for 16-bit bmp file types if I remember correctly (its been years) theres a header info and then the bmp data colors are listed in hex values, a generic closer info

[Rod]

Ok, here is how I would tackle it. However John has done lots of stuff like this, browse his page too and be sure to understand everything Anatoly has posted because he likes the technique as well.

The file format is complex but at the end of the day the picture info is not. So the trick is to leave the file header alone and just tweak the color data. So the restriction is that you must stay the same size as the original image and you must use the original color format.

Color format can be anything from one bit to 32 bits per pixel. Usually 24 bit color but it is held as a four byte quad with unused alpha channel info.

We can get the width, height and color format from analysing the header, we dont need to change the header info we just amend the color quads in the string then write the whole string back to file. Then we can load and display it as a normal .bmp

Here is some untested rough code that will get you started, you will need to experiment to understand. The quad is held on file as Alpha,Blue Green Red. Liberty of course needs Red Green Blue so you will be slicing the quad data but its all just simple string manipulation.

The only little complexity is that for some .bmps there will be padding bytes added to keep the raster line ending on a 32bit boundary. Not going to explain it here but the code handles it.


[loadbmp]
       filedialog "Choose an image","*.bmp",file$
       if file$<>"" then
           loadbmp "pic",file$
           open file$ for input as #bmp

           'get the file into a string
           bmp$ = Input$(#bmp,lof(#bmp))

           'analyse the file header
           bmpw=value(mid$(bmp$,19,4)) 'width
           bmph=value(mid$(bmp$,23,4)) 'height
           b=value(mid$(bmp$,29,2))    'bits per pixel, ie color depth
           o=value(mid$(bmp$,11,4))    'picture data offset, where the color data starts
           close #bmp
       end if


       'work out start of picture data and how to move through file
       o=o+1
       'work out how many bytes to step through the string 8=1 24=3 32=4
       st=b/8
       'work out padding each raster line must be a 4byte multiple
       mult=b/8*bmpw/4
       padding = 4*(1-(mult-int(mult))) mod 4

       for y=bmph-1 to 0 step -1
           for x=0 to bmpw-1
               'run through bmp
               if b=8 then
                   'color stored in pallet index at start of file
                   'pallet starts at 54 in steps of four ABGR A=alpha
                   pi=asc(mid$(bmp$,o,1))*4+54
               else
                   'color stored as BGR Liberty needs RGB
               end if
           o=o+st
           next
       o=o+padding
       next

   wait





So this will read a .bmp file and let you move about x,y and you could change the quad info to whatever you want. Once finnished just write it all back to a file remembering the ; at the end to stop Liberty adding CRLF.

[Rod]

Sorry forgot the value function.

function value(x$)
   select case len(x$)
       case 1
       value = asc(x$)
       case 2
       value=asc(mid$(x$,1,1))
       value=value+(asc(mid$(x$,2,1))*256)
       case 3
       value=asc(mid$(x$,1,1))
       value=value+(asc(mid$(x$,2,1))*256)
       value=value+(asc(mid$(x$,3,1))*65536)
       case 4
       value=asc(mid$(x$,1,1))
       value=value+(asc(mid$(x$,2,1))*256)
       value=value+(asc(mid$(x$,3,1))*65536)
       value=value+(asc(mid$(x$,4,1))*16777216)
   end select
end function





[tenochtitlanuk]

As Rod says.. why do you need this complexity?

The only SIMPLE colour BMP is 24 bit, which has a 54 byte header and then just triplets of pixel data.

The header and data are as shown. This is a 24-bit 500x500 BMP.



Three blocks need changing to suit your chosen dimensions. The four bytes in each are lo-->hi bytes of the hex number.
So bytes E6 71 0B 00 is the hex number 000B71E6 which is decimal 750054.
and 36 00 00 00 is hex 00000036, ie decimal 54- how far into the file the pixel triads start.

CAUTION- make width a multiple of four, or it will fail. ( see Wikipedia- "The bits representing the bitmap pixels are packed in rows. The size of each row is rounded up to a multiple of 4 bytes by padding."

To create a programmatic bmp file therefore you..
Decide width and height and work out the four-byte low/high representation.
Multiply to get pixel count and similarly work out the four bytes,
Put together a preamble string of 54 bytes with these values replacing those shown above.
Calculate and add all pixel data. ( *)
Save!

( *) You have several alternatives. My ppm methods for example... the ppm header is even simpler!
eg Make three 500x500 arrays R( 500, 500), G( 500, 500), B( 500, 500).
Use routines to set R G and B values of an image coordinate ( x, y) in these rather than 'set' or 'draw' to a graphic window.

[tsh73]

honkytonk,
I happen to find old code that writes 256-color (paletted) bitmap.
I'm not sure it will fit you but it's already written.

'Writing 256 color BMP (that is, paletted)
'by tsh73, October 2007
'of several sources
'nomainwin

'/* bmp write stuff
global BMP.width, BMP.height
'ALL ARRAYS USED FROM 0
dim BMPpalette$(256)   'colors as text, like "255 100 23" - useful from JB
dim BMPdata(0,0)       'to be REDIM'med
'*/ bmp write stuff

dim info$(10, 10)

'test data
BMP.width = 100 'different if divided/not divided by 4
BMP.height = 256
redim BMPdata(BMP.width,BMP.height)

'Making some palette    'R G B
t0 = time$("ms")
for i = 0 to 255
   'gray one
   BMPpalette$(i) = i;" ";i;" ";i
next
t1 = time$("ms")
print "Palette, ms ", t1-t0

'making some data
for x = 0 to BMP.width-1
   for y = 0 to BMP.height-1
       BMPdata(x,y) = y mod 256 'fix Nov 28 2020 for bigger heights
   next
next
t2 = time$("ms")
print "Array, ms ", t2-t1

OutFile$ = "test1.bmp"
'make sure file not extst
if fileExists(DefaultDir$, OutFile$) then
   kill OutFile$
end if

t2 = time$("ms")
'call functions
call writeFromArray OutFile$
t3 = time$("ms")
print "writeFromArray, ms ", t3-t2

print "Over!"
end

'------------------------------------------------------'
'Functions:
function createHeader$()
   'create string with header
   createHeader$ = ""
end function

function pal2binPal$()
   'BMPpalette$() -> palette$ string
   pal2binPal$ = ""
   for i = 0 to 256
    pal2binPal$ = pal2binPal$ _
       + chr$(val(word$(BMPpalette$(i),3))) _
       + chr$(val(word$(BMPpalette$(i),2))) _
       + chr$(val(word$(BMPpalette$(i),1))) _
       + chr$(0)
   next
end function

function data2Raw$()
   'BMPdata() -> raw$ string
   data2Raw$ = ""
end function

sub writeFromArray fname$
   BMPheader$ = createHeader$()
   palette$ = pal2binPal$()
   'write stuff
   'filler pads to dividable by 4 bytes
   fillLen = iif(BMP.width mod 4, 4 - BMP.width mod 4, 0)
   filler$=left$(chr$(0)+chr$(0)+chr$(0), fillLen)
   open fname$ for binary as #BMPout
       print #BMPout, BMPheader$
       print #BMPout, palette$
       for y = BMP.height-1 to 0 step -1
           'create line
           aLine$=""
           for x = 0 to BMP.width-1
               aLine$=aLine$+chr$(BMPdata(x,y))
           next
           'add filler
           aLine$=aLine$+filler$
           'write line
           print #BMPout, aLine$
       next
   close #BMPout
end sub

sub writeFromRaw fname$
end sub

'------------------------------------------------------'

   UpperLeftX = 1
   UpperLeftY = 1
   'for bitmap width be better dividable by 4
   WindowWidth = 320
   WindowHeight = 200
'    WindowWidth = 640
'    WindowHeight = 480
'    WindowWidth = 512
'    WindowHeight = 512

'increase window size so we get our requested size
print "Adjusting window for borders..."
'   call adjustWindowSize WindowWidth, WindowHeight
  print WindowWidth, WindowHeight

  open "plasma" for graphics_nsb_nf as #gr
'   open "plasma" for graphics_nsb_fs as #gr
  #gr, "trapclose quit"
  #gr, "home ; down ; posxy x y"
  width = 2*x : height = 2*y
  print  width, height

d = 2 'rect size    'but 3 is too rought it seems - ??
Maxx =  int(width/d)
Max.y = int(height/d)      'array size - from screen size
Max.color = 255  'number of colors to use
rough = 2       'how "rough" you want the plasma to be. It can be jsut too plain for small values - so we'll get no much oscillation...
min.size = 2    'pixel size, kind of?
'min.size = 10   'nice enough - but much faster (I think about full screen...)
'Time taken: 43906 for full screen and min.size = 10. Good enough...
dim screenBuf(Maxx, Max.y)

   startTime = time$("ms")
print "Making smooth palette..."
  call Makepalette

'   for i= 0 to 512
'    print i,  PAL$(i)
'   next

   #gr, "size ";min.size-1

   'set initial (seed) points
   screenBuf(0, 0) = (RND(1) * Max.color) + 1
   screenBuf(0, Max.y) = (RND(1) * Max.color) + 1
   screenBuf(Maxx, 0) = (RND(1) * Max.color) + 1
   screenBuf(Maxx, Max.y) = (RND(1) * Max.color) + 1

print "Filling underlying plasma array..."
   call Splitbox 0, 0, Maxx, Max.y

print "Time taken 1 : ";time$("ms") - startTime
startTime = time$("ms")

   oldCol$ = ""
   print "Drawing plasma from array..."
           for xx = 0 to Maxx-1
           x = xx*d
           for yy = 0 to Max.y-1
               y = yy*d
               scan
               Colr = screenBuf(xx, yy)
               col$ = PAL$(Colr)
               if  oldCol$ <> col$ then #gr, "color ";col$;";backcolor ";col$
               if d>1 then
                   #gr, "place ";x;" ";y;";boxfilled ";x+d;" ";y+d
               else
                   #gr, "set ";x;" ";y
               end if
               'print "color ";col$;";backcolor ";col$;";place ";x;" ";y;";boxfilled ";x+d;" ";y+d
               #gr, "discard"
           next
       next

print "Time taken 2 : ";time$("ms") - startTime
'Time taken: 57750 with drawing on
'Time taken: 29906 with drawing off (just creating array)
'I wonder if draw by array will be any faster, then???
'as an idea - to ret reasonable time drawing fullscreen, try to set minsize to more then 1 pixel??

startTime = time$("ms")
'easiest way to get right BMP header is to actually save BMP and look header (just change BPP and some other things after)
    #gr, "getbmp drawing 0 0 ";width;" "; height
    bmpsave "drawing", "just4header.bmp"
    unloadbmp("drawing")
'and I think if I wrote BMP upside down noone will notice - because it's just well, uncomprehensible anyway
   'get header
   open "just4header.bmp" for binary as #1
       size = lof(#1)
       header$ = input$(#1, 53)  'or 54???
   close #1
'     kill "just4header.bmp"
   'modify header
   'numbers stored hi lo
   '2  4 fileSize                                    = imagebytes + offset
   '10 4 offset                                      1078
   '28 2 BitsPerPixel (bpp)                          8
   '30 4 CompressMethod                              0
   '34 4 imagebytes                                  width*height
   '46 4 ColorsUsed                                  256
   '50 4 ImportantColors                             256
   'all goes +1 because bytes numbered from zero by loc()
   call putNumber header$, 2+1, 4, width*height + 1078
   call putNumber header$, 10+1, 4, 1078
   call putNumber header$, 28+1, 2, 8
   call putNumber header$, 30+1, 4, 0
   call putNumber header$, 34+1, 4, width*height
   call putNumber header$, 46+1, 4, 256
   call putNumber header$, 50+1, 4, 256

   'get image data
   'loop
       'open "frame.bmp" for binary
       open "frame.bmp" for binary as #1
       'write modif. header
       print  #1, header$
       'write palette
       for i = 0 to 255
           print  #1, PAL2BMP$(i)
       next
       'write image data
       'print  #1, space$(width*height)
       FOR y =  Max.y-1 TO 0 step -1
           aLine$ = ""
           FOR x = 0 TO Maxx-1
               for k = 1 to d
                   aLine$ =  aLine$ + chr$(screenBuf(x,y))
               next
           next
           for k = 1 to d
               print #1, aLine$
           next
       next
       close #1
print "Time taken 3 : ";time$("ms") - startTime

   'loop
   do while 1
       startTime = time$("ms")
       open "frame.bmp" for binary as #1
       seek #1, 54 'palette data
       for i = 0 to 255
           print  #1, PAL2BMP$(i+k)
       next
       close #1
       loadbmp "copyimage", "frame.bmp"
       #gr, "drawbmp copyimage 0 0"
       unloadbmp("copyimage")
       #gr, "discard"
       scan
       k = (k+1) mod Max.color
       tt = time$("ms") - startTime
       if  tt = 0 then  tt = 1
       fps = 1000/tt
       'print "Time taken: ";tt ;" fps: "; fps
      loop
   '//loop
  wait

'------------------------------------------------------
  SUB Makepalette
'     PAL$(0) = "0 0 0"
     FOR c = 1 TO 63
       c2 = c*4
'         cn = 63 - c
'         PAL(c).R = 63
'         PAL(c).G = c
'         PAL(c).B = 0
        PAL$(c) = "255 ";c2;" 0"
     NEXT
     FOR c = 0 TO 63
       c2 = c*4
        cn = 63 - c
       cn2 = cn*4
        ci = c + 64
'         PAL(ci).R = cn
'         PAL(ci).G = cn
'         PAL(ci).B = c
        PAL$(ci) = cn2;" ";cn2;" ";c2
     NEXT
     FOR c = 0 TO 63
       c2 = c*4
        cn = 63 - c
       cn2 = cn*4
        ci = c + 128
'         PAL(ci).R = 0
'         PAL(ci).G = c
'         PAL(ci).B = 63
        PAL$(ci) = "0 ";c2;" 255"
     NEXT
     FOR c = 0 TO 63
       c2 = c*4
        cn = 63 - c
       cn2 = cn*4
        ci = c + 192
'         PAL(ci).R = c
'         PAL(ci).G = cn
'         PAL(ci).B = cn
        PAL$(ci) = c2;" ";cn2;" ";cn2
     NEXT
     FOR c = 1 TO Max.color
'         col = PAL(c).R
'         PAL(c + Max.color).R = col
'         col = PAL(c).G
'         PAL(c + Max.color).G = col
'         col = PAL(c).B
'         PAL(c + Max.color).B = col
       PAL$(c + Max.color) =  PAL$(c)
     NEXT
'      FOR X = 1 TO Max.color
'         OUT &H3C8, X
'         OUT &H3C9, PAL(X).R
'         OUT &H3C9, PAL(X).G
'         OUT &H3C9, PAL(X).B
'      NEXT X
'     PAL$(511) = "0 0 0"
'     PAL$(512) = "0 0 0"
'   'for BMP palette is BGRempty
'   'while in PAL$ it's R G B
   for i = 0 to 512
        PAL2BMP$(i) = chr$(val(word$(PAL$(i),3))) _
           + chr$(val(word$(PAL$(i),2))) _
           + chr$(val(word$(PAL$(i),1))) _
           + chr$(0)
       'print i,  PAL2BMP$(i)
   next

  END SUB

  SUB Newcolor xa, ya, X, Y, xb, yb
     'IF Get13Pixel(X, Y) <> 0 THEN EXIT SUB
     IF screenBuf(X, Y) <> 0 THEN EXIT SUB
     avg = ABS(xa - xb) + ABS(ya - yb)
     'colour = (Get13Pixel(xa, ya) + Get13Pixel(xb, yb)) / 2 + (RND(1) - .5) * avg * rough
     colour = (screenBuf(xa, ya) + screenBuf(xb, yb)) / 2 + (RND(1) - .5) * avg * rough
     IF colour < 1 THEN colour = 1
     IF colour > Max.color THEN colour = Max.color
     'call Set13Pixel X, Y, colour
     screenBuf(X, Y) = colour
  END SUB

  SUB Splitbox X1, Y1, X2, Y2
     IF (X2 - X1 < min.size) AND (Y2 - Y1 < min.size) THEN EXIT SUB
     scan
     X = int((X1 + X2) / 2)
     Y = int((Y1 + Y2) / 2)
      call Newcolor X1, Y1, X, Y1, X2, Y1
      call Newcolor X2, Y1, X2, Y, X2, Y2
      call Newcolor X1, Y2, X, Y2, X2, Y2
      call Newcolor X1, Y1, X1, Y, X1, Y2
     IF screenBuf(X, Y) = 0 THEN
        'colour = (Get13Pixel(X1, Y1) + Get13Pixel(X2, Y1) + Get13Pixel(X2, Y2) + Get13Pixel(X1, Y2)) / 4
        colour = (screenBuf(X1, Y1) + screenBuf(X2, Y1) + screenBuf(X2, Y2) + screenBuf(X1, Y2)) / 4
        IF colour < 1 THEN colour = 1
        IF colour > Max.color THEN colour = Max.color
         'call Set13Pixel X, Y, colour
         screenBuf(X, Y) = colour
     END IF
      call Splitbox X1, Y1, X, Y
      call Splitbox X, Y1, X2, Y
      call Splitbox X, Y, X2, Y2
      call Splitbox X1, Y, X, Y2
  END SUB

'===========================================
sub quit handle$
  timer 0
  close #handle$
  end
END SUB

'------------------------------------------
  sub putNumber byref aStr$, aPos, aLen, value
   tmp$=""
   for i = 1 to aLen
       'tmp$=chr$(value mod 256)+tmp$   'numbers stored hi lo
       tmp$=tmp$+chr$(value mod 256)   'numbers stored lo hi
       value = int(value/256)
   next
   aStr$ = left$(aStr$, aPos-1)+tmp$+mid$(aStr$, aPos+aLen)
  end sub
'------------------------------------------
function iif(test, valYes, valNo)
   iif =  valNo
   if test then iif =  valYes
end function
'---------------------------------------
function fileExists(path$, filename$)
 'dimension the array info$( at the beginning of your program
 files path$, filename$, info$()
 fileExists = val(info$(0, 0))  'non zero is true
end function


[honkytonk]

Thank you very much to all, I will study your proposals

[Rod]

I was playing a little more. Rather than all the string manipulation this code copies the .bmp to a new file then manipulates the file directly. Probably the fastest you are going to get. I have dropped the 8bit code which has a pallete and complicates things. This code will deal with 24 bit or 32 bit images. It simply trawls through the entire file and reduces the red content. You could target specific pixels by calculating the pointer value from the x and y.


[loadbmp]
       filedialog "Choose an image","*.bmp",file$
       if file$<>"" then
           open file$ for input as #bmp

           'get the header into a string
           bmp$ = Input$(#bmp,lof(#bmp))

           'analyse the file header
           bmpw=value(mid$(bmp$,19,4)) 'width
           bmph=value(mid$(bmp$,23,4)) 'height
           b=value(mid$(bmp$,29,2))    'bits per pixel, ie color depth
           o=value(mid$(bmp$,11,4))    'picture data offset, where the color data starts
           close #bmp
           open "test2.bmp" for output as #bmp
           #bmp bmp$;
           close #bmp
           open "test2.bmp" for binary as #bmp
       end if


       'work out start of picture data and how to move through file
       pointer=o
       'work out how many bytes to step through the string 8=1 24=3 32=4
       bytes=b/8
       'work out padding each raster line must be a 4byte multiple
       mult=b/8*bmpw/4
       padding = 4*(1-(mult-int(mult))) mod 4

       for y=1 to bmph
           for x=1 to bmpw
               'run through bmp
               seek #bmp, pointer
               'color stored as BGR Liberty needs RGB
               b=asc(input$(#bmp,1))
               g=asc(input$(#bmp,1))
               r=asc(input$(#bmp,1))
               r=r-50
               if r<0 then r=0
               seek #bmp, pointer
               #bmp chr$(b);chr$(g);chr$(r);
               pointer=pointer+bytes
           next
           pointer=pointer+padding
       next
       close #bmp
   wait

function value(x$)
   select case len(x$)
       case 1
       value = asc(x$)
       case 2
       value=asc(mid$(x$,1,1))
       value=value+(asc(mid$(x$,2,1))*256)
       case 3
       value=asc(mid$(x$,1,1))
       value=value+(asc(mid$(x$,2,1))*256)
       value=value+(asc(mid$(x$,3,1))*65536)
       case 4
       value=asc(mid$(x$,1,1))
       value=value+(asc(mid$(x$,2,1))*256)
       value=value+(asc(mid$(x$,3,1))*65536)
       value=value+(asc(mid$(x$,4,1))*16777216)
   end select
end function




[honkytonk]

Thank you very much ROD.

[honkytonk]

it works wonderfully
A thousand times thank you !!

[tenochtitlanuk]

Anyone following this thread might look at www.diga.me.uk/inMemoryImageMethod2.html for illustration of how fast this ked of thing can be done.