program xiangqi; type PieceType = (p_none, general, advisor, elephant, horse, chariot, cannon, soldier); PieceMap = array[0..9, 'A'..'I'] of PieceType; ColorType = (c_none, red, black); ColorMap = array[0..9, 'A'..'I'] of ColorType; FullMap = record piece: PieceMap; color: ColorMap end; NotationType = (european, chinese); MoveType = record start_x, final_x: char; start_y, final_y: integer; start_piece, final_piece: PieceType; start_color, final_color: ColorType end; HistoryType = ^HistoryElement; HistoryElement = record map: FullMap; move: MoveType; previous: HistoryType end; AreaType = (field, bank, fortress); LineType = (fly, danger, step, attack); MoveDescription = ^LineMoveDescription; LineMoveDescription = record lines: array[0..7] of MoveDescription; occupied: array[0..7] of MoveDescription; this: LineType end; MoveList = ^MoveListElement; MoveListElement = record this: MoveDescription; next: MoveList end; PieceDescription = record move: MoveDescription; move_area, check_area: AreaType end; FullDescription = array[0..8] of PieceDescription; var map: FullMap; notation: NotationType; color: ColorType; autoprint: boolean; command: string; history: HistoryType; description: FullDescription; moves: MoveList; { ### Description line decoding } procedure shift(var x: char; var y: integer; direction: integer; color: ColorType); begin if color = red then begin if direction in [7, 0, 1] then y := succ(y) else if direction in [3..5] then y := pred(y); if direction in [1..3] then x := succ(x) else if direction in [5..7] then x := pred(x) end else begin if direction in [7, 0, 1] then y := pred(y) else if direction in [3..5] then y := succ(y); if direction in [1..3] then x := pred(x) else if direction in [5..7] then x := succ(x) end end; { ### Working with input/output, string } function extractWord(index: integer; data: string; delimiter: char): string; var result: string; indexer: integer; position: integer; waiting: boolean; begin result := ''; indexer := 0; waiting := true; for position := 1 to ord(data[0]) do begin if data[position] <> delimiter then begin if waiting then indexer := indexer + 1; waiting := false end else waiting := true; if (indexer = index) and (not waiting) then result := result + data[position] else if indexer > index then break end; extractWord := result end; function deleteAll(data: string; deleting: char): string; var result: string; position: integer; begin result := ''; for position := 1 to ord(data[0]) do if data[position] <> deleting then result := result + data[position]; deleteAll := result end; procedure printError(error_message: string); begin writeln('Error: ', error_message) end; procedure inputCommand(var command: string); begin writeln('Write command:'); write('>>> '); readln(command); end; procedure printHelp; begin writeln('THE GAME'); writeln(' Pronounced "shyahng chi", sometimes translated as "the elephant game".'); writeln(' This form of chess has been played for many centuries throughout China.'); writeln(' Although only beginning to become widely known in the west,'); writeln(' Xiangqi is probably played by more people than any other board game'); writeln(' in the world - including the familiar western "international" chess.'); writeln(' There are two player colors: RED and BLACK.'); writeln; writeln('THE PIECES'); writeln(' Here are the pieces - their Chinese pronunciations,'); writeln(' translated names, western chess equivalents (~ means "quite")'); writeln(' and game shortcuts:'); writeln(' "Jiang" / "Shuai" - Governor / General - King - G'); writeln(' "Shi" - Advisor / Counselor - ~ Queen - A'); writeln(' "Shiang" - Elephant / Minister - ~ Bishop - E'); writeln(' "Ma" - Horse - Knight - H'); writeln(' "Chuh" - Chariot - Rook - R'); writeln(' "Pao" - Cannon / Catapult - ~ Rook - C'); writeln(' "Ping" / "Tsuh" - Soldier - Pawn - S'); writeln; writeln('THE MOVES'); writeln(' The GOVERNOR moves one space at a time left, right, forward or backward.'); writeln(' He is confined to the nine point FORTRESS, on his side of the board.'); writeln; writeln(' The ADVISOR is also confined to the FORTRESS.'); writeln(' He moves one point diagonally.'); writeln; writeln(' The ELEPHANT moves exactly two points in any diagonal direction.'); writeln(' This piece can be blocked by another piece on the intervening square'); writeln(' and is not allowed to cross the RIVER,'); writeln(' which runs between the two sides of the board.'); writeln; writeln(' The HORSE moves first one point along the horizontal/vertical lines,'); writeln(' and then one point diagonally. Similar to the knight in western chess,'); writeln(' but this horse can be blocked by an intervening piece.'); writeln; writeln(' The CHARIOT moves exactly like the rook in western chess:'); writeln(' as many spaces as it wishes horizontally or vertically,'); writeln(' until it meets another piece or the edge of the board.'); writeln; writeln(' The CANNON moves exactly like the rook when not capturing.'); writeln(' But to capture, it must have a piece-shield,'); writeln(' friend or foe, in line to jump over.'); writeln; writeln(' The SOLDIER moves one point forward. After it crosses the RIVER,'); writeln(' it may also move to the right and left, but never backward.'); writeln(' Unlike the pawn, this piece captures just as it moves normally.'); writeln(' It does not promote upon reaching the far end of the board.'); writeln; writeln('THE DETAILS'); writeln(' The GOAL of this game is to force capture of the enemy GOVERNOR.'); writeln(' This may be by CHECKMATE (he is under attack and has no means of escape)'); writeln(' or by STALEMATE (there is no legal, safe move).'); writeln; writeln(' Except for the cannon, a piece CAPTURES by using its normal move,'); writeln(' and landing on a point occupied by an enemy piece.'); writeln(' The captured piece is removed from the board'); writeln(' and the capturing piece takes its place.'); writeln(' The CANNON also takes the place of its captured piece,'); writeln(' but must use one intervening piece.'); writeln; writeln(' When the GOVERNOR is being threatened with capture,'); writeln(' he is said to be in "CHECK", and the player must move in such a way'); writeln(' that the GOVERNOR is no longer threatened.'); writeln(' Player can not move under CHECK.'); writeln; writeln(' It is not allowed to give PERPETUAL CHECK, or a perpetual attack.'); writeln(' If the game is repeating its position,'); writeln(' the player forcing the repetition must do something else.'); writeln; writeln(' There is a special rule about the GOVERNORS.'); writeln(' The two may never face each other on the same line across the board,'); writeln(' with no intervening pieces between them.'); writeln(' It is said that they may not "SEE" each other.'); writeln; writeln(' In tournament play, to begin the game, RED moves FIRST.'); writeln; writeln(' The RIVER is line from 4-th to 5-th horizontal.'); writeln; writeln(' The FORTRESS is square:'); writeln(' DEF/012 for RED,'); writeln(' DEF/789 for BLACK.'); writeln; writeln('NOTATIONS'); writeln(' EUROPEAN: [Piece type][From column][From line]-[To column][To line]'); writeln; writeln(' CHINESE: [Piece type]...'); writeln(' ...[From column(as number) or Nearest/Farest mark(v or ^)]...'); writeln(' ...[Change mark: forvard(+), backvard(-), horizontal(=)]...'); writeln(' ...[Move number: if horizontal: to column; else: delta]'); writeln; writeln('COMMANDS'); writeln(' help'); writeln(' - print this help'); writeln; writeln(' print'); writeln(' - print current field state'); writeln; writeln(' autoprint'); writeln(' - change state of autoprinting after move feature (default: on)'); writeln; writeln(' turn'); writeln(' - print current player'); writeln; writeln(' notation'); writeln(' - print current notation'); writeln; writeln(' restart'); writeln(' - load start state'); writeln; writeln(' test'); writeln(' - load test state'); writeln; writeln(' exit'); writeln(' - exit from this game application'); writeln; writeln(' setNotation [notation_name]'); writeln(' - set current notation to [notation_name]'); writeln; writeln(' load [filename]'); writeln(' - load game from savefile with name [filename]'); writeln; writeln(' save [filename]'); writeln(' - save game to savefile with name [filename]'); writeln; writeln(' move [move_record]'); writeln(' - make move encoded in [move_record] with current notation') end; { ### Working with NotationType } procedure changeNotation(var notation: NotationType; command: string); begin case lowerCase(command) of 'european': notation := european; 'chinese': notation := chinese; else begin printError('Unknown notation.'); exit end end end; { ## Notation input/output } procedure printNotation(notation: NotationType); begin case notation of european: writeln('Notation is european.'); chinese: writeln('Notation is chinese.') end end; { ### Working with ColorType } function encodeColor(color: ColorType): char; begin case color of c_none: encodeColor := ' '; red: encodeColor := '+'; black: encodeColor := '-' end end; function getColorName(color: ColorType): string; begin case color of red: getColorName := 'red'; black: getColorName := 'black' end end; function invertColor(color: ColorType): ColorType; begin case color of c_none: invertColor := c_none; red: invertColor := black; black: invertColor := red end end; function decodeColor(symbol: char): ColorType; begin case symbol of ' ': decodeColor := c_none; '+': decodeColor := red; '-': decodeColor := black; else printError('Unknown color.') end end; { ## Color input/output } procedure printTurn(color: ColorType); begin writeln('Now is turn of ', getColorName(color), ' player.'); end; { ### Working with PieceType } function encodePiece(piece: PieceType): char; begin case piece of p_none: encodePiece := ' '; general: encodePiece := 'G'; advisor: encodePiece := 'A'; elephant: encodePiece := 'E'; horse: encodePiece := 'H'; chariot: encodePiece := 'R'; cannon: encodePiece := 'C'; soldier: encodePiece := 'S' end end; function decodePiece(symbol: char): PieceType; begin case symbol of ' ': decodePiece := p_none; 'G': decodePiece := general; 'A': decodePiece := advisor; 'E': decodePiece := elephant; 'H': decodePiece := horse; 'R': decodePiece := chariot; 'C': decodePiece := cannon; 'S': decodePiece := soldier; else begin printError('Unknown piece type.'); decodePiece := p_none end end end; function getPieceIDFromName(code: string): integer; begin case code of 'None': getPieceIDFromName := 0; 'General': getPieceIDFromName := 1; 'Advisor': getPieceIDFromName := 2; 'Elephant': getPieceIDFromName := 3; 'Horse': getPieceIDFromName := 4; 'Chariot': getPieceIDFromName := 5; 'Cannon': getPieceIDFromName := 6; 'Soldier': getPieceIDFromName := 7; 'CrossedSoldier': getPieceIDFromName := 8; end end; { ### Working with maps } function isMapsEqual(first, second: FullMap): boolean; label final; var i: integer; j: char; ok: boolean; begin ok := true; for i := 9 downto 0 do for j := 'A' to 'I' do begin ok := ok and (first.piece[i, j] = second.piece[i, j]) and (first.color[i, j] = second.color[i, j]); if not ok then goto final end; final: isMapsEqual := ok end; { ## Areas defenitions } function isField(x: char; y: integer): boolean; begin isField := (x in ['A'..'I']) and (y in [0..9]) end; function isFortress(color: ColorType; x: char; y: integer): boolean; begin isFortress := isField(x, y) and (x in ['D'..'F']) and (((color = red) and (y <= 2)) or ((color = black) and (y >= 7))) end; function isBank(color: ColorType; x: char; y: integer): boolean; begin isBank := isField(x, y) and (((color = red) and (y <= 4)) or ((color = black) and (y >= 5))) end; function isArea(area: AreaType; color: ColorType; x: char; y: integer): boolean; begin case area of field: isArea := isField(x, y); bank: isArea := isBank(color, x, y); fortress: isArea := isFortress(color, x, y) end end; function decodeArea(code: string): AreaType; begin case code of 'field': decodeArea := field; 'bank': decodeArea := bank; 'fortress': decodeArea := fortress end end; { ## Maps input/output } procedure printMap(map: FullMap); var i: integer; j: char; begin writeln; write('##'); for j := 'A' to 'I' do write('/', j, '\'); writeln('##'); for i := 9 downto 0 do begin write(i, '#'); for j := 'A' to 'I' do begin write(encodeColor(map.color[i, j])); write(encodePiece(map.piece[i, j])); write(' ') end; write('#', i); writeln() end; write('##'); for j := 'A' to 'I' do write('\', j, '/'); writeln('##'); writeln end; procedure saveMap(map: FullMap; var savefile: text); var i: integer; j: char; begin for i := 9 downto 0 do begin for j := 'A' to 'I' do write(savefile, encodeColor(map.color[i, j]), encodePiece(map.piece[i, j])); writeln(savefile) end end; procedure loadMap(var map: FullMap; var loadfile: text); var i: integer; j, c: char; begin for i := 9 downto 0 do begin for j := 'A' to 'I' do begin read(loadfile, c); map.color[i, j] := decodeColor(c); read(loadfile, c); map.piece[i, j] := decodePiece(c) end; readln(loadfile) end end; { ### Working with MoveType } procedure makeNoneMove(var move: MoveType); begin with move do begin start_x := 'A'; final_x := 'A'; start_y := 0; final_y := 0; start_piece := p_none; final_piece := p_none; start_color := c_none; final_color := c_none end end; { ## Moves input/output } procedure saveMove(move: MoveType; var savefile: text); begin write(savefile, encodeColor(move.start_color), encodePiece(move.start_piece)); write(savefile, move.start_x, move.start_y); write(savefile, encodeColor(move.final_color), encodePiece(move.final_piece)); write(savefile, move.final_x, move.final_y); writeln(savefile) end; procedure loadMove(var move: MoveType; var loadfile: text); var c: char; begin read(loadfile, c); move.start_color := decodeColor(c); read(loadfile, c); move.start_piece := decodePiece(c); read(loadfile, move.start_x); read(loadfile, move.start_y); read(loadfile, c); move.final_color := decodeColor(c); read(loadfile, c); move.final_piece := decodePiece(c); read(loadfile, move.final_x); read(loadfile, move.final_y); readln(loadfile) end; { ### Working with HistoryType } procedure pushState(map: FullMap; move: MoveType; var history: HistoryType); var p: HistoryType; begin new(p); p^.map := map; p^.move := move; p^.previous := history; history := p end; procedure deleteHistory(var history: HistoryType); begin if history <> nil then begin deleteHistory(history^.previous); dispose(history); history := nil end end; function getCount(map: FullMap; history: HistoryType): integer; begin if history <> nil then if isMapsEqual(history^.map, map) then getCount := getCount(map, history^.previous) + 1 else getCount := getCount(map, history^.previous) else getCount := 0 end; { ## History input/output } procedure saveHistory(history: HistoryType; var savefile: text); procedure subSaveHistory(history: HistoryType); begin if history <> nil then begin subSaveHistory(history^.previous); saveMap(history^.map, savefile); saveMove(history^.move, savefile) end end; begin subSaveHistory(history); writeln(savefile) end; procedure loadHistory(var history: HistoryType; var loadfile: text); var map: FullMap; move: MoveType; begin deleteHistory(history); while not eoln(loadfile) do begin loadMap(map, loadfile); loadMove(move, loadfile); pushState(map, move, history) end; readln(loadfile) end; { ### General } { procedure formDescription(var description: FullDescription); type Moves = ^MovesElement; MovesElement = record code: string; move: MoveDescription end; var rules_file: text; procedure readNext; var com: string; m_danger, m_fly, m_attack, m_step: MoveDescription; list: Moves; begin list := nil; new(m_danger); formMoveDecription(m_danger, danger, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); add(list, 'danger', m_danger); new(m_fly); formMoveDecription(m_fly, fly, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); add(list, 'fly', m_fly); new(m_attack); formMoveDecription(m_attack, attack, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); add(list, 'attack', m_attack); new(m_step); formMoveDecription(m_step, step, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); add(list, 'step', m_step); ok := false; repeat readln(rules_file, com); if extractWord(deleteAll(com, '#'), 1, ' ') = 'START' then begin code := extractWord(deleteAll(com, '#'), 2, ' '); move_area := decodeArea(extractWord(deleteAll(com, '#'), 3, ' ')); move_area := decodeArea(extractWord(deleteAll(com, '#'), 4, ' ')); repeat readln(rules_file, com); if extractWord(deleteAll(com, '#'), 1, ' ') = 'START' then begin code := extractWord(deleteAll(com, '#'), 2, ' '); move_area := decodeArea(extractWord(deleteAll(com, '#'), 3, ' ')); move_area := decodeArea(extractWord(deleteAll(com, '#'), 4, ' ')); until ok end until ok end; begin assign(rules_file, 'rules'); reset(rules_file); while not eof(rules_file) do readNext end; } procedure add(move: MoveDescription; var moves: MoveList); var p: MoveList; begin new(p); p^.next := moves; p^.this := move; moves := p end; procedure deleteMoves(var list: MoveList); begin if list <> nil then begin deleteMoves(list^.next); dispose(list^.this); dispose(list); list := nil end end; procedure formDescription(var description: FullDescription; var moves: MoveList); var m_danger, m_attack, m_fly, top_danger, top_attack, top_fly, top_step, left_fly, left_attack, left_step, left_top_fly, left_bottom_fly, bottom_danger, bottom_attack, bottom_fly, bottom_step, right_fly, right_attack, right_step, right_top_fly, right_bottom_fly: MoveDescription; procedure formMoveDecription(var md: MoveDescription; line: LineType; l7, l0, l1, l6, l2, l5, l4, l3, o7, o0, o1, o6, o2, o5, o4, o3: MoveDescription); begin md^.this := line; md^.lines[0] := l0; md^.lines[1] := l1; md^.lines[2] := l2; md^.lines[3] := l3; md^.lines[4] := l4; md^.lines[5] := l5; md^.lines[6] := l6; md^.lines[7] := l7; md^.occupied[0] := o0; md^.occupied[1] := o1; md^.occupied[2] := o2; md^.occupied[3] := o3; md^.occupied[4] := o4; md^.occupied[5] := o5; md^.occupied[6] := o6; md^.occupied[7] := o7 end; begin deleteMoves(moves); new(m_danger); add(m_danger, moves); formMoveDecription(m_danger, danger, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); new(m_fly); add(m_fly, moves); formMoveDecription(m_fly, fly, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); new(m_attack); add(m_attack, moves); formMoveDecription(m_attack, attack, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil); description[0].move_area := field; description[0].check_area := field; description[0].move := m_fly; description[1].move_area := fortress; description[1].check_area := field; new(top_danger); add(top_danger, moves); formMoveDecription(top_danger, danger, nil, top_danger, nil, nil, nil, nil, nil, nil, nil, m_danger, nil, nil, nil, nil, nil, nil); new(top_attack); add(top_attack, moves); formMoveDecription(top_attack, attack, nil, top_danger, nil, nil, nil, nil, nil, nil, nil, m_danger, nil, nil, nil, nil, nil, nil); new(bottom_danger); add(bottom_danger, moves); formMoveDecription(bottom_danger, danger, nil, nil, nil, nil, nil, nil, bottom_danger, nil, nil, nil, nil, nil, nil, nil, m_danger, nil); new(bottom_attack); add(bottom_attack, moves); formMoveDecription(bottom_attack, attack, nil, nil, nil, nil, nil, nil, bottom_danger, nil, nil, nil, nil, nil, nil, nil, m_danger, nil); new(description[1].move); add(description[1].move, moves); formMoveDecription(description[1].move, fly, nil, top_attack, nil, m_attack, m_attack, nil, bottom_attack, nil, nil, m_attack, nil, m_attack, m_attack, nil, m_attack, nil); description[2].move_area := fortress; description[2].check_area := fortress; new(description[2].move); add(description[2].move, moves); formMoveDecription(description[2].move, fly, m_attack, nil, m_attack, nil, nil, m_attack, nil, m_attack, m_attack, nil, m_attack, nil, nil, m_attack, nil, m_attack); description[3].move_area := bank; description[3].check_area := bank; new(left_top_fly); add(left_top_fly, moves); formMoveDecription(left_top_fly, fly, m_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil, nil, nil, nil); new(right_top_fly); add(right_top_fly, moves); formMoveDecription(right_top_fly, fly, nil, nil, m_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil, nil); new(left_bottom_fly); add(left_bottom_fly, moves); formMoveDecription(left_bottom_fly, fly, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil); new(right_bottom_fly); add(right_bottom_fly, moves); formMoveDecription(right_bottom_fly, fly, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil, nil, nil, nil, m_attack); new(description[3].move); add(description[3].move, moves); formMoveDecription(description[3].move, fly, left_top_fly, nil, right_top_fly, nil, nil, left_bottom_fly, nil, right_bottom_fly, nil, nil, nil, nil, nil, nil, nil, nil); description[4].move_area := field; description[4].check_area := field; new(top_fly); add(top_fly, moves); formMoveDecription(top_fly, fly, m_attack, nil, m_attack, nil, nil, nil, nil, nil, m_attack, nil, m_attack, nil, nil, nil, nil, nil); new(left_fly); add(left_fly, moves); formMoveDecription(left_fly, fly, m_attack, nil, nil, nil, nil, m_attack, nil, nil, m_attack, nil, nil, nil, nil, m_attack, nil, nil); new(right_fly); add(right_fly, moves); formMoveDecription(right_fly, fly, nil, nil, m_attack, nil, nil, nil, nil, m_attack, nil, nil, m_attack, nil, nil, nil, nil, m_attack); new(bottom_fly); add(bottom_fly, moves); formMoveDecription(bottom_fly, fly, nil, nil, nil, nil, nil, m_attack, nil, m_attack, nil, nil, nil, nil, nil, m_attack, nil, m_attack); new(description[4].move); add(description[4].move, moves); formMoveDecription(description[4].move, fly, nil, top_fly, nil, left_fly, right_fly, nil, bottom_fly, nil, nil, nil, nil, nil, nil, nil, nil, nil); description[5].move_area := field; description[5].check_area := field; new(top_attack); add(top_attack, moves); formMoveDecription(top_attack, attack, nil, top_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil, nil, nil); new(left_attack); add(left_attack, moves); formMoveDecription(left_attack, attack, nil, nil, nil, left_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil); new(right_attack); add(right_attack, moves); formMoveDecription(right_attack, attack, nil, nil, nil, nil, right_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil); new(bottom_attack); add(bottom_attack, moves); formMoveDecription(bottom_attack, attack, nil, nil, nil, nil, nil, nil, bottom_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil); new(description[5].move); add(description[5].move, moves); formMoveDecription(description[5].move, fly, nil, top_attack, nil, left_attack, right_attack, nil, bottom_attack, nil, nil, m_attack, nil, m_attack, m_attack, nil, m_attack, nil); description[6].move_area := field; description[6].check_area := field; new(top_fly); add(top_fly, moves); formMoveDecription(top_fly, fly, nil, top_fly, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil, nil, nil); new(left_fly); add(left_fly, moves); formMoveDecription(left_fly, fly, nil, nil, nil, left_fly, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil); new(right_fly); add(right_fly, moves); formMoveDecription(right_fly, fly, nil, nil, nil, nil, right_fly, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil); new(bottom_fly); add(bottom_fly, moves); formMoveDecription(bottom_fly, fly, nil, nil, nil, nil, nil, nil, bottom_fly, nil, nil, nil, nil, nil, nil, nil, m_attack, nil); new(top_step); add(top_step, moves); formMoveDecription(top_step, step, nil, top_step, nil, nil, nil, nil, nil, nil, nil, top_fly, nil, nil, nil, nil, nil, nil); new(left_step); add(left_step, moves); formMoveDecription(left_step, step, nil, nil, nil, left_step, nil, nil, nil, nil, nil, nil, nil, left_fly, nil, nil, nil, nil); new(right_step); add(right_step, moves); formMoveDecription(right_step, step, nil, nil, nil, nil, right_step, nil, nil, nil, nil, nil, nil, nil, right_fly, nil, nil, nil); new(bottom_step); add(bottom_step, moves); formMoveDecription(bottom_step, step, nil, nil, nil, nil, nil, nil, bottom_step, nil, nil, nil, nil, nil, nil, nil, bottom_fly, nil); new(description[6].move); add(description[6].move, moves); formMoveDecription(description[6].move, fly, nil, top_step, nil, left_step, right_step, nil, bottom_step, nil, nil, top_fly, nil, left_fly, right_fly, nil, bottom_fly, nil); description[7].move_area := field; description[7].check_area := field; new(description[7].move); add(description[7].move, moves); formMoveDecription(description[7].move, fly, nil, m_attack, nil, nil, nil, nil, nil, nil, nil, m_attack, nil, nil, nil, nil, nil, nil); description[8].move_area := field; description[8].check_area := field; new(description[8].move); add(description[8].move, moves); formMoveDecription(description[8].move, fly, nil, m_attack, nil, m_attack, m_attack, nil, nil, nil, nil, m_attack, nil, m_attack, m_attack, nil, nil, nil); end; procedure save(map: FullMap; history: HistoryType; color: ColorType; filename: string); var savefile: text; begin assign(savefile, filename); rewrite(savefile); saveHistory(history, savefile); saveMap(map, savefile); write(savefile, encodeColor(color)); close(savefile) end; procedure load(var map: FullMap; var history: HistoryType; var color: ColorType; filename: string); var loadfile: text; c: char; begin assign(loadfile, filename); reset(loadfile); loadHistory(history, loadfile); loadMap(map, loadfile); read(loadfile, c); color := decodeColor(c); close(loadfile) end; function makeMove(var map: FullMap; var history: HistoryType; color: ColorType; notation: NotationType; description: FullDescription; command: string): boolean; type BoolMap = array[0..9, 'A'..'I'] of boolean; var move: MoveType; i, y: integer; j, x: char; move_map: BoolMap; check_map: BoolMap; buf_map: FullMap; function decodeMove: MoveType; function decodeEuropean: MoveType; var move: MoveType; begin if ord(command[0]) <> 6 then begin printError('Wrong format of move command.'); makeNoneMove(move); decodeEuropean := move; exit end; with move do begin { Decoding } start_x := command[2]; final_x := command[5]; start_y := ord(command[3]) - ord('0'); final_y := ord(command[6]) - ord('0'); if not isField(start_x, start_y) then begin printError('Start position is not in field.'); makeNoneMove(move); decodeEuropean := move; exit end; if not isField(final_x, final_y) then begin printError('Final position is not in field.'); makeNoneMove(move); decodeEuropean := move; exit end; start_piece := map.piece[start_y][start_x]; final_piece := map.piece[final_y][final_x]; if start_piece <> decodePiece(command[1]) then begin printError('Wrong piece type.'); makeNoneMove(move); decodeEuropean := move; exit end; start_color := map.color[start_y][start_x]; final_color := map.color[final_y][final_x]; if start_color <> color then begin printError('Wrong piece color.'); makeNoneMove(move); decodeEuropean := move; exit end; end; decodeEuropean := move end; function decodeChinese: MoveType; var move: MoveType; function setByVertical(var move: MoveType; vertical: char; map: FullMap): boolean; var i: integer; ok: boolean; begin ok := false; if move.start_color = red then move.start_x := chr(ord('A') + ord(vertical) - ord('0') - 1) else move.start_x := chr(ord('I') - ord(vertical) + ord('0') + 1); with move do for i := 0 to 9 do begin if map.color[i, start_x] = start_color then if map.piece[i, start_x] = start_piece then begin if not ok then begin ok := true; start_y := i end else begin setByVertical := false; exit end end; end; setByVertical := ok end; function setByDistance(var move: MoveType; nearest: boolean; map: FullMap): boolean; var j: char; i: integer; ok: boolean; begin ok := false; with move do if (nearest and (start_color = red)) or ((not nearest) and (start_color = black)) then for i := 0 to 9 do begin if ok then break; for j := 'A' to 'I' do if map.color[i, j] = start_color then if map.piece[i, j] = start_piece then begin if not ok then begin ok := true; start_y := i; start_x := j end else begin setByDistance := false; exit end end end else for i := 9 downto 0 do begin if ok then break; for j := 'A' to 'I' do if map.color[i, j] = start_color then if map.piece[i, j] = start_piece then begin if not ok then begin ok := true; start_y := i; start_x := j end else begin setByDistance := false; exit end end end; setByDistance := ok end; begin if ord(command[0]) <> 4 then begin printError('Wrong format of move command.'); makeNoneMove(move); decodeChinese := move; exit end; with move do begin { Decoding } start_color := color; start_piece := decodePiece(command[1]); case command[2] of '1'..'9': if not setByVertical(move, command[2], map) then begin printError('Can not determine piece by column.'); makeNoneMove(move); decodeChinese := move; exit end; '^': if not setByDistance(move, false, map) then begin printError('Can not determine farest piece.'); makeNoneMove(move); decodeChinese := move; exit end; 'v': if not setByDistance(move, true, map) then begin printError('Can not determine nearest piece.'); makeNoneMove(move); decodeChinese := move; exit end; else begin printError('Wrong position symbol.'); makeNoneMove(move); decodeChinese := move; exit end end; case start_piece of general, chariot, cannon, soldier: case command[3] of '+': begin final_x := start_x; if start_color = red then final_y := start_y + ord(command[4]) - ord('0') else final_y := start_y - ord(command[4]) + ord('0') end; '=': begin final_y := start_y; if start_color = red then final_x := chr(ord('A') + ord(command[4]) - ord('0') - 1) else final_x := chr(ord('I') - ord(command[4]) + ord('0') + 1) end; '-': begin final_x := start_x; if start_color = red then final_y := start_y - ord(command[4]) + ord('0') else final_y := start_y + ord(command[4]) - ord('0') end; else begin printError('Wrong move mark.'); makeNoneMove(move); decodeChinese := move; exit end end; advisor, elephant: case command[3] of '+': if start_color = red then begin final_x := chr(ord('A') + ord(command[4]) - ord('0') - 1); final_y := start_y + abs(ord(final_x) - ord(start_x)) end else begin final_x := chr(ord('I') - ord(command[4]) + ord('0') + 1); final_y := start_y - abs(ord(final_x) - ord(start_x)) end; '-': if start_color = red then begin final_x := chr(ord('A') + ord(command[4]) - ord('0') - 1); final_y := start_y - abs(ord(final_x) - ord(start_x)) end else begin final_x := chr(ord('I') - ord(command[4]) + ord('0') + 1); final_y := start_y + abs(ord(final_x) - ord(start_x)) end; else begin printError('Wrong move mark.'); makeNoneMove(move); decodeChinese := move; exit end end; horse: case command[3] of '+': if start_color = red then begin final_x := chr(ord('A') + ord(command[4]) - ord('0') - 1); final_y := start_y + 3 - abs(ord(final_x) - ord(start_x)) end else begin final_x := chr(ord('I') - ord(command[4]) + ord('0') + 1); final_y := start_y - 3 + abs(ord(final_x) - ord(start_x)) end; '-': if start_color = red then begin final_x := chr(ord('A') + ord(command[4]) - ord('0') - 1); final_y := start_y - 3 + abs(ord(final_x) - ord(start_x)) end else begin final_x := chr(ord('I') - ord(command[4]) + ord('0') + 1); final_y := start_y + 3 - abs(ord(final_x) - ord(start_x)) end; else begin printError('Wrong move mark.'); makeNoneMove(move); decodeChinese := move; exit end end end; if not isField(final_x, final_y) then begin printError('Final position is not in field.'); makeNoneMove(move); decodeChinese := move; exit end; final_piece := map.piece[final_y][final_x]; final_color := map.color[final_y][final_x] end; decodeChinese := move end; begin case notation of european: decodeMove := decodeEuropean; chinese: decodeMove := decodeChinese end end; procedure formMaps(var move_map, check_map: BoolMap; map: FullMap; description: MoveDescription; move_area, check_area: AreaType; color: ColorType; x: char; y: integer); var i: integer; tx: char; ty: integer; begin if description <> nil then begin if isArea(move_area, color, x, y) then if description^.this in [step, attack] then move_map[y, x] := true; if isArea(check_area, color, x, y) then if description^.this in [danger, attack] then check_map[y, x] := true; tx := x; ty := y; for i := 0 to 7 do begin x := tx; y := ty; shift(x, y, i, color); if isArea(move_area, color, x, y) or isArea(check_area, color, x, y) then begin if map.color[y, x] <> c_none then formMaps(move_map, check_map, map, description^.occupied[i], move_area, check_area, color, x, y) else formMaps(move_map, check_map, map, description^.lines[i], move_area, check_area, color, x, y) end end end end; procedure findGeneral(map: FullMap; color: ColorType; var x: char; var y: integer); var i, d: integer; j: char; begin d := 0; for j := 'D' to 'F' do begin if color = black then d := 7; for i := d to d + 2 do if (map.color[i, j] = color) and (map.piece[i, j] = general) then begin x := j; y := i; exit end end end; function canEscape(map: FullMap; color: ColorType): boolean; var i, p, y, u: integer; j, t, x, v: char; buf_map: FullMap; check_map, a_map, b_map, move_map: BoolMap; begin canEscape := false; for i := 0 to 9 do for j := 'A' to 'I' do if map.color[i, j] = color then begin for p := 0 to 9 do for t := 'A' to 'I' do begin move_map[p, t] := false; check_map[p, t] := false end; formMaps(move_map, check_map, map, description[ord(map.piece[i, j])].move, description[ord(map.piece[i, j])].move_area, description[ord(map.piece[i, j])].check_area, color, j, i); for p := 0 to 9 do for t := 'A' to 'I' do if move_map[p, t] and ((map.color[p, t] = c_none) or (check_map[p, t] and (map.color[p, t] <> color))) then begin buf_map := map; buf_map.color[i, j] := c_none; buf_map.piece[i, j] := p_none; buf_map.color[p, t] := map.color[i, j]; buf_map.piece[p, t] := map.piece[i, j]; for u := 0 to 9 do for v := 'A' to 'I' do a_map[u, v] := false; for u := 0 to 9 do for v := 'A' to 'I' do if buf_map.color[u, v] = invertColor(color) then formMaps(b_map, a_map, buf_map, description[ord(buf_map.piece[u, v])].move, description[ord(buf_map.piece[u, v])].move_area, description[ord(buf_map.piece[u, v])].check_area, invertColor(color), v, u); findGeneral(buf_map, color, x, y); if not a_map[y, x] then begin canEscape := true; exit end; end; end end; begin move := decodeMove; with move do begin if move.start_piece = p_none then begin makeMove := false; exit end; { Check move } if start_color <> color then begin printError('Wrong color.'); makeMove := false; exit end; if final_color = start_color then begin printError('You can not capture your pieces.'); makeMove := false; exit end; for i := 0 to 9 do for j := 'A' to 'I' do begin move_map[i, j] := false; check_map[i, j] := false end; if (start_piece = soldier) and not isBank(color, start_x, start_y) then formMaps(move_map, check_map, map, description[8].move, description[8].move_area, description[8].check_area, color, start_x, start_y) else formMaps(move_map, check_map, map, description[ord(start_piece)].move, description[ord(start_piece)].move_area, description[ord(start_piece)].check_area, color, start_x, start_y); if (not move_map[final_y, final_x]) or ((map.color[final_y, final_x] <> c_none) and (not check_map[final_y, final_x])) then begin printError('This piece can not move like that.'); makeMove := false; exit end; { Check mates } buf_map := map; buf_map.color[start_y, start_x] := c_none; buf_map.piece[start_y, start_x] := p_none; buf_map.color[final_y, final_x] := start_color; buf_map.piece[final_y, final_x] := start_piece; for i := 0 to 9 do for j := 'A' to 'I' do check_map[i, j] := false; for i := 0 to 9 do for j := 'A' to 'I' do if buf_map.color[i, j] = invertColor(color) then formMaps(move_map, check_map, buf_map, description[ord(buf_map.piece[i, j])].move, description[ord(buf_map.piece[i, j])].move_area, description[ord(buf_map.piece[i, j])].check_area, invertColor(color), j, i); findGeneral(buf_map, color, x, y); if check_map[y, x] then begin printError('You can not move under the check.'); makeMove := false; exit end; for i := 0 to 9 do for j := 'A' to 'I' do check_map[i, j] := false; for i := 0 to 9 do for j := 'A' to 'I' do if buf_map.color[i, j] = color then formMaps(move_map, check_map, buf_map, description[ord(buf_map.piece[i, j])].move, description[ord(buf_map.piece[i, j])].move_area, description[ord(buf_map.piece[i, j])].check_area, color, j, i); findGeneral(buf_map, invertColor(color), x, y); if check_map[y, x] then begin if not canEscape(buf_map, invertColor(color)) then begin writeln; writeln('#### ', getColorName(color), ' wins by MATE ####'); writeln; load(map, history, color, 'start'); printMap(map); printTurn(color); makeMove := false; exit end; writeln('# ', getColorName(invertColor(color)), ' in CHECK #') end else if not canEscape(buf_map, invertColor(color)) then begin writeln; writeln('#### ', getColorName(color), ' wins by PATE ####'); writeln; load(map, history, color, 'start'); printMap(map); printTurn(color); makeMove := false; exit end; if getCount(map, history) >= 4 then begin writeln; writeln('#### PERPETUAL CHECK ####'); writeln; load(map, history, color, 'start'); printMap(map); printTurn(color); makeMove := false; exit end; { Make move } pushState(map, move, history); map.color[start_y, start_x] := c_none; map.piece[start_y, start_x] := p_none; map.color[final_y, final_x] := start_color; map.piece[final_y, final_x] := start_piece; makeMove := true; end end; begin moves := nil; formDescription(description, moves); notation := european; autoprint := true; writeln('Welcome in Xiangqi game realization by AKVeresov!'); writeln('To show help write "help" command.'); load(map, history, color, 'start'); writeln('The game has began.'); printMap(map); printTurn(color); repeat inputCommand(command); case extractWord(1, command, ' ') of 'load': begin load(map, history, color, extractWord(2, command, ' ')); writeln('Game is loaded from "', extractWord(2, command, ' '), '" file.'); printMap(map); printTurn(color) end; 'save': begin save(map, history, color, extractWord(2, command, ' ')); writeln('Game is saved to "', extractWord(2, command, ' '), '" file.') end; 'move': if makeMove(map, history, color, notation, description, extractWord(2, command, ' ')) then begin if autoprint then printMap(map); color := invertColor(color); printTurn(color) end; 'restart': begin load(map, history, color, 'start'); writeln('The game has began.'); printMap(map); printTurn(color) end; 'test': begin load(map, history, color, 'test'); writeln('Test has began.'); printMap(map); printTurn(color) end; 'setNotation': begin changeNotation(notation, extractWord(2, command, ' ')); printNotation(notation) end; 'notation': printNotation(notation); 'print': printMap(map); 'turn': printTurn(color); 'autoprint': begin autoprint := not autoprint; case autoprint of false: writeln('Autoprint is off.'); true: writeln('Autoprint is on.') end end; 'help': printHelp; 'exit': break; else printError('Unknown command.') end until false; deleteHistory(history); deleteMoves(moves); writeln('Goodbue!') end.