Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Чт мар 28, 2024 18:36

...
Google Search
Forth-FAQ Spy Grafic

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




Ответить
Имя пользователя:
Заголовок:
Текст сообщения:
Введите текст вашего сообщения. Длина сообщения в символах не более: 60000

Размер шрифта:
Цвет шрифта
Настройки:
BBCode ВКЛЮЧЕН
[img] ВЫКЛЮЧЕН
[flash] ВЫКЛЮЧЕН
[url] ВКЛЮЧЕН
Смайлики ВЫКЛЮЧЕНЫ
Отключить в этом сообщении BBCode
Не преобразовывать адреса URL в ссылки
Вопрос
Теперь гостю придется вводить здесь пароль. Не от своей учетной записи, а ПАРОЛЬ ДЛЯ ГОСТЯ, получить который можно после регистрации на форуме через ЛС.:
Этот вопрос предназначен для выявления и предотвращения автоматических регистраций.
   

Обзор темы - Ещё игрушка "логический лабиринт" ,
Автор Сообщение
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Пока небольшое неначительное усовершенствование (над перспективами размышляю)

Пришло в голову, что если сделать квадратик сплошным а не в виде рамки, то на нём без увеличения размеров поместятся 4- буквенные SWAP DROP TUCK OVER
также добавил NOOP
:)

В коде единственный пример с этими словами
Код:
" user32.dll"  LOADLIBRARY " MessageBeep" GETPROCADDRESS  VALUE MessageBeep_API
: ERROR_POS 16 MessageBeep_API 
API1 DROP ;
: END_SUCCESS 0 MessageBeep_API 
API1 DROP ;

-1 VALUE game?_value
: game? game?_value ;


HERE 32 CELLS ALLOT VALUE VSTACK
0 VALUE VSTACK_P
0 VALUE VSTACK_ERR

: >VS \ ( n --> )
\ поместить на стек
VSTACK_P 8 = IF 1 TO VSTACK_ERR ELSE VSTACK_P DUP 1 + TO VSTACK_P CELLS VSTACK + ! THEN
;

: VS> \ ( --> n )
\ снять со стека
VSTACK_P 0 = IF -1 TO VSTACK_ERR ELSE VSTACK_P 1 - DUP TO VSTACK_P CELLS VSTACK + @ THEN
;
: VSDEPTH VSTACK_P ;
: GET_VSTACK_ERR VSTACK_ERR 0 TO VSTACK_ERR ;

HERE 32 CELLS ALLOT VALUE VRSTACK
0 VALUE VRSTACK_P
0 VALUE VRSTACK_ERR

: >VRS \ ( n --> )
\ поместить на стек
VRSTACK_P 8 = IF 1 TO VRSTACK_ERR ELSE VRSTACK_P DUP 1 + TO VRSTACK_P CELLS VRSTACK + ! THEN
;

: VRS> \ ( --> n )
\ снять со стека
VRSTACK_P 0 = IF -1 TO VRSTACK_ERR ELSE VRSTACK_P 1 - DUP TO VRSTACK_P CELLS VRSTACK + @ THEN
;
: VRSDEPTH VRSTACK_P ;
: GET_VRSTACK_ERR VRSTACK_ERR 0 TO VRSTACK_ERR ;


\ 4 colors

10 10 250 RGB VALUE _RED      50 120 250 RGB VALUE _ORANGE
110 110 112 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
255 0 255 RGB VALUE _MAGENTA    173 171 172 RGB VALUE _LIGHTGRAY
218 218 211 RGB VALUE _VERYLIGHTGRAY2    218 218 211 RGB VALUE _VERYLIGHTGRAY
0 VALUE _BLACK


1 VALUE NUMBER_GREEN
2 VALUE NUMBER_YELLOW
3 VALUE NUMBER_RED
4 VALUE NUMBER_LIGHTBLUE
5 VALUE NUMBER_ORANGE
6 VALUE NUMBER_MAGENTA
7 VALUE NUMBER__VERYLIGHTGRAY2
8 VALUE NUMBER_GRAY
9 VALUE NUMBER_LIGHTGRAY
10 VALUE NUMBER_VERYLIGHTGRAY
11 VALUE NUMBER_WHITE
12 VALUE NUMBER_BLACK


: color... \ ( number --> color )
CASE
0 OF _BLACK ENDOF
NUMBER_GREEN OF GREEN ENDOF
NUMBER_RED OF _RED ENDOF
NUMBER_LIGHTBLUE OF _LIGHTBLUE ENDOF
NUMBER_YELLOW OF _YELLOW ENDOF
NUMBER_GRAY OF _GRAY ENDOF
NUMBER_LIGHTGRAY OF _LIGHTGRAY ENDOF
NUMBER_WHITE OF _WHITE ENDOF
NUMBER_BLACK OF NEAR_BLACK ENDOF
NUMBER_ORANGE OF _ORANGE ENDOF
NUMBER_MAGENTA OF _MAGENTA ENDOF
NUMBER__VERYLIGHTGRAY2 OF _VERYLIGHTGRAY ENDOF
NUMBER_VERYLIGHTGRAY OF _VERYLIGHTGRAY ENDOF
ENDCASE
;
   

100 VALUE coord_start_X   \ coordinates of game-board
170 VALUE coord_start_Y


0 VALUE potential_direction

4 VALUE board_size.tiny   
6 VALUE board_size.small   
8 VALUE board_size.medium   
10 VALUE board_size.large   
12 VALUE board_size.huge   
board_size.tiny VALUE board_size

board_size  1 - VALUE last_selected_y
0 VALUE last_selected_x   

48 VALUE sq_size_   \ size of square

0 VALUE stack_X
0 VALUE ret_X

: stack_X()
coord_start_X sq_size_ board_size * 30 + + TO stack_X
   ;

: ret_X()
coord_start_X sq_size_ board_size * 130 + + TO ret_X
   ;   
   
stack_X() ret_X()


: show_stack _YELLOW SETCOLOR
   stack_X coord_start_Y TEXTXY " DATA STACK"
   PRINT
   9 1 DO
   stack_X I 20 * 34 +  coord_start_Y +
   OVER OVER TEXTXY  "             " PRINT TEXTXY
   I 1 -
   DUP VSDEPTH < 
       IF CELLS VSTACK + @ .
      ELSE   DROP
      THEN
   LOOP
   
   GREEN SETCOLOR
   ret_X coord_start_Y TEXTXY " RETURN STACK"
   PRINT
   9 1 DO
   ret_X I 20 * 34 +  coord_start_Y + 
   OVER OVER TEXTXY  "             " PRINT TEXTXY 
   I 1 -
   DUP VRSDEPTH < 
       IF CELLS VRSTACK + @ .
      ELSE DROP
      THEN
   LOOP   
   ;   

: VS_ERR_PRINT
   _RED SETCOLOR 0 > IF
   stack_X coord_start_Y 194 +  TEXTXY "  OVERFLOW   " PRINT
   ELSE
   stack_X coord_start_Y 54 +  TEXTXY "  UNDERFLOW  " PRINT
   THEN ;

: VRS_ERR_PRINT
   _RED SETCOLOR 0 > IF
   ret_X coord_start_Y 194 +  TEXTXY "  OVERFLOW   " PRINT
   ELSE
   ret_X coord_start_Y 54 +  TEXTXY "  UNDERFLOW  " PRINT
   THEN ;
   
: TO_RET
   VS> GET_VSTACK_ERR
   DUP
   IF ERROR_POS VS_ERR_PRINT
   ELSE
   DROP >VRS
   GET_VRSTACK_ERR
      DUP
      IF ERROR_POS VRS_ERR_PRINT >VS
      ELSE DROP show_stack
      THEN
   THEN   
   ;
   ' TO_RET TO K_PGUP
: FROM_RET
   VRS> GET_VRSTACK_ERR
   DUP
   IF ERROR_POS VRS_ERR_PRINT
   ELSE
   DROP >VS
   GET_VSTACK_ERR
      DUP
      IF ERROR_POS VS_ERR_PRINT >VRS
      ELSE DROP show_stack
      THEN
   THEN   
   ;
   ' FROM_RET TO K_PGDOWN   


0   VALUE  square_tick.tickness
0   VALUE  square_tick.size
0   VALUE  square_tick.color

: square_tick       \ ( X Y color size tick --> )
   TO square_tick.tickness TO square_tick.size
   TO square_tick.color

\ (presently: X Y  )
   OVER OVER  square_tick.size +
   square_tick.tickness 0 DO OVER OVER  I -  square_tick.size square_tick.color HLINE LOOP
   DROP square_tick.size +  OVER
   square_tick.tickness 0 DO OVER  I - OVER square_tick.size square_tick.color VLINE LOOP
   DROP DROP
   square_tick.tickness 0 DO OVER  I + OVER square_tick.size square_tick.color VLINE LOOP
   square_tick.tickness 0 DO OVER  OVER I + square_tick.size square_tick.color HLINE LOOP
   DROP DROP   
   ;
   

CREATE ARR 32 CELLS ALLOT

: elementes... SWAP CELLS ARR + ! ;

1 1 VALUE    _?      "  ?"   elementes...
2 2 VALUE    _NOT  " NOT"   elementes...
4 4 VALUE    _INVerse  " INV"   elementes...
5 5 VALUE    _OR   "  OR"  elementes...
3 3 VALUE    _XOR  " XOR"    elementes...
6 6 VALUE    _AND  " AND"  elementes...
8 8 VALUE    _DUP  " DUP"   elementes...
7 7 VALUE    _+   "  + "  elementes...
9 9 VALUE    _-    "  - "  elementes...
10 10 VALUE    _*    "  * "  elementes...
11 11 VALUE    _/    "  / "  elementes...
12 12 VALUE    _<>   " <> "  elementes...
13 13 VALUE    _<    "  < "  elementes...
14 14 VALUE    _>    "  > "  elementes...
15 15 VALUE    _=    "  = "  elementes...
16 16 VALUE    _ROT    " ROT"  elementes...  17 17 VALUE    _:))    " :))"  elementes...
18 18 VALUE    _NIP    " NIP"  elementes...
19 19 VALUE    _MOD    " MOD"  elementes...
20 20 VALUE    _MIN    " MIN"  elementes...
21 21 VALUE    _MAX    " MAX"  elementes...
22 22 VALUE    _DROP    " DROP"  elementes...
23 23 VALUE    _SWAP    " SWAP"  elementes...
24 24 VALUE    _NOOP    " NOOP"  elementes...
25 25 VALUE    _OVER    " OVER"  elementes...
26 26 VALUE    _TUCK    " TUCK"  elementes...
26 VALUE elementes_all

: do_?  -1 ;
: do_NOT VSDEPTH 1 < IF 0 ELSE VS> NOT >VS -1 THEN ;
: do_INVerse VSDEPTH  1 < IF 0 ELSE VS> -1 XOR >VS -1 THEN ;
: do_OR VSDEPTH 2 < IF 0 ELSE VS> VS> OR >VS -1 THEN ;
: do_XOR VSDEPTH 2 < IF 0 ELSE VS> VS> XOR  >VS -1 THEN ;
: do_AND VSDEPTH 2 < IF 0 ELSE VS> VS> AND >VS -1 THEN ;
: do_DUP VSDEPTH 7 > IF 0 ELSE VS> DUP >VS >VS -1 THEN ;
: do_+ VSDEPTH 2 < IF 0 ELSE VS> VS> + >VS -1 THEN ;
: do_- VSDEPTH 2 < IF 0 ELSE VS> VS>  SWAP - >VS -1 THEN ;
: do_* VSDEPTH 2 < IF 0 ELSE VS> VS> * >VS -1 THEN ;
: do_/ VSDEPTH 2 < VS> DUP >VS  0 = OR IF 0 ELSE VS> VS>  SWAP / >VS -1 THEN ;
: do_<> VSDEPTH 2 < IF 0 ELSE VS> VS> = NOT >VS -1 THEN ;
: do_< VSDEPTH 2 < IF 0 ELSE VS> VS>  SWAP < >VS -1 THEN ;
: do_> VSDEPTH 2 < IF 0 ELSE VS> VS>  SWAP > >VS -1 THEN ;
: do_= VSDEPTH 2 < IF 0 ELSE VS> VS>  = >VS -1 THEN ;
: do_ROT VSDEPTH 3 < IF 0 ELSE VS>  VS>  VS>  SWAP >VS  SWAP >VS >VS -1 THEN ;
: do_NIP VSDEPTH 2 <  IF 0 ELSE VS>  VS>  DROP >VS -1 THEN ;
: do_MOD VSDEPTH 2 < VS> DUP >VS  0 = OR IF 0 ELSE VS> VS>  SWAP MOD >VS -1 THEN ;
: do_MIN VSDEPTH 2 <  IF 0 ELSE VS>  VS>  OVER OVER < IF DROP  >VS ELSE >VS DROP THEN -1 THEN ;
: do_MAX VSDEPTH 2 <  IF 0 ELSE VS>  VS>  OVER OVER > IF DROP  >VS ELSE >VS DROP THEN -1 THEN ;
: do_SWAP VSDEPTH 2 <  IF 0 ELSE VS>  VS>  SWAP >VS >VS -1 THEN ;
: do_OVER VSDEPTH 2 < VSDEPTH 7 > OR IF 0 ELSE VS>  VS>  DUP  >VS SWAP >VS  >VS -1 THEN ;
: do_DROP VSDEPTH 1 <  IF 0 ELSE VS>   DROP -1 THEN ;
: do_NOOP  -1  ;
: do_TUCK VSDEPTH 7 > IF 0 ELSE VS>  VS>  OVER   >VS  >VS >VS -1 THEN ;
: do_:)) VRSTACK_P 0 = VSTACK_P 0 > AND  VS> 0 = AND IF END_SUCCESS 0 TO game?_value -1 ELSE 0 THEN ;
 

: element_execute
CASE
_?     OF      do_?   ENDOF
_NOT   OF      do_NOT   ENDOF
_INVerse   OF      do_INVerse   ENDOF
_OR    OF      do_OR   ENDOF
_XOR   OF      do_XOR   ENDOF
_AND   OF      do_AND   ENDOF
_DUP   OF      do_DUP   ENDOF
_+     OF      do_+   ENDOF
_-     OF      do_-   ENDOF
_*     OF      do_*   ENDOF
_/     OF      do_/   ENDOF
_<>    OF      do_<>   ENDOF
_<     OF      do_<   ENDOF
_>     OF      do_>   ENDOF
_=     OF      do_=   ENDOF
_ROT   OF      do_ROT   ENDOF
_:))   OF      do_:))   ENDOF
_NIP   OF      do_NIP   ENDOF
_MOD   OF      do_MOD   ENDOF
_MIN   OF      do_MIN   ENDOF
_MAX   OF      do_MAX   ENDOF
_SWAP   OF      do_SWAP   ENDOF
_DROP   OF      do_DROP   ENDOF
_TUCK   OF      do_TUCK   ENDOF
_NOOP   OF      do_NOOP   ENDOF
_OVER   OF      do_OVER   ENDOF
ENDCASE
   ;


\ board

HERE 144 CELLS ALLOT VALUE PATH_VECT 0 VALUE PATH_VECT_point
HERE 144 CELLS ALLOT VALUE PATH_BOARD
HERE 144 CELLS ALLOT VALUE GAME_BOARD
HERE 144 CELLS ALLOT VALUE COLOR_BOARD
HERE 144 CELLS ALLOT VALUE VALUES_RESULTS
HERE 576 CELLS ALLOT VALUE REVERSE_BOARD
HERE 4096 CELLS ALLOT VALUE DATASTACK_
HERE 4096 CELLS ALLOT VALUE RETSTACK_

: BOARD_ 0 PATH_BOARD 144 FILL 0 REVERSE_BOARD 144 FILL  ;

: PATH_BOARD_add 4 last_selected_x last_selected_y  board_size * + CELLS PATH_BOARD + !
   ;
: PATH_BOARD_away 0 SWAP CELLS PATH_BOARD + !
   ;
: PATH_VECT_add PATH_VECT_point DUP CELLS PATH_VECT + potential_direction  SWAP !
1 + TO PATH_VECT_point
   ;
: PATH_VECT_add_from_stack  PATH_VECT_point DUP 1 + TO PATH_VECT_point
CELLS PATH_VECT + !
   ;
: PATH_VECT_away PATH_VECT_point 1 - DUP   CELLS PATH_VECT + @ SWAP
TO   PATH_VECT_point
   ;

: stacks_store.copy_data \ ( address - )
CELLS 9 * 8 0 DO DUP I CELLS + DATASTACK_ + I CELLS VSTACK + @ SWAP ! LOOP
8 CELLS + DATASTACK_ + VSTACK_P SWAP !
;
: stacks_store.copy_ret \ ( address - )
CELLS 9 *  8 0 DO DUP I CELLS + RETSTACK_ + I CELLS VRSTACK + @ SWAP ! LOOP
8 CELLS + RETSTACK_ + VRSTACK_P SWAP !
;


: stacks_store
DUP stacks_store.copy_data
stacks_store.copy_ret
;

: stacks_cansel.copy_data \ ( address - )
CELLS 9 *  8 0 DO DUP I CELLS + DATASTACK_ + @ I CELLS VSTACK +  ! LOOP
8 CELLS + DATASTACK_ + @  TO VSTACK_P
;
: stacks_cansel.copy_ret \ ( address - )
CELLS 9 *   8 0 DO DUP I CELLS + RETSTACK_ + @ I CELLS VRSTACK +  ! LOOP
8 CELLS + RETSTACK_ + @  TO VRSTACK_P
;

: stacks_cansel
DUP stacks_cansel.copy_data
stacks_cansel.copy_ret
;


36 VALUE show_boards.color_size \ размер цвета поля (или поля цвета  )
16 VALUE show_boards.color_tick \ толщина поля цвета
7 VALUE show_boards.color_shift \ сдвиг поля цвета
42 VALUE show_boards.pos_size \ размер квадратика. обозн. позицию
4 VALUE show_boards.pos_shift \ сдвиг квадратика. обозн. позицию
5 VALUE show_boards.pos_tick  \ толщина квадратика. обозн. позицию
9 VALUE show_boards.mark_size  \  размер маркера возврата (допустимость бэк...)
5 VALUE show_boards.mark_tick \  толщина маркера возврата (допустимость бэк...)
30 VALUE show_boards.mark_shift \ сдвиг  маркера возврата

14 VALUE show_boards.text_shift




: color_board
12 0 DO
12 0 DO
J board_size * I + CELLS COLOR_BOARD +
I 2 / 2 MOD 0 =  J 2 /  2 MOD  0 = XOR IF NUMBER_LIGHTBLUE ELSE NUMBER_ORANGE THEN SWAP !

LOOP
LOOP
  NUMBER_RED board_size 1 - CELLS COLOR_BOARD + !
  NUMBER_RED board_size DUP 1 - * CELLS COLOR_BOARD + !
;
color_board


0 VALUE show_board.temp

: last_selected_abs  last_selected_y board_size * last_selected_x  +  CELLS ;
: string_size? \ ( str_addr --> length )
0
BEGIN
SWAP DUP C@ 0 >
WHILE
1 + SWAP 1 +
REPEAT
DROP
;

: show_board \ ( -- )
\  доску

board_size 0
   DO
   board_size 0
      DO
       sq_size_ I * coord_start_X +  sq_size_ J * coord_start_Y +
      OVER OVER  \ серый квадрат
       2 + SWAP 2 + SWAP
       _GRAY sq_size_ 2 - 2 square_tick
    
      OVER show_boards.color_shift + OVER  show_boards.color_shift +
      J board_size * I + CELLS COLOR_BOARD + @
      J board_size * I + CELLS PATH_BOARD + @  +
      color...
      show_boards.color_size show_boards.color_tick 
      square_tick       
    
    
      J board_size * I + CELLS COLOR_BOARD + @
      J board_size * I + CELLS PATH_BOARD + @ +
      color... SETBGCOLOR
      0 SETCOLOR
      OVER  OVER show_boards.text_shift +
    
      J board_size * I + CELLS GAME_BOARD + @
      DUP ABS 256 >
      IF
      DUP 0 < IF  -1 * 255 AND -1 * ELSE  255 AND THEN
      TO show_board.temp
      SWAP show_boards.text_shift + SWAP TEXTXY show_board.temp .
      ELSE
     >R SWAP
     R@ CELLS
     ARR + @ string_size?
     8 * 2 /  sq_size_  2 / SWAP -  + 2 +  SWAP TEXTXY R>
     CELLS ARR + @ PRINT
      THEN
      0 SETBGCOLOR 

     
     
      J board_size * I + CELLS REVERSE_BOARD + @
      DUP 0 = IF DROP DROP DROP ELSE TO show_board.temp
      OVER  show_boards.mark_shift + 2 + OVER  show_boards.mark_shift + 2 +
      show_board.temp
      color... 
      show_boards.mark_size 2 -  show_boards.mark_tick square_tick
      SWAP show_boards.mark_shift + SWAP  show_boards.mark_shift +
      0 
      show_boards.mark_size 2 square_tick

      THEN
      LOOP
   LOOP
   
      sq_size_ last_selected_x * coord_start_X +  sq_size_ last_selected_y * coord_start_Y +
      SWAP show_boards.pos_shift + SWAP  show_boards.pos_shift +
      _WHITE
      show_boards.pos_size show_boards.pos_tick square_tick
     
      show_stack
;



: startxy
board_size  1 - TO last_selected_y
0 TO last_selected_x
;




: clear_two
last_selected_x sq_size_  * coord_start_X +  sq_size_ last_selected_y * coord_start_Y +
_BLACK sq_size_ DUP 2 / square_tick
sq_size_  * coord_start_Y + SWAP sq_size_  * coord_start_X + SWAP
_BLACK sq_size_ DUP 2 / square_tick
;

: possibility_before
   
   OVER OVER board_size * + CELLS DUP
   PATH_BOARD + @ 0 = SWAP
   COLOR_BOARD + @ last_selected_x
   last_selected_y board_size * + CELLS COLOR_BOARD + @ =
   VRSDEPTH 0 = OR AND
   ;

   
: step_to_do
last_selected_x last_selected_y board_size * + stacks_store
OVER OVER board_size * + CELLS GAME_BOARD  + @
DUP ABS 256 >
      IF DUP 0 < IF  -1 * 255 AND -1 * ELSE  255 AND THEN  >VS
      GET_VSTACK_ERR DUP IF VS_ERR_PRINT   0   ELSE DROP -1 THEN
      ELSE element_execute
      THEN     
   ;
   
: game_step
   TO potential_direction
   possibility_before
   IF  step_to_do 
      IF   PATH_BOARD_add PATH_VECT_add 
         OVER OVER
         clear_two TO last_selected_y  TO last_selected_x  show_board   
      ELSE ERROR_POS DROP DROP   
      THEN
    ELSE ERROR_POS   DROP DROP 
   THEN
   ;

: _right
game?
IF last_selected_x board_size 1 - < IF last_selected_x 1 + last_selected_y 2 game_step ELSE ERROR_POS  THEN
THEN
;
' _right TO K_RIGHT

: _left
game?
IF last_selected_x 0 > IF last_selected_x 1 - last_selected_y 4 game_step ELSE  ERROR_POS  THEN THEN
;
' _left TO K_LEFT

: _up
game?
IF last_selected_y 0 > IF last_selected_x last_selected_y 1 - 1 game_step ELSE  ERROR_POS THEN
THEN
;
' _up TO K_UP


: _down
game?
IF last_selected_y board_size 1 - < IF last_selected_x last_selected_y 1 + 3 game_step ELSE  ERROR_POS THEN
  THEN
;
' _down TO K_DOWN



: back_move

PATH_VECT_point 0 >
game?  AND
 
IF
   PATH_VECT_away DUP
   CASE
   1   OF   last_selected_x last_selected_y 1 +   ENDOF
   2   OF   last_selected_x 1 - last_selected_y   ENDOF
   3   OF   last_selected_x last_selected_y 1 -   ENDOF
   4   OF   last_selected_x 1 + last_selected_y   ENDOF
   ENDCASE 
   OVER OVER board_size * + CELLS REVERSE_BOARD + DUP @
   NUMBER_RED =
   IF 
   ERROR_POS   DROP  DROP  DROP  PATH_VECT_add_from_stack
   ELSE 
   DUP @  1 + SWAP ! OVER OVER board_size * + PATH_BOARD_away 
    OVER OVER board_size * + stacks_cansel   
    OVER OVER clear_two   
    TO last_selected_y  TO last_selected_x  DROP
    show_board 
   THEN

ELSE ERROR_POS THEN
;
' back_move DUP DUP TO K_F10 TO K_F11 TO K_F12



\  GAME BEGIN начало игры и т.п. загрузка новых игр по пути наименьшего сопротивления
0 VALUE game_map.index 0 VALUE game_map.err 0 VALUE game_map.non

: E,EXEM DROP -1 TO game_map.err ;
: E,EM game_map.err IF DROP  ELSE  TO game_map.err THEN ;
: N,EM game_map.non IF DROP  ELSE  TO game_map.non THEN ;
: E,? game_map.index DUP board_size DUP * >
IF E,EXEM ELSE DUP 1 + TO game_map.index CELLS GAME_BOARD + !  THEN ;
: E, DUP elementes_all > OVER 1 < OR IF E,EM ELSE E,?  THEN  ;
: N,? DUP 0 < IF -512 + ELSE 512 + THEN E,? ;
: N, DUP ABS 99 > IF N,EM ELSE N,?  THEN  ;

\ массив доступных игр
HERE 8 2 * CELLS ALLOT VALUE available_games 
0 VALUE available_games_point
\ 2 CELLS - строка описания игры и адрес слова-загрузчика, которое содержит (загружает) данные
: available_games.to \ ( xt c-addr -- success  number )
      available_games_point 14 >
      IF
      " слишком много элементов для available_games " PRINT 0
      ELSE
      available_games_point  CELLS available_games + !
      available_games_point 1 + CELLS available_games + ! -1
      available_games_point DUP 2 + TO available_games_point
      THEN     
      ;
     
\ игра должна определеяться словом  ????
\ :   ???? ['] game_description   " game verbal description "  available_games.to ;  ????


: example_4
board_size.tiny TO board_size     
color_board  \ стандарт, или можно определить своё
startxy  \ стандарт, или можно определить своё
\ доска
_TUCK   E,   4   N,   _<>   E,   _:))   E,
5   N,   _SWAP   E,   _NOOP   E,   _<>   E,
_NIP   E,   _-   E,   _DROP   E,   4   N,
_?   E,   _SWAP   E,   5   N,   _OVER   E,



\ стек так и выглядит
9 >VS
5 >VS
3 >VS
6 >VS
7 >VS 
   ;
:  example_4_des ['] example_4   " простой пример 4x4 игры со словами SWAP DROP TUCK OVER " 
available_games.to ;   
                        example_4_des DROP DROP
\ end example game description

VECT game.map 0 VALUE game.descr
0 VALUE game.last
0 VALUE game.lastp
: new_game   \ ( number -- )
   DUP 12 > OVER  1 + CELLS available_games + @ 0 = OR
   
   IF " ненормальный номер игры " PRINT DROP
   ELSE
   DUP TO game.lastp DUP
   CELLS available_games + @ TO game.descr 1  + CELLS  available_games + @ TO game.map
   0 TO game_map.index 0 TO game_map.err 0 TO game_map.non
   0 TO VSTACK_P 0 TO VRSTACK_P
   game.map 
   game_map.err  game_map.non OR
   last_selected_x last_selected_y board_size * + CELLS GAME_BOARD + @ _? = NOT OR
   0 = IF
      game.lastp TO game.last \ потенциальный номер игры в реально последню
     \ этот номер будет использоваться циклом игр F3 и "началом той же самой заново" по F2
      stack_X() ret_X()
      BOARD_
      0 TO PATH_VECT_point
      CLS show_board coord_start_X  coord_start_Y  28 - TEXTXY _LIGHTGRAY SETCOLOR game.descr PRINT
      -1 TO game?_value
      ELSE
      CLS
      0 TO game?_value
      show_board 
      coord_start_X  coord_start_Y  28 - TEXTXY
      " невозможно загрузить игру: ошибка в расположении элементов либо начальной позиции"  PRINT
      THEN
   THEN
;


: game_cycle game.last 2 +
      DUP
      14 > OVER CELLS available_games + @ 0 = OR IF DROP 0  THEN
      DUP
       CELLS available_games + @ 0 = IF 160 90 TEXTXY " No available games " PRINT DROP ELSE new_game THEN
   ;
   ' game_cycle TO K_F3
   
: game_again   
   game.last DUP
   CELLS available_games + @ 0 =
   IF 160 90 TEXTXY " No available games " PRINT DROP ELSE new_game THEN
;
' game_again TO K_F2
game_again

Сообщение Добавлено: Чт июл 22, 2010 22:02
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Вспоминается что в Fallout-е
При "взломе компьютера" красиво так в консоли с зелеными буквами грузились файлы с расширением .f
Правда фортом в этой головоломке и не пахло, было что то вроде "быков и коров"
Сообщение Добавлено: Ср июл 14, 2010 11:59
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
вопрос писал(а):
Вот я не знаю, это требует размышлений

Что то внутре :wink: мне подсказывает что оно того стоит.
Сообщение Добавлено: Ср июл 14, 2010 11:53
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
_Harry писал(а):
вопрос писал(а):
Например - генератор начальных позиций.

Да тут наверно и в 800 строк не уложишся....

Вот я не знаю, это требует размышлений :roll:
Сообщение Добавлено: Ср июл 14, 2010 11:16
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
вопрос писал(а):
Например - генератор начальных позиций.

Да тут наверно и в 800 строк не уложишся....
Сообщение Добавлено: Ср июл 14, 2010 01:05
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Спасибо. :D Пока эта игра - только идея, хотя уже на 800 строк, но нужно ещё много чего, чтобы говорить о коммерческой стоимости. Например - генератор начальных позиций.
Сообщение Добавлено: Вт июл 13, 2010 22:53
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Очень интересно!
Предлагаю автору присвоить звание Супер Джедая :D
А если без шуток то во многих навороченных стреляках и всяки ролевых игрушках,
часто встречается момент "взлома" компьютера, замка и т.п. Как правило это несложная головоломка.
Может стоит попытаться эту игру продать какой ни будь фирме занимающейся разработкой игр. Глядишь кто то из стрелков подрастет и фортером станет.
Сообщение Добавлено: Вт июл 13, 2010 22:47
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Подумал - что если не все понимают правила игры - может быть, тему читают не только фортеры

поэтому иллюстрация на примере 4х4 задачи из предыдущего постинга

(прошу прощения, если рисунки велики - не было времени их аккуратно отредактировать)

Изображение
итак - стартовая позиция 1.
ЧТо если "лабиринт" проходится так просто, кратчайшим путём?
Попробуем, пойдём лесенкой вправо-вверх и так дальше
Сначала вправо - позиция 2 - мы встречаем цифру и игра, как и обычный форт в режиме интерпретации , разбирая исходник, кладёт цифру на стек
Потом вверх - позиция 3 - 6 прибавилось к 1 и получилось 7
Потом снова вправо - позиция 4 : теперь работает NIP

Однако, нас постигнет неудача в конце "лесенки"
Изображение
мы не можем перейти в верхнее правое поле, т.к. на стеке данных - не 0

Попробуем анализировать ситуацию, составить план прохождения лабиринта.
Для начала мы замечаем, что оба поля, через которые можно попасть на выиграшное поле :)) - это операторы "не равно" <>
Это означает,что 0 на стеке может образоваться, если мы перейдём на эти поля с двумя равными цифрами на вершине стека.
Т.е. если перед тем, как ступить на поле "не равно" мы будем иметь равные цифры, оператор даст 0 и дальше с этим нулём мы попадём на :))

Попробуем получить равные цифры. Предпримем опять наивную попытку. На стеке и на поле все цифры разные, т.о. чтобы получить одинаковые , нужны над ними какие-то действия (и действий на поле немного - плюс и MOD :D )
Изображение
Мы замечаем, что если сложить 2ю и 3ю на стеке цифры, то получится 9 и это приведёт к образованию 2 девяток подряд, нам мешает 6 , которую можно временно убрать на стек возвратов
получается : шаг вправо - положить 6 на стек возвратов - перейти на +
Всё хорошо, теперь нужно доставить две девятки к :)) , точнее к <>
8)
Изображение
Не тут то было, способа сделать так, чтобы эти 2 цифры оказались в нужный момент не существует.
Для начала, придётся вернуть на стек 6, иначе с заполненным стеком игра не выпустит нас за пределы бирюзового цвета, а дальше - нет оператора, который убирал бы одну цифру со стека не задевая вторую ... :D

Тем не менее, это всё-таки очень нетру дная задача и имеет множество решений.
Для того, чтобы попасть в конечную позицию, достаточно произвести 4 действия
Изображение
1. С достаточным количеством цифр любым путём подойти к полю с " не равно" , ступив на него, получить на стеке -1
1.а Вспомнить, что Х -1 MOD всегда даст 0
2. получить упомянутый 0, перейдя на MOD

Изображение
3. сохранить 0 клавишей PGUP на стек возвратов
4. перейти на другое поле с "не равно" , т.к. все три поля одного цвета

дальше понятно - 0 возвращается на стек данных и игра окончена
Сообщение Добавлено: Вт июл 13, 2010 21:34
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Заметил, что в форте ещё есть трёхбуквенные операторы (слова) MOD NIP MAX MIN
добавил их в игру :D , в этом варианте кода три стартовых позиции, в которых присутствуют эти операторы. На примере самой простой также поясняются правила игры - см. след. постинг.
ПОсле загрузки файла нужно нажать F2
Код:
" user32.dll"  LOADLIBRARY " MessageBeep" GETPROCADDRESS  VALUE MessageBeep_API
: ERROR_POS 16 MessageBeep_API 
API1 DROP ;
: END_SUCCESS 0 MessageBeep_API 
API1 DROP ;

-1 VALUE game?_value
: game? game?_value ;


HERE 32 CELLS ALLOT VALUE VSTACK
0 VALUE VSTACK_P
0 VALUE VSTACK_ERR

: >VS \ ( n --> )
\ поместить на стек
VSTACK_P 8 = IF 1 TO VSTACK_ERR ELSE VSTACK_P DUP 1 + TO VSTACK_P CELLS VSTACK + ! THEN
;

: VS> \ ( --> n )
\ снять со стека
VSTACK_P 0 = IF -1 TO VSTACK_ERR ELSE VSTACK_P 1 - DUP TO VSTACK_P CELLS VSTACK + @ THEN
;
: VSDEPTH VSTACK_P ;
: GET_VSTACK_ERR VSTACK_ERR 0 TO VSTACK_ERR ;

HERE 32 CELLS ALLOT VALUE VRSTACK
0 VALUE VRSTACK_P
0 VALUE VRSTACK_ERR

: >VRS \ ( n --> )
\ поместить на стек
VRSTACK_P 8 = IF 1 TO VRSTACK_ERR ELSE VRSTACK_P DUP 1 + TO VRSTACK_P CELLS VRSTACK + ! THEN
;

: VRS> \ ( --> n )
\ снять со стека
VRSTACK_P 0 = IF -1 TO VRSTACK_ERR ELSE VRSTACK_P 1 - DUP TO VRSTACK_P CELLS VRSTACK + @ THEN
;
: VRSDEPTH VRSTACK_P ;
: GET_VRSTACK_ERR VRSTACK_ERR 0 TO VRSTACK_ERR ;


\ 4 colors

10 10 250 RGB VALUE _RED      50 120 250 RGB VALUE _ORANGE
110 110 112 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
255 0 255 RGB VALUE _MAGENTA    173 171 172 RGB VALUE _LIGHTGRAY
218 218 211 RGB VALUE _VERYLIGHTGRAY2    218 218 211 RGB VALUE _VERYLIGHTGRAY
0 VALUE _BLACK


1 VALUE NUMBER_GREEN
2 VALUE NUMBER_YELLOW
3 VALUE NUMBER_RED
4 VALUE NUMBER_LIGHTBLUE
5 VALUE NUMBER_ORANGE
6 VALUE NUMBER_MAGENTA
7 VALUE NUMBER__VERYLIGHTGRAY2
8 VALUE NUMBER_GRAY
9 VALUE NUMBER_LIGHTGRAY
10 VALUE NUMBER_VERYLIGHTGRAY
11 VALUE NUMBER_WHITE
12 VALUE NUMBER_BLACK


: color... \ ( number --> color )
CASE
0 OF _BLACK ENDOF
NUMBER_GREEN OF GREEN ENDOF
NUMBER_RED OF _RED ENDOF
NUMBER_LIGHTBLUE OF _LIGHTBLUE ENDOF
NUMBER_YELLOW OF _YELLOW ENDOF
NUMBER_GRAY OF _GRAY ENDOF
NUMBER_LIGHTGRAY OF _LIGHTGRAY ENDOF
NUMBER_WHITE OF _WHITE ENDOF
NUMBER_BLACK OF NEAR_BLACK ENDOF
NUMBER_ORANGE OF _ORANGE ENDOF
NUMBER_MAGENTA OF _MAGENTA ENDOF
NUMBER__VERYLIGHTGRAY2 OF _VERYLIGHTGRAY ENDOF
NUMBER_VERYLIGHTGRAY OF _VERYLIGHTGRAY ENDOF
ENDCASE
;
   

100 VALUE coord_start_X   \ coordinates of game-board
170 VALUE coord_start_Y


0 VALUE potential_direction

4 VALUE board_size.tiny   
6 VALUE board_size.small   
8 VALUE board_size.medium   
10 VALUE board_size.large   
12 VALUE board_size.huge   
board_size.tiny VALUE board_size

board_size  1 - VALUE last_selected_y
0 VALUE last_selected_x   

48 VALUE sq_size_   \ size of square

0 VALUE stack_X
0 VALUE ret_X

: stack_X()
coord_start_X sq_size_ board_size * 30 + + TO stack_X
   ;

: ret_X()
coord_start_X sq_size_ board_size * 130 + + TO ret_X
   ;   
   
stack_X() ret_X()


: show_stack _YELLOW SETCOLOR
   stack_X coord_start_Y TEXTXY " DATA STACK"
   PRINT
   9 1 DO
   stack_X I 20 * 34 +  coord_start_Y +
   OVER OVER TEXTXY  "             " PRINT TEXTXY
   I 1 -
   DUP VSDEPTH < 
       IF CELLS VSTACK + @ .
      ELSE   DROP
      THEN
   LOOP
   
   GREEN SETCOLOR
   ret_X coord_start_Y TEXTXY " RETURN STACK"
   PRINT
   9 1 DO
   ret_X I 20 * 34 +  coord_start_Y + 
   OVER OVER TEXTXY  "             " PRINT TEXTXY 
   I 1 -
   DUP VRSDEPTH < 
       IF CELLS VRSTACK + @ .
      ELSE DROP
      THEN
   LOOP
   
   ;   

: VS_ERR_PRINT
   _RED SETCOLOR 0 > IF
   stack_X coord_start_Y 194 +  TEXTXY "  OVERFLOW   " PRINT
   ELSE
   stack_X coord_start_Y 54 +  TEXTXY "  UNDERFLOW  " PRINT
   THEN ;

: VRS_ERR_PRINT
   _RED SETCOLOR 0 > IF
   ret_X coord_start_Y 194 +  TEXTXY "  OVERFLOW   " PRINT
   ELSE
   ret_X coord_start_Y 54 +  TEXTXY "  UNDERFLOW  " PRINT
   THEN ;
   
: TO_RET
   VS> GET_VSTACK_ERR
   DUP
   IF ERROR_POS VS_ERR_PRINT
   ELSE
   DROP >VRS
   GET_VRSTACK_ERR
      DUP
      IF ERROR_POS VRS_ERR_PRINT >VS
      ELSE DROP show_stack
      THEN
   THEN   
   ;
   ' TO_RET TO K_PGUP
: FROM_RET
   VRS> GET_VRSTACK_ERR
   DUP
   IF ERROR_POS VRS_ERR_PRINT
   ELSE
   DROP >VS
   GET_VSTACK_ERR
      DUP
      IF ERROR_POS VS_ERR_PRINT >VRS
      ELSE DROP show_stack
      THEN
   THEN   
   ;
   ' FROM_RET TO K_PGDOWN   


0   VALUE  square_tick.tickness
0   VALUE  square_tick.size
0   VALUE  square_tick.color

: square_tick       \ ( X Y color size tick --> )
   TO square_tick.tickness TO square_tick.size
   TO square_tick.color

\ (presently: X Y  )
   OVER OVER  square_tick.size +
   square_tick.tickness 0 DO OVER OVER  I -  square_tick.size square_tick.color HLINE LOOP
   DROP square_tick.size +  OVER
   square_tick.tickness 0 DO OVER  I - OVER square_tick.size square_tick.color VLINE LOOP
   DROP DROP
   square_tick.tickness 0 DO OVER  I + OVER square_tick.size square_tick.color VLINE LOOP
   square_tick.tickness 0 DO OVER  OVER I + square_tick.size square_tick.color HLINE LOOP
   DROP DROP   
   ;
   

CREATE ARR 32 CELLS ALLOT

: elementes... SWAP CELLS ARR + ! ;

1 1 VALUE    _?      "  ?"   elementes...
2 2 VALUE    _NOT  " NOT"   elementes...
4 4 VALUE    _INVerse  " INV"   elementes...
5 5 VALUE    _OR   "  OR"  elementes...
3 3 VALUE    _XOR  " XOR"    elementes...
6 6 VALUE    _AND  " AND"  elementes...
8 8 VALUE    _DUP  " DUP"   elementes...
7 7 VALUE    _+   "  + "  elementes...
9 9 VALUE    _-    "  - "  elementes...
10 10 VALUE    _*    "  * "  elementes...
11 11 VALUE    _/    "  / "  elementes...
12 12 VALUE    _<>   " <> "  elementes...
13 13 VALUE    _<    "  < "  elementes...
14 14 VALUE    _>    "  > "  elementes...
15 15 VALUE    _=    "  = "  elementes...
16 16 VALUE    _ROT    " ROT"  elementes...
17 17 VALUE    _:))    " :))"  elementes...
18 18 VALUE    _NIP    " NIP"  elementes...
19 19 VALUE    _MOD    " MOD"  elementes...
20 20 VALUE    _MIN    " MIN"  elementes...
21 21 VALUE    _MAX    " MAX"  elementes...
21 VALUE elementes_all

: do_?  -1 ;
: do_NOT VSDEPTH 1 < IF 0 ELSE VS> NOT >VS -1 THEN ;
: do_INVerse VSDEPTH  1 < IF 0 ELSE VS> -1 XOR >VS -1 THEN ;
: do_OR VSDEPTH 2 < IF 0 ELSE VS> VS> OR >VS -1 THEN ;
: do_XOR VSDEPTH 2 < IF 0 ELSE VS> VS> XOR  >VS -1 THEN ;
: do_AND VSDEPTH 2 < IF 0 ELSE VS> VS> AND >VS -1 THEN ;
: do_DUP VSDEPTH 7 > IF 0 ELSE VS> DUP >VS >VS -1 THEN ;
: do_+ VSDEPTH 2 < IF 0 ELSE VS> VS> + >VS -1 THEN ;
: do_- VSDEPTH 2 < IF 0 ELSE VS> VS>  SWAP - >VS -1 THEN ;
: do_* VSDEPTH 2 < IF 0 ELSE VS> VS> * >VS -1 THEN ;
: do_/ VSDEPTH 2 < VS> DUP >VS  0 = OR IF 0 ELSE VS> VS>  SWAP / >VS -1 THEN ;
: do_<> VSDEPTH 2 < IF 0 ELSE VS> VS> = NOT >VS -1 THEN ;
: do_< VSDEPTH 2 < IF 0 ELSE VS> VS>  SWAP < >VS -1 THEN ;
: do_> VSDEPTH 2 < IF 0 ELSE VS> VS>  SWAP > >VS -1 THEN ;
: do_= VSDEPTH 2 < IF 0 ELSE VS> VS>  = >VS -1 THEN ;
: do_ROT VSDEPTH 3 < IF 0 ELSE VS>  VS>  VS>  SWAP >VS  SWAP >VS >VS -1 THEN ;
: do_:)) VRSTACK_P 0 = VSTACK_P 0 > AND  VS> 0 = AND IF END_SUCCESS 0 TO game?_value -1 ELSE 0 THEN ;
: do_NIP VSDEPTH 2 <  IF 0 ELSE VS>  VS>  DROP >VS -1 THEN ;
: do_MOD VSDEPTH 2 < VS> DUP >VS  0 = OR IF 0 ELSE VS> VS>  SWAP MOD >VS -1 THEN ;
: do_MIN VSDEPTH 2 <  IF 0 ELSE VS>  VS>  OVER OVER < IF DROP  >VS ELSE >VS DROP THEN -1 THEN ;
: do_MAX VSDEPTH 2 <  IF 0 ELSE VS>  VS>  OVER OVER > IF DROP  >VS ELSE >VS DROP THEN -1 THEN ;
 

: element_execute

CASE
_?     OF      do_?   ENDOF
_NOT   OF      do_NOT   ENDOF
_INVerse   OF      do_INVerse   ENDOF
_OR    OF      do_OR   ENDOF
_XOR   OF      do_XOR   ENDOF
_AND   OF      do_AND   ENDOF
_DUP   OF      do_DUP   ENDOF
_+     OF      do_+   ENDOF
_-     OF      do_-   ENDOF
_*     OF      do_*   ENDOF
_/     OF      do_/   ENDOF
_<>    OF      do_<>   ENDOF
_<     OF      do_<   ENDOF
_>     OF      do_>   ENDOF
_=     OF      do_=   ENDOF
_ROT   OF      do_ROT   ENDOF
_:))   OF      do_:))   ENDOF
_NIP   OF      do_NIP   ENDOF
_MOD   OF      do_MOD   ENDOF
_MIN   OF      do_MIN   ENDOF
_MAX   OF      do_MAX   ENDOF
ENDCASE

   ;


\ board

HERE 144 CELLS ALLOT VALUE PATH_VECT 0 VALUE PATH_VECT_point
HERE 144 CELLS ALLOT VALUE PATH_BOARD
HERE 144 CELLS ALLOT VALUE GAME_BOARD
HERE 144 CELLS ALLOT VALUE COLOR_BOARD
HERE 144 CELLS ALLOT VALUE VALUES_RESULTS
HERE 576 CELLS ALLOT VALUE REVERSE_BOARD
HERE 4096 CELLS ALLOT VALUE DATASTACK_
HERE 4096 CELLS ALLOT VALUE RETSTACK_

: BOARD_ 0 PATH_BOARD 144 FILL 0 REVERSE_BOARD 144 FILL  ;

: PATH_BOARD_add 4 last_selected_x last_selected_y  board_size * + CELLS PATH_BOARD + !
   ;
: PATH_BOARD_away 0 SWAP CELLS PATH_BOARD + !
   ;
: PATH_VECT_add PATH_VECT_point DUP CELLS PATH_VECT + potential_direction  SWAP !
1 + TO PATH_VECT_point
   ;
: PATH_VECT_add_from_stack  PATH_VECT_point DUP 1 + TO PATH_VECT_point
CELLS PATH_VECT + !
   ;
: PATH_VECT_away PATH_VECT_point 1 - DUP   CELLS PATH_VECT + @ SWAP
TO   PATH_VECT_point
   ;

: stacks_store.copy_data \ ( address - )
CELLS 9 * 8 0 DO DUP I CELLS + DATASTACK_ + I CELLS VSTACK + @ SWAP ! LOOP
8 CELLS + DATASTACK_ + VSTACK_P SWAP !
;
: stacks_store.copy_ret \ ( address - )
CELLS 9 *  8 0 DO DUP I CELLS + RETSTACK_ + I CELLS VRSTACK + @ SWAP ! LOOP
8 CELLS + RETSTACK_ + VRSTACK_P SWAP !
;


: stacks_store
DUP stacks_store.copy_data
stacks_store.copy_ret
;

: stacks_cansel.copy_data \ ( address - )
CELLS 9 *  8 0 DO DUP I CELLS + DATASTACK_ + @ I CELLS VSTACK +  ! LOOP
8 CELLS + DATASTACK_ + @  TO VSTACK_P
;
: stacks_cansel.copy_ret \ ( address - )
CELLS 9 *   8 0 DO DUP I CELLS + RETSTACK_ + @ I CELLS VRSTACK +  ! LOOP
8 CELLS + RETSTACK_ + @  TO VRSTACK_P
;

: stacks_cansel
DUP stacks_cansel.copy_data
stacks_cansel.copy_ret
;


36 VALUE show_boards.color_size \ размер цвета поля (или поля цвета  )
5 VALUE show_boards.color_tick \ толщина поля цвета
7 VALUE show_boards.color_shift \ сдвиг поля цвета
42 VALUE show_boards.pos_size \ размер квадратика. обозн. позицию
4 VALUE show_boards.pos_shift \ сдвиг квадратика. обозн. позицию
5 VALUE show_boards.pos_tick  \ толщина квадратика. обозн. позицию
9 VALUE show_boards.mark_size  \  размер маркера возврата (допустимость бэк...)
5 VALUE show_boards.mark_tick \  толщина маркера возврата (допустимость бэк...)
30 VALUE show_boards.mark_shift \ сдвиг  маркера возврата

14 VALUE show_boards.text_shift




: color_board
12 0 DO
12 0 DO
J board_size * I + CELLS COLOR_BOARD +
I 2 / 2 MOD 0 =  J 2 /  2 MOD  0 = XOR IF NUMBER_LIGHTBLUE ELSE NUMBER_ORANGE THEN SWAP !

LOOP
LOOP
  NUMBER_RED board_size 1 - CELLS COLOR_BOARD + !
  NUMBER_RED board_size DUP 1 - * CELLS COLOR_BOARD + !
;
color_board


0 VALUE show_board.temp

: last_selected_abs  last_selected_y board_size * last_selected_x  +  CELLS ;

: show_board \ ( -- )
\  доску

board_size 0
   DO
   board_size 0
      DO
       sq_size_ I * coord_start_X +  sq_size_ J * coord_start_Y +
      OVER OVER  \ серый квадрат
       2 + SWAP 2 + SWAP
       _GRAY sq_size_ 2 - 2 square_tick
     
      OVER show_boards.text_shift + OVER show_boards.text_shift +
      J board_size * I + CELLS COLOR_BOARD + @
      J board_size * I + CELLS PATH_BOARD + @ +
      color...
      SETCOLOR
      TEXTXY J board_size * I + CELLS GAME_BOARD + @
      DUP ABS 256 >
      IF DUP 0 < IF  -1 * 255 AND -1 * ELSE  255 AND THEN .
      ELSE CELLS ARR + @  PRINT
      THEN
     
      OVER show_boards.color_shift + OVER  show_boards.color_shift +
      J board_size * I + CELLS COLOR_BOARD + @
      J board_size * I + CELLS PATH_BOARD + @  +
      color...
      show_boards.color_size show_boards.color_tick 
      square_tick
     
     
      J board_size * I + CELLS REVERSE_BOARD + @
      DUP 0 = IF DROP DROP DROP ELSE TO show_board.temp
      OVER  show_boards.mark_shift + 2 + OVER  show_boards.mark_shift + 2 +
      show_board.temp
      color... 
      show_boards.mark_size 2 -  show_boards.mark_tick square_tick
      SWAP show_boards.mark_shift + SWAP  show_boards.mark_shift +
      0 
      show_boards.mark_size 2 square_tick

      THEN
      LOOP
   LOOP
   
      sq_size_ last_selected_x * coord_start_X +  sq_size_ last_selected_y * coord_start_Y +
      SWAP show_boards.pos_shift + SWAP  show_boards.pos_shift +
      _WHITE
      show_boards.pos_size show_boards.pos_tick square_tick
     
      show_stack
;



: startxy
board_size  1 - TO last_selected_y
0 TO last_selected_x
;




: clear_two
last_selected_x sq_size_  * coord_start_X +  sq_size_ last_selected_y * coord_start_Y +
_BLACK sq_size_ DUP 2 / square_tick
sq_size_  * coord_start_Y + SWAP sq_size_  * coord_start_X + SWAP
_BLACK sq_size_ DUP 2 / square_tick
;

: possibility_before
   
   OVER OVER board_size * + CELLS DUP
   PATH_BOARD + @ 0 = SWAP
   COLOR_BOARD + @ last_selected_x
   last_selected_y board_size * + CELLS COLOR_BOARD + @ =
   VRSDEPTH 0 = OR AND
   ;

   
: step_to_do
last_selected_x last_selected_y board_size * + stacks_store
OVER OVER board_size * + CELLS GAME_BOARD  + @
DUP ABS 256 >
      IF DUP 0 < IF  -1 * 255 AND -1 * ELSE  255 AND THEN  >VS
      GET_VSTACK_ERR DUP IF VS_ERR_PRINT   0   ELSE DROP -1 THEN
      ELSE element_execute
      THEN     
   ;
   
: game_step
   TO potential_direction
   possibility_before
   IF  step_to_do 
      IF   PATH_BOARD_add PATH_VECT_add 
         OVER OVER
         clear_two TO last_selected_y  TO last_selected_x  show_board   
      ELSE ERROR_POS DROP DROP   
      THEN
    ELSE ERROR_POS   DROP DROP 
   THEN
   ;

: _right
game?
IF last_selected_x board_size 1 - < IF last_selected_x 1 + last_selected_y 2 game_step ELSE ERROR_POS  THEN
THEN
;
' _right TO K_RIGHT

: _left
game?
IF last_selected_x 0 > IF last_selected_x 1 - last_selected_y 4 game_step ELSE  ERROR_POS  THEN THEN
;
' _left TO K_LEFT

: _up
game?
IF last_selected_y 0 > IF last_selected_x last_selected_y 1 - 1 game_step ELSE  ERROR_POS THEN
THEN
;
' _up TO K_UP


: _down
game?
IF last_selected_y board_size 1 - < IF last_selected_x last_selected_y 1 + 3 game_step ELSE  ERROR_POS THEN
  THEN
;
' _down TO K_DOWN



: back_move

PATH_VECT_point 0 >
game?  AND
 
IF
   PATH_VECT_away DUP
   CASE
   1   OF   last_selected_x last_selected_y 1 +   ENDOF
   2   OF   last_selected_x 1 - last_selected_y   ENDOF
   3   OF   last_selected_x last_selected_y 1 -   ENDOF
   4   OF   last_selected_x 1 + last_selected_y   ENDOF
   ENDCASE 
   OVER OVER board_size * + CELLS REVERSE_BOARD + DUP @
   NUMBER_RED =
   IF 
   ERROR_POS   DROP  DROP  DROP  PATH_VECT_add_from_stack
   ELSE 
   DUP @  1 + SWAP ! OVER OVER board_size * + PATH_BOARD_away 
    OVER OVER board_size * + stacks_cansel   
    OVER OVER clear_two   
    TO last_selected_y  TO last_selected_x  DROP
    show_board 
   THEN

ELSE ERROR_POS THEN
;
' back_move DUP DUP TO K_F10 TO K_F11 TO K_F12



\  GAME BEGIN начало игры и т.п. загрузка новых игр по пути наименьшего сопротивления
0 VALUE game_map.index 0 VALUE game_map.err 0 VALUE game_map.non

: E,EXEM DROP -1 TO game_map.err ;
: E,EM game_map.err IF DROP  ELSE  TO game_map.err THEN ;
: N,EM game_map.non IF DROP  ELSE  TO game_map.non THEN ;
: E,? game_map.index DUP board_size DUP * >
IF E,EXEM ELSE DUP 1 + TO game_map.index CELLS GAME_BOARD + !  THEN ;
: E, DUP elementes_all > OVER 1 < OR IF E,EM ELSE E,?  THEN  ;
: N,? DUP 0 < IF -512 + ELSE 512 + THEN E,? ;
: N, DUP ABS 99 > IF N,EM ELSE N,?  THEN  ;

\ массив доступных игр
HERE 8 2 * CELLS ALLOT VALUE available_games 
0 VALUE available_games_point
\ 2 CELLS - строка описания игры и адрес слова-загрузчика, которое содержит (загружает) данные
: available_games.to \ ( xt c-addr -- success  number )
      available_games_point 14 >
      IF
      " слишком много элементов для available_games " PRINT 0
      ELSE
      available_games_point  CELLS available_games + !
      available_games_point 1 + CELLS available_games + ! -1
      available_games_point DUP 2 + TO available_games_point
      THEN     
      ;
     
\ игра должна определеяться словом  ????
\ :   ???? ['] game_description   " game verbal description "  available_games.to ;  ????


: example_4
board_size.tiny TO board_size     
color_board  \ стандарт, или можно определить своё
startxy  \ стандарт, или можно определить своё
\ доска
2   N,   _NIP   E,   _<>   E,   _:))   E,
5   N,   _NIP   E,   _MOD   E,   _<>   E,
7   N,   _+   E,   _NIP   E,   _NIP   E,
_?   E,   6   N,   4   N,   3   N,


\ стек так и выглядит
11 >VS
10 >VS
9 >VS
8 >VS
1 >VS 
   ;
:  example_4_des ['] example_4   " простой пример 4x4 игры со словами NIP MOD " 
available_games.to ;   
                        example_4_des DROP DROP
\ end example game description

VECT game.map 0 VALUE game.descr
0 VALUE game.last
0 VALUE game.lastp
: new_game   \ ( number -- )
   DUP 12 > OVER  1 + CELLS available_games + @ 0 = OR
   
   IF " ненормальный номер игры " PRINT DROP
   ELSE
   DUP TO game.lastp DUP
   CELLS available_games + @ TO game.descr 1  + CELLS  available_games + @ TO game.map
   0 TO game_map.index 0 TO game_map.err 0 TO game_map.non
   0 TO VSTACK_P 0 TO VRSTACK_P
   game.map 
   game_map.err  game_map.non OR
   last_selected_x last_selected_y board_size * + CELLS GAME_BOARD + @ _? = NOT OR
   0 = IF
      game.lastp TO game.last \ потенциальный номер игры в реально последню
     \ этот номер будет использоваться циклом игр F3 и "началом той же самой заново" по F2
      stack_X() ret_X()
      BOARD_
      0 TO PATH_VECT_point
      CLS show_board coord_start_X  coord_start_Y  28 - TEXTXY _LIGHTGRAY SETCOLOR game.descr PRINT
      -1 TO game?_value
      ELSE
      CLS
      0 TO game?_value
      show_board 
      coord_start_X  coord_start_Y  28 - TEXTXY
      " невозможно загрузить игру: ошибка в расположении элементов либо начальной позиции"  PRINT
      THEN
   THEN
;


: game_cycle game.last 2 +
      DUP
      14 > OVER CELLS available_games + @ 0 = OR IF DROP 0  THEN
      DUP
       CELLS available_games + @ 0 = IF 160 90 TEXTXY " No available games " PRINT DROP ELSE new_game THEN
   ;
   ' game_cycle TO K_F3
   
: game_again   
   game.last DUP
   CELLS available_games + @ 0 =
   IF 160 90 TEXTXY " No available games " PRINT DROP ELSE new_game THEN
;
' game_again TO K_F2

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

: example_6b
board_size.small TO board_size     
color_board  \ стандарт
startxy  \ стандарт
\ доска
3   N,   -3   N,   -4   N,   _+   E,   _MAX   E,   _:))    E,
-3   N,   3   N,   -3   N,   _NIP   E,   _XOR   E,   _MAX   E,
_OR   E,   _-   E,   4   N,   -4   N,   _NIP   E,   _-   E,
5   N,   6   N,   -4   N,   4   N,   -3   N,   -4   N,
7   N,   8   N,   10   N,   _+   E,   3   N,   -3   N,
_?   E,   9   N,   11   N,   _XOR   E,   -3   N,   3   N,



\ стек
1 >VS
2 >VS
3 >VS
4 >VS
4 >VS
4 >VS 
   ; 
:  example_6b_des ['] example_6b   " пример игры 6х6 c операторами MAX MIN NIP - обнаружено 1 решениe " 
   available_games.to ;   
                        example_6b_des  DROP DROP
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

\ -------------------------------------------------------------------------                       

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 

: example_6c
board_size.small TO board_size     
color_board  \ стандарт
startxy  \ стандарт
\ доска
5   N,   0   N,   1   N,   _NIP   E,   _<>   E,   _:))   E,
2   N,   _NIP   E,   3   N,   2   N,   _NIP   E,   _<>   E,
7   N,   _NIP   E,   _NOT   E,   5      N,   3   N,   _NIP   E,
9   N,   _+   E,   _XOR   E,   _OR   E,   7   N,   4   N,
3   N,   4   N,   _NIP   E,   _NIP   E,   _NIP   E,   9   N,
_?   E,   0   N,   0   N,   1   N,   2   N,   5   N,

\ стек
10 >VS
9 >VS
8 >VS
7 >VS
6 >VS
-4 >VS 
   ; 
:  example_6c_des ['] example_6c   " пример  6х6 где интенсивно используется NIP :)  "  available_games.to ;   
                        example_6c_des  DROP DROP
                       
                       
\ -------------------------------------------------------------------------   
                 
Сообщение Добавлено: Вт июл 13, 2010 20:50
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Сама программа очень проста - она реагирует на 9 клавиш (11, т.к. одна клавиша изображается тремя )
Стрелки - движение позиции по доске, слово, вызваемое прерыванием стрелки, кладёт на стек переменные, которые обозначают положение на доске текущее, изменив их (прибавив или вычтя 1, т.к. движение только на 1 поле )
имея ввиду поле, куда предполагается пойти.
: _down
game?
IF last_selected_y board_size 1 - < IF last_selected_x last_selected_y 1 + 3 game_step ELSE ERROR_POS THEN
THEN
;

' _down TO K_DOWN

слово game? убеждается, что игра в процессе
также, это слово _down производит проверку геометрии, т.е. не идёт ли пользователь за размеры, ERROR_POS на самом деле просто звуковой сигнал
изменив координаты и положив на стек цифру, шифрующую направление (3 если вниз)
слово, вызываемое стрелкой вызывает game_step шаг игры

: game_step 
TO potential_direction
possibility_before
IF step_to_do
IF PATH_BOARD_add PATH_VECT_add
OVER OVER
clear_two TO last_selected_y TO last_selected_x show_board
ELSE ERROR_POS DROP DROP
THEN
ELSE ERROR_POS DROP DROP
THEN
;

это и вся сложность :)))
potential_direction - это переменная, хранящая код направления хода, этот код будет внесен в PATH_VECT
только в том случае, если возможен предлагаемый ход
в случае с ходом вниз, в переменную potential_direction попадёт 3ка
НА стеке остаются координаты того поля, куда попадёт пользователь, если ход закончится успешно
сначала слово game_step передаёт их в слово possibility_before , которое проверяет возможность хода исходя из правил, которые можно применить ДО попытки сделать ход

: possibility_before 

OVER OVER \ координаты будут сохранены для последующего

board_size * + CELLS DUP
PATH_BOARD + @ 0 = SWAP
COLOR_BOARD + @ last_selected_x
last_selected_y board_size * + CELLS COLOR_BOARD + @ =
VRSDEPTH 0 = OR AND
;


таких правил всего 2 - не является ли поле уже пройденным : смотрим PATH_BOARD
и не является ли ход сменой цветов а если да, то пуст ли стек возвратов
таким образом реализуются 2 правила в игре - не ходить на пройденное и
менять цвет поля толко с пустым стеком возвратов
последнее правило делает игру не такой простой и
иммитирует правило настоящего форта
т.к. нельзя забывать стек возвратов при NEXT

если эти правила соблюдены, possibility_before
возвращает -1 и game_step
вызывает step_to_do

step_to_do - попытка сделать ход - имеется ввиду не на доске, а осуществить математическое действие, предполагаемое этим ходом с данными на стеке

step_to_do может возвращать
(a) ИСТИНУ если ход получился или
(b) 0 если скажем, переполнился стек или недостаточно элементов или деление на 0х00

далее происходит вот этот фрагмент
IF	PATH_BOARD_add PATH_VECT_add  
OVER OVER
clear_two TO last_selected_y TO last_selected_x show_board
ELSE ERROR_POS DROP DROP
THEN

Если всё хорошо, то PATH_BOARD_add PATH_VECT_add внесут изменения в PATH_BOARD и PATH_VECT
координаты попадут в last_selected_y last_selected_x чем воспользуется show_board
в противном случае - звуковой сигнал и координаты будут вытерты со стека
ERROR_POS DROP DROP
и снова ждём прерываний

Действия обозначены номерами, каждому номеру соответствует строка, которая отображается на доске, переменная, которая используется при кодировании стартовой позиции, которая выглядит как строка - форт позволяет, только перед подчёркивание - действие + обозначено _+
действие вызывается по номеру в слове element_execute, где каждому номеру сопоставлено
слово, выполняющее действие _+ - do_+
и т.п.
Само номера заданы вот этим
1 1 VALUE 	_?   	"  ?"   elementes...
2 2 VALUE _NOT " NOT" elementes...
4 4 VALUE _INVerse " INV" elementes...
5 5 VALUE _OR " OR" elementes...
3 3 VALUE _XOR " XOR" elementes...
6 6 VALUE _AND " AND" elementes...
8 8 VALUE _DUP " DUP" elementes...
7 7 VALUE _+ " + " elementes...
9 9 VALUE _- " - " elementes...
10 10 VALUE _* " * " elementes...
11 11 VALUE _/ " / " elementes...
12 12 VALUE _<> " <> " elementes...
13 13 VALUE _< " < " elementes...
14 14 VALUE _> " > " elementes...
15 15 VALUE _= " = " elementes...
16 16 VALUE _ROT " ROT" elementes...
17 17 VALUE _:)) " :))" elementes...


Слово element_execute возвращает удачу
или неудачу действия, которую в свою
очередь получает от слов
: do_NOT VSDEPTH 1 < IF 0 ELSE VS> NOT >VS -1 THEN ;
: do_INVerse VSDEPTH 1 < IF 0 ELSE VS> -1 XOR >VS -1 THEN ;
: do_OR VSDEPTH 2 < IF 0 ELSE VS> VS> OR >VS -1 THEN ;
: do_XOR VSDEPTH 2 < IF 0 ELSE VS> VS> XOR >VS -1 THEN ;
: do_AND VSDEPTH 2 < IF 0 ELSE VS> VS> AND >VS -1 THEN ;
: do_DUP VSDEPTH 7 > IF 0 ELSE VS> DUP >VS >VS -1 THEN ;
: do_+ VSDEPTH 2 < IF 0 ELSE VS> VS> + >VS -1 THEN ;
: do_- VSDEPTH 2 < IF 0 ELSE VS> VS> SWAP - >VS -1 THEN ;
: do_* VSDEPTH 2 < IF 0 ELSE VS> VS> * >VS -1 THEN ;
: do_/ VSDEPTH 2 < VS> DUP >VS 0 = OR IF 0 ELSE VS> VS> SWAP / >VS -1 THEN ;
: do_<> VSDEPTH 2 < IF 0 ELSE VS> VS> = NOT >VS -1 THEN ;
: do_< VSDEPTH 2 < IF 0 ELSE VS> VS> SWAP < >VS -1 THEN ;
: do_> VSDEPTH 2 < IF 0 ELSE VS> VS> SWAP > >VS -1 THEN ;
: do_= VSDEPTH 2 < IF 0 ELSE VS> VS> = >VS -1 THEN ;
: do_ROT VSDEPTH 3 < IF 0 ELSE VS> VS> VS> SWAP >VS SWAP >VS >VS -1 THEN ;
: do_:)) VRSTACK_P 0 = VSTACK_P 0 > AND VS> 0 = AND IF END_SUCCESS 0 TO game?_value -1 ELSE 0 THEN ;
которые вызывает по номеру

каждое из этих слов либо производит действия и возвращает TRUE
либо не производит действий и возвращает FALSE
Сообщение Добавлено: Вс июл 04, 2010 17:48
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Итак, как устроен код
Очень просто, на самом деле.

Сначала небольшое отступление. Как должен быть описан алгоритм игры - в терминах привил и событий игры или в терминах языка реализации? Этот вопрос не пустой - в ответ на этот вопрос родились понятия "абстракция данных" и "обьектно-ориентированное программирование"
С точки зрения эффективности работы лучшим является вариант с абстракцией данных. Если это имеет хороший вид, то программист имеет дело только с логикой игры. В случае, если абстракция даных отсутствует, программист имеет дело ... нет не с логикой кода, а с двумя перемешанными логиками - логикой кода и логикой игры, причём эта логика бывает асимметрична.

В этом коде абстракция данных отсуствует.

Потому такой нечитабельный.

Если же разобраться, то ничего сложного нет.

Начнём с правил игры - игрок (решатель задачи) ходит по ячейкам. Вся игра может быть описана , если указано
1. расположение цветов на доске
2. расположение операций и чисел на доске
3. маршрут и текущее положение
4. количество возвращений через каждую ячейку

Можно уложить всё в одну доску-массив структур, но это может быть сложнее, потому сделаны

HERE 144 CELLS ALLOT VALUE PATH_VECT 0 VALUE PATH_VECT_point
HERE 144 CELLS ALLOT VALUE PATH_BOARD
HERE 144 CELLS ALLOT VALUE GAME_BOARD
HERE 144 CELLS ALLOT VALUE COLOR_BOARD
HERE 144 CELLS ALLOT VALUE VALUES_RESULTS
HERE 576 CELLS ALLOT VALUE REVERSE_BOARD
HERE 4096 CELLS ALLOT VALUE DATASTACK_
HERE 4096 CELLS ALLOT VALUE RETSTACK_

PATH_VECT показывает направление движение по ходам
1 ход - нулевой элемент массива и т.д. так удобнее. т.к. чтобы найти след. ход, мы просто используем PATH_VECT_point
PATH_BOARD отдельно от PATH_VECT, т.к. служит для подсвечивания пройденного пути серым - содержит число, на которое увеличивается номер цвета, если ячейка пройдена (всегда 4)
GAME_BOARD содержит операции форта, точнее числа, отсылающие к операциям
COLOR_BOARD содержит цвета соотв. ячеек
VALUES_RESULTS - отладочное - забыл убрать, ничего не содержит
DATASTACK_ RETSTACK_ - массивы, хранящие состояяния стеков на момент ухода из ячейки, возвратившись в ячейку, игрок находит там стеки возвращённые к нужному состоянию
Как видим, всё хранится отдельно , все массивы имеют размерность 144 * 4 кроме DATASTACK_ RETSTACK_ - они выстроены из предположения, что необходимо сохранять в каждом ходе 16 CELLS + 2 глубины

Вначале массивы нужно заполнить, для чего служат слова
color_board распределяет цвета на доске, можно было бы поячеечно, но зачем, если ясна математическая закономерность, стандартное слово создаёт "шахматную" структуру с удвоенным размером поля
startxy - устанавливает стартовое выделение в нужное положение ( должно совпасть со знаком вопроса и в стандартном слове находится в левом нижнем углу)
E, компилирует элемент - номер оператора ( вроде + - = * ) в GAME_BOARD
N, компилирует число, признаком числа является то, что оно больше 256 - предполагается, что числа вообще меньше 100 или больше -100 (чтобы ограничить количество значащих цифр)
само число прибавляется к 512, чтобы не создавать дополнительных структур
т.о. GAME_BOARD содержит операции 1-17 и числа 512 и выше, слово, изображающее доску вычитает из чисел 512 и остаток выводит на экран. На всякий случай эти слова производят проверки корректности предлагаемых данных, только потом размещают их, для этого служат слова
: E,EXEM DROP -1 TO game_map.err ;
: E,EM game_map.err IF DROP ELSE TO game_map.err THEN ;
: N,EM game_map.non IF DROP ELSE TO game_map.non THEN ;
: E,? game_map.index DUP board_size DUP * >
IF E,EXEM ELSE DUP 1 + TO game_map.index CELLS GAME_BOARD + ! THEN ;
: N,? DUP 0 < IF -512 + ELSE 512 + THEN E,? ;


Может быть это неправильно, но нет слова-загрузчика для всех игр, а есть слово-загрузчик отдельное для каждой игры.
Например example_4 - это слово-пример загрузчика - оно вызывает слова
color_board
startxy
устанавливает размер доски и заполняет доску
Загрузчик потом может быть вызван словом
new_game
при вызове новой игры

Каждому загрузчику по пятам следует вспомогательное слово (индивидуально)
которое помещает адрес загрузчика в массив available_games , откуда его достанет
new_game
при вызове новой игры
ещё строку описания
в примере это example_4_des
массив адресов - чтобы оперировать списком доступных игр - наприер менять их в цикле game_cycle

Загрузчик игры может пользоваться не стандартными словами color_board , а определить собственные, которые компилируются вместе с загрузчиком и представляют собою его часть (см. слова example_8e color_board8e startxy8e )

фактически игры не загружаются а до-компилируются,что громоздко, но очень быстро

хм. продолжение следует если интересно
Сообщение Добавлено: Сб июл 03, 2010 21:36
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Цитата:
А разве демонстрация кода в сети на всеобщее обозрение не подразумевает, что кто-то будет исследовать его?

Хорошо, код исправим. Но демонстрируется прежде всего идея - форт в виде правил динамической интеллектуальной задачи - может, это даже не совсем игра (как и предыдущая). Но по виду - игра.
Сообщение Добавлено: Сб июл 03, 2010 09:10
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
вопрос писал(а):
Кроме того, этих слов нет в доступных мне PDF, и меня это раздражает по правде говоря, хотя это личное дело Хищника. Компилятор, который работает не со всей клавитурой или по крайней мере из документации непонятно, что он работает со всей ( потом вытру эту фразу) (улыбайтесь)

У меня есть api-файл с подсказками для SciTE. На данный момент там описано лишь 298 слов из 704, большинство из мануала. Т.к. спроса нет на него, а сам я и так помню большинство слов кварка - вот и не обновляю почти. Если кому-то нужно - могу описать все остальные.
вопрос писал(а):
Что касается ARRAY - то он есть не во всех фортах, а потому надёжнее так

Ну во-первых код - для кварка. И опять забыт один из плюсов форта - его расширяемость. ARRAY - это одна фраза:
Код:
: ARRAY CREATE CELLS ALLOT ;

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

А разве демонстрация кода в сети на всеобщее обозрение не подразумевает, что кто-то будет исследовать его? Тем более, комментарии важны в первую очередь для самого автора. Я вот например уже давно выработал в себе привычку писать везде стековые комментарии, даже если слово из одной фразы. И обязательно описываю что делает слово. За исключением только тестового и экспериментального кода.
Сообщение Добавлено: Сб июл 03, 2010 08:44
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
вопрос писал(а):
Ну, При наличии заказа постараюсь сделать. это априорный заказ - он как бы существует сам по себе.

Чем векторность клавиш мешала бы вот этому

VoidVolker уже писал - есть векторы KEYDOWN и KEYUP. Еще есть VARIABLE LASTKEY, там будет код нажатой/отпущенной клавиши. Если по KEYDOWN обработать код самостоятельно, а потом заменить содержимое LASTKEY на 0, клавиша окажется "проглоченной".
Сообщение Добавлено: Сб июл 03, 2010 01:24
  Заголовок сообщения:  Re: Ещё игрушка "логический лабиринт" ,  Ответить с цитатой
Хищник писал(а):
вопрос писал(а):
Кроме того, любопытно, что Кварк делает с WM_PAINT - MessageBox не прорисовывается

При наличии заказа постараюсь сделать. С клавишами дело такое - что не требуется для редактирования вводимого текста (плюс что попалось на глаза), то и сделано. Сейчас обработка любой клавиши - это вектор. С WM_PAINT можно сделать одно - постоянно выполнять, иначе не будет отрисовки.
Я тут в некотором роде уезжаю отдыхать, но с нетбуком и GPRS-модемом. Так что на запросы общественности смогу отреагировать, в пределах разумного.


Ну, При наличии заказа постараюсь сделать. это априорный заказ - он как бы существует сам по себе.

Чем векторность клавиш мешала бы вот этому
С клавишами дело такое - что не требуется для редактирования вводимого текста

Вообще - обсуждаем тут игру :| - всё-таки это форт-игра или форт в виде игры
или игра для фортеров специально
Сообщение Добавлено: Сб июл 03, 2010 00:41

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


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