Автор |
Сообщение |
|
|
Заголовок сообщения: |
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
Пока небольшое неначительное усовершенствование (над перспективами размышляю)
Пришло в голову, что если сделать квадратик сплошным а не в виде рамки, то на нём без увеличения размеров поместятся 4- буквенные SWAP DROP TUCK OVER также добавил NOOP :)
В коде единственный пример с этими словами [code] " 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
[/code]
|
|
|
|
Добавлено: Чт июл 22, 2010 22:02 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
Вспоминается что в Fallout-е При "взломе компьютера" красиво так в консоли с зелеными буквами грузились файлы с расширением .f Правда фортом в этой головоломке и не пахло, было что то вроде "быков и коров"
Вспоминается что в Fallout-е При "взломе компьютера" красиво так в консоли с зелеными буквами грузились файлы с расширением [b].f[/b] Правда фортом в этой головоломке и не пахло, было что то вроде "быков и коров"
|
|
|
|
Добавлено: Ср июл 14, 2010 11:59 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
вопрос писал(а): Вот я не знаю, это требует размышлений Что то внутре мне подсказывает что оно того стоит.
[quote="вопрос"]Вот я не знаю, это требует размышлений[/quote] Что то внутре :wink: мне подсказывает что оно того стоит.
|
|
|
|
Добавлено: Ср июл 14, 2010 11:53 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
_Harry писал(а): вопрос писал(а): Например - генератор начальных позиций. Да тут наверно и в 800 строк не уложишся.... Вот я не знаю, это требует размышлений
[quote="_Harry"][quote="вопрос"]Например - генератор начальных позиций.[/quote] Да тут наверно и в 800 строк не уложишся....[/quote] Вот я не знаю, это требует размышлений :roll:
|
|
|
|
Добавлено: Ср июл 14, 2010 11:16 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
вопрос писал(а): Например - генератор начальных позиций. Да тут наверно и в 800 строк не уложишся....
[quote="вопрос"]Например - генератор начальных позиций.[/quote] Да тут наверно и в 800 строк не уложишся....
|
|
|
|
Добавлено: Ср июл 14, 2010 01:05 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
Спасибо. Пока эта игра - только идея, хотя уже на 800 строк, но нужно ещё много чего, чтобы говорить о коммерческой стоимости. Например - генератор начальных позиций.
Спасибо. :D Пока эта игра - только идея, хотя уже на 800 строк, но нужно ещё много чего, чтобы говорить о коммерческой стоимости. Например - генератор начальных позиций.
|
|
|
|
Добавлено: Вт июл 13, 2010 22:53 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
Очень интересно! Предлагаю автору присвоить звание Супер Джедая А если без шуток то во многих навороченных стреляках и всяки ролевых игрушках, часто встречается момент "взлома" компьютера, замка и т.п. Как правило это несложная головоломка. Может стоит попытаться эту игру продать какой ни будь фирме занимающейся разработкой игр. Глядишь кто то из стрелков подрастет и фортером станет.
Очень интересно! Предлагаю автору присвоить звание [color=#FF0000][b]Супер Джедая[/b][/color] :D А если без шуток то во многих навороченных стреляках и всяки ролевых игрушках, часто встречается момент [b]"взлома"[/b] компьютера, замка и т.п. Как правило это несложная головоломка. Может стоит попытаться эту игру продать какой ни будь фирме занимающейся разработкой игр. Глядишь кто то из стрелков подрастет и фортером станет.
|
|
|
|
Добавлено: Вт июл 13, 2010 22:47 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
Подумал - что если не все понимают правила игры - может быть, тему читают не только фортеры поэтому иллюстрация на примере 4х4 задачи из предыдущего постинга (прошу прощения, если рисунки велики - не было времени их аккуратно отредактировать) итак - стартовая позиция 1. ЧТо если "лабиринт" проходится так просто, кратчайшим путём? Попробуем, пойдём лесенкой вправо-вверх и так дальше Сначала вправо - позиция 2 - мы встречаем цифру и игра, как и обычный форт в режиме интерпретации , разбирая исходник, кладёт цифру на стек Потом вверх - позиция 3 - 6 прибавилось к 1 и получилось 7 Потом снова вправо - позиция 4 : теперь работает NIP Однако, нас постигнет неудача в конце "лесенки" мы не можем перейти в верхнее правое поле, т.к. на стеке данных - не 0 Попробуем анализировать ситуацию, составить план прохождения лабиринта. Для начала мы замечаем, что оба поля, через которые можно попасть на выиграшное поле :)) - это операторы "не равно" <>Это означает,что 0 на стеке может образоваться, если мы перейдём на эти поля с двумя равными цифрами на вершине стека. Т.е. если перед тем, как ступить на поле "не равно" мы будем иметь равные цифры, оператор даст 0 и дальше с этим нулём мы попадём на :)) Попробуем получить равные цифры. Предпримем опять наивную попытку. На стеке и на поле все цифры разные, т.о. чтобы получить одинаковые , нужны над ними какие-то действия (и действий на поле немного - плюс и MOD ) Мы замечаем, что если сложить 2ю и 3ю на стеке цифры, то получится 9 и это приведёт к образованию 2 девяток подряд, нам мешает 6 , которую можно временно убрать на стек возвратов получается : шаг вправо - положить 6 на стек возвратов - перейти на +Всё хорошо, теперь нужно доставить две девятки к :)) , точнее к <> Не тут то было, способа сделать так, чтобы эти 2 цифры оказались в нужный момент не существует. Для начала, придётся вернуть на стек 6, иначе с заполненным стеком игра не выпустит нас за пределы бирюзового цвета, а дальше - нет оператора, который убирал бы одну цифру со стека не задевая вторую ... Тем не менее, это всё-таки очень нетру дная задача и имеет множество решений. Для того, чтобы попасть в конечную позицию, достаточно произвести 4 действия 1. С достаточным количеством цифр любым путём подойти к полю с " не равно" , ступив на него, получить на стеке -1 1.а Вспомнить, что Х -1 MOD всегда даст 0 2. получить упомянутый 0, перейдя на MOD 3. сохранить 0 клавишей PGUP на стек возвратов 4. перейти на другое поле с "не равно" , т.к. все три поля одного цвета дальше понятно - 0 возвращается на стек данных и игра окончена
Подумал - что если не все понимают правила игры - может быть, тему читают не только фортеры
поэтому иллюстрация на примере 4х4 задачи из предыдущего постинга
(прошу прощения, если рисунки велики - не было времени их аккуратно отредактировать)
[img]http://s002.radikal.ru/i198/1007/f3/a253e9a65111.png[/img] итак - стартовая позиция 1. ЧТо если "лабиринт" проходится так просто, кратчайшим путём? Попробуем, пойдём лесенкой вправо-вверх и так дальше Сначала вправо - позиция 2 - мы встречаем цифру и игра, как и обычный форт [size=50]в режиме интерпретации[/size] , разбирая исходник, кладёт цифру на стек Потом вверх - позиция 3 - 6 прибавилось к 1 и получилось 7 Потом снова вправо - позиция 4 : теперь работает NIP
Однако, нас постигнет неудача в конце "лесенки" [img]http://s03.radikal.ru/i176/1007/97/d71b19d2b8a6.png[/img] мы не можем перейти в верхнее правое поле, т.к. на стеке данных - не 0
Попробуем анализировать ситуацию, составить план прохождения лабиринта. Для начала мы замечаем, что оба поля, через которые можно попасть на выиграшное поле [color=#FF0040][b]:[/b][b])[/b][b])[/b] [/color] - это операторы "не равно" [b]<[/b][b]>[/b] Это означает,что 0 на стеке может образоваться, если мы перейдём на эти поля с двумя равными цифрами на вершине стека. Т.е. если перед тем, как ступить на поле "не равно" мы будем иметь равные цифры, оператор даст 0 и дальше с этим нулём мы попадём на [color=#FF0040][b]:[/b][b])[/b][b])[/b] [/color]
Попробуем получить равные цифры. Предпримем опять наивную попытку. На стеке и на поле все цифры разные, т.о. чтобы получить одинаковые , нужны над ними какие-то действия (и действий на поле немного - плюс и MOD :D ) [img]http://s56.radikal.ru/i151/1007/69/a8b2268be6ec.png[/img] Мы замечаем, что если сложить 2ю и 3ю на стеке цифры, то получится 9 и это приведёт к образованию 2 девяток подряд, нам мешает 6 , которую можно временно убрать на стек возвратов получается : [b]шаг вправо - положить 6 на стек возвратов - перейти на +[/b] Всё хорошо, теперь нужно доставить две девятки к [color=#FF0040][b]:[/b][b])[/b][b])[/b] [/color] , точнее к [b]<[/b][b]>[/b] 8) [img]http://i072.radikal.ru/1007/1d/1b244903fddf.png[/img] Не тут то было, способа сделать так, чтобы эти 2 цифры оказались в нужный момент не существует. Для начала, придётся вернуть на стек 6, иначе с заполненным стеком игра не выпустит нас за пределы бирюзового цвета, а дальше - нет оператора, который убирал бы одну цифру со стека не задевая вторую ... :D
Тем не менее, это всё-таки очень нетру дная задача и имеет множество решений. Для того, чтобы попасть в конечную позицию, достаточно произвести 4 действия [img]http://s13.radikal.ru/i186/1007/65/d066c4240c3d.png[/img] [b]1. [/b]С достаточным количеством цифр любым путём подойти к полю с " не равно" , ступив на него, получить на стеке -1 [b]1.а [/b]Вспомнить, что Х -1 MOD всегда даст 0 [b]2. [/b]получить упомянутый 0, перейдя на MOD
[img]http://s39.radikal.ru/i083/1007/c7/595a42b3b8d7.png[/img] [b]3. [/b]сохранить 0 клавишей PGUP на стек возвратов [b]4. [/b]перейти на другое поле с "не равно" , т.к. все три поля одного цвета
дальше понятно - 0 возвращается на стек данных и игра окончена
|
|
|
|
Добавлено: Вт июл 13, 2010 21:34 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
Заметил, что в форте ещё есть трёхбуквенные операторы (слова) MOD NIP MAX MIN добавил их в игру , в этом варианте кода три стартовых позиции, в которых присутствуют эти операторы. На примере самой простой также поясняются правила игры - см. след. постинг. ПОсле загрузки файла нужно нажать 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 \ -------------------------------------------------------------------------
Заметил, что в форте ещё есть трёхбуквенные операторы (слова) MOD NIP MAX MIN добавил их в игру :D , в этом варианте кода три стартовых позиции, в которых присутствуют эти операторы. На примере самой простой также поясняются правила игры - см. след. постинг. ПОсле загрузки файла нужно нажать F2 [code] " 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 \ ------------------------------------------------------------------------- [/code]
|
|
|
|
Добавлено: Вт июл 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
Сама программа очень проста - она реагирует на 9 клавиш (11, т.к. одна клавиша изображается тремя ) Стрелки - движение позиции по доске, слово, вызваемое прерыванием стрелки, кладёт на стек переменные, которые обозначают положение на доске текущее, изменив их (прибавив или вычтя 1, т.к. движение только на 1 поле ) имея ввиду поле, куда предполагается пойти. [pre]: _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 ;[/pre] ' _down TO K_DOWN
слово game? убеждается, что игра в процессе также, это слово _down производит проверку геометрии, т.е. не идёт ли пользователь за размеры, ERROR_POS на самом деле просто звуковой сигнал изменив координаты и положив на стек цифру, шифрующую направление (3 если вниз) слово, вызываемое стрелкой вызывает game_step шаг игры
[pre]: 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 ;[/pre] это и вся сложность :))) potential_direction - это переменная, хранящая код направления хода, этот код будет внесен в PATH_VECT только в том случае, если возможен предлагаемый ход в случае с ходом вниз, в переменную potential_direction попадёт 3ка НА стеке остаются координаты того поля, куда попадёт пользователь, если ход закончится успешно сначала слово game_step передаёт их в слово possibility_before , которое проверяет возможность хода исходя из правил, которые можно применить ДО попытки сделать ход
[pre]: 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 ;[/pre]
таких правил всего 2 - не является ли поле уже пройденным : смотрим PATH_BOARD и не является ли ход сменой цветов а если да, то пуст ли стек возвратов таким образом реализуются 2 правила в игре - не ходить на пройденное и менять цвет поля толко с пустым стеком возвратов последнее правило делает игру не такой простой и иммитирует правило настоящего форта т.к. нельзя забывать стек возвратов при NEXT
если эти правила соблюдены, possibility_before возвращает -1 и game_step вызывает step_to_do
step_to_do - попытка сделать ход - имеется ввиду не на доске, а осуществить математическое действие, предполагаемое этим ходом с данными на стеке
step_to_do может возвращать (a) ИСТИНУ если ход получился или (b) 0 если скажем, переполнился стек или недостаточно элементов или деление на 0х00
далее происходит вот этот фрагмент [pre]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[/pre] Если всё хорошо, то 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_+ и т.п. Само номера заданы вот этим [pre]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...[/pre]
Слово 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 )
фактически игры не загружаются а до-компилируются,что громоздко, но очень быстро хм. продолжение следует если интересно
Итак, как устроен код Очень просто, на самом деле.
Сначала небольшое отступление. Как должен быть описан алгоритм игры - в терминах привил и событий игры или в терминах языка реализации? Этот вопрос не пустой - в ответ на этот вопрос родились понятия "абстракция данных" и "обьектно-ориентированное программирование" С точки зрения эффективности работы лучшим является вариант с абстракцией данных. Если это имеет хороший вид, то программист имеет дело только с логикой игры. В случае, если абстракция даных отсутствует, программист имеет дело ... нет не с логикой кода, а с двумя перемешанными логиками - логикой кода и логикой игры, причём эта логика бывает асимметрична.
В этом коде абстракция данных отсуствует.
Потому такой нечитабельный.
Если же разобраться, то ничего сложного нет.
Начнём с правил игры - игрок (решатель задачи) ходит по ячейкам. Вся игра может быть описана , если указано 1. расположение цветов на доске 2. расположение операций и чисел на доске 3. маршрут и текущее положение 4. количество возвращений через каждую ячейку
Можно уложить всё в одну доску-массив структур, но это может быть сложнее, потому сделаны [b] 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_ [/b] [b]PATH_VECT[/b] показывает направление движение по ходам 1 ход - нулевой элемент массива и т.д. так удобнее. т.к. чтобы найти след. ход, мы просто используем [b]PATH_VECT_point[/b] [b]PATH_BOARD[/b] отдельно от [b]PATH_VECT,[/b] т.к. служит для подсвечивания пройденного пути серым - содержит число, на которое увеличивается номер цвета, если ячейка пройдена (всегда 4) [b]GAME_BOARD[/b] содержит операции форта, точнее числа, отсылающие к операциям [b]COLOR_BOARD[/b] содержит цвета соотв. ячеек [b]VALUES_RESULTS[/b] - отладочное - забыл убрать, ничего не содержит [b]DATASTACK_ RETSTACK_[/b] - массивы, хранящие состояяния стеков на момент ухода из ячейки, возвратившись в ячейку, игрок находит там стеки возвращённые к нужному состоянию Как видим, всё хранится отдельно , все массивы имеют размерность 144 * 4 кроме [b]DATASTACK_ RETSTACK_[/b] - они выстроены из предположения, что необходимо сохранять в каждом ходе 16 CELLS + 2 глубины
Вначале массивы нужно заполнить, для чего служат слова [b]color_board [/b] распределяет цвета на доске, можно было бы поячеечно, но зачем, если ясна математическая закономерность, стандартное слово создаёт "шахматную" структуру с удвоенным размером поля [b]startxy[/b] - устанавливает стартовое выделение в нужное положение ( должно совпасть со знаком вопроса и в стандартном слове находится в левом нижнем углу) [b]E, [/b] компилирует элемент - номер оператора ( вроде + - = * ) в GAME_BOARD [b]N,[/b] компилирует число, признаком числа является то, что оно больше 256 - предполагается, что числа вообще меньше 100 или больше -100 (чтобы ограничить количество значащих цифр) само число прибавляется к 512, чтобы не создавать дополнительных структур т.о. GAME_BOARD содержит операции 1-17 и числа 512 и выше, слово, изображающее доску вычитает из чисел 512 и остаток выводит на экран. На всякий случай эти слова производят проверки корректности предлагаемых данных, только потом размещают их, для этого служат слова [b]: 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,? ;[/b]
Может быть это неправильно, но нет слова-загрузчика для всех игр, а есть слово-загрузчик отдельное для каждой игры. Например example_4 - это слово-пример загрузчика - оно вызывает слова [b]color_board [/b] [b]startxy [/b] устанавливает размер доски и заполняет доску Загрузчик потом может быть вызван словом [b]new_game [/b] при вызове новой игры
Каждому загрузчику по пятам следует [color=#BF0040]вспомогательное слово[/color] (индивидуально) которое помещает адрес загрузчика в массив available_games , откуда его достанет [b]new_game [/b] при вызове новой игры ещё строку описания в примере это [color=#BF0040]example_4_des[/color] массив адресов - чтобы оперировать списком доступных игр - наприер менять их в цикле [b]game_cycle [/b]
Загрузчик игры может пользоваться не стандартными словами color_board , а определить собственные, которые компилируются вместе с загрузчиком и представляют собою его часть (см. слова [i]example_8e color_board8e startxy8e [/i])
фактически игры не загружаются а до-компилируются,что громоздко, но очень быстро хм. продолжение следует если интересно
|
|
|
|
Добавлено: Сб июл 03, 2010 21:36 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
Цитата: А разве демонстрация кода в сети на всеобщее обозрение не подразумевает, что кто-то будет исследовать его? Хорошо, код исправим. Но демонстрируется прежде всего идея - форт в виде правил динамической интеллектуальной задачи - может, это даже не совсем игра (как и предыдущая). Но по виду - игра.
[quote]А разве демонстрация кода в сети на всеобщее обозрение не подразумевает, что кто-то будет исследовать его? [/quote] Хорошо, код исправим. Но демонстрируется прежде всего идея - форт в виде правил динамической интеллектуальной задачи - может, это даже не совсем игра (как и предыдущая). Но по виду - игра.
|
|
|
|
Добавлено: Сб июл 03, 2010 09:10 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
вопрос писал(а): Кроме того, этих слов нет в доступных мне PDF, и меня это раздражает по правде говоря, хотя это личное дело Хищника. Компилятор, который работает не со всей клавитурой или по крайней мере из документации непонятно, что он работает со всей ( потом вытру эту фразу) (улыбайтесь) У меня есть api-файл с подсказками для SciTE. На данный момент там описано лишь 298 слов из 704, большинство из мануала. Т.к. спроса нет на него, а сам я и так помню большинство слов кварка - вот и не обновляю почти. Если кому-то нужно - могу описать все остальные. вопрос писал(а): Что касается ARRAY - то он есть не во всех фортах, а потому надёжнее так Ну во-первых код - для кварка. И опять забыт один из плюсов форта - его расширяемость. ARRAY - это одна фраза: Код: : ARRAY CREATE CELLS ALLOT ; И факторизация тоже местами очень сильно забыта. вопрос писал(а): Сделано на одном дыхании - потому даже без комментариев, можно поправить. Я буду рад, если кто-то заинтересуется самой игрой (ведь это моя идея хоть и несложная ) или её устройством... оно простое. А разве демонстрация кода в сети на всеобщее обозрение не подразумевает, что кто-то будет исследовать его? Тем более, комментарии важны в первую очередь для самого автора. Я вот например уже давно выработал в себе привычку писать везде стековые комментарии, даже если слово из одной фразы. И обязательно описываю что делает слово. За исключением только тестового и экспериментального кода.
[quote="вопрос"]Кроме того, этих слов нет в доступных мне PDF, и меня это раздражает по правде говоря, хотя это личное дело Хищника. Компилятор, который работает не со всей клавитурой или по крайней мере из документации непонятно, что он работает со всей ( потом вытру эту фразу) (улыбайтесь)[/quote] У меня есть api-файл с подсказками для SciTE. На данный момент там описано лишь 298 слов из 704, большинство из мануала. Т.к. спроса нет на него, а сам я и так помню большинство слов кварка - вот и не обновляю почти. Если кому-то нужно - могу описать все остальные. [quote="вопрос"]Что касается ARRAY - то он есть не во всех фортах, а потому надёжнее так[/quote] Ну во-первых код - для кварка. И опять забыт один из плюсов форта - его расширяемость. ARRAY - это одна фраза: [code]: ARRAY CREATE CELLS ALLOT ;[/code] И факторизация тоже местами очень сильно забыта. [quote="вопрос"]Сделано на одном дыхании - потому даже без комментариев, можно поправить. Я буду рад, если кто-то заинтересуется самой игрой (ведь это моя идея хоть и несложная ) или её устройством... оно простое.[/quote] А разве демонстрация кода в сети на всеобщее обозрение не подразумевает, что кто-то будет исследовать его? Тем более, комментарии важны в первую очередь для самого автора. Я вот например уже давно выработал в себе привычку писать везде стековые комментарии, даже если слово из одной фразы. И обязательно описываю что делает слово. За исключением только тестового и экспериментального кода.
|
|
|
|
Добавлено: Сб июл 03, 2010 08:44 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
вопрос писал(а): Ну, При наличии заказа постараюсь сделать. это априорный заказ - он как бы существует сам по себе.
Чем векторность клавиш мешала бы вот этому VoidVolker уже писал - есть векторы KEYDOWN и KEYUP. Еще есть VARIABLE LASTKEY, там будет код нажатой/отпущенной клавиши. Если по KEYDOWN обработать код самостоятельно, а потом заменить содержимое LASTKEY на 0, клавиша окажется "проглоченной".
[quote="вопрос"]Ну, При наличии заказа постараюсь сделать. это априорный заказ - он как бы существует сам по себе.
Чем векторность клавиш мешала бы вот этому[/quote] VoidVolker уже писал - есть векторы KEYDOWN и KEYUP. Еще есть VARIABLE LASTKEY, там будет код нажатой/отпущенной клавиши. Если по KEYDOWN обработать код самостоятельно, а потом заменить содержимое LASTKEY на 0, клавиша окажется "проглоченной".
|
|
|
|
Добавлено: Сб июл 03, 2010 01:24 |
|
|
|
|
|
Заголовок сообщения: |
Re: Ещё игрушка "логический лабиринт" , |
|
|
Хищник писал(а): вопрос писал(а): Кроме того, любопытно, что Кварк делает с WM_PAINT - MessageBox не прорисовывается При наличии заказа постараюсь сделать. С клавишами дело такое - что не требуется для редактирования вводимого текста (плюс что попалось на глаза), то и сделано. Сейчас обработка любой клавиши - это вектор. С WM_PAINT можно сделать одно - постоянно выполнять, иначе не будет отрисовки. Я тут в некотором роде уезжаю отдыхать, но с нетбуком и GPRS-модемом. Так что на запросы общественности смогу отреагировать, в пределах разумного. Ну, При наличии заказа постараюсь сделать. это априорный заказ - он как бы существует сам по себе. Чем векторность клавиш мешала бы вот этому С клавишами дело такое - что не требуется для редактирования вводимого текстаВообще - обсуждаем тут игру - всё-таки это форт-игра или форт в виде игры или игра для фортеров специально
[quote="Хищник"][quote="вопрос"] Кроме того, любопытно, что Кварк делает с WM_PAINT - MessageBox не прорисовывается [/quote] При наличии заказа постараюсь сделать. С клавишами дело такое - что не требуется для редактирования вводимого текста (плюс что попалось на глаза), то и сделано. Сейчас обработка любой клавиши - это вектор. С WM_PAINT можно сделать одно - постоянно выполнять, иначе не будет отрисовки. Я тут в некотором роде уезжаю отдыхать, но с нетбуком и GPRS-модемом. Так что на запросы общественности смогу отреагировать, в пределах разумного.[/quote]
Ну, [color=#BF0080]При наличии заказа постараюсь сделать.[/color] это априорный заказ - он как бы существует сам по себе.
Чем векторность клавиш мешала бы вот этому [color=#BF0080]С клавишами дело такое - что не требуется для редактирования вводимого текста[/color]
Вообще - обсуждаем тут игру :| - всё-таки это форт-игра или форт в виде игры или игра [i]для фортеров специально[/i]
|
|
|
|
Добавлено: Сб июл 03, 2010 00:41 |
|
|
|
|