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

...
Google Search
Forth-FAQ Spy Grafic

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




Начать новую тему Ответить на тему  [ Сообщений: 22 ]  На страницу Пред.  1, 2
Автор Сообщение
 Заголовок сообщения: Re: Ещё игрушка "логический лабиринт" ,
СообщениеДобавлено: Вт июл 13, 2010 22:47 
Не в сети
Аватара пользователя

Зарегистрирован: Пт дек 26, 2008 21:16
Сообщения: 407
Откуда: Великий Новгород
Благодарил (а): 9 раз.
Поблагодарили: 3 раз.
Очень интересно!
Предлагаю автору присвоить звание Супер Джедая :D
А если без шуток то во многих навороченных стреляках и всяки ролевых игрушках,
часто встречается момент "взлома" компьютера, замка и т.п. Как правило это несложная головоломка.
Может стоит попытаться эту игру продать какой ни будь фирме занимающейся разработкой игр. Глядишь кто то из стрелков подрастет и фортером станет.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Ещё игрушка "логический лабиринт" ,
СообщениеДобавлено: Вт июл 13, 2010 22:53 
Не в сети

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


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Ещё игрушка "логический лабиринт" ,
СообщениеДобавлено: Ср июл 14, 2010 01:05 
Не в сети
Аватара пользователя

Зарегистрирован: Пт дек 26, 2008 21:16
Сообщения: 407
Откуда: Великий Новгород
Благодарил (а): 9 раз.
Поблагодарили: 3 раз.
вопрос писал(а):
Например - генератор начальных позиций.

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


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Ещё игрушка "логический лабиринт" ,
СообщениеДобавлено: Ср июл 14, 2010 11:16 
Не в сети

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

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

Вот я не знаю, это требует размышлений :roll:


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Ещё игрушка "логический лабиринт" ,
СообщениеДобавлено: Ср июл 14, 2010 11:53 
Не в сети
Аватара пользователя

Зарегистрирован: Пт дек 26, 2008 21:16
Сообщения: 407
Откуда: Великий Новгород
Благодарил (а): 9 раз.
Поблагодарили: 3 раз.
вопрос писал(а):
Вот я не знаю, это требует размышлений

Что то внутре :wink: мне подсказывает что оно того стоит.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Ещё игрушка "логический лабиринт" ,
СообщениеДобавлено: Ср июл 14, 2010 11:59 
Не в сети
Аватара пользователя

Зарегистрирован: Пт дек 26, 2008 21:16
Сообщения: 407
Откуда: Великий Новгород
Благодарил (а): 9 раз.
Поблагодарили: 3 раз.
Вспоминается что в Fallout-е
При "взломе компьютера" красиво так в консоли с зелеными буквами грузились файлы с расширением .f
Правда фортом в этой головоломке и не пахло, было что то вроде "быков и коров"


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Ещё игрушка "логический лабиринт" ,
СообщениеДобавлено: Чт июл 22, 2010 22:02 
Не в сети

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

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

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

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


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

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

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

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

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

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


\ 4 colors

10 10 250 RGB VALUE _RED      50 120 250 RGB VALUE _ORANGE
110 110 112 RGB VALUE _GRAY   250 250 10 RGB VALUE _LIGHTBLUE
10 250 250 RGB VALUE _YELLOW   70 250 70 RGB VALUE _GREEN
255 255 255 RGB VALUE _WHITE   40 40 40 RGB VALUE NEAR_BLACK
255 0 255 RGB VALUE _MAGENTA    173 171 172 RGB VALUE _LIGHTGRAY
218 218 211 RGB VALUE _VERYLIGHTGRAY2    218 218 211 RGB VALUE _VERYLIGHTGRAY
0 VALUE _BLACK


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


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

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


0 VALUE potential_direction

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

board_size  1 - VALUE last_selected_y
0 VALUE last_selected_x   

48 VALUE sq_size_   \ size of square

0 VALUE stack_X
0 VALUE ret_X

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

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


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

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

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


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

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

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

CREATE ARR 32 CELLS ALLOT

: elementes... SWAP CELLS ARR + ! ;

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

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

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


\ board

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

: BOARD_ 0 PATH_BOARD 144 FILL 0 REVERSE_BOARD 144 FILL  ;

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

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


: stacks_store
DUP stacks_store.copy_data
stacks_store.copy_ret
;

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

: stacks_cansel
DUP stacks_cansel.copy_data
stacks_cansel.copy_ret
;


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

14 VALUE show_boards.text_shift




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

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


0 VALUE show_board.temp

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

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

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

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

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



: startxy
board_size  1 - TO last_selected_y
0 TO last_selected_x
;




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

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

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

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

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

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


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



: back_move

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

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



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

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

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


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



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

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


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



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

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


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

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


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

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