hedgewars/runhelper.dpr
changeset 1 30f2d1037d5d
child 4 bcbd7adb4e4b
equal deleted inserted replaced
0:475c0f2f9d17 1:30f2d1037d5d
       
     1 (*
       
     2  * Hedgewars, a worms-like game
       
     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
       
     4  *
       
     5  * Distributed under the terms of the BSD-modified licence:
       
     6  *
       
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
       
     8  * of this software and associated documentation files (the "Software"), to deal
       
     9  * with the Software without restriction, including without limitation the
       
    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
       
    11  * sell copies of the Software, and to permit persons to whom the Software is
       
    12  * furnished to do so, subject to the following conditions:
       
    13  *
       
    14  * 1. Redistributions of source code must retain the above copyright notice,
       
    15  *    this list of conditions and the following disclaimer.
       
    16  * 2. Redistributions in binary form must reproduce the above copyright notice,
       
    17  *    this list of conditions and the following disclaimer in the documentation
       
    18  *    and/or other materials provided with the distribution.
       
    19  * 3. The name of the author may not be used to endorse or promote products
       
    20  *    derived from this software without specific prior written permission.
       
    21  *
       
    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
       
    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
       
    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
       
    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
       
    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
       
    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
       
    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
       
    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
       
    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
       
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
       
    32  *)
       
    33 
       
    34 program runhelper;
       
    35 {$APPTYPE CONSOLE}
       
    36 {$J+}
       
    37 uses SDLh;
       
    38 var servsock, clsock: PTCPSocket;
       
    39     ip: TIPAddress;
       
    40     event: TSDL_Event;
       
    41 
       
    42 procedure Send(s: shortstring);
       
    43 begin
       
    44 SDLNet_TCP_Send(clsock, @s, succ(byte(s[0])))
       
    45 end;
       
    46 
       
    47 procedure SendConfig;
       
    48 begin
       
    49 Send('TL');
       
    50 Send('eaddteam');
       
    51 Send('ename team "C0CuCKAzZz"');
       
    52 Send('ename hh0 "Йожык"');
       
    53 Send('ename hh1 "Ёжик"');
       
    54 Send('ename hh2 "Ёжык"');
       
    55 Send('ename hh3 "Йожик"');
       
    56 Send('ename hh4 "Ёжик без ножек"');
       
    57 Send('ename hh5 "Just hedgehog"');
       
    58 Send('ename hh6 "Ёжик без головы"');
       
    59 Send('ename hh7 "Валасатый йож"');
       
    60 Send('ebind left  "+left"');
       
    61 Send('ebind right "+right"');
       
    62 Send('ebind up    "+up"');
       
    63 Send('ebind down  "+down"');
       
    64 Send('ebind F1  "slot 1"');
       
    65 Send('ebind F2  "slot 2"');
       
    66 Send('ebind F3  "slot 3"');
       
    67 Send('ebind F4  "slot 4"');
       
    68 Send('ebind F5  "slot 5"');
       
    69 Send('ebind F6  "slot 6"');
       
    70 Send('ebind F7  "slot 7"');
       
    71 Send('ebind F8  "slot 8"');
       
    72 Send('ebind F10 "quit"');
       
    73 Send('ebind F11 "capture"');
       
    74 Send('ebind space     "+attack"');
       
    75 Send('ebind return    "ljump"');
       
    76 Send('ebind backspace "hjump"');
       
    77 Send('ebind tab       "switch"');
       
    78 Send('ebind 1 "timer 1"');
       
    79 Send('ebind 2 "timer 2"');
       
    80 Send('ebind 3 "timer 3"');
       
    81 Send('ebind 4 "timer 4"');
       
    82 Send('ebind 5 "timer 5"');
       
    83 Send('ebind mousel "put"');
       
    84 Send('egrave "coffin"');
       
    85 Send('ecolor 65535');
       
    86 Send('eadd hh0 0');
       
    87 Send('eadd hh1 0');
       
    88 Send('eadd hh2 0');
       
    89 Send('eadd hh3 0');
       
    90 Send('eaddteam');
       
    91 Send('ename team "-= ЕЖЫ =-"');
       
    92 Send('ename hh0 "Маленький"');
       
    93 Send('ename hh1 "Удаленький"');
       
    94 Send('ename hh2 "Игольчатый"');
       
    95 Send('ename hh3 "Стреляный"');
       
    96 Send('ename hh4 "Ежиха"');
       
    97 Send('ename hh5 "Ежонок"');
       
    98 Send('ename hh6 "Инфернальный"');
       
    99 Send('ename hh7 "X"');
       
   100 Send('egrave Bone');
       
   101 Send('ecolor 16776960');
       
   102 Send('eadd hh0 1');
       
   103 Send('eadd hh1 1');
       
   104 Send('eadd hh2 1');
       
   105 Send('eadd hh3 1');
       
   106 end;
       
   107 
       
   108 procedure ParseCmd(s: shortstring);
       
   109 begin
       
   110 case s[1] of
       
   111      '?': Send('!');
       
   112      'C': SendConfig;
       
   113      end;
       
   114 end;
       
   115 
       
   116 procedure DoIt;
       
   117 const ss: string = '';
       
   118 var s: shortstring;
       
   119     i: integer;
       
   120 begin
       
   121 i:= SDLNet_TCP_Recv(clsock, @s[1], 255);
       
   122 if i = -2  then
       
   123    begin
       
   124    SDLNet_TCP_Close(clsock);
       
   125    clsock:= nil;
       
   126    ss:= '';
       
   127    exit
       
   128    end;
       
   129 byte(s[0]):= i;
       
   130 ss:= ss + s;
       
   131 while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
       
   132       begin
       
   133       s:= copy(ss, 2, byte(ss[1]));
       
   134       Delete(ss, 1, Succ(byte(ss[1])));
       
   135       ParseCmd(s)
       
   136       end;
       
   137 end;
       
   138 
       
   139 begin
       
   140 WriteLn('run hw 640 480 avematan 46631 (CVSKGIHSVHX) 1');
       
   141 SDL_Init(0);
       
   142 SDLNet_Init;
       
   143 ip.host:= 0;     
       
   144 ip.port:= $27B6;
       
   145 servsock:= SDLNet_TCP_Open(ip);
       
   146 repeat
       
   147   if clsock = nil then
       
   148      clsock:= SDLNet_TCP_Accept(servsock);
       
   149   if clsock <> nil then
       
   150      DoIt;
       
   151   SDL_PollEvent(@event);
       
   152 until event.type_ = SDL_QUITEV;
       
   153 SDLNet_Quit;
       
   154 SDL_Quit
       
   155 end.