RosettaCodeData/Task/Bitmap-Write-a-PPM-file/Action-/bitmap-write-a-ppm-file.action

93 lines
1.7 KiB
Plaintext

INCLUDE "H6:RGBIMAGE.ACT" ;from task Bitmap
PROC SaveHeader(RgbImage POINTER img
CHAR ARRAY format BYTE dev)
PrintDE(dev,format)
PrintBD(dev,img.w)
PutD(dev,32)
PrintBDE(dev,img.h)
PrintBDE(dev,255)
RETURN
PROC SavePPM3(RgbImage POINTER img CHAR ARRAY path)
BYTE dev=[1],x,y
RGB c
Close(dev)
Open(dev,path,8)
SaveHeader(img,"P3",dev)
FOR y=0 TO img.h-1
DO
FOR x=0 TO img.w-1
DO
GetRgbPixel(img,x,y,c)
PrintBD(dev,c.r) PutD(dev,32)
PrintBD(dev,c.g) PutD(dev,32)
PrintBD(dev,c.b)
IF x=img.w-1 THEN
PutDE(dev)
ELSE
PutD(dev,32)
FI
OD
OD
Close(dev)
RETURN
PROC SavePPM6(RgbImage POINTER img CHAR ARRAY path)
BYTE dev=[1],x,y
RGB c
Close(dev)
Open(dev,path,8)
SaveHeader(img,"P6",dev)
FOR y=0 TO img.h-1
DO
FOR x=0 TO img.w-1
DO
GetRgbPixel(img,x,y,c)
PutD(dev,c.r)
PutD(dev,c.g)
PutD(dev,c.b)
OD
OD
Close(dev)
RETURN
PROC Load(CHAR ARRAY path)
CHAR ARRAY line(255)
BYTE dev=[1]
Close(dev)
Open(dev,path,4)
WHILE Eof(dev)=0
DO
InputSD(dev,line)
PrintE(line)
OD
Close(dev)
RETURN
PROC Main()
BYTE ARRAY rgbdata=[
0 0 0 0 0 255 0 255 0
255 0 0 0 255 255 255 0 255
255 255 0 255 255 255 31 63 127
63 31 127 127 31 63 127 63 31]
BYTE width=[3],height=[4]
RgbImage img
CHAR ARRAY path3="D:PPM3.PPM"
CHAR ARRAY path6="D:PPM6.PPM"
Put(125) PutE() ;clear the screen
InitRgbImage(img,width,height,rgbdata)
PrintF("Saving %S...%E%E",path3)
SavePPM3(img,path3)
PrintF("Saving %S...%E%E",path6)
SavePPM6(img,path6)
PrintF("Loading %S...%E%E",path3)
Load(path3)
RETURN