Автор |
Сообщение |
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
|
|
|
Добавлено: Ср ноя 17, 2010 23:43 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
Цитата: Игра в квадратики. Я давно заметил, что на фортеров оказывает какое-то мистическое действие слово four(th) Все придуманные фортерами игры имеют дело с квадратиками или кубиками. Не знаю, как и расценивать http://rnd.cnews.ru/math/news/top/index ... /17/416368бактерии учатся программировать, упоминается игра "жизнь" - кто-то ведь делал её на форте (не помню кто) и что самое интересное, игровое поле - квадрат Цитата: буквально и построили систему из взаимодействующих бактерий, которая способна находить правильные решения для судоку. "Поскольку правила судоку просты, мы подумали, что, возможно, бактерии смогут решить его, если мы заложим в них правила, которым они должны следовать", - говорит возглавивший команду Рио Таниучи (Ryo Taniuchi). Для того, чтобы заложить правила поведения каждой отдельной бактерии применялись методы генного ижиниринга, когда при помощи вирусов в организм встраиваются гены, заставляющие его определенным образом реагировать на внешние сигналы.
Поле игры представляло из себя квадрат 4?4 и даже более того Цитата: каждая бактерия могла принимать один из четырех возможных цветов. Каждый цвет соответствовал числу от 1 до 4. мистика
[quote]Игра в квадратики. Я давно заметил, что на фортеров оказывает какое-то мистическое действие слово four(th) Все придуманные фортерами игры имеют дело с квадратиками или кубиками.[/quote] Не знаю, как и расценивать http://rnd.cnews.ru/math/news/top/index_science.shtml?2010/11/17/416368 бактерии учатся программировать, упоминается игра "жизнь" - кто-то ведь делал её на форте (не помню кто) и что самое интересное, игровое поле - :o квадрат [quote]буквально и построили систему из взаимодействующих бактерий, которая способна находить правильные решения для судоку. "Поскольку правила судоку просты, мы подумали, что, возможно, бактерии смогут решить его, если мы заложим в них правила, которым они должны следовать", - говорит возглавивший команду Рио Таниучи (Ryo Taniuchi). Для того, чтобы заложить правила поведения каждой отдельной бактерии применялись методы генного ижиниринга, когда при помощи вирусов в организм встраиваются гены, заставляющие его определенным образом реагировать на внешние сигналы.
Поле игры представляло из себя квадрат 4?4[/quote]
и даже более того [quote]каждая бактерия могла принимать один из четырех возможных цветов. Каждый цвет соответствовал числу от 1 до 4.[/quote]мистика
|
|
|
|
Добавлено: Ср ноя 17, 2010 23:23 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
Мне интересно - кто-нибудь "разложить" квадратики попытался? Каковы впечатления от самой идеи - это ведь не для детей - планирование предсказание вероятностных событий.
Мне интересно - кто-нибудь "разложить" квадратики попытался? Каковы впечатления от самой идеи - это ведь не для детей - [s]планирование[/s] предсказание вероятностных событий.
|
|
|
|
Добавлено: Сб июл 03, 2010 09:14 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
Открыл новую тему насчет изображения в разделе Quark.
Открыл новую тему насчет изображения в разделе Quark.
|
|
|
|
Добавлено: Пт май 28, 2010 00:10 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
VoidVolker писал(а): вопрос писал(а): но чем это вызвано? Небольшим разрешением экрана. А каким? Я там внёс исправления - если нажать на F7, то меняется размер изображения на экране. Этого достаточно?
[quote="VoidVolker"][quote="вопрос"]но чем это вызвано?[/quote] Небольшим разрешением экрана.[/quote] А каким? Я там внёс исправления - если нажать на F7, то меняется размер изображения на экране. Этого достаточно?
|
|
|
|
Добавлено: Чт май 27, 2010 23:49 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
вопрос писал(а): но чем это вызвано? Небольшим разрешением экрана.
[quote="вопрос"]но чем это вызвано?[/quote] Небольшим разрешением экрана.
|
|
|
|
Добавлено: Чт май 27, 2010 22:20 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
В OpenGL есть не вполне понятное мне поведение функции DrawPixels, с помощью которой и отрисовывается экран. Функция достаточно низкоуровневая, и служит для прямого доступа к поверхности экрана. Проблема кроется в том, что OpenGL направляет ось Y вверх, а образ экрана - наоборот. В результате при отрисовке на разных видеокартах поведение оказывается различным - лучше всех себя ведет Intel GMA, который может принимать экран "как есть", и правильно понимает, что "вот это" надо преобразовать в "вон то" - эта фраза включает в себя и правильное отсечение по горизонтали, и разворот оси ординат. А вот дискретные видеокарты почему-то капризничают, что касается прежде всего отсечения. Сейчас в кварке реализован достаточно подробный алгоритм, отрисовывающий экран буквально построчно, и с программным отсечением. К сожалению, это не всегда помогает на видеокартах, где драйвер OpenGL установлен "из коробки" (т.е. пришел с операционной системой).
В OpenGL есть не вполне понятное мне поведение функции DrawPixels, с помощью которой и отрисовывается экран. Функция достаточно низкоуровневая, и служит для прямого доступа к поверхности экрана. Проблема кроется в том, что OpenGL направляет ось Y вверх, а образ экрана - наоборот. В результате при отрисовке на разных видеокартах поведение оказывается различным - лучше всех себя ведет Intel GMA, который может принимать экран "как есть", и правильно понимает, что "вот это" надо преобразовать в "вон то" - эта фраза включает в себя и правильное отсечение по горизонтали, и разворот оси ординат. А вот дискретные видеокарты почему-то капризничают, что касается прежде всего отсечения. Сейчас в кварке реализован достаточно подробный алгоритм, отрисовывающий экран буквально построчно, и с программным отсечением. К сожалению, это не всегда помогает на видеокартах, где драйвер OpenGL установлен "из коробки" (т.е. пришел с операционной системой).
|
|
|
|
Добавлено: Чт май 27, 2010 21:47 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
в общем - изменил код - в стартовом сообщении - добавил resize по F7
меняет циклически - проверил от 640 до 1024
в общем - изменил код - [b]в стартовом сообщении[/b] - добавил resize по F7
меняет циклически - проверил от 640 до 1024
|
|
|
|
Добавлено: Чт май 27, 2010 21:40 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
VoidVolker писал(а): вопрос писал(а): то есть как? не понял... А так, что часть правого квадрата за пределами экрана. хм, это досадно. можно просто поменять переменные 100 VALUE coord_start_X \ coordinates of game-board 170 VALUE coord_start_Y 495 VALUE H_coord_start_X но чем это вызвано? у меня, похоже, глюк с внутренним позционированием в окне кварка - это не зависит от разрешения при выводе в окне - нормальное позиционирование, при разворачивании окна в полный экран - рисунок резко уплывает вверх такой глюк должен был получиться, если в коде кварка при неразвёрнутом на весь экран окне позиционирование происходит нормально - исходя из размеров окна, а при разворачивании - исходя из разрешения монитора автора вот при окне а вот при полном экране явно никаких 170 стартовых y
[quote="VoidVolker"][quote="вопрос"]то есть как? не понял...[/quote] А так, что часть правого квадрата за пределами экрана.[/quote]
хм, это досадно. можно просто поменять переменные 100 VALUE coord_start_X \ coordinates of game-board 170 VALUE coord_start_Y 495 VALUE H_coord_start_X но чем это вызвано?
у меня, похоже, глюк с внутренним позционированием в окне кварка - это не зависит от разрешения при выводе в окне - нормальное позиционирование, при разворачивании окна в полный экран - рисунок резко уплывает вверх :( такой глюк должен был получиться, если в коде кварка при неразвёрнутом на весь экран окне позиционирование происходит нормально - исходя из размеров окна, а при разворачивании - исходя из разрешения монитора автора
вот при окне [img]http://s03.radikal.ru/i176/1005/3e/87c0946fe6cc.gif[/img]
а вот при полном экране [img]http://s006.radikal.ru/i213/1005/c0/985ba3f63eb7.gif[/img] явно никаких 170 стартовых [size=150][b]y[/b][/size]
|
|
|
|
Добавлено: Чт май 27, 2010 21:05 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
вопрос писал(а): то есть как? не понял... А так, что часть правого квадрата за пределами экрана.
[quote="вопрос"]то есть как? не понял...[/quote] А так, что часть правого квадрата за пределами экрана.
|
|
|
|
Добавлено: Чт май 27, 2010 13:28 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
Цитата: Уже есть RANDOM. это необычный рандом, я с ним потрудился - нужно не совсем в разброс Цитата: А игра на экране не умещается. то есть как? не понял... Цитата: И хелп много раз печатается при повторном вызове. подправил
[quote]Уже есть RANDOM.[/quote] это необычный рандом, я с ним потрудился - нужно [i]не совсем[/i] в разброс [quote]А игра на экране не умещается.[/quote] то есть как? не понял... [quote]И хелп много раз печатается при повторном вызове.[/quote] подправил
|
|
|
|
Добавлено: Чт май 27, 2010 12:04 |
|
|
|
|
|
Заголовок сообщения: |
Re: Игра в квадрат |
|
|
Забавная. А игра на экране не умещается. И хелп много раз печатается при повторном вызове. Следует учесть текущие размеры экрана. вопрос писал(а): HERE 100 CELLS ALLOT VALUE MSTACK Код: 100 ARRAY MSTACK вопрос писал(а): 0 VALUE _BLACK Есть константа BLACK. вопрос писал(а): 10 10 250 RGB VALUE _RED Лишние вычисления. Лучше сразу указывать цвет: Код: 0x0A0AFA VALUE _RED вопрос писал(а): : _RND \ ( --> randomised_0...3 ) Уже есть RANDOM. вопрос писал(а): MSTACK DUP I CELLS + Код: MSTACK DUP I -TH
Забавная. А игра на экране не умещается. И хелп много раз печатается при повторном вызове. Следует учесть текущие размеры экрана. [quote="вопрос"]HERE 100 CELLS ALLOT VALUE MSTACK[/quote] [code]100 ARRAY MSTACK[/code] [quote="вопрос"]0 VALUE _BLACK[/quote] Есть константа BLACK. [quote="вопрос"]10 10 250 RGB VALUE _RED[/quote] Лишние вычисления. Лучше сразу указывать цвет: [code]0x0A0AFA VALUE _RED[/code] [quote="вопрос"]: _RND \ ( --> randomised_0...3 ) [/quote] Уже есть RANDOM. [quote="вопрос"]MSTACK DUP I CELLS +[/quote] [code]MSTACK DUP I -TH[/code]
|
|
|
|
Добавлено: Чт май 27, 2010 11:59 |
|
|
|
|
|
Заголовок сообщения: |
Игра в квадрат |
|
|
Игра в квадратики. Я давно заметил, что на фортеров оказывает какое-то мистическое действие слово four(th) Все придуманные фортерами игры имеют дело с квадратиками или кубиками. Квадрис (тетрис квадратный), позже я обнаружил, что существует КвадриКс (не могу понять, почему такие похожие названия). Недавно был выложен лого для форума с кубиками! Теперь эта игра под squar...k кварк Смысл следующий - две доски с рандомизированно разложенными квадратиками 4 цветов, единственный ход, который можно сделать - перемещение подходящего квадратика с правой доски на левую (в нужную позицию). После того как ход сделан, на левой доске происходит перемена цветов (правая неподвижна). Перемещённый квадратик исчезает с правой доски. Одинаково меняются все квадратики одного цвета - все серые меняются одинаково и т.д. Ни один цвет не остаётся прежним. Таким образом рисунок доски не меняется, меняется только гамма. Однако остаётся неизменным цвет только что перемещённого квадратика - т.е. если перемещён красный квадратик, то он не поменяет цвет вместе с остальными красными, а останется красным, это позволяет менять "рисунок" Успешным считается ход, когда только что перемещённый квадратик образует фигурку, которая в Lines называется square после перемены цветов - т.е. мы переместили квадратик, цвета сменились, его цвет оказался удачен таких фигурок может быть несколько (комбинации squares) малиновый - ход - красным - фигуры Фактически нужно угадать цвет, т.к. - рандомизация. Стратегия угадывания - смысл и задача. После удачного хода образовавшаяся фигурка заштриховывается и ... вошедшие в неё квадратики далее остаются неизменными и цвет не меняют - это "статический результат", "застывшие". Они заштриховываются вертикальными линиями. Ходить на них нельзя. И последнее в игре правило - "застывшие" могут образовывать фигурки squares с новыми квадратиками при одном условии - фигурка образуется только, если в фигурку входит хотя бы один квадратик, сменивший цвет в результате хода, т.е. кроме только что перемещённого квадратика и "застывших". Задача игры - превратить всё в "застывших". Ещё раз - перемещённый квадратик цвет не меняет, "застывшие" тоже, следовательно, нужно угадать смену цвета хотя бы одним квадратиком, образующим фигуру Доска может быть от 3 до 9 размера. (кладём на стек размер и жмём F4) По умолчанию - 5 ( F3) Новая игра с предыдущими установками - F2 Я пробовал и раскладывал доски от 3 до 9. Есть два тренировочных mode меняются циклически по F5 : состояние высвечивается над левой доской EQUALLY - красный в серый -далее голубой, жёлтый, красный ... всегда - цикл - собственно не игра - слишком легко REPETITION RANDOM через раз - полумера - раз рандомизация, другой раз повторение предыдущего порядка смены always RANDOM - нормальное состояние игры F6 - цвета ... Ход - выделяем квадратик на праввой или левой доске и щёлкаем на поле другой доски - ход будет сделан справа налево в любом случае, правая кнопка мыши - отменить выделение. Как играть? Ну, собственно, самое прямолинейное - просто пытаться, исходя их того, что смена цветов совпадёт рано или поздно с нужным замыслом т.к. постоянное несовпадение всего 4 цветов - слишком маловероятно. Но слишком быстро исчерпается правая доска, потому нужно некоторое рассуждение и прогноз - это интеллектуальная задача а не игрушка. Главное открытие, которое должен сделать игрок - при рассуждении и планировании степень везения непропорционально больше, чем при наивных попытках. Собственно, мы играем со своим пониманием вероятности Код: HERE 100 CELLS ALLOT VALUE MSTACK 0 VALUE MSTACK_P
: >MS \ ( n --> ) \ поместить на стек MSTACK_P 99 = IF " MSTACK overflow " PRINT ELSE MSTACK_P DUP 1 + TO MSTACK_P CELLS MSTACK + ! THEN ;
: MS> \ ( n --> ) \ снять со стека MSTACK_P 0 = IF " MSTACK underflow " PRINT ELSE MSTACK_P 1 - DUP TO MSTACK_P CELLS MSTACK + @ THEN ; : MSDEPTH MSTACK_P ;
\ 4 colors
10 10 250 RGB VALUE _RED 50 120 250 RGB VALUE _ORANGE 128 128 128 RGB VALUE _GRAY 250 250 10 RGB VALUE _LIGHTBLUE 10 250 250 RGB VALUE _YELLOW 70 250 70 RGB VALUE _GREEN 255 255 255 RGB VALUE _WHITE 40 40 40 RGB VALUE NEAR_BLACK 0 VALUE _BLACK
0 VALUE colors.type_ \ 0 - first -1 - second : colors.first 10 10 250 RGB TO _RED 50 120 250 RGB TO _ORANGE 128 128 128 RGB TO _GRAY 250 250 10 RGB TO _LIGHTBLUE 10 250 250 RGB TO _YELLOW ;
: colors.second 101 0 235 RGB TO _RED 177 0 201 RGB TO _ORANGE 137 159 159 RGB TO _GRAY 255 195 19 RGB TO _LIGHTBLUE 81 190 255 RGB TO _YELLOW ;
1 VALUE NUMBER_RED 2 VALUE NUMBER_GRAY 3 VALUE NUMBER_LIGHTBLUE 4 VALUE NUMBER_YELLOW 5 VALUE NUMBER_WHITE 6 VALUE NUMBER_BLACK
100 VALUE coord_start_X \ coordinates of game-board 170 VALUE coord_start_Y
495 VALUE H_coord_start_X \ coordinates of instrumental board 170 VALUE H_coord_start_Y
40 VALUE sq_size_ \ size of square
8 VALUE board_size 8 VALUE H_board_size
: color... \ ( number --> color ) CASE NUMBER_RED OF _RED ENDOF NUMBER_GRAY OF _GRAY ENDOF NUMBER_LIGHTBLUE OF _LIGHTBLUE ENDOF NUMBER_YELLOW OF _YELLOW ENDOF NUMBER_WHITE OF _WHITE ENDOF NUMBER_BLACK OF NEAR_BLACK ENDOF 0 OF _BLACK ENDOF ENDCASE ;
0 VALUE sq_paint.color
0 VALUE XY_sq_paint__X \ internal X coordinate for XY_sq_paint : XY_sq_paint \ ( X Y color --> ) TO sq_paint.color SWAP TO XY_sq_paint__X DUP sq_size_ + \ (presently: Begin End ... of y for single sq) SWAP DO XY_sq_paint__X I sq_size_ sq_paint.color HLINE LOOP ; _ORANGE VALUE sep_color : sq_separation_abstract \ ( X Y --> ) несколько примитивно ... OVER OVER OVER OVER OVER OVER sq_size_ sep_color HLINE 1 + SWAP 1 + SWAP sq_size_ 1 - sep_color HLINE 2 + SWAP 2 + SWAP sq_size_ 2 - sep_color HLINE OVER OVER OVER OVER OVER OVER sq_size_ sep_color VLINE 1 + SWAP 1 + SWAP sq_size_ 1 - sep_color VLINE 2 + SWAP 2 + SWAP sq_size_ 2 - sep_color VLINE OVER sq_size_ + 1 - OVER sq_size_ sep_color VLINE sq_size_ + 1 - sq_size_ sep_color HLINE ; : sq_separation \ ( X Y --> ) _WHITE TO sep_color sq_separation_abstract ; : sq_separation_spec \ ( X Y --> ) _ORANGE TO sep_color sq_separation_abstract ;
0 VALUE XY_sq_hatch__Y : hatch \ ( X Y --> ) заштриховать квадратик ... TO XY_sq_hatch__Y DUP sq_size_ + \ (presently: Begin End ... of X for single sq) SWAP DO I XY_sq_hatch__Y sq_size_ _BLACK VLINE 1 I + XY_sq_hatch__Y sq_size_ _BLACK VLINE 4 +LOOP ;
\ board
HERE 81 CELLS ALLOT VALUE LOGIK_BOARD HERE 100 CELLS ALLOT VALUE STATIC_RESULTS HERE 81 CELLS ALLOT VALUE RESERVE_BOARD
\ for random " kernel32.dll" LOADLIBRARY " GetTickCount" GETPROCADDRESS VALUE GTC_ : GTC GTC_ API0 ; \ на стеке - миллисекунды
23 VALUE _RND_FIRST_VALUE 23 VALUE _RND_C 3 VALUE _RND_SECOND_VALUE 71 CONSTANT _RND_BEG 0 VALUE RND__ : _RND_INIT GTC DUP 10000001 < IF 10500000 + THEN 1 OR TO RND__ RND__ _RND_BEG MOD TO _RND_FIRST_VALUE RND__ _RND_FIRST_VALUE MOD DUP 0 > IF 4 MOD 1 + ELSE 3 THEN TO _RND_SECOND_VALUE ;
: _RND \ ( --> randomised_0...3 ) RND__ _RND_FIRST_VALUE MOD 4 MOD 1 + RND__ _RND_FIRST_VALUE RND__ _RND_C / _RND_BEG MOD * + _RND_BEG MOD DUP 0 = IF 17 + _RND_SECOND_VALUE + THEN TO _RND_FIRST_VALUE DUP TO _RND_SECOND_VALUE _RND_C OVER + TO _RND_C ; : start_board \ ( -- ) \ рандомизированно заполняет доску _RND_INIT board_size 0 DO board_size 0 DO _RND J board_size * I + CELLS LOGIK_BOARD + ! \ board 0 J board_size * I + CELLS STATIC_RESULTS + ! \ results LOOP LOOP
board_size 0 DO H_board_size 0 DO _RND J board_size * I + CELLS RESERVE_BOARD + ! \ board LOOP LOOP ;
: show_boards \ ( -- ) \ доску board_size 0 DO board_size 0 DO sq_size_ J * coord_start_Y + sq_size_ I * coord_start_X + SWAP OVER OVER J board_size * I + CELLS LOGIK_BOARD + @ color... XY_sq_paint J board_size * I + CELLS STATIC_RESULTS + @ IF hatch ELSE DROP DROP THEN LOOP LOOP
board_size 0 DO board_size 0 DO sq_size_ J * coord_start_Y + sq_size_ I * H_coord_start_X + SWAP J board_size * I + CELLS RESERVE_BOARD + @ color... XY_sq_paint LOOP LOOP ;
1 VALUE coord_logik \ координаты клика мышкой - основная доска 2 VALUE coord_reserv \ координаты клика мышкой - дополнительная доска 0 VALUE coord_free \ координаты - никакие
0 VALUE last_ 0 VALUE last_color 0 VALUE click_status \ последний клик? 0 VALUE separate_status \ выбрано ? 0 VALUE last_selected_y \ выбрано ? 0 VALUE last_selected_x \ выбрано ?
: coord_logik_X_?? \ ( X --> FLAG ) DUP coord_start_X < NOT SWAP coord_start_X sq_size_ board_size * + 1 - > NOT AND ; : coord_reserv_X_?? \ ( X --> FLAG ) DUP H_coord_start_X < NOT SWAP H_coord_start_X sq_size_ H_board_size * + 1 - > NOT AND ; : coord_logik_Y_?? \ ( Y --> FLAG ) DUP coord_start_Y < NOT SWAP coord_start_Y sq_size_ board_size * + 1 - > NOT AND ; : coord_ \ ( --> X Y status) MOUSE-X @ DUP coord_logik_X_?? IF MOUSE-Y @ DUP coord_logik_Y_?? IF coord_logik ELSE coord_free THEN ELSE MOUSE-Y @ DUP coord_logik_Y_?? IF OVER coord_reserv_X_?? IF coord_reserv ELSE coord_free THEN ELSE coord_free THEN THEN ;
: logik_board:(cell-->pixel) \ ( NUMBER_Y NUMBER_X --> X Y ) sq_size_ * coord_start_X + SWAP sq_size_ * coord_start_Y + ; : reserve_board:(cell-->pixel) \ ( NUMBER_Y NUMBER_X --> X Y ) sq_size_ * H_coord_start_X + SWAP sq_size_ * coord_start_Y + ; : select \ ( X Y --> )
click_status TO separate_status DUP TO last_selected_x OVER TO last_selected_y click_status coord_logik = IF logik_board:(cell-->pixel) ELSE reserve_board:(cell-->pixel) THEN sq_separation ;
: deselect \ ( --> ) 0 TO separate_status 0 TO last_selected_y 0 TO last_selected_x show_boards ; : no_hatch? \ ( Y X --> Y X Flag ) click_status coord_logik = IF OVER OVER SWAP board_size * + CELLS STATIC_RESULTS + @ 0 = ELSE OVER OVER SWAP H_board_size * + CELLS RESERVE_BOARD + @ 0 > THEN ;
\ 0 VALUE pause_count \ предполагалась пауза таймра 0 VALUE pause_start.mouse_left 0 VALUE pause_start.mouse_right : mouse_pause \ пауза до любого клика мышью pause_start.mouse_left TO <MOUSE_LEFT> pause_start.mouse_right TO <MOUSE_RIGHT> ['] NOOP TO <MOUSE_WHEEL> show_boards ;
: mouse_pause_start ['] mouse_pause TO <MOUSE_LEFT> ['] mouse_pause TO <MOUSE_RIGHT> ['] mouse_pause TO <MOUSE_WHEEL> ;
: to_last board_size * + CELLS LOGIK_BOARD + TO last_ ;
0 VALUE square?_top 0 VALUE square?_top_left 0 VALUE square?_bottom 0 VALUE square?_bottom_left 0 VALUE square?_left 0 VALUE square?_top_right 0 VALUE square?_right 0 VALUE square?_bottom_right \ : square?_NSF \ ( -- flag ) square is Not Single free Flag 0 MSTACK_P 0 DO MSTACK DUP I CELLS + @ SWAP I 1 + CELLS + @ SWAP board_size * + CELLS STATIC_RESULTS + @ 0 = IF 1 + THEN 2 +LOOP 0 > ;
: resultativ? board_size * + CELLS LOGIK_BOARD + @ last_color = ;
: square? \ ( X Y -- TRUE | FALSE ) 0 TO MSTACK_P 0 TO MSTACK_P 0 TO square?_right 0 TO square?_left 0 TO square?_bottom 0 TO square?_top 0 TO square?_bottom_left 0 TO square?_top_left 0 TO square?_bottom_right 0 TO square?_top_right
DUP 0 > >MS OVER OVER 1 - resultativ? MS> AND TO square?_top OVER 0 > >MS OVER 1 - OVER resultativ? MS> AND TO square?_left DUP board_size 1 - < >MS OVER OVER 1 + resultativ? MS> AND TO square?_bottom OVER board_size 1 - < >MS OVER 1 + OVER resultativ? MS> AND TO square?_right square?_left square?_top AND IF OVER 1 - OVER 1 - resultativ? IF -1 TO square?_top_left THEN THEN square?_left square?_bottom AND IF OVER 1 - OVER 1 + resultativ? IF -1 TO square?_bottom_left THEN THEN square?_right square?_top AND IF OVER 1 + OVER 1 - resultativ? IF -1 TO square?_top_right THEN THEN square?_right square?_bottom AND IF OVER 1 + OVER 1 + resultativ? IF -1 TO square?_bottom_right THEN THEN square?_top_left IF OVER 1 - OVER 1 - >MS >MS OVER 1 - OVER >MS >MS OVER OVER 1 - >MS >MS THEN square?_top_right IF square?_top_left NOT IF OVER OVER 1 - >MS >MS THEN OVER 1 + OVER 1 - >MS >MS OVER 1 + OVER >MS >MS THEN square?_bottom_right IF square?_top_right NOT IF OVER 1 + OVER >MS >MS THEN OVER 1 + OVER 1 + >MS >MS OVER OVER 1 + >MS >MS THEN square?_bottom_left IF square?_bottom_right NOT IF OVER OVER 1 + >MS >MS THEN OVER 1 - OVER 1 + >MS >MS square?_top_left NOT IF OVER 1 - OVER >MS >MS THEN THEN MSTACK_P 0 > IF square?_NSF ELSE 0 THEN IF >MS >MS -1 ELSE DROP DROP 0 THEN ; \ ( end: square? )
: rules_aply last_ LOGIK_BOARD - 1 CELLS / DUP board_size MOD SWAP board_size /
\ (presently: x y ) square? deselect show_boards IF MS> MS> OVER OVER SWAP logik_board:(cell-->pixel) sq_separation board_size * + CELLS STATIC_RESULTS + -1 SWAP ! BEGIN MSTACK_P 0 > WHILE MS> MS> OVER OVER SWAP logik_board:(cell-->pixel) sq_separation_spec board_size * + CELLS STATIC_RESULTS + -1 SWAP ! REPEAT mouse_pause_start THEN ;
: bstepmr_RAND 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " RANDOM " PRINT 1 1 TEXTXY ; : bstepmr_REPETITION 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " REPETITION " PRINT 1 1 TEXTXY ; : bstepmr_equally 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " EQUALLY " PRINT 1 1 TEXTXY ; : bstepmr_alwaysrand 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " always RANDOM " PRINT 1 1 TEXTXY ; 1 VALUE board_step.mode -1 VALUE board_step.mode_paar.flag \ менять или не менять способ перемещения 2 VALUE board_step.mode_paar 0 VALUE board_step.mode_simple 1 VALUE board_step.mode_random HERE 5 CELLS ALLOT VALUE board_step.array 0 VALUE board_step.temp : board_step.randomize 5 1 DO 0 I CELLS board_step.array + ! LOOP 5 1 DO I 3 = 4 CELLS board_step.array + @ 0 = AND IF 3 4 CELLS board_step.array + ! ELSE BEGIN
_RND DUP I = IF DROP 0 ELSE CELLS board_step.array + DUP @ 0 = IF I SWAP ! -1 ELSE DROP 0 THEN THEN UNTIL THEN LOOP ;
: board_step board_step.mode board_step.mode_simple = IF bstepmr_equally board_size 0 DO board_size 0 DO J board_size * I + CELLS LOGIK_BOARD + DUP @ J board_size * I + CELLS STATIC_RESULTS + @ 0 = IF DUP 4 = IF 3 - ELSE 1 + THEN SWAP ! ELSE DROP DROP THEN LOOP LOOP ELSE
board_step.mode board_step.mode_paar = IF board_step.mode_paar.flag IF board_step.randomize 0 TO board_step.mode_paar.flag bstepmr_REPETITION ELSE -1 TO board_step.mode_paar.flag bstepmr_RAND THEN ELSE board_step.randomize bstepmr_alwaysrand THEN board_size 0 DO board_size 0 DO J board_size * I + CELLS LOGIK_BOARD + DUP @ J board_size * I + CELLS STATIC_RESULTS + @ 0 = IF CELLS board_step.array + @ SWAP ! ELSE DROP DROP THEN LOOP LOOP THEN last_color last_ ! ;
: move_from \ ( Y X --> ) \ на стеке - последний клик (адрес на осн. доске) \ в переменных - адрес на вспомогательной доске OVER OVER SWAP to_last SWAP board_size * + CELLS LOGIK_BOARD + last_selected_x last_selected_y H_board_size * + CELLS RESERVE_BOARD + DUP @ DUP TO last_color SWAP 0 SWAP ! SWAP ! ; : move_to \ ( Y X --> ) \ на стеке - последний клик (адрес на вспомогательной доске) \ в переменных - адрес на осн. доске SWAP H_board_size * + CELLS RESERVE_BOARD + DUP @ DUP TO last_color SWAP 0 SWAP ! last_selected_x last_selected_y OVER OVER to_last board_size * + CELLS LOGIK_BOARD + ! ; : game_step \ ( Y X --> ) no_hatch? IF separate_status 0 > IF click_status separate_status = IF deselect select ELSE click_status coord_logik = IF move_from ELSE move_to THEN board_step \ color for board to change rules_aply \ if colors combination effect THEN ELSE select THEN ELSE DROP DROP THEN ;
: logik_board:(pixel-->cell) \ ( X Y --> NUMBER_Y NUMBER_X ) coord_start_Y - sq_size_ / SWAP coord_start_X - sq_size_ / ; : reserve_board:(pixel-->cell) \ ( X Y --> NUMBER_Y NUMBER_X ) coord_start_Y - sq_size_ / SWAP H_coord_start_X - sq_size_ / ; : mouse_right deselect ; ' mouse_right DUP TO <MOUSE_RIGHT> TO pause_start.mouse_right : mouse_left coord_ DUP 0 > IF DUP TO click_status coord_logik =
IF logik_board:(pixel-->cell) ELSE reserve_board:(pixel-->cell) THEN game_step ELSE deselect DROP DROP DROP THEN ; : colors.type_change colors.type_ IF colors.first 0 TO colors.type_ ELSE colors.second -1 TO colors.type_ THEN show_boards ; ' colors.type_change TO K_F6
\ - - - - - - - - - - - - - - - - - - : mode_change board_step.mode CASE board_step.mode_simple OF board_step.mode_random TO board_step.mode bstepmr_alwaysrand ENDOF board_step.mode_random OF board_step.mode_paar TO board_step.mode bstepmr_RAND ENDOF board_step.mode_paar OF board_step.mode_simple TO board_step.mode bstepmr_equally ENDOF ENDCASE ; ' mode_change TO K_F5
: start_game start_board deselect CLS show_boards ['] mouse_left DUP TO <MOUSE_LEFT> TO pause_start.mouse_left -1 TO board_step.mode_paar.flag ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : start_regular \ ( -- ) board_size DUP 2 > SWAP 10 < AND H_board_size DUP 2 > SWAP 10 < AND AND IF start_game ELSE 5 TO board_size 5 TO H_board_size start_game " Размер доски должен быть между 3 и 9, по умолчанию 5 (установлено) " PRINT THEN ; : start_default 5 TO board_size 5 TO H_board_size board_step.mode_random TO board_step.mode start_game ;
: start_new_size DEPTH 1 < IF " На стеке нет размера доски ! " PRINT CR ELSE DUP 2 > OVER 10 < AND IF DUP TO board_size TO H_board_size board_step.mode_random TO board_step.mode start_game ELSE " Размер доски должен быть между 3 и 9 " PRINT THEN THEN ; ' start_default TO K_F3 ' start_regular TO K_F2 ' start_new_size TO K_F4
: help... " F1 - help F2 - start new game F3 - start default game F4 - start new size F5 - random mode F6 - colors F7 - size_tuning" PRINT 0 0 GOTOXY ; ' help... TO K_F1 help...
\ RESIZE 0 VALUE IMAGE_SIZE : size_tuning IMAGE_SIZE CASE 0 OF 1 TO IMAGE_SIZE 20 TO coord_start_X 50 TO coord_start_Y 30 TO sq_size_ 320 TO H_coord_start_X ENDOF 1 OF 2 TO IMAGE_SIZE 50 TO coord_start_X 50 TO coord_start_Y 36 TO sq_size_ 390 TO H_coord_start_X ENDOF 2 OF 0 TO IMAGE_SIZE 80 TO coord_start_X 170 TO coord_start_Y 40 TO sq_size_ 460 TO H_coord_start_X ENDOF ENDCASE CLS show_boards ; ' size_tuning TO K_F7
Игра в квадратики. Я давно заметил, что на фортеров оказывает какое-то мистическое действие слово four(th) Все придуманные фортерами игры имеют дело с квадратиками или кубиками. Квадрис (тетрис квадратный), позже я обнаружил, что существует КвадриКс (не могу понять, почему такие похожие названия). Недавно был выложен лого для форума с кубиками! :?
[size=150]Теперь эта игра под [s]squar[/s]...k :o :shock: кварк [/size] Смысл следующий - две доски с рандомизированно разложенными квадратиками 4 цветов, единственный ход, который можно сделать - перемещение подходящего квадратика с правой доски на левую (в нужную позицию). После того как ход сделан, на левой доске происходит перемена цветов (правая неподвижна). Перемещённый квадратик исчезает с правой доски. Одинаково меняются все квадратики одного цвета - все серые меняются одинаково и т.д. Ни один цвет не остаётся прежним. Таким образом рисунок доски не меняется, меняется только гамма. Однако остаётся неизменным цвет только что перемещённого квадратика - т.е. если перемещён красный квадратик, то он не поменяет цвет вместе с остальными красными, а останется красным, это позволяет менять "рисунок" Успешным считается ход, когда только что перемещённый квадратик образует фигурку, которая в Lines называется square после перемены цветов - т.е. мы переместили квадратик, цвета сменились, его цвет оказался удачен таких фигурок может быть несколько (комбинации squares) [img]http://s49.radikal.ru/i124/1005/d0/839b2cf14946.jpg[/img] малиновый - ход - красным - фигуры Фактически нужно угадать цвет, т.к. - рандомизация. [b]Стратегия угадывания - смысл и задача. [/b] После удачного хода образовавшаяся фигурка заштриховывается и ... вошедшие в неё квадратики далее остаются неизменными и цвет не меняют - это "статический результат", "застывшие". Они заштриховываются вертикальными линиями. Ходить на них нельзя. И последнее в игре правило - "застывшие" могут образовывать фигурки squares с новыми квадратиками при одном условии - фигурка образуется только, если в фигурку входит хотя бы один квадратик, сменивший цвет в результате хода, т.е. кроме только что перемещённого квадратика и "застывших". Задача игры - превратить всё в "застывших". Ещё раз - перемещённый квадратик цвет не меняет, "застывшие" тоже, следовательно, нужно угадать смену цвета хотя бы одним квадратиком, образующим фигуру
Доска может быть от 3 до 9 размера. (кладём на стек размер и жмём F4) По умолчанию - 5 ( F3) Новая игра с предыдущими установками - F2 Я пробовал и раскладывал доски от 3 до 9.
Есть два тренировочных mode :) меняются циклически по F5 : состояние высвечивается над левой доской EQUALLY - красный в серый -далее голубой, жёлтый, красный ... всегда - цикл - собственно не игра - слишком легко REPETITION RANDOM через раз - полумера - раз рандомизация, другой раз повторение предыдущего порядка смены always RANDOM - нормальное состояние игры
F6 - цвета ... Ход - выделяем квадратик на праввой или левой доске и щёлкаем на поле другой доски - ход будет сделан справа налево в любом случае, правая кнопка мыши - отменить выделение.
Как играть? Ну, собственно, самое прямолинейное - просто пытаться, исходя их того, что смена цветов совпадёт рано или поздно с нужным замыслом :) т.к. постоянное несовпадение всего 4 цветов - слишком маловероятно. Но слишком быстро исчерпается правая доска, потому нужно некоторое рассуждение и прогноз - это интеллектуальная задача а не игрушка. Главное открытие, которое должен сделать игрок - при рассуждении и планировании степень везения непропорционально больше, чем при наивных попытках. [b]Собственно, мы играем со своим пониманием вероятности[/b]
[code] HERE 100 CELLS ALLOT VALUE MSTACK 0 VALUE MSTACK_P
: >MS \ ( n --> ) \ поместить на стек MSTACK_P 99 = IF " MSTACK overflow " PRINT ELSE MSTACK_P DUP 1 + TO MSTACK_P CELLS MSTACK + ! THEN ;
: MS> \ ( n --> ) \ снять со стека MSTACK_P 0 = IF " MSTACK underflow " PRINT ELSE MSTACK_P 1 - DUP TO MSTACK_P CELLS MSTACK + @ THEN ; : MSDEPTH MSTACK_P ;
\ 4 colors
10 10 250 RGB VALUE _RED 50 120 250 RGB VALUE _ORANGE 128 128 128 RGB VALUE _GRAY 250 250 10 RGB VALUE _LIGHTBLUE 10 250 250 RGB VALUE _YELLOW 70 250 70 RGB VALUE _GREEN 255 255 255 RGB VALUE _WHITE 40 40 40 RGB VALUE NEAR_BLACK 0 VALUE _BLACK
0 VALUE colors.type_ \ 0 - first -1 - second : colors.first 10 10 250 RGB TO _RED 50 120 250 RGB TO _ORANGE 128 128 128 RGB TO _GRAY 250 250 10 RGB TO _LIGHTBLUE 10 250 250 RGB TO _YELLOW ;
: colors.second 101 0 235 RGB TO _RED 177 0 201 RGB TO _ORANGE 137 159 159 RGB TO _GRAY 255 195 19 RGB TO _LIGHTBLUE 81 190 255 RGB TO _YELLOW ;
1 VALUE NUMBER_RED 2 VALUE NUMBER_GRAY 3 VALUE NUMBER_LIGHTBLUE 4 VALUE NUMBER_YELLOW 5 VALUE NUMBER_WHITE 6 VALUE NUMBER_BLACK
100 VALUE coord_start_X \ coordinates of game-board 170 VALUE coord_start_Y
495 VALUE H_coord_start_X \ coordinates of instrumental board 170 VALUE H_coord_start_Y
40 VALUE sq_size_ \ size of square
8 VALUE board_size 8 VALUE H_board_size
: color... \ ( number --> color ) CASE NUMBER_RED OF _RED ENDOF NUMBER_GRAY OF _GRAY ENDOF NUMBER_LIGHTBLUE OF _LIGHTBLUE ENDOF NUMBER_YELLOW OF _YELLOW ENDOF NUMBER_WHITE OF _WHITE ENDOF NUMBER_BLACK OF NEAR_BLACK ENDOF 0 OF _BLACK ENDOF ENDCASE ;
0 VALUE sq_paint.color
0 VALUE XY_sq_paint__X \ internal X coordinate for XY_sq_paint : XY_sq_paint \ ( X Y color --> ) TO sq_paint.color SWAP TO XY_sq_paint__X DUP sq_size_ + \ (presently: Begin End ... of y for single sq) SWAP DO XY_sq_paint__X I sq_size_ sq_paint.color HLINE LOOP ; _ORANGE VALUE sep_color : sq_separation_abstract \ ( X Y --> ) несколько примитивно ... OVER OVER OVER OVER OVER OVER sq_size_ sep_color HLINE 1 + SWAP 1 + SWAP sq_size_ 1 - sep_color HLINE 2 + SWAP 2 + SWAP sq_size_ 2 - sep_color HLINE OVER OVER OVER OVER OVER OVER sq_size_ sep_color VLINE 1 + SWAP 1 + SWAP sq_size_ 1 - sep_color VLINE 2 + SWAP 2 + SWAP sq_size_ 2 - sep_color VLINE OVER sq_size_ + 1 - OVER sq_size_ sep_color VLINE sq_size_ + 1 - sq_size_ sep_color HLINE ; : sq_separation \ ( X Y --> ) _WHITE TO sep_color sq_separation_abstract ; : sq_separation_spec \ ( X Y --> ) _ORANGE TO sep_color sq_separation_abstract ;
0 VALUE XY_sq_hatch__Y : hatch \ ( X Y --> ) заштриховать квадратик ... TO XY_sq_hatch__Y DUP sq_size_ + \ (presently: Begin End ... of X for single sq) SWAP DO I XY_sq_hatch__Y sq_size_ _BLACK VLINE 1 I + XY_sq_hatch__Y sq_size_ _BLACK VLINE 4 +LOOP ;
\ board
HERE 81 CELLS ALLOT VALUE LOGIK_BOARD HERE 100 CELLS ALLOT VALUE STATIC_RESULTS HERE 81 CELLS ALLOT VALUE RESERVE_BOARD
\ for random " kernel32.dll" LOADLIBRARY " GetTickCount" GETPROCADDRESS VALUE GTC_ : GTC GTC_ API0 ; \ на стеке - миллисекунды
23 VALUE _RND_FIRST_VALUE 23 VALUE _RND_C 3 VALUE _RND_SECOND_VALUE 71 CONSTANT _RND_BEG 0 VALUE RND__ : _RND_INIT GTC DUP 10000001 < IF 10500000 + THEN 1 OR TO RND__ RND__ _RND_BEG MOD TO _RND_FIRST_VALUE RND__ _RND_FIRST_VALUE MOD DUP 0 > IF 4 MOD 1 + ELSE 3 THEN TO _RND_SECOND_VALUE ;
: _RND \ ( --> randomised_0...3 ) RND__ _RND_FIRST_VALUE MOD 4 MOD 1 + RND__ _RND_FIRST_VALUE RND__ _RND_C / _RND_BEG MOD * + _RND_BEG MOD DUP 0 = IF 17 + _RND_SECOND_VALUE + THEN TO _RND_FIRST_VALUE DUP TO _RND_SECOND_VALUE _RND_C OVER + TO _RND_C ; : start_board \ ( -- ) \ рандомизированно заполняет доску _RND_INIT board_size 0 DO board_size 0 DO _RND J board_size * I + CELLS LOGIK_BOARD + ! \ board 0 J board_size * I + CELLS STATIC_RESULTS + ! \ results LOOP LOOP
board_size 0 DO H_board_size 0 DO _RND J board_size * I + CELLS RESERVE_BOARD + ! \ board LOOP LOOP ;
: show_boards \ ( -- ) \ доску board_size 0 DO board_size 0 DO sq_size_ J * coord_start_Y + sq_size_ I * coord_start_X + SWAP OVER OVER J board_size * I + CELLS LOGIK_BOARD + @ color... XY_sq_paint J board_size * I + CELLS STATIC_RESULTS + @ IF hatch ELSE DROP DROP THEN LOOP LOOP
board_size 0 DO board_size 0 DO sq_size_ J * coord_start_Y + sq_size_ I * H_coord_start_X + SWAP J board_size * I + CELLS RESERVE_BOARD + @ color... XY_sq_paint LOOP LOOP ;
1 VALUE coord_logik \ координаты клика мышкой - основная доска 2 VALUE coord_reserv \ координаты клика мышкой - дополнительная доска 0 VALUE coord_free \ координаты - никакие
0 VALUE last_ 0 VALUE last_color 0 VALUE click_status \ последний клик? 0 VALUE separate_status \ выбрано ? 0 VALUE last_selected_y \ выбрано ? 0 VALUE last_selected_x \ выбрано ?
: coord_logik_X_?? \ ( X --> FLAG ) DUP coord_start_X < NOT SWAP coord_start_X sq_size_ board_size * + 1 - > NOT AND ; : coord_reserv_X_?? \ ( X --> FLAG ) DUP H_coord_start_X < NOT SWAP H_coord_start_X sq_size_ H_board_size * + 1 - > NOT AND ; : coord_logik_Y_?? \ ( Y --> FLAG ) DUP coord_start_Y < NOT SWAP coord_start_Y sq_size_ board_size * + 1 - > NOT AND ; : coord_ \ ( --> X Y status) MOUSE-X @ DUP coord_logik_X_?? IF MOUSE-Y @ DUP coord_logik_Y_?? IF coord_logik ELSE coord_free THEN ELSE MOUSE-Y @ DUP coord_logik_Y_?? IF OVER coord_reserv_X_?? IF coord_reserv ELSE coord_free THEN ELSE coord_free THEN THEN ;
: logik_board:(cell-->pixel) \ ( NUMBER_Y NUMBER_X --> X Y ) sq_size_ * coord_start_X + SWAP sq_size_ * coord_start_Y + ; : reserve_board:(cell-->pixel) \ ( NUMBER_Y NUMBER_X --> X Y ) sq_size_ * H_coord_start_X + SWAP sq_size_ * coord_start_Y + ; : select \ ( X Y --> )
click_status TO separate_status DUP TO last_selected_x OVER TO last_selected_y click_status coord_logik = IF logik_board:(cell-->pixel) ELSE reserve_board:(cell-->pixel) THEN sq_separation ;
: deselect \ ( --> ) 0 TO separate_status 0 TO last_selected_y 0 TO last_selected_x show_boards ; : no_hatch? \ ( Y X --> Y X Flag ) click_status coord_logik = IF OVER OVER SWAP board_size * + CELLS STATIC_RESULTS + @ 0 = ELSE OVER OVER SWAP H_board_size * + CELLS RESERVE_BOARD + @ 0 > THEN ;
\ 0 VALUE pause_count \ предполагалась пауза таймра 0 VALUE pause_start.mouse_left 0 VALUE pause_start.mouse_right : mouse_pause \ пауза до любого клика мышью pause_start.mouse_left TO <MOUSE_LEFT> pause_start.mouse_right TO <MOUSE_RIGHT> ['] NOOP TO <MOUSE_WHEEL> show_boards ;
: mouse_pause_start ['] mouse_pause TO <MOUSE_LEFT> ['] mouse_pause TO <MOUSE_RIGHT> ['] mouse_pause TO <MOUSE_WHEEL> ;
: to_last board_size * + CELLS LOGIK_BOARD + TO last_ ;
0 VALUE square?_top 0 VALUE square?_top_left 0 VALUE square?_bottom 0 VALUE square?_bottom_left 0 VALUE square?_left 0 VALUE square?_top_right 0 VALUE square?_right 0 VALUE square?_bottom_right \ : square?_NSF \ ( -- flag ) square is Not Single free Flag 0 MSTACK_P 0 DO MSTACK DUP I CELLS + @ SWAP I 1 + CELLS + @ SWAP board_size * + CELLS STATIC_RESULTS + @ 0 = IF 1 + THEN 2 +LOOP 0 > ;
: resultativ? board_size * + CELLS LOGIK_BOARD + @ last_color = ;
: square? \ ( X Y -- TRUE | FALSE ) 0 TO MSTACK_P 0 TO MSTACK_P 0 TO square?_right 0 TO square?_left 0 TO square?_bottom 0 TO square?_top 0 TO square?_bottom_left 0 TO square?_top_left 0 TO square?_bottom_right 0 TO square?_top_right
DUP 0 > >MS OVER OVER 1 - resultativ? MS> AND TO square?_top OVER 0 > >MS OVER 1 - OVER resultativ? MS> AND TO square?_left DUP board_size 1 - < >MS OVER OVER 1 + resultativ? MS> AND TO square?_bottom OVER board_size 1 - < >MS OVER 1 + OVER resultativ? MS> AND TO square?_right square?_left square?_top AND IF OVER 1 - OVER 1 - resultativ? IF -1 TO square?_top_left THEN THEN square?_left square?_bottom AND IF OVER 1 - OVER 1 + resultativ? IF -1 TO square?_bottom_left THEN THEN square?_right square?_top AND IF OVER 1 + OVER 1 - resultativ? IF -1 TO square?_top_right THEN THEN square?_right square?_bottom AND IF OVER 1 + OVER 1 + resultativ? IF -1 TO square?_bottom_right THEN THEN square?_top_left IF OVER 1 - OVER 1 - >MS >MS OVER 1 - OVER >MS >MS OVER OVER 1 - >MS >MS THEN square?_top_right IF square?_top_left NOT IF OVER OVER 1 - >MS >MS THEN OVER 1 + OVER 1 - >MS >MS OVER 1 + OVER >MS >MS THEN square?_bottom_right IF square?_top_right NOT IF OVER 1 + OVER >MS >MS THEN OVER 1 + OVER 1 + >MS >MS OVER OVER 1 + >MS >MS THEN square?_bottom_left IF square?_bottom_right NOT IF OVER OVER 1 + >MS >MS THEN OVER 1 - OVER 1 + >MS >MS square?_top_left NOT IF OVER 1 - OVER >MS >MS THEN THEN MSTACK_P 0 > IF square?_NSF ELSE 0 THEN IF >MS >MS -1 ELSE DROP DROP 0 THEN ; \ ( end: square? )
: rules_aply last_ LOGIK_BOARD - 1 CELLS / DUP board_size MOD SWAP board_size /
\ (presently: x y ) square? deselect show_boards IF MS> MS> OVER OVER SWAP logik_board:(cell-->pixel) sq_separation board_size * + CELLS STATIC_RESULTS + -1 SWAP ! BEGIN MSTACK_P 0 > WHILE MS> MS> OVER OVER SWAP logik_board:(cell-->pixel) sq_separation_spec board_size * + CELLS STATIC_RESULTS + -1 SWAP ! REPEAT mouse_pause_start THEN ;
: bstepmr_RAND 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " RANDOM " PRINT 1 1 TEXTXY ; : bstepmr_REPETITION 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " REPETITION " PRINT 1 1 TEXTXY ; : bstepmr_equally 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " EQUALLY " PRINT 1 1 TEXTXY ; : bstepmr_alwaysrand 130 coord_start_Y 24 - TEXTXY " " PRINT 130 coord_start_Y 24 - TEXTXY " always RANDOM " PRINT 1 1 TEXTXY ; 1 VALUE board_step.mode -1 VALUE board_step.mode_paar.flag \ менять или не менять способ перемещения 2 VALUE board_step.mode_paar 0 VALUE board_step.mode_simple 1 VALUE board_step.mode_random HERE 5 CELLS ALLOT VALUE board_step.array 0 VALUE board_step.temp : board_step.randomize 5 1 DO 0 I CELLS board_step.array + ! LOOP 5 1 DO I 3 = 4 CELLS board_step.array + @ 0 = AND IF 3 4 CELLS board_step.array + ! ELSE BEGIN
_RND DUP I = IF DROP 0 ELSE CELLS board_step.array + DUP @ 0 = IF I SWAP ! -1 ELSE DROP 0 THEN THEN UNTIL THEN LOOP ;
: board_step board_step.mode board_step.mode_simple = IF bstepmr_equally board_size 0 DO board_size 0 DO J board_size * I + CELLS LOGIK_BOARD + DUP @ J board_size * I + CELLS STATIC_RESULTS + @ 0 = IF DUP 4 = IF 3 - ELSE 1 + THEN SWAP ! ELSE DROP DROP THEN LOOP LOOP ELSE
board_step.mode board_step.mode_paar = IF board_step.mode_paar.flag IF board_step.randomize 0 TO board_step.mode_paar.flag bstepmr_REPETITION ELSE -1 TO board_step.mode_paar.flag bstepmr_RAND THEN ELSE board_step.randomize bstepmr_alwaysrand THEN board_size 0 DO board_size 0 DO J board_size * I + CELLS LOGIK_BOARD + DUP @ J board_size * I + CELLS STATIC_RESULTS + @ 0 = IF CELLS board_step.array + @ SWAP ! ELSE DROP DROP THEN LOOP LOOP THEN last_color last_ ! ;
: move_from \ ( Y X --> ) \ на стеке - последний клик (адрес на осн. доске) \ в переменных - адрес на вспомогательной доске OVER OVER SWAP to_last SWAP board_size * + CELLS LOGIK_BOARD + last_selected_x last_selected_y H_board_size * + CELLS RESERVE_BOARD + DUP @ DUP TO last_color SWAP 0 SWAP ! SWAP ! ; : move_to \ ( Y X --> ) \ на стеке - последний клик (адрес на вспомогательной доске) \ в переменных - адрес на осн. доске SWAP H_board_size * + CELLS RESERVE_BOARD + DUP @ DUP TO last_color SWAP 0 SWAP ! last_selected_x last_selected_y OVER OVER to_last board_size * + CELLS LOGIK_BOARD + ! ; : game_step \ ( Y X --> ) no_hatch? IF separate_status 0 > IF click_status separate_status = IF deselect select ELSE click_status coord_logik = IF move_from ELSE move_to THEN board_step \ color for board to change rules_aply \ if colors combination effect THEN ELSE select THEN ELSE DROP DROP THEN ;
: logik_board:(pixel-->cell) \ ( X Y --> NUMBER_Y NUMBER_X ) coord_start_Y - sq_size_ / SWAP coord_start_X - sq_size_ / ; : reserve_board:(pixel-->cell) \ ( X Y --> NUMBER_Y NUMBER_X ) coord_start_Y - sq_size_ / SWAP H_coord_start_X - sq_size_ / ; : mouse_right deselect ; ' mouse_right DUP TO <MOUSE_RIGHT> TO pause_start.mouse_right : mouse_left coord_ DUP 0 > IF DUP TO click_status coord_logik =
IF logik_board:(pixel-->cell) ELSE reserve_board:(pixel-->cell) THEN game_step ELSE deselect DROP DROP DROP THEN ; : colors.type_change colors.type_ IF colors.first 0 TO colors.type_ ELSE colors.second -1 TO colors.type_ THEN show_boards ; ' colors.type_change TO K_F6
\ - - - - - - - - - - - - - - - - - - : mode_change board_step.mode CASE board_step.mode_simple OF board_step.mode_random TO board_step.mode bstepmr_alwaysrand ENDOF board_step.mode_random OF board_step.mode_paar TO board_step.mode bstepmr_RAND ENDOF board_step.mode_paar OF board_step.mode_simple TO board_step.mode bstepmr_equally ENDOF ENDCASE ; ' mode_change TO K_F5
: start_game start_board deselect CLS show_boards ['] mouse_left DUP TO <MOUSE_LEFT> TO pause_start.mouse_left -1 TO board_step.mode_paar.flag ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : start_regular \ ( -- ) board_size DUP 2 > SWAP 10 < AND H_board_size DUP 2 > SWAP 10 < AND AND IF start_game ELSE 5 TO board_size 5 TO H_board_size start_game " Размер доски должен быть между 3 и 9, по умолчанию 5 (установлено) " PRINT THEN ; : start_default 5 TO board_size 5 TO H_board_size board_step.mode_random TO board_step.mode start_game ;
: start_new_size DEPTH 1 < IF " На стеке нет размера доски ! " PRINT CR ELSE DUP 2 > OVER 10 < AND IF DUP TO board_size TO H_board_size board_step.mode_random TO board_step.mode start_game ELSE " Размер доски должен быть между 3 и 9 " PRINT THEN THEN ; ' start_default TO K_F3 ' start_regular TO K_F2 ' start_new_size TO K_F4
: help... " F1 - help F2 - start new game F3 - start default game F4 - start new size F5 - random mode F6 - colors F7 - size_tuning" PRINT 0 0 GOTOXY ; ' help... TO K_F1 help...
\ RESIZE 0 VALUE IMAGE_SIZE : size_tuning IMAGE_SIZE CASE 0 OF 1 TO IMAGE_SIZE 20 TO coord_start_X 50 TO coord_start_Y 30 TO sq_size_ 320 TO H_coord_start_X ENDOF 1 OF 2 TO IMAGE_SIZE 50 TO coord_start_X 50 TO coord_start_Y 36 TO sq_size_ 390 TO H_coord_start_X ENDOF 2 OF 0 TO IMAGE_SIZE 80 TO coord_start_X 170 TO coord_start_Y 40 TO sq_size_ 460 TO H_coord_start_X ENDOF ENDCASE CLS show_boards ; ' size_tuning TO K_F7
[/code]
|
|
|
|
Добавлено: Чт май 27, 2010 11:40 |
|
|
|
|