RosettaCodeData/Task/Bitmap-Midpoint-circle-algo.../Action-/bitmap-midpoint-circle-algo...

64 lines
1.1 KiB
Plaintext

INCLUDE "H6:RGBCIRCL.ACT" ;from task Midpoint circle algorithm
RGB black,yellow,violet,blue
PROC DrawImage(RgbImage POINTER img BYTE x,y)
RGB POINTER ptr
BYTE i,j
ptr=img.data
FOR j=0 TO img.h-1
DO
FOR i=0 TO img.w-1
DO
IF RgbEqual(ptr,yellow) THEN
Color=1
ELSEIF RgbEqual(ptr,violet) THEN
Color=2
ELSEIF RgbEqual(ptr,blue) THEN
Color=3
ELSE
Color=0
FI
Plot(x+i,y+j)
ptr==+RGBSIZE
OD
OD
RETURN
PROC Main()
RgbImage img
BYTE CH=$02FC,width=[81],height=[51],st=[3]
BYTE ARRAY ptr(12393)
BYTE n
INT x,y
RGB POINTER col
Graphics(7+16)
SetColor(0,13,12) ;yellow
SetColor(1,4,8) ;violet
SetColor(2,8,6) ;blue
SetColor(4,0,0) ;black
RgbBlack(black)
RgbYellow(yellow)
RgbViolet(violet)
RgbBlue(blue)
InitRgbImage(img,width,height,ptr)
FillRgbImage(img,black)
FOR n=0 TO height/st
DO
IF n MOD 3=0 THEN col=yellow
ELSEIF n MOD 3=1 THEN col=violet
ELSE col=blue FI
RgbCircle(img,width/2,height/2,st*n,col)
OD
DrawImage(img,(160-width)/2,(96-height)/2)
DO UNTIL CH#$FF OD
CH=$FF
RETURN