задачка острова
<pre> \ задача острова
lib\ext\locals.f
0 VALUE матрица
0 VALUE остров
0 VALUE есть
0 VALUE вокруг
0 VALUE шм
0 VALUE вм
: мт ( -- adr u x y ) \ 0-48 X-88
S" 0X00XX0XX00X0XXXX00XX000" 6 4 ;
мт TO вм TO шм ALLOCATE THROW TO матрица матрица вм шм * MOVE
\ матрица вм шм * TYPE \ тест
4 ALLOCATE THROW TO есть 4 есть !
4 ALLOCATE THROW TO вокруг 4 вокруг !
\ добавить точку номер I в конец списка
: add.point ( I adr -- adr1 )
{ i adr }
adr DUP @ CELL + RESIZE THROW -> adr
adr @ CELL + adr !
i adr DUP @ + 4 - !
adr
; \ : t1 вокруг add.point TO вокруг вокруг 16 DUMP ; 7 t1 \EOF
\ уничтожить точку острова
: X>0 ( i -- )
матрица + 48 SWAP C!
;
\ получить линейные координаты точек окружающих точку i
: l4 ( i -- w e s n ) \ западная восточная северная и южная
>R
R@ шм MOD IF R@ 1- ELSE -1 THEN \ слева
R@ 1+ шм MOD IF R@ 1+ ELSE -1 THEN \ справа
R@ шм - \ сврху
R> шм + \ снизу
; \ 7 l4 \EOF
\ пополнить список "вокург" точками вокруг точки i
: get.list1 ( i -- )
l4
4 0
DO
DUP 0 < 0= >R DUP шм вм * > 0= R> * \ точка в матрице ?
IF
DUP матрица + C@ 88 = \ точка суша
IF вокруг add.point TO вокруг ELSE DROP THEN
ELSE DROP THEN
LOOP
; \ 7 вокруг get.list1 вокруг 32 DUMP \EOF
\ пройти по списку "есть" и получить список точек "вокруг"
: get.list ( -- )
есть C@ CELL / 1 - 0
DO
есть CELL + I CELLS + C@ get.list1
LOOP
; \ 7 есть add.point TO есть get.list \EOF
: утопить_есть
есть @ CELL / 1- 0
?DO
есть CELL + I CELLS + @ X>0
LOOP
; \ матрица шм вм * CR TYPE 7 есть add.point TO есть 8 есть add.point TO есть утопить_есть матрица шм вм * CR TYPE \EOF
: очистить_вокруг
CELL ALLOCATE THROW TO вокруг 4 вокруг !
;
\ произвести последовательное уничтожение територии острова
: утопить_остров ( I -- )
есть add.point TO есть
BEGIN
get.list
утопить_есть
вокруг @ 4 <>
WHILE
есть FREE THROW
вокруг TO есть
очистить_вокруг
REPEAT
очистить_вокруг
; \ матрица шм вм * CR TYPE 1 утопить_остров матрица шм вм * CR TYPE \EOF
: считать_острова
шм вм * 0
DO
матрица I + C@ 88 =
IF
остров 1+ TO остров
I утопить_остров
THEN
LOOP
; считать_острова остров . \EOF</pre>
уж не обессуте если кривовато, я человек неискушенный,
стековой нотации islands ( addr u -- x ) не соответствует, но веть и adr u не совсем корректно отражает сущность матрицы
(как и решение 1-ой задачки впрочем)