/* BITMAP FILE: write out a file in PPM format, P6 (binary). 14/5/2010 */
test: procedure options (main);
   declare image (0:19,0:19) bit (24);
   declare 1 pixel union,
            2 color bit (24) aligned,
            2 primaries,
               3 R character (1),
               3 G character (1),
               3 B character (1);
   declare ch character (1);
   declare (i, j) fixed binary;
   declare out file record;

   open file (out) title ('/IMAGE.PPM,TYPE(FIXED),RECSIZE(1)' ) OUTPUT;

   ch = 'P'; write file (out) from (ch);
   ch = '6'; write file (out) from (ch);

   call put_integer (hbound(image, 1));
   call put_integer (hbound(image, 2));
   call put_integer (255);

   do i = 0 to hbound(image,1);
      do j = 0 to hbound(image, 2);
         color = image(i,j);
         write file (out) from (R);
         write file (out) from (G);
         write file (out) from (B);
      end;
   end;

put_integer: procedure (k);
   declare k fixed binary;
   declare s character (30) varying;
   declare i fixed binary;
   declare ch character (1);

   s = k;
   s = trim(s);
   do i = 1 to length(s);
      ch = substr(s, i, 1);
      write file (out) from (ch);
   end;
   ch = '09'x;
   write file (out) from (ch);
end put_integer;
end test;