The SiMPLE Program Gallery

< Prev | The SiMPLE Program Gallery | Next >

Bitmap Image "Scruncher"

This program "scrunches" down a photographic bitmap image into a 16-color bitmap image so that the "plotbmp" task (see the "Bitmap Image Displayer") can utilize it more efficiently.

(Click here to see some examples of scrunched images.) (Click here for an explanation of how scrunching works.)

Source Listing

// // Program: Bitmap Image "Scruncher" // Author: Bob Bishop // Pro-SiMPLE inpath=keyintext("Input path: ") outpath=keyintext("Output path: ") scrunch (inpath, outpath) @ //////////////////////////////////////////////////////////// // // // The scrunch task generates a 16-color bitmap image // // from a photographic bitmap image. (The only kinds // // of images that the Free version of SiMPLE can dis- // // play are 16-color bitmap images.) // // // // The scrunch task has two calling parameters: // // // // inpath - the path to the photgraphic // // image to be used. (MUST be a // // Bitmap image, not a JPEG or GIF.) // // outpath - the path to the 16-color bitmap // // image that is to be generated. // // // //////////////////////////////////////////////////////////// Task scrunch (Text inpath, Text outpath) Common Int z[]={0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15} Common Int rr[16], gg[16], bb[16] Common Int red[256], grn[256], blu[256] Common Int xsize, ysize, zbits Int r, g, b, rgb, x, zz command="read "+inpath If outpath~inpath Display "The output path must be different from the input path" Return Endif Open g (command) get bmp data @ Close g If zbits!=8 And zbits!=24 Display inpath,,"is not an 8-bit or 24-bit bitmap image" Return Endif Open g (command) command="write "+outpath Open f (command) Do k=1,54 Read binary g (x, 0) If (k=11) x=118 If (k=12) x=0 If (k=29) x=4 Write binary f (x, 0) Loop If (zbits=8) skip (1024) @ Do k=0,15 Write binary f (84*bb[z[k]], 0) Write binary f (84*gg[z[k]], 0) Write binary f (84*rr[z[k]], 0) Write binary f (0, 0) Loop Graphon If zbits=8 Do yy=ysize-1,0 Do xx=0,xsize-1 Read binary g (rgb, 0) r=red[rgb]; g=grn[rgb]; b=blu[rgb] out pixel (xx, yy, r, g, b, zz) @ Loop If (xsize%2) Write binary f (zz, 0) skip ((16384-xsize)%4) @ pad ((16384-(xsize+1)/2)%4) @ Loop Endif If zbits=24 Do yy=ysize-1,0 Do xx=0,xsize-1 Read binary g (b, 0) Read binary g (g, 0) Read binary g (r, 0) out pixel (xx, yy, r, g, b, zz) @ Loop If (xsize%2) Write binary f (zz, 0) skip (xsize%4) @ pad ((16384-(xsize+1)/2)%4) @ Loop Endif Close g Close f Task out pixel (Int xx, Int yy, Int r, Int g, Int b, Int zz) Common Int z[16] hue=convert rgb (xx, yy, r, g, b) Put pixel (xx, yy, hue) ndx=z[hue] If (xx%2=0) zz=16*ndx Else zz=zz+ndx If (xx%2) Write binary f (zz, 0) /////////////////////////////////////////////////// // // // The convertrgb function tries to find the // // closest match to a given RGB color. // // // /////////////////////////////////////////////////// Int convert rgb (Int x, Int y, Int r, Int g, Int b) Common Int rr[]={0,0,0,0,2,2,2,2,1,1,1,1,3,3,3,3} Common Int gg[]={0,0,2,2,0,0,1,2,1,1,3,3,1,1,3,3} Common Int bb[]={0,2,0,2,0,2,0,2,1,3,1,3,1,3,1,3} Int2 err, rerr, gerr, berr min=999999L Do k=0,15 Do j=k,0 rerr=42*(rr[j]+rr[k])-r gerr=42*(gg[j]+gg[k])-g berr=42*(bb[j]+bb[k])-b err=rerr*rerr+gerr*gerr+berr*berr If (err>min) Continue If (err=min And j!=k) Continue min=err; za=j; zb=k Loop Loop If ((x+y)%2) Return za Else Return zb Task get bmp data Common Int xsize, ysize, zbits Common Int red[256], grn[256], blu[256] Int a, b Read binary g (a, 0) Read binary g (b, 0) If a!=66 Or b!=77 Display "Not a valid bitmap file" pause; quit Endif skip (8) @ Read binary g (a, 0) Read binary g (b, 0) picdata=a+256*b skip (6) @ Read binary g (a, 0) Read binary g (b, 0) xsize=a+256*b skip (2) @ Read binary g (a, 0) Read binary g (b, 0) ysize=a+256*b skip (4) @ Read binary g (zbits, 0) skip (25) @ If (zbits=1) skip (8) @ If (zbits=4) skip (64) @ If zbits=8 loc=54 Do k=0,255 Read binary g (blu[k], 0) Read binary g (grn[k], 0) Read binary g (red[k], 0) skip (1) @ loc=loc+4; If loc=picdata Break Loop Endif Task skip (Int n) Do k=1,n,1 Read binary g (0, 0) Loop Task pad (Int n) Do k=1,n,1 Write binary f (0, 0) Loop

How To Run The Program

If you're feeling ambitious and have nothing better to do, you could just copy
the source listing by hand! However, there is a much easier way to do it:

Copy the source listing into the Windows Clipboard

Paste the Clipboard into a new text document

Drop that text document onto the "Drop SiMPLE Listing Here" icon

(If you would like to contribute any of your SiMPLE programs to The Gallery, just e-mail them to us.)