Anonymous user
Category:Action! Bitmap tools: Difference between revisions
→LOADPPM5.ACT
(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...") |
|||
| (5 intermediate revisions by the same user not shown) | |||
Line 1:
== Action! Bitmap tools ==
All the following source codes have been prepared to solve tasks in the Rosetta Code website.
Line 6 ⟶ 8:
The following module contains definition of grayscale image.
<lang Action!>MODULE
Line 55 ⟶ 56:
----
===
The following module
<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)
| |||