home *** CD-ROM | disk | FTP | other *** search
/ The Best of Select: Games Special 11 / CD_1.iso / wingames / corewar / demowar.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-01  |  2KB  |  84 lines
  1. Program DemoWar;
  2. {$A+,B-,D+,F-,G+,I+,K+,L+,N-,P+,Q+,R+,S+,T+,V+,W+,X+,Y+}
  3. {$M 16384,8192}
  4. {(C) Barbara Tikart  Polarwolf Hard & Software, Erlenbach am Main}
  5.  
  6. Uses WinTypes, WinProcs, WinCrt, Strings, UseMars;
  7.  
  8. Var IP1, IP2, TMP: Integer;
  9.     IPCount: LongInt;
  10.     VM, H: TMarsHandle;
  11.     PRG1Name, PRG2Name, T: Array [0..255] Of Char;
  12.  
  13. Label ERROR, SIEG1, SIEG2, ENDE;
  14.  
  15. Begin
  16.   CmdShow := sw_ShowMaximized;
  17.   WriteLn ('*** CoreWar *** Demo der Schnittstelle zu MARS 1.0 *** (C) Polarwolf ***');
  18.   WriteLn;
  19.   Write ('Datei-Name von Programm 1:');
  20.   ReadLn (PRG1Name);
  21.   Write ('Datei-Name von Programm 2:');
  22.   ReadLn (PRG2Name);
  23.  
  24.   VM := CreateMarsVM (8000);
  25.   Randomize;
  26.  
  27.   If StrScan (PRG1Name, '.') = Nil Then StrCat (PRG1Name, '.RED');
  28.   LoadMarsObjCode (PRG1Name, H);
  29.   If H = 0 Then Goto ERROR;
  30.   IP1 := 0;
  31.   TMP := IP1;
  32.   LinkMarsPRG (VM, H, TMP); {Endadresse des Programms wird nicht ben÷tigt}
  33.   If TMP = IP1 Then Goto ERROR;
  34.   StrCopy (T, 'NAME');
  35.   If FindAttrInMarsObjCode (H, T, 254) Then StrCopy (PRG1Name, T);
  36.   DiscardMarsObjCode (H);
  37.  
  38.   If StrScan (PRG2Name, '.') = Nil Then StrCat (PRG2Name, '.RED');
  39.   LoadMarsObjCode (PRG2Name, H);
  40.   If H = 0 Then Goto ERROR;
  41.   IP2 := Random (6000) +1000;
  42.   TMP := IP2;
  43.   LinkMarsPRG (VM, H, TMP); {Endadresse des Programms wird nicht ben÷tigt}
  44.   If TMP = IP2 Then Goto ERROR;
  45.   StrCopy (T, 'NAME');
  46.   If FindAttrInMarsObjCode (H, T, 254) Then StrCopy (PRG2Name, T);
  47.   DiscardMarsObjCode (H);
  48.  
  49.   WriteLn ;
  50.   WriteLn ('Es tritt an: ', PRG1Name, ' gegen ', PRG2Name);
  51.  
  52.   IPCount := 0;
  53.   Repeat
  54.     ExecMarsCmd (VM, IP1, TMP); {Adresse der modifizierten Speicherstelle wird nicht ben÷tigt}
  55.     If IP1 = -1 Then Goto SIEG2;
  56.     ExecMarsCmd (VM, IP2, TMP); {s.o.}
  57.     If IP2 = -1 Then Goto SIEG1;
  58.     Inc (IPCount);
  59.     If IPCount Mod 1024 = 0 Then Write ('.'); {Damit der Benutzer nicht einschlΣft}
  60.   Until IPCount = 100000;  {1 1/4 Zeilen Punkte.... Das mu▀ reichen}
  61.   WriteLn;
  62.   WriteLn ('Der Kampf endet unentschieden.');
  63.   Goto ENDE;
  64.  
  65. SIEG1: WriteLn;
  66.   WriteLn (PRG1Name, ' hat den Kampf gewonnen.');
  67.   Goto ENDE;
  68.  
  69. SIEG2: WriteLn;
  70.   WriteLn (PRG2Name, ' hat den Kampf gewonnen.');
  71.   Goto ENDE;
  72.  
  73. ERROR: WriteLn;
  74.     WriteLn ('Leider ist ein Fehler aufgetreten.');
  75. ENDE: DestroyMarsVM (VM)
  76. End.
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.