procedure rp
set talk off
*================================================= 08/18/91 05:19pm ===*
* *
* реализация игрушки Soko-ban преследует учебные *
* цели и акцентирует внимание на критичных *
* к процессу программирования местах *
* *
* *
* ------ версия "З н а н и е - с и л а" ------ *
* *
*========================================== (c) Insight corp., 1991 ===*
*============================================= определение констант ===*
*------------------------------------------ коды управляющих клавиш ----
F_esc = 27
F_restart = 32 && фактически - код пробела, но для нас он игра-
*ет роль клавиши, сбрасывающей лабиринт в началь-
*ное состояние
F_Left = 19
F_Right = 4
F_Up = 5
F_Down = 24
*----------------------------константы, задающие кодировку спрайтов ---
* обратим внимание на тот факт, что спрайты с индексом b *)
* представляют собой код, смещенный на С_ctrl_bit, что *)
* позволяет легко определять поле, в котором находится ьточкаь*)
* - место, предназначенное для заталкивания туда ящиков *)
* свободное для движения простраство
* кстати, места под точками с точки зрения данного выражения
*являются свободными для движения)
store 2 to C_free_place, S_free_place
store - S_free_place to Cb_free_place, Sb_free_place
* фигурка двигателя (объекта, который двигает ящики) *
store 1 to C_man, S_man
store - S_man to Cb_man, Sb_man
* стена лабиринта *
store 9 to C_wall, S_wall
store - S_wall to Cb_wall, Sb_wall
* код объекта передвижения - ящика *
store 4 to C_box, S_box
store - S_box to Cb_box, Sb_box
*=====================================================================*)
dimension game_field ( 20, 30 )
* массив пред- *)
* ставляет собой эквивалент изображения на *)
* экране, но в кодах, что позволяет функции *)
* moving осуществлять проверку корректности *)
* перемещения по лабиринту *)
man_X=0 && пара целых представляет собой текущие коор- *)
man_Y=0 && динаты двигателя *)
score_all=0 && общее количество мест для ящиков *)
score_new=0 && текущее количество ящиков, уложенных на место *)
kbrd_key=0 && переменная - код следующего введенного *)
&& с клавиатуры символа *)
bell = [? chr( 7 )] && супер-пупер-подпрограмма для выдачи сигнала
*---------------------------------------------------------------------*)
clear
&bell
*@ 5, 10 double
do maze_init
&bell
&bell
do game_round
*------------------------------------------------ раздача слоников ---*)
&bell
&bell
&bell
if( score_new = score_all )
@ 16, 20 say [*** маладец! ***]
else
@ 16, 20 say [*** слаб-ба-к! ***]
endif
*--------------------------------------------------------------------*)
set console off
wait
set console on
clear
return && -- end of procedure rp --
*=====================функция выводит на экран изображение спрайта ===*)
function sprtout
parameters sprite_code
*-------------------------------------------------------------*)
* благодаря тому, что вся программа пользуется для вывода *)
* спрайта на экран этой функцией, здесь *)
* локализуется информация о внешнем виде спрайта, *)
* его цвете, что соответственно, облегчает задачу *)
* проведения изменений в игрушке *)
*-------------------------------------------------------------*)
do case
case (sprite_code = C_free_place)
sprite_pict = [ ]
case sprite_code = Cb_free_place
sprite_pict = [. ]
case (sprite_code = C_man) .or. (sprite_code = Cb_man)
sprite_pict = [><]
case (sprite_code = C_wall) .or. (sprite_code = Cb_wall)
sprite_pict = chr(178)+chr(178)
*-------------------------------------------------------------*
*| интерес представляет тот факт, что по кодам S_man и Sb_man |
*| выводится один и тот же рисунок спрайта, а по кодам S_box и |
*| Sb_box - разные, что дает возможность автоматически выводить|
*| на экран правильную картинку для ящика (незакрашенный, если |
*| на пустом поле и закрашенный, если на поле, предназначенном |
*| ящика) и двигателя ( одну и ту же картинку и на пустом поле |
*| и на поле для ящика |
*-------------------------------------------------------------*)
case (sprite_code = C_box)
sprite_pict = [<>]
case (sprite_code = Cb_box)
sprite_pict = chr(17)+chr(16)
otherwise
sprite_pict = [ ]
endcase
return( sprite_pict )
*=====================================================================*)
procedure sprite_show
parameters sprite_x, sprite_y, sprite_type
*-------------------------------------------------------------*)
* процедура обеспечивает логический вывод графического образа *)
* за спрайта в пределах всех программы, здесь же происходит *)
* коррекция содержимого массива game_field[]; *)
* *)
* в данной процедуре поддерживается ведение счетчика игры *)
*-------------------------------------------------------------*)
* проверка необходимости корректировать счетчик очков *)
if( game_field( sprite_x, sprite_y ) = Cb_box )
if( sprite_type <> C_box )
* если по координате, на которой только что стоял ящик,
*пишется не-ящик, уменьшить счетчик количества поставленных
*на место ящиков
score_new = score_new - 1
endif
endif
if( game_field( sprite_x, sprite_y ) < 0 )
if( sprite_type = C_box )
* если по координате, на которой должен стоять ящик,
*пишется код ящика, увеличить счетчик количества постав-
*ленных на место ящиков
score_new = score_new + 1
endif
endif
game_field( sprite_x, sprite_y ) = ;
sign( game_field( sprite_x, sprite_y )) * ;
abs( sprite_type )
if( sprite_type < 0 )
game_field( sprite_x, sprite_y ) = ;
- game_field( sprite_x, sprite_y )
endif
@ sprite_x, sprite_y*2 ;
say sprtout( game_field( sprite_x, sprite_y ) )
return
*=====================================================================*)
procedure maze_init
*-------------------------------------------------------------*
* процедура инициализирует массив game_field[], содержащий *
* поле лабиринта, ящики, места для них *
* а также устанавливает счетчики игрушки: общее количество *
* мест для установки ящиков score_all, количество уже *
* установленных на место ящиков score_new *
*-------------------------------------------------------------*
dimension maze( 20 )
* 0 1 2 3
* 1234567890123456789012345678901
maze( 01 ) = ь000000000000000000000000000000ь
maze( 02 ) = ь000000099999000000000000000000ь
maze( 03 ) = ь000000090009000000000000000000ь
maze( 04 ) = ь000000094009000000000000000000ь
maze( 05 ) = ь000009990049990000000000000000ь
maze( 06 ) = ь000009004004090000000000000000ь
maze( 07 ) = ь000999090999090000099999900000ь
maze( 08 ) = ь000900090999099999990033900000ь
maze( 09 ) = ь000904004000000000000033900000ь
maze( 10 ) = ь000999990999909199990033900000ь
maze( 11 ) = ь000000090000009990099999900000ь
maze( 12 ) = ь000000099999999000000000000000ь
maze( 13 ) = ь000000000000000000000000000000ь
*---------------- начальная инициализация массива & очистка экрана ---
i = 1
do while( i <= 20 )
j = 1
do while( j <= 30 )
game_field( i,j ) = C_free_place
j = j + 1
enddo
i = i + 1
enddo
*-------------------------------------------- считывание лабиринта ---
score_all = 0
score_new = 0
i = 1
do while( i <= 13 )
j = 1
do while( j <= 30 )
do case
case substr( maze( i ), j, 1 ) = ь0ь
do sprite_show with i, j, S_free_place
case substr( maze( i ), j, 1 ) = ь9ь
do sprite_show with i, j, S_wall
case substr( maze( i ), j, 1 ) = ь4ь
do sprite_show with i, j, S_box
case substr( maze( i ), j, 1 ) = ь3ь
do sprite_show with i, j, Sb_free_place
score_all = score_all + 1
case substr( maze( i ), j, 1 ) = ь7ь
do sprite_show with i, j, Sb_box
score_all = score_all + 1
score_new = score_new + 1
case substr( maze( i ), j, 1 ) = ь1ь
do sprite_show with i, j, S_man
man_X = i
man_Y = j
case substr( maze( i ), j, 1 ) = ь2ь
do sprite_show with i, j, Sb_man
man_X = i
man_Y = j
score_all = score_all + 1
otherwise
do sprite_show with i, j, S_free_place
endcase
j = j + 1
enddo
i = i + 1
enddo
return
*=====================================================================
procedure moving
parameters dlt_x, dlt_Y
*-------------------------------------------------------------*
* процедура осуществляет отработку движения в заданном направ-*
* лении *
* *
* направление задается парой смещений dlt_x, dlt_y *
* *
* так, например, если dlt_x = 0, a dlt_y = + 1, то это означа-*
* ет, что отрабатывается движение ^ *
* в направлении вниз, то есть, | ( 0, - 1 ) *
* согласно следующей системе | *
* координат: <-- -- + -- --> *
* ( - 1, 0 ) | ( + 1, 0 ) *
* | *
* V ( 0, + 1 ) *
*-------------------------------------------------------------*
* свободно ли следующее поле?
if( abs(game_field(man_X+dlt_X,man_Y+dlt_Y)) = S_free_place)
* перемещение двигателя на следующее поле
man_X = man_X + dlt_X
man_Y = man_Y + dlt_Y
else && проверим, может это ящик
if( abs(game_field(man_X+dlt_X, man_Y+dlt_Y)) = S_box )
* а свободно ли поле за ящиком?
if( abs(game_field(man_X+dlt_X*2, man_Y+dlt_Y*2)) ;
= S_free_place )
* переместим ящик и двигателя на поле в данном направлении
do sprite_show with man_X+dlt_X, man_Y+dlt_Y, S_free_place
do sprite_show with man_X+dlt_X*2, man_Y+dlt_Y*2, S_box
man_X = man_X + dlt_X
man_Y = man_Y + dlt_Y
endif
endif
endif
return
*=====================================================================*
procedure game_round
*-------------------------------------------------------------*
* *
* основной цикл игрушки *
* *
*-------------------------------------------------------------*
game_yes = .t.
do while( game_yes )
* выводим двигателя по текущей координате
do sprite_show with man_X, man_Y, S_man
* вводим команду с клавиатуры
* сразу же заметим, что пользоваться командой inkey() в данном
* случае (то есть в данном языке) надо осторожно: здесь эта команда
* не вводит символ с клавиатуры, а производит опрос клавиатуры с
* последующим вводом символа
kbrd_key = 0
DO WHILE .NOT.( (kbrd_key = F_esc).or.(kbrd_key = F_restart).or.;
(kbrd_key = F_Left).or.(kbrd_key = F_Right).or.;
(kbrd_key = F_Up).or.(kbrd_key = F_Down) )
kbrd_key = 0
DO WHILE kbrd_key = 0
kbrd_key = INKEY()
ENDDO
ENDDO
* стираем двигателя по текущей координате
do sprite_show with man_X, man_Y, S_free_place
* отрабатываем управляющую клавишу
do case
case (kbrd_key = F_Left )
do moving with 0, -1
case (kbrd_key = F_Right )
do moving with 0, +1
case (kbrd_key = F_Up )
do moving with -1, 0
case (kbrd_key = F_Down )
do moving with +1, 0
endcase
* и так до тех пор, пока либо не установим все ящики на месте, либо
*не введем код F_esc, либо код F_restart
if( (score_new = score_all) ;
.or. (kbrd_key = F_esc) .or. (kbrd_key = F_restart) )
game_yes = .f.
endif
enddo
return