Category:Action! Bitmap tools: Difference between revisions

From Rosetta Code
Content added Content deleted
(Created page with "All the following source codes have been prepared to solve tasks in the Rosetta Code website. ---- === GRIMAGE.ACT === The following module contains definition of grayscale...")
 
No edit summary
Line 1: Line 1:
== Action! Bitmap tools ==

All the following source codes have been prepared to solve tasks in the Rosetta Code website.
All the following source codes have been prepared to solve tasks in the Rosetta Code website.



Revision as of 23:11, 14 November 2021

Action! Bitmap tools

All the following source codes have been prepared to solve tasks in the Rosetta Code website.


GRIMAGE.ACT

The following module contains definition of grayscale image.

<lang Action!>MODULE

TYPE GrayImage=[

 BYTE gw,gh
 CARD gdata]

PROC InitGrayImage(GrayImage POINTER img

 BYTE width,height CARD d)
 img.gw=width
 img.gh=height
 img.gdata=d

RETURN

PROC FillGrayImage(GrayImage POINTER img BYTE c)

 SetBlock(img.gdata,img.gw*img.gh,c)

RETURN

CARD FUNC GetGrayPtr(GrayImage POINTER img INT x,y)

 IF x<0 OR x>=img.gw OR y<0 OR y>=img.gh THEN
   RETURN (0)
 FI  

RETURN (img.gdata+x+y*img.gw)

BYTE FUNC GetGrayPixel(GrayImage POINTER img

 INT x,y)
 BYTE POINTER ptr
 
 ptr=GetGrayPtr(img,x,y)
 IF ptr=0 THEN
   Break()
 FI

RETURN (ptr^)

PROC SetGrayPixel(GrayImage POINTER img

 INT x,y BYTE c)
 BYTE POINTER ptr
 
 ptr=GetGrayPtr(img,x,y)
 IF ptr THEN
   ptr^=c
 FI

RETURN

MODULE</lang>


LOADPPM5.ACT

The following module is designed for loading images in PPM format version 5 (grayscale, binary).

<lang Action!>MODULE

INCLUDE "H6:GRIMAGE.ACT" ;from task Grayscale image INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

PROC DecodeSize(CHAR ARRAY s BYTE POINTER width,height)

 BYTE i
 width^=ValB(s)
 i=1
 WHILE i<=s(0) AND s(i)#32
 DO
   s(i)=32
   i==+1
 OD
 height^=ValB(s)

RETURN

PROC LoadHeader(GrayImage POINTER img

 CHAR ARRAY format BYTE dev)
 CHAR ARRAY line(255)
 BYTE header,size,max,width,height
 header=0 size=0 max=0
 WHILE max=0
 DO
   InputSD(dev,line)
   IF line(0)>0 AND line(1)#'# THEN
     IF header=0 THEN
       IF SCompare(format,format)#0 THEN
         Break()
       FI
       header=1
     ELSEIF size=0 THEN
       DecodeSize(line,@width,@height)
       IF width=0 OR height=0 THEN
         Break()
       FI
       img.gw=width img.gh=height
       size=1
     ELSEIF max=0 THEN
       max=ValB(line)
       IF max#255 THEN
         Break()
       FI
     FI
   FI
 OD

RETURN

PROC LoadPPM5(GrayImage POINTER img CHAR ARRAY path)

 BYTE dev=[1],x,y,c
 Close(dev)
 Open(dev,path,4)
 LoadHeader(img,"P5",dev)
 FOR y=0 TO img.gh-1
 DO
   FOR x=0 TO img.gw-1
   DO
     c=GetD(dev)
     SetGrayPixel(img,x,y,c)
   OD
 OD
 Close(dev)

RETURN

MODULE</lang>