/* Schach.rexx */

/*
	Dieses Skript fungiert als Mittler zwischen AHP4 und ChessMan.
	Es ermöglicht ein Schachspiel über das Übertragungsmedium Packet Radio.

	Folgendes Remote-Makro MUSS definiert werden:

	//MDEF //SCHACH //REXX Chess.ahp $p

	Ist dieses Makro nicht definiert, so funktioniert auch das Spiel nicht

	Zum Starten muß einfach nur //SCHACH eingegeben werden. Die Station, bei
	der Schach als erstes aufgerufen wird, beginnt und zieht mit der Farbe
	Weiß.

	Im Verzeichnis ahp4:pRexx muß sich das Programm ChessMan befinden.
*/

options results

parse arg port start_par

/* Feststellen, ob AHP läuft */

if ~show("p", "rexx_AHP") then do
  say "AHP läuft nicht!"
  exit 10
end

if port = "" then do
  say "Syntax:"
  say "rx Schach.rexx <port> [init]"
  exit 0
end

start_par = strip(start_par)

if start_par = "Init" then do
  erststart = 0
end
else do
  erststart = 1
end

/* Diesen ARexx-Portnamen soll ChessMan verwenden */

chessrexx = "ChessMan."||port
spiel_vorbei = 0

/* Hier kommt der Aufruf des Schach-Programmes ChessMan. */

if show("p", chessrexx) then do
  address value chessrexx
  'resettable'
end
else do
  address command
  call pragma("DIRECTORY", "ahp4:pRexx")
  "run >NIL: ahp4:pRexx/ChessMan PORT "||chessrexx||" OFFX 10 OFFY 10"
end

/*	Für den Start des Schachprogramms bei der anderen Station sorgen */

address 'rexx_AHP'

say "Eigenes Rufzeichen ermitteln"

'tncparam '||port||' I'
mycall = result

say "AHP-Portdaten ändern (Remote und Prompt abschalten)"

'portdata '||port||' remote set 0'
'portdata '||port||' prompt set 0'

say "Bei Erststart auf Start-Msg warten..."

if erststart then do
  address value chessrexx

  'settitle Auf Start-Msg warten...'

  address 'rexx_AHP'

  'transmit '||port||' text //Schach Init'

  'textwait '||port||' reset'
  'textwait '||port||' timeout off'
  'textwait '||port||' add Schach wird gestartet!'
  'textwait '||port||' wait'

  if result ~= "SCHACH WIRD GESTARTET!" then do
    signal value cleanexit
  end
end

say "abc = ..."

abc = "abcdefgh"

/*
	Startup-Prozeduren durchführen
	zuerst die Startup-Prozedur für den Erststarter:
*/

say "Erststart-Routine durchführen (natürlich nur bei Erststart)"
say "Erststart = "||erststart

if erststart then do
  address 'rexx_AHP'
  'msgwindow . Zum Start König Ihrer Farbe anklicken!'||'0a'X||'Vorher kann ein altes Spiel geladen werden!'

  address value chessrexx
  'settitle Wähle den König Deiner Farbe!'

  /* Warten, bis ein König angeklickt wurde */

  do forever
    'select field'
    feld = result

    'getfield '||feld
    hier_farbe = word(result, 1)

    if hier_farbe = "BLACK" then do
      dort_farbe = "WHITE"
    end
    else do
      dort_farbe = "BLACK"
    end

    figur = word(result, 2)

    if figur = "KING" then break
  end

  /*
     Nun müssen die Init-Strings zusammengebastelt werden
     Das Spielfeld wird nach Figuren durchsucht. Dabei werden
     bei jeder gefundenen Figur Texte an die jeweiligen Init-Strings
     angehängt.
  */

  black_init = "initblack"
  white_init = "initwhite"

  do a = 1 to 8
    c = substr(abc, a, 1)

    do b = 1 to 8
      feld = c||b
      'getfield 'feld

      farbe = word(result, 1)
      figur = word(result, 2)

      if farbe ~= "EMPTY" then do
        text = AssembleInit(figur, feld)

        if farbe = "WHITE" then do
          white_init = white_init||" "||text
        end
        else do
          black_init = black_init||" "||text
        end
      end
    end
  end

  /* Init-Texte aussenden */

  address 'rexx_AHP'

  'transmit '||port||' text '||white_init
  'transmit '||port||' text '||black_init

  /* Farbe ermitteln, die am Zug ist */

  address value chessrexx

  'getactualplayer'

  dranfarbe = result

  address 'rexx_AHP'

  'transmit '||port||' text color '||hier_farbe||' 'dranfarbe
end

/*
	Nun die Startup-Prozedur für den Zweitstarter
*/

say "Zweitstart-Routine kommt jetzt!"

if ~erststart then do
  address value chessrexx

  'settitle Initialisierung läuft...'

  /* Zuerst das Spielfeld löschen */

  do t=1 to 8
    u = substr(abc, t, 1)
    'clearfield '||u||'1'
    'clearfield '||u||'2'
    'clearfield '||u||'7'
    'clearfield '||u||'8'
  end

  /*
	  Folgende 3 Zeilen werden vom anderen Programm übermittelt:

	  initwhite a2 b2 c2 d2 e2 f2 g2 h2 Ta1 Sb1 Lc1 Dd1 Ke1 Lf1 Sg1 Th1
     initblack a2 b2 c2 d2 e2 f2 g2 h2 Ta1 Sb1 Lc1 Dd1 Ke1 Lf1 Sg1 Th1
     color <dort_farbe> <start_farbe>

  */

  address 'rexx_AHP'

  'textwait '||port||' reset'
  'textwait '||port||' timeout off'
  'textwait '||port||' add initwhite'
  'textwait '||port||' waitlock'

  if result ~= "INITWHITE" then do
    signal value cleanexit
  end

  'getlastline '||port

  zeile = result

  /* Weiße Figuren setzen */

  do f=2 to 18
    figur = word(zeile, f)

    if figur = "" then break

    call SetFigur(figur, "WHITE")
  end

  'textwait '||port||' reset'
  'textwait '||port||' timeout off'
  'textwait '||port||' add initblack'
  'textwait '||port||' waitlock'

  if result ~= "INITBLACK" then do
    signal value cleanexit
  end

  'getlastline '||port

  zeile = result

  /* Schwarze Figuren setzen */

  do f=2 to 18
    figur = word(zeile, f)

    if figur = "" then break

    call SetFigur(figur, "BLACK")
  end

  'textwait '||port||' reset'
  'textwait '||port||' timeout off'
  'textwait '||port||' add color'
  'textwait '||port||' waitlock'

  if result ~= "COLOR" then do
    signal value cleanexit
  end

  'getlastline '||port
  zeile = result

  dort_farbe = word(zeile, 2)

  if dort_farbe = "BLACK" then do
    hier_farbe = "WHITE"
  end
  else do
    hier_farbe = "BLACK"
  end

  dranfarbe = word(zeile, 3)

  address value chessrexx

  'setactualplayer '||dranfarbe
end

/* Namen initialisieren */

address 'rexx_AHP'

'call '||port

rufzeichen = result
gewonnen_hier = 0
gewonnen_dort = 0
disconflag    = 0

mz = 2
sz = 4

if hier_farbe = "BLACK" then do
  mz = 4
  sz = 2
end


address value chessrexx

'setname '||hier_farbe||' '||mycall
'setname '||dort_farbe||' '||rufzeichen

do forever
  /* Sind wir dran mit einem Schachzug? */

  if hier_farbe = dranfarbe then do

    /* Ja ! */

    if ~show("p", chessrexx) then do
      signal value cleanexit
    end

    address value chessrexx

    do forever

      'settitle Figur wählen'

      'select moveable '||hier_farbe
      start_feld = result

      if start_feld = "cancelled" then do
        signal value cleanexit
      end

      'settitle Wohin soll gesetzt werden?'

      'select move '||start_feld
      ziel_feld = result

      if ziel_feld = "cancelled" then do
        signal value cleanexit
      end

      if ziel_feld ~= "EXIT" then break
    end

    'settitle Figur wird gezogen'
    'move '||start_feld||' '||ziel_feld

    'getactualplayer'
    dranfarbe = result

    address 'rexx_AHP'

    'transmit '||port||' text move '||start_feld||' '||ziel_feld

    address value chessrexx

    'getstatus'

    zustand = result

    if word(zustand, sz) = "MATE" then do
      spiel_vorbei  = 1
      gewonnen_hier = 1
      signal value cleanexit
    end

    if word(zustand, mz) = "MATE" then do
      gewonnen_dort = 1
      spiel_vorbei  = 1
      signal value cleanexit
    end
  end

  if dort_farbe = dranfarbe then do
    if ~show("p", chessrexx) then do
      signal value cleanexit
    end

    address value chessrexx

    'settitle '||rufzeichen||' überlegt.'

    address 'rexx_AHP'

    'textwait '||port||' reset'
    'textwait '||port||' timeout off'
    'textwait '||port||' add move'
    'textwait '||port||' add cancelled'
    'textwait '||port||' waitlock'

    if result ~= "MOVE" then do
      signal value cleanexit
    end

    'getlastline '||port

    zeile = result

    if ~show("p", chessrexx) then do
      signal value cleanexit
    end

    address value chessrexx

    'settitle '||rufzeichen||' zieht'

    'move '||word(zeile, 2)||' '||word(zeile, 3)

    'getactualplayer'
    dranfarbe = result

    'getstatus'

    zustand = result

    if word(zustand, sz) = "MATE" then do
      spiel_vorbei  = 1
      gewonnen_hier = 1
      signal value cleanexit
    end

    if word(zustand, mz) = "MATE" then do
      spiel_vorbei  = 1
      gewonnen_dort = 1
      signal value cleanexit
    end
  end
end

exit 0

AssembleInit: procedure
parse arg figur, feld

if figur = "PAWN" then do
  antwort = feld
end
else if figur = "CASTLE" then do
  antwort = "T"||feld
end
else if figur = "KNIGHT" then do
  antwort = "S"||feld
end
else if figur = "BISHOP" then do
  antwort = "L"||feld
end
else if figur = "LADY" then do
  antwort = "D"||feld
end
else if figur = "KING" then do
  antwort = "K"||feld
end

return antwort

SetFigur: procedure expose chessrexx

parse arg figur, farbe

feld = right(figur, 2)
kennung = left(figur, 1)
antwort = ""

if kennung = "T" then do
  antwort = "CASTLE"
end
else if kennung = "L" then do
  antwort = "BISHOP"
end
else if kennung = "S" then do
  antwort = "KNIGHT"
end
else if kennung = "D" then do
  antwort = "LADY"
end
else if kennung = "K" then do
  antwort = "KING"
end
else do
  antwort = "PAWN"
end

/* Nun die Figur setzen */

address value chessrexx

'setfield '||feld||' '||farbe||' 'antwort

return

cleanexit:

if show("p", "rexx_AHP") then do
  address 'rexx_AHP'

  if ~spiel_vorbei then do
    'transmit '||port||' text cancelled'
  end

  'portdata '||port||' remote set 1'
  'portdata '||port||' prompt set 1'
  'buffer lock '||port||' set 0'
end

if show("p", chessrexx) then do
  address value chessrexx

  if ~spiel_vorbei then do
    'quit'
  end
  else do
    if gewonnen_hier then do
      'settitle '||rufzeichen||' ist Schach-Matt!'
    end

    if gewonnen_dort then do
      'settitle Du bist Schach-Matt!'
    end
  end
end

exit 0