\ Life game \ Alex Furashev http://forth-j.narod.ru/day07.htm \ Michail Maximov. REQUIRE AT-XY ~day\common\console.f : СоздатьМатрицу ( ширин высот адр ) \ ширин и высота -- кол-во элементов, поэтому отсчет 1! DUP @ 1000 > IF \ Освобождение памяти, если есть указатель - DUP FREE DROP \ какое-то относит. большое положит. число THEN >R 1 MAX ( ширин высот R: адр ) SWAP 1 MAX ( высот ширин R: адр ) \ получили длину + 2 ячейки под размер матрицы 2DUP * 1+ ( адр ширин высот длин ) CELLS \ Получили длину в байтах ! ALLOCATE IF -300 THROW THEN >R ( высот ширин R: адр адрМатр ) R@ ! ( высот R: адр адрМатр ) \ сохранил ширину матрицы R@ CELL+ ! ( R: адр адрМатр ) \ сохранил высоту матрицы R> R> ! \ сохранил адрес матрицы в переменной ; : ШиринаМатрицы ( адрМатр ) @ \ получил адрес памяти матрицы @ \ только теперь ширину ; ( шир ) : ВысотаМатрицы ( адрМатр ) @ CELL+ @ ; ( выс ) : ?LifeEXIT S" IF DROP 2DROP 0 EXIT THEN" EVALUATE ; IMMEDIATE : ?LifeEXIT1 IF 2DROP 2DROP 0 RDROP THEN ; : ЭлМатрицы ( х у адрМатр -- adr|0 ) \ координаты начинаются с 0 !!! 2DUP ВысотаМатрицы 1- > ?LifeEXIT ROT ( y адрМатр x ) DUP 0< \ если х вышел за пределы диапазона, то возвращаю 0 ?LifeEXIT ( y адрМатр x ) OVER ШиринаМатрицы 1- OVER < \ должен быть строго меньше границы ?LifeEXIT ( y адрМатр x ) ROT ( адрМатр x y ) DUP 0< \ если y вышел за пределы диапазона, то возвращаю 0 ?LifeEXIT ( адрМатр x y ) \ проверку дипапазона закончили 2 PICK ВысотаМатрицы * + \ преобразовали двумерные координат в одномерные 2+ \ с учетом 2-х служебных ячеек CELL * \ получили адрес элемента относит блока памяти SWAP @ \ адрес блока памяти + @ \ абс. адрес элемента и его значение ; : =ЭлМатрицы ( знач х у адрМатр -- adr|0 ) \ координаты начинаются с 0 !!! 2DUP ВысотаМатрицы 1- > ?LifeEXIT1 ROT ( знач y адрМатр x ) DUP 0< \ если х вышел за пределы диапазона, то возвращаю 0 ?LifeEXIT1 ( знач y адрМатр x ) 2DUP SWAP ШиринаМатрицы 1- > \ должен быть строго меньше границы ?LifeEXIT1 ( знач y адрМатр x ) ROT ( знач адрМатр x y ) DUP 0< \ если y вышел за пределы диапазона, то возвращаю 0 ?LifeEXIT1 ( знач адрМатр x y ) \ проверку дипапазона закончили 2 PICK ВысотаМатрицы * + \ преобразовали двумерные координат в одномерные 2+ \ с учетом 2-х служебных ячеек CELL * \ получили адрес элемента относит блока памяти SWAP @ \ адрес блока памяти + \ абс. адрес элемента ! \ запоминаю его значение ; : ОчиститьМатрицу ( адрМатр ) DUP ВысотаМатрицы 0 DO DUP ШиринаМатрицы 0 DO 0 I J 3 PICK =ЭлМатрицы LOOP LOOP DROP ; : ПоказатьМатрицу ( адрМатр ) DUP ВысотаМатрицы 0 DO DUP ШиринаМатрицы 0 DO I J 2 PICK ЭлМатрицы . LOOP CR LOOP DROP ; \ -------------------------------------------------------------------- \ ---------------------------- Данные -------------------------------- USER Среда 0 Среда ! USER Кол-воСоседей 0 Кол-воСоседей ! 20 20 Среда СоздатьМатрицу Среда ОчиститьМатрицу 20 20 Кол-воСоседей СоздатьМатрицу Кол-воСоседей ОчиститьМатрицу : ЗаселитьСреду Среда ВысотаМатрицы 0 DO Среда ШиринаМатрицы 0 DO I J * 5 MOD DUP 2 = OVER 3 = OR IF DROP 1 ELSE DROP 0 THEN \ определил -- живет здесь бактерия (1) или нет(0) J I Среда =ЭлМатрицы LOOP LOOP ; : ЕстьБактерия? ( x y ) Среда ЭлМатрицы \ если есть бактерия, то 1 иначе 0 ; ( 1 | 0 ) : РассчитатьКол-воСоседей Кол-воСоседей ВысотаМатрицы 0 DO Кол-воСоседей ШиринаМатрицы 0 DO I 1- J 1- ЕстьБактерия? \ нижний левый угол I 1- J ЕстьБактерия? + \ обход по часовой I 1- J 1+ ЕстьБактерия? + I J 1+ ЕстьБактерия? + I 1+ J 1+ ЕстьБактерия? + I 1+ J ЕстьБактерия? + I 1+ J 1- ЕстьБактерия? + I J 1- ЕстьБактерия? + ( колБакт ) I J Кол-воСоседей =ЭлМатрицы \ Сохранили значение LOOP LOOP ; : ПоказатьСовмещенно Кол-воСоседей ВысотаМатрицы 0 DO Среда ШиринаМатрицы 0 DO J I Среда ЭлМатрицы IF ." X" ELSE ." " THEN LOOP 2 SPACES Кол-воСоседей ШиринаМатрицы 0 DO J I Кол-воСоседей ЭлМатрицы . LOOP CR LOOP ; : ПоказатьСреду Среда ВысотаМатрицы 0 DO Среда ШиринаМатрицы 0 DO J I Среда ЭлМатрицы IF ." X" ELSE ." " THEN LOOP CR LOOP ; : ОбновитьСреду Среда ВысотаМатрицы 0 DO Среда ШиринаМатрицы 0 DO J I Кол-воСоседей ЭлМатрицы DUP 2 < IF DROP \ умерла от недостатка 0 J I Среда =ЭлМатрицы ELSE 4 > IF \ умерла от перенаселенности 0 J I Среда =ЭлМатрицы ELSE \ родилась новая или продолжает жить старая 1 J I Среда =ЭлМатрицы THEN THEN LOOP LOOP ; \ ------------------------------- : Main 4 3 TEXT-ATTR ЗаселитьСреду \ Инициализировали РассчитатьКол-воСоседей \ ПоказатьСовмещенно \ Для отладки BEGIN 0 0 AT-XY ПоказатьСреду ОбновитьСреду РассчитатьКол-воСоседей CR ." Q - выход" KEY 0x20 OR \ символы делаем маленькими [CHAR] q = UNTIL ; Main