Category:Action! Bitmap tools
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>
RGBIMAGE.ACT
The following module contains definition of RGB color image. <lang Action!>MODULE
DEFINE RGBSIZE="3"
TYPE RGB=[BYTE r,g,b]
TYPE RgbImage=[
BYTE w,h CARD data]
BYTE FUNC RgbEqual(RGB POINTER c1,c2)
IF c1.r=c2.r AND c1.g=c2.g AND c1.b=c2.b THEN RETURN (1) FI
RETURN (0)
PROC RgbBlack(RGB POINTER c)
c.r=0 c.g=0 c.b=0
RETURN
PROC RgbWhite(RGB POINTER c)
c.r=255 c.g=255 c.b=255
RETURN
PROC RgbRed(RGB POINTER c)
c.r=255 c.g=0 c.b=0
RETURN
PROC RgbGreen(RGB POINTER c)
c.r=0 c.g=255 c.b=0
RETURN
PROC RgbBlue(RGB POINTER c)
c.r=0 c.g=0 c.b=255
RETURN
PROC RgbYellow(RGB POINTER c)
c.r=255 c.g=255 c.b=0
RETURN
PROC RgbViolet(RGB POINTER c)
c.r=255 c.g=0 c.b=255
RETURN
PROC InitRgbImage(RgbImage POINTER img
BYTE width,height CARD d)
img.w=width img.h=height img.data=d
RETURN
PROC FillRgbImage(RgbImage POINTER img RGB POINTER c)
RGB POINTER ptr BYTE x,y
ptr=img.data
FOR y=1 TO img.h
DO
FOR x=1 TO img.w
DO
ptr.r=c.r
ptr.g=c.g
ptr.b=c.b
ptr==+3
OD
OD
RETURN
CARD FUNC GetRgbPtr(RgbImage POINTER img INT x,y)
IF x<0 OR x>=img.w OR y<0 OR y>=img.h THEN RETURN (0) FI
RETURN (img.data+(x+y*img.w)*RGBSIZE)
PROC GetRgbPixel(RgbImage POINTER img
INT x,y RGB POINTER c) RGB POINTER ptr ptr=GetRgbPtr(img,x,y) IF ptr THEN c.r=ptr.r c.g=ptr.g c.b=ptr.b ELSE Break() FI
RETURN
PROC SetRgbPixel(RgbImage POINTER img
INT x,y RGB POINTER c) RGB POINTER ptr ptr=GetRgbPtr(img,x,y) IF ptr THEN ptr.r=c.r ptr.g=c.g ptr.b=c.b FI
RETURN
MODULE</lang>
RGBLINE.ACT
The following module contains implementation of Bresenham's algorithm for drawing line on RGB color image. <lang Action!>MODULE
INCLUDE "H6:RGBIMAGE.ACT" ;from task Bitmap
PROC RgbLine(RgbImage POINTER img
INT x1,y1,x2,y2 RGB POINTER c) INT dx,dy,sx,sy,err,e2
IF x1>x2 THEN dx=x1-x2 ELSE dx=x2-x1 FI
IF y1>y2 THEN dy=y1-y2 ELSE dy=y2-y1 FI
IF x1<x2 THEN sx=1 ELSE sx=-1 FI
IF y1<y2 THEN sy=1 ELSE sy=-1 FI
IF dx>dy THEN err=dx/2 ELSE err=-dy/2 FI
DO
SetRgbPixel(img,x1,y1,c)
IF x1=x2 AND y1=y2 THEN
EXIT
FI
e2=err
IF e2>-dx THEN
err==-dy
x1==+sx
FI
IF e2<dy THEN
err==+dx
y1==+sy
FI
OD
RETURN
MODULE</lang>
RGBCIRCL.ACT
The following module contains implementation of drawing circle on RGB color image using midpoint circle algorithm. <lang Action!>MODULE
INCLUDE "H6:RGBIMAGE.ACT" ;from task Bitmap
PROC RgbCircle(RgbImage POINTER img
INT x0,y0,radius RGB POINTER c) INT f,ddfx,ddfy,x,y
f=1-radius ddfx=0 ddfy=-2*radius x=0 y=radius SetRgbPixel(img,x0,y0+radius,c) SetRgbPixel(img,x0,y0-radius,c) SetRgbPixel(img,x0+radius,y0,c) SetRgbPixel(img,x0-radius,y0,c)
WHILE x<y
DO
IF f>=0 THEN
y==-1
ddfy==+2
f==+ddfy
FI
x==+1
ddfx==+2
f==+ddfx+1
SetRgbPixel(img,x0+x,y0+y,c)
SetRgbPixel(img,x0-x,y0+y,c)
SetRgbPixel(img,x0+x,y0-y,c)
SetRgbPixel(img,x0-x,y0-y,c)
SetRgbPixel(img,x0+y,y0+x,c)
SetRgbPixel(img,x0-y,y0+x,c)
SetRgbPixel(img,x0+y,y0-x,c)
SetRgbPixel(img,x0-y,y0-x,c)
OD
RETURN
MODULE</lang>
RGB2GRAY.ACT
The following module is responsible for conversion from RGB color image into grayscale image. <lang Action!>MODULE
INCLUDE "H6:RGBIMAGE.ACT" ;from task Bitmap INCLUDE "H6:GRIMAGE.ACT" ;from task Grayscale image INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
REAL rFact,gFact,bFact
PROC InitRgbToGray()
ValR("0.2126",rFact)
ValR("0.7152",gFact)
ValR("0.0722",bFact)
RETURN
BYTE FUNC Luminance(RGB POINTER c)
REAL r1,r2,r3
IntToReal(c.r,r1) ;r1=R RealMult(rFact,r1,r2) ;r2=0.2126*R IntToReal(c.g,r1) ;r1=G RealMult(gFact,r1,r3) ;r3=0.7152*G RealAdd(r2,r3,r1) ;r1=0.2126*R+0.7152*G IntToReal(c.b,r2) ;r2=B RealMult(bFact,r2,r3) ;r3=0.0722*B RealAdd(r1,r3,r2) ;r2=0.2126*R+0.7152*G+0.0722*B
RETURN (RealToInt(r2))
PROC RgbToGray(RgbImage POINTER src GrayImage POINTER dst)
BYTE x,y,lum RGB c
FOR y=0 TO dst.h-1
DO
FOR x=0 TO dst.w-1
DO
GetRgbPixel(src,x,y,c)
lum=Luminance(c)
SetGrayPixel(dst,x,y,lum)
OD
OD
RETURN
PROC GrayToRgb(GrayImage POINTER src RgbImage POINTER dst)
BYTE x,y,lum RGB c
FOR y=0 TO dst.h-1
DO
FOR x=0 TO dst.w-1
DO
lum=GetGrayPixel(src,x,y)
c.r=lum c.g=lum c.b=lum
SetRgbPixel(dst,x,y,c)
OD
OD
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
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>
Pages in category "Action! Bitmap tools"
The following 13 pages are in this category, out of 13 total.