Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Пн июл 16, 2018 02:37

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 13 ] 
Автор Сообщение
 Заголовок сообщения: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 11:40 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Игра в квадратики. Я давно заметил, что на фортеров оказывает какое-то мистическое действие слово four(th)
Все придуманные фортерами игры имеют дело с квадратиками или кубиками. Квадрис (тетрис квадратный), позже я обнаружил, что существует КвадриКс (не могу понять, почему такие похожие названия). Недавно был выложен лого для форума с кубиками! :?

Теперь эта игра под squar...k :o :shock: кварк
Смысл следующий - две доски с рандомизированно разложенными квадратиками 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





Последний раз редактировалось вопрос Чт май 27, 2010 21:37, всего редактировалось 2 раз(а).

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 11:59 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1254
Благодарил (а): 3 раз.
Поблагодарили: 16 раз.
Забавная. А игра на экране не умещается. И хелп много раз печатается при повторном вызове. Следует учесть текущие размеры экрана.
вопрос писал(а):
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

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 12:04 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Цитата:
Уже есть RANDOM.

это необычный рандом, я с ним потрудился - нужно не совсем в разброс
Цитата:
А игра на экране не умещается.
то есть как? не понял...
Цитата:
И хелп много раз печатается при повторном вызове.

подправил


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 13:28 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1254
Благодарил (а): 3 раз.
Поблагодарили: 16 раз.
вопрос писал(а):
то есть как? не понял...

А так, что часть правого квадрата за пределами экрана.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 21:05 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
VoidVolker писал(а):
вопрос писал(а):
то есть как? не понял...

А так, что часть правого квадрата за пределами экрана.


хм, это досадно. можно просто поменять переменные
100 VALUE coord_start_X \ coordinates of game-board
170 VALUE coord_start_Y
495 VALUE H_coord_start_X
но чем это вызвано?

у меня, похоже, глюк с внутренним позционированием в окне кварка - это не зависит от разрешения
при выводе в окне - нормальное позиционирование, при разворачивании окна в полный экран - рисунок резко уплывает вверх :(
такой глюк должен был получиться, если в коде кварка при неразвёрнутом на весь экран окне позиционирование происходит нормально - исходя из размеров окна, а при разворачивании - исходя из разрешения монитора автора

вот при окне
Изображение

а вот при полном экране Изображение
явно никаких 170 стартовых y


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 21:40 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
в общем - изменил код - в стартовом сообщении - добавил resize по F7

меняет циклически - проверил от 640 до 1024


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 21:47 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6341
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
В OpenGL есть не вполне понятное мне поведение функции DrawPixels, с помощью которой и отрисовывается экран. Функция достаточно низкоуровневая, и служит для прямого доступа к поверхности экрана. Проблема кроется в том, что OpenGL направляет ось Y вверх, а образ экрана - наоборот. В результате при отрисовке на разных видеокартах поведение оказывается различным - лучше всех себя ведет Intel GMA, который может принимать экран "как есть", и правильно понимает, что "вот это" надо преобразовать в "вон то" - эта фраза включает в себя и правильное отсечение по горизонтали, и разворот оси ординат. А вот дискретные видеокарты почему-то капризничают, что касается прежде всего отсечения. Сейчас в кварке реализован достаточно подробный алгоритм, отрисовывающий экран буквально построчно, и с программным отсечением. К сожалению, это не всегда помогает на видеокартах, где драйвер OpenGL установлен "из коробки" (т.е. пришел с операционной системой).


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 22:20 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1254
Благодарил (а): 3 раз.
Поблагодарили: 16 раз.
вопрос писал(а):
но чем это вызвано?

Небольшим разрешением экрана.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Чт май 27, 2010 23:49 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
VoidVolker писал(а):
вопрос писал(а):
но чем это вызвано?

Небольшим разрешением экрана.

А каким?
Я там внёс исправления - если нажать на F7, то меняется размер изображения на экране.
Этого достаточно?


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Пт май 28, 2010 00:10 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6341
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
Открыл новую тему насчет изображения в разделе Quark.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Сб июл 03, 2010 09:14 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Мне интересно - кто-нибудь "разложить" квадратики попытался? Каковы впечатления от самой идеи - это ведь не для детей - планирование предсказание вероятностных событий.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Ср ноя 17, 2010 23:23 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Цитата:
Игра в квадратики. Я давно заметил, что на фортеров оказывает какое-то мистическое действие слово four(th)
Все придуманные фортерами игры имеют дело с квадратиками или кубиками.

Не знаю, как и расценивать
http://rnd.cnews.ru/math/news/top/index ... /17/416368
бактерии учатся программировать, упоминается игра "жизнь" - кто-то ведь делал её на форте (не помню кто)
и что самое интересное, игровое поле - :o квадрат
Цитата:
буквально и построили систему из взаимодействующих бактерий, которая способна находить правильные решения для судоку. "Поскольку правила судоку просты, мы подумали, что, возможно, бактерии смогут решить его, если мы заложим в них правила, которым они должны следовать", - говорит возглавивший команду Рио Таниучи (Ryo Taniuchi). Для того, чтобы заложить правила поведения каждой отдельной бактерии применялись методы генного ижиниринга, когда при помощи вирусов в организм встраиваются гены, заставляющие его определенным образом реагировать на внешние сигналы.

Поле игры представляло из себя квадрат 4?4


и даже более того
Цитата:
каждая бактерия могла принимать один из четырех возможных цветов. Каждый цвет соответствовал числу от 1 до 4.
мистика


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Игра в квадрат
СообщениеДобавлено: Ср ноя 17, 2010 23:43 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июн 25, 2009 11:12
Сообщения: 412
Благодарил (а): 41 раз.
Поблагодарили: 8 раз.
Посмотрел на бактерий :o заодно нашел про новинку Хокинга http://www.ng.ru/science/2010-11-10/14_hoking.html


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 13 ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB