RosettaCodeData/Task/Brownian-tree/Action-/brownian-tree.action
2023-07-01 13:44:08 -04:00

90 lines
1.6 KiB
Text

BYTE FUNC CheckNeighbors(CARD x BYTE y)
IF Locate(x-1,y-1)=1 THEN RETURN (1) FI
IF Locate(x,y-1)=1 THEN RETURN (1) FI
IF Locate(x+1,y-1)=1 THEN RETURN (1) FI
IF Locate(x-1,y)=1 THEN RETURN (1) FI
IF Locate(x+1,y)=1 THEN RETURN (1) FI
IF Locate(x-1,y+1)=1 THEN RETURN (1) FI
IF Locate(x,y+1)=1 THEN RETURN (1) FI
IF Locate(x+1,y+1)=1 THEN RETURN (1) FI
RETURN (0)
PROC DrawTree()
DEFINE MAXW="255"
DEFINE MINX="1"
DEFINE MAXX="318"
DEFINE MINY="1"
DEFINE MAXY="190"
BYTE CH=$02FC
CARD x,l,r
BYTE y,t,b,w,h,dx,dy,m=[20]
x=160 y=96
Plot(x,y)
l=x-m r=x+m
t=y-m b=y+m
w=r-l+1 h=b-t+1
DO
DO
x=Rand(w)+l y=Rand(h)+t
UNTIL Locate(x,y)=0
OD
WHILE CheckNeighbors(x,y)=0
DO
DO
dx=Rand(3) dy=Rand(3)
UNTIL dx#2 OR dy#2
OD
IF dx=0 THEN
IF x>l THEN x==-1
ELSE x=r-1
FI
ELSEIF dx=1 THEN
IF x<r THEN x==+1
ELSE x=l+1
FI
FI
IF dy=0 THEN
IF y>t THEN y==-1
ELSE y=b-1
FI
ELSEIF dy=1 THEN
IF y<b THEN y==+1
ELSE y=t+1
FI
FI
OD
Plot(x,y)
IF l>MINX AND l+m>x AND w<MAXW THEN
l==-1 w==+1
FI
IF r<MAXX AND r-m<x AND w<MAXW THEN
r==+1 w==+1
FI
IF t>MINY AND t+m>y THEN
t==-1 h==+1
FI
IF b<MAXY AND b-m<y THEN
b==+1 h==+1
FI
Poke(77,0) ;turn off the attract mode
UNTIL CH#$FF ;until key pressed
OD
CH=$FF
RETURN
PROC Main()
BYTE COLOR1=$02C5,COLOR2=$02C6
Graphics(8+16)
Color=1
COLOR1=$0E
COLOR2=$02
DrawTree()
RETURN