Ермаков И. Е., Шамардина Е. Игра "Точки"

Скачать программу

Сборка 29.08.09, 7zip, 0.6M

Поддерживается игра по сети.

Приведение приложения к «общепринятому виду» намеренно не приводилось. Используется интерактивный текст Блэкбокса с командами, сохранен интерфейс среды. Это позволяет легко работать с многими полями игры, создавать и сохранять документы с историей игр, комментариями и т.п. И, наконец, демонстрируется, что можно совершенно «не заморачиваться».

Реализация и исходные тексты

Исходные тексты в формате ODC входят в сборку игры — подсистема Точки.

Также эта информация приведена ниже.

Подсистема Точки

Модули: ТочкиИгра, ТочкиХранение, ТочкиГрафика, ТочкиКоманды, ТочкиСетевая

В модуле ТочкиИгра реализована основная логика игры — хранение ходов, расчёт захваченных областей и их границ.

В основном используются разные варианты волнового алгоритма.

История окружений не хранится. Алгоритм каждый раз перерасчитывает области заново. Очевидно, что если удаётся построить алгоритм как «чистую функцию», то его проще реализовать и менее вероятны ошибки, которые могли бы возникнуть при модификации состояния окружений.

Единственная возникшая проблема была связана с обработкой правила «При появлении в свободной области точки соперника, свободная область будет считаться областью окружения, при условии, что точка соперника не была завершающей в его окружении». Очевидно, что для правильного расчёта таких пересекающихся потенциальных областей нужно знать, какое из окружений строить.

Таким образом, какую-то часть информации об областях нужно накапливать. Мы попытались найти такую её часть, которая после единственного присваивания уже не будет изменяться (потому что области могут разрушаться при внешнем окружении). Такой информацией является свойство каждой точки «была_в_плену». Если точка попадала в окружение, то она никогда уже не может участвовать в границе окружения. Тогда при ходе игрока в свободную область нужно начинать перерасчёт областей с того игрока, который ходил. Если ему удалось замкнуть окружение, то точка из границы противника получит признак «была_в_плену» — и при последующем расчёте его областей образовать окружение не сможет.

Модуль ТочкиИгра

MODULE ТочкиИгра;
 
  TYPE 
    Игра* = POINTER TO LIMITED RECORD
      поле-: Поле;
      игроков-: INTEGER;
      ход-: INTEGER;
      статистика-: Статистика
    END;
 
    Статистика* = RECORD
      количество_пленных-, 
      территория-: ARRAY 16 OF INTEGER
    END;
 
    Поле* = POINTER TO ARRAY OF ARRAY OF Узел;
 
    Узел* = RECORD
      точка_игрока-: INTEGER;
      поставлена_на_ходе-: INTEGER;
      область-: Область;
      граница-: ARRAY 2 OF Область;
      была_в_плену-: BOOLEAN
    END;
 
    Область* = POINTER TO RECORD
      игрок-: INTEGER;
      точек_противника-: INTEGER
    END;
 
    Волна = POINTER TO ARRAY OF ARRAY OF BOOLEAN;
 
  VAR
    нулевая_статистика: Статистика; 
 
  PROCEDURE Новая_игра* (ш, в: INTEGER; игроков: INTEGER): Игра;
    VAR и: Игра; i, j: INTEGER;
  BEGIN
    ASSERT((ш >= 2) & (в >= 2), 20);
    ASSERT(игроков > 0, 21);
    NEW(и);
    NEW(и.поле, ш, в);
    и.игроков := игроков;
    FOR  i := 0 TO LEN(и.поле)-1   DO
      FOR  j := 0 TO LEN(и.поле, 1)-1 DO
        и.поле[i, j].точка_игрока := -1
      END
    END;
    RETURN и
  END Новая_игра;
 
  PROCEDURE^ Перерасчёт (и: Игра; начиная_с_игрока: INTEGER);
 
  PROCEDURE (и: Игра) Сделать_ход* (x, y: INTEGER; игрок: INTEGER), NEW;  
  BEGIN
    ASSERT(и.поле[x, y].точка_игрока = -1, 20);
    ASSERT(игрок >= 0, 21);
    и.поле[x, y].точка_игрока := игрок;
    и.поле[x, y].поставлена_на_ходе := и.ход;
    INC(и.ход);
    Перерасчёт(и, игрок)
  END Сделать_ход;
 
  PROCEDURE^ Очистить_области (поле: Поле);
  PROCEDURE^ Рассчитать_области (поле: Поле; для_игрока: INTEGER);
  PROCEDURE^ Рассчитать_границы (поле: Поле; для_игрока: INTEGER);
  PROCEDURE^ Посчитать_пленных (поле: Поле; для_игрока: INTEGER; OUT n: INTEGER);
 
  PROCEDURE Посчитать_территорию (и: Игра);
    VAR  i, j: INTEGER;
  BEGIN
    FOR  i := 0  TO LEN(и.поле)-1 DO
      FOR  j := 0  TO LEN(и.поле, 1)-1 DO
        IF и.поле[i, j].область # NIL THEN
          INC(и.статистика.территория[и.поле[i, j].область.игрок])
        END
      END
    END
  END Посчитать_территорию;
 
  PROCEDURE Перерасчёт (и: Игра; начиная_с_игрока: INTEGER);
    VAR i: INTEGER;
  BEGIN
    Очистить_области(и.поле);
    и.статистика := нулевая_статистика;
    i := начиная_с_игрока;
    Рассчитать_области(и.поле, i);
    Рассчитать_границы(и.поле, i);
    Посчитать_пленных(и.поле, i, и.статистика.количество_пленных[i]);
    FOR i := 0 TO и.игроков-1 DO
      IF i # начиная_с_игрока THEN
        Рассчитать_области(и.поле, i);
        Рассчитать_границы(и.поле, i);
        Посчитать_пленных(и.поле, i, и.статистика.количество_пленных[i])
      END
    END;
    Посчитать_территорию(и)
  END Перерасчёт;
 
  PROCEDURE Очистить_области (поле: Поле);
    VAR i, j: INTEGER;
  BEGIN
    FOR  i := 0 TO LEN(поле) - 1 DO
      FOR  j := 0 TO LEN(поле, 1)-1 DO
        поле[i, j].область := NIL;
        поле[i, j].граница[0] := NIL;
        поле[i, j].граница[1] := NIL;
      END
    END
  END Очистить_области;
 
  PROCEDURE^ Начать_волну (волна: Волна; поле: Поле; для_игрока: INTEGER);
  PROCEDURE^ Ход_волны (поле: Поле; волна: Волна; для_игрока: INTEGER; OUT расширение: BOOLEAN);
  PROCEDURE^ Найти_области (поле: Поле; волна: Волна; для_игрока: INTEGER);
 
  PROCEDURE Рассчитать_области (поле: Поле; для_игрока: INTEGER);
    VAR волна: POINTER TO ARRAY OF ARRAY OF BOOLEAN;
        расширение: BOOLEAN;
  BEGIN
    NEW(волна, LEN(поле), LEN(поле, 1));
    Начать_волну(волна, поле, для_игрока);
    REPEAT
      Ход_волны(поле, волна, для_игрока, расширение)
    UNTIL ~расширение;
    Найти_области (поле, волна, для_игрока)
  END Рассчитать_области;
 
  PROCEDURE Начать_волну (волна: Волна; поле: Поле; для_игрока: INTEGER);
    VAR  i: INTEGER;
  BEGIN
    FOR  i := 0 TO LEN(волна)-1   DO
      волна[i, 0] := поле[i, 0].точка_игрока # для_игрока;
      волна[i, LEN(волна, 1)-1] := поле[i, LEN(волна, 1)-1].точка_игрока # для_игрока
    END;
    FOR  i := 0 TO LEN(волна, 1)-1   DO
      волна[0, i] := поле[0, i].точка_игрока # для_игрока;
      волна[LEN(волна)-1, i] := поле[LEN(волна)-1, i].точка_игрока # для_игрока
    END
  END Начать_волну;
 
  PROCEDURE Волна_рядом (волна: Волна; x, y: INTEGER): BOOLEAN;
  BEGIN
    RETURN волна[x, y-1] OR волна[x+1, y]  OR волна[x, y+1] OR волна[x-1, y]
  END Волна_рядом;
 
  PROCEDURE Ход_волны (поле: Поле; волна: Волна; для_игрока: INTEGER; OUT расширение: BOOLEAN);
    VAR i, j: INTEGER;
  BEGIN
    расширение := FALSE;
    FOR  i := 1 TO LEN(волна)-2 DO
      FOR  j := 1 TO LEN(волна, 1)-2 DO
        IF ~волна[i, j] 
& ((поле[i, j].точка_игрока # для_игрока) OR поле[i, j].была_в_плену)
& Волна_рядом(волна, i, j) THEN
          волна[i, j] := TRUE;
          расширение := TRUE
        END
      END
    END
  END Ход_волны;
 
  PROCEDURE Найти_области (поле: Поле; волна: Волна; для_игрока: INTEGER);
    VAR x, y: INTEGER;
 
    PROCEDURE Найти_неопределённую;
      VAR 
    BEGIN
      x := 1;
      y := 1;
      WHILE (y < LEN(поле, 1)-1)
& ~( ~Волна_рядом(волна, x, y) & (поле[x, y].область = NIL) ) DO
        INC(x);
        IF  x >= LEN(поле)-1  THEN
          x := 1;
          INC(y)
        END
      END
    END Найти_неопределённую;
 
    PROCEDURE Новая_область;
    BEGIN
      NEW(поле[x, y].область);
      поле[x, y].область.игрок := для_игрока
    END Новая_область;
 
    PROCEDURE Заполнить_область;
      VAR i, j: INTEGER; расширение: BOOLEAN; 
    BEGIN
      REPEAT
        расширение := FALSE;
        FOR  i := 1  TO LEN(поле)-2 DO
          FOR  j := 1  TO LEN(поле, 1)-2 DO
            IF  ~Волна_рядом(волна, i, j) & (поле[i, j].область = NIL) THEN
              IF поле[i, j-1].область # NIL THEN
                поле[i, j].область := поле[i, j-1].область;
                расширение := TRUE
              ELSIF поле[i+1, j-1].область # NIL THEN
                поле[i, j].область := поле[i+1, j-1].область;
                расширение := TRUE
              ELSIF поле[i+1, j].область # NIL THEN
                поле[i, j].область := поле[i+1, j].область;
                расширение := TRUE
              ELSIF поле[i+1, j+1].область # NIL THEN
                поле[i, j].область := поле[i+1, j+1].область;
                расширение := TRUE
              ELSIF поле[i, j+1].область # NIL THEN
                поле[i, j].область := поле[i, j+1].область;
                расширение := TRUE
              ELSIF поле[i-1, j+1].область # NIL THEN
                поле[i, j].область := поле[i-1, j+1].область;
                расширение := TRUE
              ELSIF поле[i-1, j].область # NIL THEN
                поле[i, j].область := поле[i-1, j].область;
                расширение := TRUE
              ELSIF поле[i-1, j-1].область # NIL THEN
                поле[i, j].область := поле[i-1, j-1].область;
                расширение := TRUE
              END
            END
          END
        END
      UNTIL ~расширение      
    END Заполнить_область;
 
  BEGIN
    Найти_неопределённую;
    WHILE y < LEN(поле, 1)-1 DO
      Новая_область;
      Заполнить_область;
      Найти_неопределённую
    END
  END Найти_области;
 
  PROCEDURE Добавить_границу (VAR узел: Узел; область: Область);
  BEGIN
    IF (узел.граница[0] # область) & (узел.граница[1] # область) THEN
      IF  узел.граница[0] = NIL THEN
        узел.граница[0] := область
      ELSE
        ASSERT(узел.граница[1] = NIL, 100);
        узел.граница[1] := область
      END
    END
  END Добавить_границу;
 
  PROCEDURE Рассчитать_границы (поле: Поле; для_игрока: INTEGER);
    VAR  i, j: INTEGER;
  BEGIN
    FOR  i := 1  TO LEN(поле)-2   DO
      FOR  j := 1  TO LEN(поле, 1)-2   DO
        IF (поле[i, j].область # NIL) & (поле[i, j].область.игрок = для_игрока) THEN
          IF поле[i, j-1].область = NIL THEN
            ASSERT(поле[i, j-1].точка_игрока = для_игрока, 100);
            Добавить_границу(поле[i, j-1], поле[i, j].область)
          END;
          IF поле[i+1, j-1].область = NIL THEN
            IF поле[i+1, j-1].точка_игрока = для_игрока THEN
              Добавить_границу(поле[i+1, j-1], поле[i, j].область)
            END
          END;
          IF поле[i+1, j].область = NIL THEN
            ASSERT(поле[i+1, j].точка_игрока = для_игрока, 100);
            Добавить_границу(поле[i+1, j], поле[i, j].область)
          END;
          IF поле[i+1, j+1].область = NIL THEN
            IF поле[i+1, j+1].точка_игрока = для_игрока THEN
              Добавить_границу(поле[i+1, j+1], поле[i, j].область)    
            END
          END;
          IF поле[i, j+1].область = NIL THEN
            ASSERT(поле[i, j+1].точка_игрока = для_игрока, 100);
            Добавить_границу(поле[i, j+1], поле[i, j].область)
          END;
          IF поле[i-1, j+1].область = NIL THEN
            IF поле[i-1, j+1].точка_игрока = для_игрока THEN
              Добавить_границу(поле[i-1, j+1], поле[i, j].область)
            END
          END;
          IF поле[i-1, j].область = NIL THEN
            ASSERT(поле[i-1, j].точка_игрока = для_игрока, 100);
            Добавить_границу(поле[i-1, j], поле[i, j].область)
          END;
          IF поле[i-1, j-1].область = NIL THEN
            IF поле[i-1, j-1].точка_игрока = для_игрока THEN
              Добавить_границу(поле[i-1, j-1], поле[i, j].область)
            END
          END
        END
      END
    END
  END Рассчитать_границы;
 
  PROCEDURE Посчитать_пленных (поле: Поле; для_игрока: INTEGER; OUT n: INTEGER);
    VAR i, j: INTEGER;
  BEGIN
    n := 0;
    FOR  i := 0  TO LEN(поле)-1   DO
      FOR  j := 0  TO  LEN(поле, 1)-1  DO
        IF (поле[i, j].область # NIL) & (поле[i, j].область.игрок = для_игрока) 
& (поле[i, j].точка_игрока >= 0) & (поле[i, j].точка_игрока # для_игрока) THEN
          поле[i, j].была_в_плену := TRUE;
          INC(поле[i, j].область.точек_противника);
          INC(n)
        END
      END
    END
  END Посчитать_пленных;
 
END ТочкиИгра.

Модуль ТочкиХранение

MODULE  ТочкиХранение;
  IMPORT Игра := ТочкиИгра, Tm := TextMappers;
 
  TYPE 
    Ход* = POINTER TO RECORD
      след*: Ход;
      x*, y*: INTEGER;
    END;
 
  PROCEDURE История* (поле: Игра.Поле): Ход;
    VAR нач, кон: Ход; номер_хода: INTEGER; x, y: INTEGER;
 
    PROCEDURE Найти_ход;
    BEGIN
      x := 0; y := 0;
      WHILE (y < LEN(поле, 1))
& ~( (поле[x, y].точка_игрока # -1)
& (поле[x, y].поставлена_на_ходе = номер_хода) ) DO
        INC(x);
        IF x >= LEN(поле) THEN
          x :=0; 
          INC(y)
        END
      END
    END Найти_ход;
 
  BEGIN
    номер_хода := 0;
    Найти_ход;
    WHILE y < LEN(поле, 1) DO
      IF кон # NIL THEN
        NEW(кон.след);
        кон := кон.след
      ELSE
        NEW(нач);
        кон := нач
      END;
      кон.x := x;
      кон.y := y;
      INC(номер_хода);
      Найти_ход;
    END;
    RETURN нач
  END История;
 
  PROCEDURE В_текст* (история: Ход; VAR fm: Tm.Formatter);
    VAR n: INTEGER;
  BEGIN
    n := 1;
    WHILE история # NIL DO
      fm.WriteInt(n);
      fm.WriteString(' - (' );
      fm.WriteInt(история.x);
      fm.WriteString(', ');
      fm.WriteInt(история.y);
      fm.WriteString(')');
      fm.WriteLn;
      история := история.след;
      INC(n)
    END;
    fm.WriteChar('#')
  END В_текст;
 
  PROCEDURE Из_текста* (VAR sc: Tm.Scanner): Ход;
    VAR x, y: INTEGER; усп: BOOLEAN;
        нач, кон: Ход;
 
    PROCEDURE Взять_ход;
    BEGIN
      sc.Scan; (* читать дефис *)
      sc.Scan; (* читать скобку *)
      sc.Scan;
      IF sc.type = Tm.int THEN
        x := sc.int;
        sc.Scan; (* читать запятую *)
        sc.Scan;
        IF sc.type = Tm.int THEN
          y := sc.int;
          sc.Scan; (* читать скобку *)
          усп := TRUE
        ELSE
          усп := FALSE
        END
      ELSE
        усп := FALSE
      END
    END Взять_ход;
 
  BEGIN
    sc.Scan; усп := TRUE;
    WHILE  усп & ~( (sc.type = Tm.char) & (sc.char = '#') OR (sc.type = Tm.eot) )  DO
      Взять_ход;
      IF усп THEN
        IF  нач = NIL THEN
          NEW(нач);
          кон := нач
        ELSE
          NEW(кон.след);
          кон := кон.след
        END;
        кон.x := x;
        кон.y := y;
        sc.Scan
      END
    END;
    RETURN нач
  END Из_текста;
 
END ТочкиХранение.

Модуль ТочкиГрафика

MODULE  ТочкиГрафика;
 
  IMPORT Views, Игра := ТочкиИгра, Properties, Controllers,
Fonts, Strings, Stores, Хранение := ТочкиХранение;
 
  CONST
    мм = 36000;
    клетка = 5 * мм;
    поля = 5 * мм;
    радиус_точки =  мм * 7 DIV 6;
    размер_шрифта = 12 * Fonts.point;
    для_всех_игроков* = -1;
    version = 0;
 
  TYPE
    View = POINTER TO RECORD (Views.View)
      игра: Игра.Игра;
      игрок: INTEGER;
      последние_ходы_игроков: ARRAY 16 OF Ход;
      время_игроков: ARRAY 16 OF INTEGER;
      карандаш: RECORD
        x, y: INTEGER
      END;
      для_игрока: INTEGER
    END;
 
    Ход = RECORD
      x, y: INTEGER
    END;
 
  VAR
    цвета_игроков*: ARRAY 16 OF INTEGER;
    цвет_фона*, цвет_шрифта*, цвет_сетки*, цвет_последних_ходов*: INTEGER; 
 
  PROCEDURE^ Рисовать_карандаш (f: Views.Frame; l, t: INTEGER; x, y, ш, в: INTEGER;
цвет: INTEGER; пассивен: BOOLEAN);
  PROCEDURE^ Рисовать_статус (v: View; f: Views.Frame; l, t: INTEGER);    
  PROCEDURE^ Рисовать_статистику (f: Views.Frame; l, t: INTEGER; игроков: INTEGER;
статистика: Игра.Статистика);
  PROCEDURE^ Рисовать_сетку (f: Views.Frame; l, t: INTEGER; ш, в: INTEGER);
  PROCEDURE^ Рисовать_точки (f: Views.Frame; l, t: INTEGER; поле: Игра.Поле);
  PROCEDURE^ Рисовать_последние_ходы (f: Views.Frame; l, t: INTEGER;
IN ходы: ARRAY OF Ход; n: INTEGER);
  PROCEDURE^ Рисовать_границы (f: Views.Frame; l, t: INTEGER; поле: Игра.Поле);
 
  PROCEDURE (v: View) GetBackground (VAR color: INTEGER);
  BEGIN
    color := цвет_фона
  END GetBackground;
 
  PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
    VAR  i, j: INTEGER;
  BEGIN
    Рисовать_статистику(f, 0, 0, v.игра.игроков, v.игра.статистика);
    Рисовать_сетку(f, поля, v.игра.игроков * размер_шрифта + поля,
LEN(v.игра.поле), LEN(v.игра.поле, 1));
    Рисовать_последние_ходы(f, поля, v.игра.игроков * размер_шрифта + поля,
v.последние_ходы_игроков, v.игра.игроков);
    Рисовать_точки(f, поля, v.игра.игроков * размер_шрифта + поля, v.игра.поле);
    Рисовать_границы(f, поля, v.игра.игроков * размер_шрифта + поля, v.игра.поле);
    IF (v.карандаш.x # -1) & (v.карандаш.y # -1) THEN
      Рисовать_карандаш(f, поля, v.игра.игроков * размер_шрифта + поля,
v.карандаш.x, v.карандаш.y, LEN(v.игра.поле), LEN(v.игра.поле, 1), цвета_игроков[v.игрок],
(v.для_игрока # -1) & (v.игрок # v.для_игрока))
    END;
    Рисовать_статус(v, f, поля, v.игра.игроков * размер_шрифта
+ поля + (LEN(v.игра.поле, 1) - 1) * клетка + поля)
  END Restore;
 
  PROCEDURE Рисовать_карандаш (f: Views.Frame; l, t: INTEGER;
x, y, ш, в: INTEGER; цвет: INTEGER; пассивен: BOOLEAN);
  BEGIN
    f.DrawLine(l + x * клетка - клетка DIV 2, t + y * клетка - клетка DIV 2, 
          l + x * клетка + клетка DIV 2, t + y * клетка + клетка DIV 2, 0, цвет);
    f.DrawLine(l + x * клетка - клетка DIV 2, t + y * клетка + клетка DIV 2, 
          l + x * клетка + клетка DIV 2, t + y * клетка - клетка DIV 2, 0, цвет);
    IF пассивен THEN
      f.DrawLine(l + x * клетка - клетка DIV 2, t + y * клетка - клетка DIV 2, 
            l + x * клетка + клетка DIV 2,t + y * клетка - клетка DIV 2, 0, цвет);
      f.DrawLine(l + x * клетка - клетка DIV 2, t + y * клетка + клетка DIV 2, 
            l + x * клетка + клетка DIV 2, t + y * клетка + клетка DIV 2, 0, цвет);
    END
  END Рисовать_карандаш;
 
  PROCEDURE Рисовать_статус (v: View; f: Views.Frame; l, t: INTEGER);
    VAR font: Fonts.Font; asc, dsc, w: INTEGER;
        txt: ARRAY 128 OF CHAR;
        s: ARRAY 16 OF CHAR;
  BEGIN
    font := Fonts.dir.Default();
    font := Fonts.dir.This(font.typeface, размер_шрифта, font.style, font.weight);
    font.GetBounds(asc, dsc, w);
    Strings.IntToString(v.игра.ход + 1, s);
    txt := s + '-й ход. ';
    IF v.карандаш.x > -1 THEN
      txt := txt + ' (';
      Strings.IntToString(v.карандаш.x, s);
      txt := txt + s + ', ';
      Strings.IntToString(v.карандаш.y, s);
      txt := txt + s + ')'
    END;
    f.DrawString(l, t + asc, цвет_шрифта, txt, font)
  END Рисовать_статус;
 
  PROCEDURE Рисовать_статистику (f: Views.Frame; l, t: INTEGER;
игроков: INTEGER; статистика: Игра.Статистика);
    VAR i: INTEGER; font: Fonts.Font; asc, dsc, w: INTEGER;
        txt: ARRAY 128 OF CHAR;
        s: ARRAY 16 OF CHAR;
  BEGIN
    font := Fonts.dir.Default();
    font := Fonts.dir.This(font.typeface, размер_шрифта, font.style, font.weight);
    font.GetBounds(asc, dsc, w);
    FOR  i := 0  TO игроков-1 DO
      txt := ' Пленных: ';
      Strings.IntToString(статистика.количество_пленных[i], s);
      txt := txt + s + ' Территория: ';
      Strings.IntToString(статистика.территория[i], s);
      txt := txt + s;
      f.DrawString(l, t +asc + размер_шрифта * i, цвета_игроков[i], txt, font) 
    END
  END Рисовать_статистику;
 
  PROCEDURE Рисовать_сетку (f: Views.Frame; l, t: INTEGER; ш, в: INTEGER);
    VAR  i: INTEGER;
  BEGIN
    FOR  i := 0   TO ш - 1 DO
      f.DrawLine(l + i * клетка, t, l + i * клетка,
t + (в - 1) * клетка, 0, цвет_сетки)
    END;
    FOR  i := 0   TO в - 1 DO
      f.DrawLine(l, t + i * клетка, l + (ш - 1) * клетка,
t + i * клетка,   0, цвет_сетки)
    END
  END Рисовать_сетку;
 
  PROCEDURE^ Рисовать_узел (f: Views.Frame; x, y: INTEGER; IN узел: Игра.Узел);
 
  PROCEDURE Рисовать_точки (f: Views.Frame; l, t: INTEGER; поле: Игра.Поле);
    VAR i, j: INTEGER; 
  BEGIN
    FOR  i := 0  TO LEN(поле) - 1 DO
      FOR  j := 0  TO LEN(поле, 1) - 1 DO
        Рисовать_узел(f, l + i * клетка, t + j * клетка, поле[i, j])
      END
    END
  END Рисовать_точки;
 
  PROCEDURE Рисовать_свободную (f: Views.Frame; x, y: INTEGER; игрок: INTEGER);
  BEGIN
    f.DrawOval(x - радиус_точки, y - радиус_точки, x + радиус_точки,
y + радиус_точки, -1, цвета_игроков[игрок])
  END Рисовать_свободную;
 
  PROCEDURE Рисовать_взятую (f: Views.Frame; x, y: INTEGER; чья, кем: INTEGER);
  BEGIN
    f.DrawOval(x - радиус_точки, y - радиус_точки, x + радиус_точки,
y + радиус_точки, 0, цвета_игроков[кем])
  END Рисовать_взятую;
 
  PROCEDURE Рисовать_узел (f: Views.Frame; x, y: INTEGER; IN узел: Игра.Узел);
  BEGIN
    IF  узел.точка_игрока >= 0  THEN
      IF  (узел.область = NIL) OR (узел.точка_игрока = узел.область.игрок) THEN
        Рисовать_свободную(f, x, y, узел.точка_игрока)        
      ELSE
        Рисовать_взятую(f, x, y, узел.точка_игрока, узел.точка_игрока)
      END
    END
  END Рисовать_узел;
 
  PROCEDURE Рисовать_последние_ходы (f: Views.Frame; l, t: INTEGER;
IN ходы: ARRAY OF Ход; n: INTEGER);
    VAR i: INTEGER; x, y: INTEGER;
  BEGIN
    FOR i := 0 TO n-1 DO
      IF ходы[i].x > -1 THEN
        x := l + клетка*ходы[i].x;
        y := t + клетка*ходы[i].y;
        f.DrawOval(x - 2*радиус_точки, y - 2*радиус_точки, x + 2*радиус_точки,
y + 2*радиус_точки, 0, цвет_последних_ходов)
      END
    END
  END Рисовать_последние_ходы;
 
  PROCEDURE Внутренняя_клетка (поле: Игра.Поле; l, t: INTEGER;
для_игрока: INTEGER): BOOLEAN;
    VAR n: INTEGER;
  BEGIN
    RETURN (0 <= l) & (l <= LEN(поле) - 2) & (0 <= t) & (t <= LEN(поле, 1) - 2)
      & (
        (поле[l, t].область # NIL) & (поле[l, t].область.игрок = для_игрока) &
        (поле[l+1, t+1].область = поле[l, t].область)
        OR
        (поле[l+1, t].область # NIL) & (поле[l+1, t].область.игрок = для_игрока) &
        (поле[l, t+1].область = поле[l+1, t].область)
      )
  END Внутренняя_клетка;
 
  PROCEDURE Идёт_граница (IN у1, у2: Игра.Узел): BOOLEAN;
    VAR  
  BEGIN
    RETURN (у1.граница[0] # NIL)
& ((у1.граница[0] = у2.граница[0]) OR (у1.граница[0] = у2.граница[1]))
OR (у1.граница[1] # NIL)
& ((у1.граница[1] = у2.граница[0]) OR (у1.граница[1] = у2.граница[1]))
  END Идёт_граница;
 
  PROCEDURE Рисовать_границы (f: Views.Frame; l, t: INTEGER; поле: Игра.Поле);
    VAR i, j: INTEGER;
 
    PROCEDURE Вверх_вправо (x, y: INTEGER);
    BEGIN
      IF Идёт_граница(поле[x, y-1], поле[x, y]) THEN
        f.DrawLine(l + x * клетка, t + y * клетка, l + x * клетка,
t + (y - 1) * клетка, 0, цвета_игроков[поле[x, y].точка_игрока])
      ELSIF Идёт_граница(поле[x+1, y], поле[x, y]) THEN
        f.DrawLine(l + x * клетка, t + y * клетка, l + (x + 1) * клетка,
t + y * клетка, 0, цвета_игроков[поле[x, y].точка_игрока])
      ELSIF Идёт_граница(поле[x+1, y-1], поле[x, y])THEN
        IF ~Внутренняя_клетка(поле, x, y-1, поле[x, y].точка_игрока) THEN
          f.DrawLine(l + x * клетка, t + y * клетка, l + (x + 1) * клетка,
t + (y - 1) * клетка, 0, цвета_игроков[поле[x, y].точка_игрока])
        END
      END
    END Вверх_вправо;
 
    PROCEDURE Вниз_вправо (x, y: INTEGER);
    BEGIN
      IF  Идёт_граница(поле[x+1, y], поле[x, y]) THEN
        f.DrawLine(l + x * клетка, t + y * клетка, l + (x + 1) * клетка,
t + y * клетка, 0, цвета_игроков[поле[x, y].точка_игрока])
      ELSIF Идёт_граница(поле[x, y+1], поле[x, y]) THEN
        f.DrawLine(l + x * клетка, t + y * клетка, l + x * клетка,
t + (y + 1) * клетка, 0, цвета_игроков[поле[x, y].точка_игрока])
      ELSIF Идёт_граница(поле[x+1, y+1], поле[x, y]) THEN
        IF ~Внутренняя_клетка(поле, x, y, поле[x, y].точка_игрока) THEN
          f.DrawLine(l + x * клетка, t + y * клетка, l + (x + 1) * клетка,
t + (y + 1) * клетка, 0, цвета_игроков[поле[x, y].точка_игрока])
        END
      END
    END Вниз_вправо;
 
    PROCEDURE Вверх (x, y: INTEGER); 
    BEGIN
      IF Идёт_граница(поле[x, y-1], поле[x, y]) THEN
        f.DrawLine(l + x * клетка, t + y * клетка, l + x * клетка,
t + (y - 1) * клетка, 0, цвета_игроков[поле[x, y].точка_игрока])
      END
    END Вверх;
 
  BEGIN
    FOR  i := 0  TO LEN(поле) - 2   DO
      FOR  j := 1  TO LEN(поле, 1) - 2  DO
        IF поле[i, j].граница[0] # NIL THEN
          Вверх_вправо(i, j);
          Вниз_вправо(i, j)
        END
      END
    END;
    FOR  i := 0   TO LEN(поле) - 2   DO
      IF  поле[i, 0].граница[0] # NIL THEN
        Вниз_вправо(i, 0)
      END;
      IF  поле[i, LEN(поле, 1) - 1].граница[0] # NIL  THEN
        Вверх_вправо(i, LEN(поле, 1) - 1)
      END
    END;
    FOR  j := 1 TO LEN(поле, 1) - 1 DO
      IF  поле[LEN(поле) - 1, j].граница[0] # NIL  THEN
        Вверх(LEN(поле) - 1, j)
      END
    END
  END Рисовать_границы;
 
  PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
  BEGIN
    WITH msg: Properties.SizePref DO
      msg.w := 2 * поля + (LEN(v.игра.поле) - 1) * клетка;
      msg.h := v.игра.игроков*размер_шрифта + 2 * поля
+ (LEN(v.игра.поле, 1) - 1) * клетка + 2 * размер_шрифта;
      msg.fixedW := TRUE;
      msg.fixedH := TRUE;
    ELSE  
    END
  END HandlePropMsg;
 
  PROCEDURE^ Щелчок_по_узлу (v: View; x, y: INTEGER);
 
  PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg:
 Views.CtrlMessage; VAR focus: Views.View);
    VAR  x, y: INTEGER;
  BEGIN
    WITH msg: Controllers.TrackMsg DO
      x := msg.x - (поля - клетка DIV 2);
      y := msg.y - (v.игра.игроков*размер_шрифта + поля - клетка DIV 2);
      x := x DIV клетка;
      y := y DIV клетка;
      IF (0 <= x) & (x < LEN(v.игра.поле)) & (0 <= y ) & (y < LEN(v.игра.поле, 1))  THEN
        IF (v.для_игрока = -1) OR (v.для_игрока = v.игрок) THEN
          Щелчок_по_узлу(v, x, y);
          Views.Update(v, Views.keepFrames)
        END
      END
    | msg: Controllers.PollCursorMsg DO
      x := msg.x - (поля - клетка DIV 2);
      y := msg.y - (v.игра.игроков*размер_шрифта + поля - клетка DIV 2);
      x := x DIV клетка;
      y := y DIV клетка;
      IF (0 <= x) & (x < LEN(v.игра.поле)) & (0 <= y) & (y < LEN(v.игра.поле, 1)) THEN
      ELSE
        x := -1; y := -1
      END;
      IF (x # v.карандаш.x) OR (y # v.карандаш.y) THEN
        v.карандаш.x := x;
        v.карандаш.y := y;
        Views.Update(v, Views.keepFrames)
      END      
    ELSE
    END
  END HandleCtrlMsg;
 
  PROCEDURE^ Принять_ход* (v: Views.View; x, y: INTEGER);
 
  PROCEDURE Щелчок_по_узлу (v: View; x, y: INTEGER);
  BEGIN
    IF  (v.игра.поле[x, y].точка_игрока = -1) 
& ((v.игра.поле[x, y].область = NIL)
OR (v.игра.поле[x, y].область.точек_противника = 0))  THEN
      Принять_ход(v, x, y)
    END
  END Щелчок_по_узлу;
 
  PROCEDURE Эта_игра* (v: Views.View): Игра.Игра;
  BEGIN
    WITH v: View DO
      RETURN v.игра
    ELSE
      RETURN NIL
    END  
  END Эта_игра;
 
  PROCEDURE Принять_ход* (v: Views.View; x, y: INTEGER);
  BEGIN
    WITH v: View DO
      ASSERT((v.игра.поле[x, y].точка_игрока = -1)
& ((v.игра.поле[x, y].область = NIL)
OR (v.игра.поле[x, y].область.точек_противника = 0)), 20);
      v.игра.Сделать_ход(x, y, v.игрок);
      v.последние_ходы_игроков[v.игрок].x := x;
      v.последние_ходы_игроков[v.игрок].y := y;
      v.игрок := (v.игрок + 1) MOD v.игра.игроков;
      Views.Update(v, Views.keepFrames);
      Views.SetDirty(v)
    END
  END Принять_ход;
 
  PROCEDURE Ходит_игрок* (v: Views.View): INTEGER;
  BEGIN
    WITH v: View DO
      RETURN v.игрок
    END
  END Ходит_игрок;
 
  PROCEDURE Последний_ход* (v: Views.View; OUT x, y: INTEGER);
    VAR игрок: INTEGER;
  BEGIN
    WITH v: View DO
      игрок := (v.игрок - 1) MOD v.игра.игроков;
      x := v.последние_ходы_игроков[игрок].x;
      y := v.последние_ходы_игроков[игрок].y
    END
  END Последний_ход;
 
  PROCEDURE Сделать_для_игрока* (v: Views.View; игрок: INTEGER);
  BEGIN
    ASSERT(игрок >= для_всех_игроков, 20);
    WITH v: View DO
      v.для_игрока := игрок
    END
  END Сделать_для_игрока;
 
  PROCEDURE Для_какого_игрока* (v: Views.View): INTEGER;
  BEGIN
    WITH v: View DO
      RETURN v.для_игрока
    END      
  END Для_какого_игрока;
 
  PROCEDURE Init (v: View);
    VAR  i: INTEGER;
  BEGIN
    v.игрок := 0;
    v.карандаш.x := -1;
    v.карандаш.y := -1;
    v.для_игрока := для_всех_игроков;
    FOR i := 0 TO LEN(v.последние_ходы_игроков)-1 DO
      v.последние_ходы_игроков[i].x := -1;
      v.последние_ходы_игроков[i].y := -1
    END;
  END Init;
 
  PROCEDURE Новое_поле* (игра: Игра.Игра): Views.View;
    VAR v: View;
  BEGIN
    ASSERT(игра # NIL, 20);
    NEW(v);
    Init(v);
    v.игра := игра;
    RETURN v
  END Новое_поле;
 
  (* Сериализация *)
 
  PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
    VAR  ходы: Хранение.Ход; i: INTEGER;
  BEGIN
    wr.WriteVersion(version);
    wr.WriteInt(LEN(v.игра.поле));
    wr.WriteInt(LEN(v.игра.поле, 1));
    wr.WriteInt(v.игра.игроков);
    wr.WriteInt(v.игра.ход);
    ходы := Хранение.История(v.игра.поле);
    FOR  i := 1  TO  v.игра.ход  DO
      wr.WriteInt(ходы.x);
      wr.WriteInt(ходы.y);
      ходы := ходы.след
    END;
  END Externalize;
 
  PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
    VAR  ver: INTEGER; ш, в, игроков, ход: INTEGER; i, x, y: INTEGER;
  BEGIN
    Init(v);
    rd.ReadVersion(version, version, ver);
    IF  ~rd.cancelled  THEN
      rd.ReadInt(ш);
      rd.ReadInt(в);
      rd.ReadInt(игроков);
      rd.ReadInt(ход);
      v.игра := Игра.Новая_игра(ш, в, игроков);
      v.игрок := 0;
      FOR  i := 1 TO ход DO
        rd.ReadInt(x);
        rd.ReadInt(y);
        Принять_ход(v, x, y)
      END
    END
  END Internalize;
 
  PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
    VAR  ходы: Хранение.Ход;
  BEGIN
    WITH source: View DO
      Init(v);
      v.игра := Игра.Новая_игра(LEN(source.игра.поле),
LEN(source.игра.поле, 1), source.игра.игроков);
      ходы := Хранение.История(source.игра.поле);
      WHILE ходы # NIL DO
        Принять_ход(v, ходы.x, ходы.y);
        ходы := ходы.след
      END
    END
  END CopyFromSimpleView;  
 
BEGIN
  цвета_игроков[0] := 0C0C0C0H;
  цвета_игроков[1] := 00000C0H;
  цвета_игроков[2] := 0C00000H;
  цвета_игроков[3] := 0C000H;
  цвет_фона := 0;
  цвет_шрифта := 0C0C0C0H;
  цвет_сетки := 0303030H;
  цвет_последних_ходов := 0505050H;
END ТочкиГрафика.

Модуль ТочкиКоманды

MODULE ТочкиКоманды;
 
  IMPORT Views, Игра := ТочкиИгра, Графика := ТочкиГрафика, Net := CommStreams,
DevCommanders, Services, Log := StdLog, Tm := TextMappers, Windows, TextModels,
TextViews, Хранение := ТочкиХранение;
 
  VAR
    ширина*, высота*: INTEGER;
    число_игроков*: INTEGER;
 
    история: Хранение.Ход;
    поле: Views.View;
 
    далее_на*: INTEGER;
    до_хода*: INTEGER;
 
  PROCEDURE Открыть*;
    VAR игра: Игра.Игра;
        v: Views.View;
  BEGIN
    игра := Игра.Новая_игра(ширина, высота, число_игроков);
    v := Графика.Новое_поле(игра);
    Views.OpenView(v)
  END Открыть;
 
  PROCEDURE Новая_игра*;
    VAR sc: Tm.Scanner;
  BEGIN
    ASSERT(DevCommanders.par.text # NIL, 20);
    sc.ConnectTo(DevCommanders.par.text);
    sc.SetPos(DevCommanders.par.beg);
    sc.Scan; ASSERT(sc.type = Tm.int, 21);
    ширина := sc.int;
    sc.Scan; ASSERT((sc.type = Tm.string) & (sc.string = "x"), 22);
    sc.Scan; ASSERT(sc.type = Tm.int, 23);
    высота := sc.int;
    sc.Scan; ASSERT((sc.type = Tm.string) & (sc.string = "игроков"), 24);
    sc.Scan; ASSERT(sc.type = Tm.int, 25);
    число_игроков := sc.int
  END Новая_игра;
 
  PROCEDURE Сохранить_историю*;
    VAR w: Windows.Window;
        игра: Игра.Игра;
        tm: TextModels.Model;
        история: Хранение.Ход;
        fm: Tm.Formatter;
        tv: TextViews.View;
  BEGIN
    w := Windows.dir.First();
    WHILE (w # NIL) & ~ ( Графика.Эта_игра(w.doc.ThisView()) # NIL ) DO
      w := Windows.dir.Next(w)
    END;
    IF w # NIL THEN
      игра := Графика.Эта_игра(w.doc.ThisView());
      tm := TextModels.dir.New();
      fm.ConnectTo(tm);
      fm.WriteView(DevCommanders.dir.New());
      fm.WriteString('"ТочкиКоманды.Загрузить_историю;StdCmds.OpenToolDialog('
+ "'Точки/Rsrc/Проигрыватель', 'Вперёд'" + ')"');
      fm.WriteLn;
      fm.WriteInt(LEN(игра.поле));
      fm.WriteString(' x ');
      fm.WriteInt(LEN(игра.поле, 1));
      fm.WriteString(' игроков ');
      fm.WriteInt(игра.игроков);
      fm.WriteLn;
      история := Хранение.История(игра.поле);
      Хранение.В_текст(история, fm);
      tv := TextViews.dir.New(tm);
      Views.OpenView(tv)
    END
  END Сохранить_историю;
 
  PROCEDURE Загрузить_историю*;
    VAR  sc: Tm.Scanner; ш, в, игроков: INTEGER; игра: Игра.Игра;
  BEGIN
    ASSERT(DevCommanders.par.text # NIL, 20);
    sc.ConnectTo(DevCommanders.par.text);
    sc.SetPos(DevCommanders.par.beg);
    sc.Scan; ASSERT(sc.type = Tm.int, 21);
    ш := sc.int;
    sc.Scan; ASSERT((sc.type = Tm.string) & (sc.string = "x"), 22);
    sc.Scan; ASSERT(sc.type = Tm.int, 23);
    в := sc.int;
    sc.Scan; ASSERT((sc.type = Tm.string) & (sc.string = "игроков"), 24);
    sc.Scan; ASSERT(sc.type = Tm.int, 25);
    игроков := sc.int;
    история := Хранение.Из_текста(sc);
    игра := Игра.Новая_игра(ш, в, игроков);
    поле := Графика.Новое_поле(игра);
    Views.OpenView(поле)
  END Загрузить_историю;
 
  PROCEDURE Далее*;
    VAR n: INTEGER;
  BEGIN
    IF далее_на <= 0 THEN
      далее_на := 1
    END;
    n := далее_на;
    WHILE (история # NIL) & (n > 0 )  DO
      Графика.Принять_ход(поле, история.x, история.y);
      история := история.след;
      DEC(n)
    END
  END Далее;
 
  PROCEDURE До_конца*;
  BEGIN
    WHILE  история # NIL  DO
      Графика.Принять_ход(поле, история.x, история.y);
      история := история.след
    END
  END До_конца;
 
  PROCEDURE До_хода*;
  BEGIN
    IF до_хода <= 0 THEN
      до_хода := 1
    END;
    IF поле # NIL THEN
      WHILE (история # NIL) & (Графика.Эта_игра(поле).ход < до_хода-1) DO
        Графика.Принять_ход(поле, история.x, история.y);
        история := история.след
      END
    END
  END До_хода;
 
  PROCEDURE Настроить_цвета*;
    VAR rd: TextModels.Reader;
        цв: INTEGER; i: INTEGER;
 
    PROCEDURE Читать_цвет;
    BEGIN
      rd.Read;
      WHILE ~rd.eot & ~ ( (rd.char # " ") & (rd.char # TextModels.tab) ) DO
        rd.Read
      END;
      цв := rd.attr.color;
      rd.Read;
      WHILE ~rd.eot & ~ ( (rd.char = " ") OR (rd.char = TextModels.tab) ) DO
        rd.Read
      END;
    END Читать_цвет;
 
  BEGIN
    ASSERT(DevCommanders.par.text # NIL, 20);
    rd := DevCommanders.par.text.NewReader(NIL);
    rd.SetPos(DevCommanders.par.beg);
    Читать_цвет;
    Графика.цвет_фона := цв;
    Читать_цвет;
    Графика.цвет_сетки := цв;
    Читать_цвет;
    Графика.цвет_шрифта := цв;
    Читать_цвет;
    Графика.цвет_последних_ходов := цв;
    FOR  i := 0  TO 3 DO
      Читать_цвет;
      Графика.цвета_игроков[i] := цв
    END    
  END Настроить_цвета;
 
BEGIN
  ширина := 39;
  высота := 32;
  число_игроков := 2;
  далее_на := 1;
  до_хода := 1
END ТочкиКоманды.

Модуль ТочкиСетевая

MODULE ТочкиСетевая;
 
  IMPORT Services, Net := CommStreams, Игра := ТочкиИгра, Графика := ТочкиГрафика,
Views, Dialog, Windows, DevCommanders, Tm := TextMappers;
 
  CONST
    ждём_локального_хода = 1;
    ждём_сетевого_хода = 2;
 
    timeout = 5000;
 
    интервал_подачи_сигнала = 10000;
 
  TYPE
    Server = POINTER TO RECORD (Services.Action)
      in: Net.Listener;
      clients: ClientItem
    END;
 
    ClientItem = POINTER TO RECORD
      next: ClientItem;
      s: Net.Stream
    END;
 
    Msg = ARRAY 4 OF BYTE;
 
    Client = POINTER TO RECORD (Services.Action)
      s: Net.Stream;
      игра: Игра.Игра;
      поле: Views.View;
      для_игрока: INTEGER;
      состояние: INTEGER;
      время_ожидания_сетевых_ходов: LONGINT
    END;
 
  VAR
    stop: BOOLEAN;
 
  PROCEDURE Receive (s: Net.Stream; OUT msg: Msg; OUT n: INTEGER);
    VAR i: INTEGER;
        t: LONGINT;
  BEGIN
    n := 0;
    s.ReadBytes(msg, 0, 4, i);
    IF i > 0 THEN
      t := Services.Ticks();
      n := i;
      WHILE (n < LEN(msg)) & (Services.Ticks() - t < timeout) DO
        s.ReadBytes(msg, n, 4-n, i);
        INC(n, i)
      END
    END
  END Receive;
 
  PROCEDURE Transmit (s: Net.Stream; OUT msg: Msg; OUT n: INTEGER);
    VAR i: INTEGER;
        t: LONGINT;
  BEGIN
    n := 0;
    t := Services.Ticks();
    REPEAT
      s.WriteBytes(msg, n, 4-n, i);
      INC(n, i)
    UNTIL (n = LEN(msg)) OR (Services.Ticks() - t > timeout)
  END Transmit;
 
  PROCEDURE (srv: Server) Do;
    VAR s: Net.Stream;
        c: ClientItem;
        msg: Msg;
        n: INTEGER;
 
    PROCEDURE Retranslate;
      VAR to: ClientItem;
    BEGIN
      to := srv.clients;
      WHILE to # NIL DO
        IF (to # c) & to.s.IsConnected() THEN
          Transmit(to.s, msg, n);
          IF n < LEN(msg) THEN
            to.s.Close
          END
        END;
        to := to.next
      END
    END Retranslate;
 
  BEGIN
    IF ~ stop THEN
      srv.in.Accept(s);
      IF s # NIL THEN
        NEW(c); c.s := s;
        c.next := srv.clients;
        srv.clients := c
      END;
      c := srv.clients;
      WHILE c # NIL DO
        IF c.s.IsConnected() THEN
          Receive(c.s, msg, n);
          IF n = LEN(Msg) THEN
            Retranslate
          ELSIF n > 0 THEN
            c.s.Close
          END
        END;
        c := c.next
      END;
      Services.DoLater(srv, Services.now)
    ELSE
      srv.in.Close
    END
  END Do;
 
  PROCEDURE ^ Послать_ход (s: Net.Stream; x, y: INTEGER);
 
  PROCEDURE (cl: Client) Do;
    VAR i: INTEGER; x, y: INTEGER;
        msg: Msg;
        n: INTEGER;
  BEGIN
    IF cl.поле.context = NIL THEN (* окно было закрыто *)
      cl.состояние := -1
    END;
    CASE cl.состояние OF
    | ждём_локального_хода:
      IF Графика.Ходит_игрок(cl.поле) # cl.для_игрока THEN
        Графика.Последний_ход(cl.поле, x, y);
        Послать_ход(cl.s, x, y);
        IF cl.s.IsConnected() THEN
          cl.состояние := ждём_сетевого_хода;
          cl.время_ожидания_сетевых_ходов := Services.Ticks()
        ELSE
          cl.состояние := -1
        END
      END
    | ждём_сетевого_хода:
      Receive(cl.s, msg, n);
      IF n = LEN(msg) THEN
        x := msg[0] + msg[1]*256;
        y := msg[2] + msg[3]*256;
        Графика.Принять_ход(cl.поле, x, y);
        IF Графика.Ходит_игрок(cl.поле) = cl.для_игрока THEN
          cl.состояние := ждём_локального_хода;
          IF Services.Ticks() - cl.время_ожидания_сетевых_ходов > интервал_подачи_сигнала THEN
            Dialog.Beep
          END
        ELSE
          cl.состояние := ждём_сетевого_хода
        END
      ELSIF (n = 0) & cl.s.IsConnected() THEN
        cl.состояние := ждём_сетевого_хода
      ELSE
        cl.состояние := -1
      END
    END;
    IF cl.состояние # -1 THEN
      Services.DoLater(cl, Services.now)
    ELSE
      Dialog.ShowMsg('Ошибка сетевого подключения!');
      cl.s.Close
    END
  END Do;
 
  PROCEDURE Послать_ход (s: Net.Stream; x, y: INTEGER);
    VAR msg: Msg;
        n: INTEGER;
  BEGIN
    msg[0] := SHORT(SHORT(x MOD 256));
    msg[1] := SHORT(SHORT(x DIV 256));
    msg[2] := SHORT(SHORT(y MOD 256));
    msg[3] := SHORT(SHORT(y DIV 256));
    Transmit(s, msg, n);
    IF n < LEN(msg) THEN
      s.Close
    END
  END Послать_ход;
 
  PROCEDURE Пустить_сервер*;
    VAR sc: Tm.Scanner;
        srv: Server;
        res: INTEGER;
  BEGIN
    stop := FALSE;
    ASSERT(DevCommanders.par.text # NIL, 20);
    sc.ConnectTo(DevCommanders.par.text);
    sc.SetPos(DevCommanders.par.beg);
    sc.Scan; ASSERT(sc.type = Tm.string, 21);
    NEW(srv);
    Net.NewListener("CommTCP", sc.string, srv.in, res);
    IF srv.in # NIL THEN
      Services.DoLater(srv, Services.now)
    ELSE
      Dialog.ShowMsg("Не удалось открыть локальный порт!")
    END
  END Пустить_сервер;
 
  PROCEDURE Остановить_сервера*;
  BEGIN
    stop := TRUE
  END Остановить_сервера;
 
  PROCEDURE Подключить*;
    VAR cl: Client;
        w: Windows.Window;
        sc: Tm.Scanner;
        adr: ARRAY 256 OF CHAR;
        для_игрока: INTEGER;
        res: INTEGER;
  BEGIN
    ASSERT(DevCommanders.par.text # NIL, 20);
    sc.ConnectTo(DevCommanders.par.text);
    sc.SetPos(DevCommanders.par.beg);
    sc.Scan; ASSERT(sc.type = Tm.string, 21);
    adr := sc.string$;
    sc.Scan; ASSERT((sc.type = Tm.string), 22);
    IF sc.string = "игрока" THEN
      sc.Scan; ASSERT((sc.type = Tm.int), 23);
      для_игрока := sc.int
    ELSIF sc.string = "наблюдателя" THEN
      для_игрока := 100
    ELSE
      HALT(24)
    END;
    w := Windows.dir.First();
    WHILE (w # NIL) & ~ ( Графика.Эта_игра(w.doc.ThisView()) # NIL ) DO
      w := Windows.dir.Next(w)
    END;
    IF w # NIL THEN
      NEW(cl);
      Net.NewStream("CommTCP", "0.0.0.0:0", adr, cl.s, res);
      IF cl.s # NIL THEN
        cl.поле := w.doc.ThisView();
        cl.игра := Графика.Эта_игра(cl.поле);
        cl.для_игрока := для_игрока;
        Графика.Сделать_для_игрока(cl.поле, для_игрока);
        IF cl.для_игрока = 0 THEN
          cl.состояние := ждём_локального_хода
        ELSE
          cl.состояние := ждём_сетевого_хода
        END;
        Services.DoLater(cl, Services.now)
      ELSE
        Dialog.ShowMsg("Не удалось подключиться к серверу!")
      END
    ELSE
      Dialog.ShowMsg("Нет открытого окна с игрой!")
    END
  END Подключить;
 
END ТочкиСетевая.
© 2005-2024 OberonCore и коллектив авторов.