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>
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>
Pages in category "Action! Bitmap tools"
The following 13 pages are in this category, out of 13 total.