Golos Blogs

Ещё раз вернёмся к задаче с прыгающими шашками, тогда на экране шашки отображались цифрами, а мы реализовали лишь логику игры. Теперь изобразим шашки на экране.

Зделаем сначала подпрограмму для рисования одной шашки в заданном месте экрана, с указанием чёрная это шашка или белая.

sub shashka(ByVal x as Integer, ByVal y as Integer, ByVal k as Integer)

процедура shashka будет принимать три параметра: x,y - координаты позиции на экране где нужно нарисовать шашку, и параметр k(1-шашка белая, 2-чёрная, 0 - шашки нет, рисуем пустое место)

    dim as integer p,c1,c2,c3

в процедуре объявим дополнительно четыре пеерменных: p-радиус шашки, c1-цвет линий для рисования шашки,c2-цвет самой шашки,c3-цвет цилиндрической поверхности шашки.

    if k=2 then c1=15: c2=0: c3=0
    if k=1 then c1=7: c2=15: c3=7

в зависимости от k задаём параметры цветов для рисования шашки

    if k>0 then
        circle(x,y),3*p,c1,,,0.5
        paint(x,y),c2,c1
        circle(x,y),1*p,c1,,,0.5
        circle(x,y),2*p,c1,,,0.5
   
        line(x-3*p,y)-(x-3*p,y+1*p),c1
        line(x+3*p,y)-(x+3*p,y+1*p),c1
        circle(x,y+1*p),3*p,c1,3.14,6.28,0.5
        paint(x,y+3*p/2+p/4),c3,c1
    else 
       circle(x,y+3*p/2),3,7,,,0.5
   end if

на этом процедура рисования одной шашки заканчивается
end sub

Нам понадобится ещё одна процедура, которая рисует всё игровое поле в зависимости от массива где хранится расположение шашек.

sub pole()
    dim as integer d, i
    d=80
    
    for i=1 to 7
      shashka(100+d*i, 200, a(i))
    next i
end sub

Теперь нужно слегка изменить код из урока 16

dim as integer a(1 to 7)={1,1,1,0,2,2,2},c,i,flag
dim as string k

do
    flag=0
    for i=1 to 7
        locate(3,i*2)
        if a(i) =1 then color 11:print "O"
        if a(i) =2 then color 14:print "O"
        if a(i) =0 then color 8:print "."
        locate(4,i*2-1):color 7:print i;
    next i

    do:k=inkey():loop while k=""

    c=asc(k)-48

    if a(c)=1 and c<7 then if a(c+1)=0 then swap a(c),a(c+1)
    if a(c)=1 and c<6 then if a(c+2)=0 then swap a(c),a(c+2)

    if a(c)=2 and c>1 then if a(c-1)=0 then swap a(c),a(c-1)
    if a(c)=2 and c>2 then if a(c-2)=0 then swap a(c),a(c-2)

    if a(1)=a(2) and a(2)=a(3) and a(4)=a(5) and a(5)=a(6) and a(4)=0 then flag=1

    if asc(k)=32 then flag=1
    if asc(k)=27 then a(1)=1:a(2)=1:a(3)=1:a(4)=0:a(5)=2:a(6)=2:a(7)=2

loop while flag=0

а именно после присваивания переменной flag=0 и перед циклом опрашивания нажатой клавиши с inkey стираем цикл и делаем вызов процедуры pole

но компилятор выдаст ошибку, что в процедуре pole не объявленна переменная а(массив А). На самом деле массив есть но его не видно(( dim shared as integer a(1 to 7)={1,1,1,0,2,2,2} Сейчас нужно просто добавить ключевое слово shared при объявлении массива, а подробнее это рассмотрим чуть позже.

screen 20

dim shared as integer a(1 to 7)={1,1,1,0,2,2,2},flag,c
dim as string k

sub shashka(ByVal x as Integer, ByVal y as Integer, ByVal k as Integer)
    dim as integer p,c1,c2,c3 
    p=11

    if k=2 then c1=15: c2=0: c3=0
    if k=1 then c1=7: c2=15: c3=7

    if k>0 then
        circle(x,y),3*p,c1,,,0.5
        paint(x,y),c2,c1
        circle(x,y),1*p,c1,,,0.5
        circle(x,y),2*p,c1,,,0.5
    
        line(x-3*p,y)-(x-3*p,y+1*p),c1
        line(x+3*p,y)-(x+3*p,y+1*p),c1
        circle(x,y+1*p),3*p,c1,3.14,6.28,0.5
        paint(x,y+3*p/2+p/4),c3,c1
    else 
        circle(x,y+3*p/2),3,7,,,0.5
    end if
end sub

sub pole()
    dim as integer d, i
     
    d=80
    
    for i=1 to 7
      shashka(100+d*i, 200, a(i))
    next i
end sub

do
    flag=0
    
    pole()
    
    do:k=inkey():loop while k=""

    c=asc(k)-48

    if a(c)=1 and c<7 then if a(c+1)=0 then swap a(c),a(c+1)
    if a(c)=1 and c<6 then if a(c+2)=0 then swap a(c),a(c+2)

    if a(c)=2 and c>1 then if a(c-1)=0 then swap a(c),a(c-1)
    if a(c)=2 and c>2 then if a(c-2)=0 then swap a(c),a(c-2)

    if a(1)=a(2) and a(2)=a(3) and a(5)=a(6) _
       and a(6)=a(7) and a(4)=0 and a(1)=2 then flag=1

    if asc(k)=32 then flag=1
    if asc(k)=27 then a(1)=1:a(2)=1:a(3)=1:a(4)=0:a(5)=2:a(6)=2:a(7)=2

loop while flag=0

После запуска уже "готовой" программы обнаруживается, что шашка не стирается, когда рисуется пустое место - исправим этот недочёт просто - очистим экран командой cls, а ещё было удобно когда места пронумерованы. Для этого воспользуемся новой подпрограммой(из встроенной библиотеки). Она выводит текстовую строку в месте заданном координатами.
Draw String (100+d*i, 235), str(i)

19 FreeBASIC - "Прыгающие шашки" (графика и процедура)