Changeset 6 for trunk/Direct.pas


Ignore:
Timestamp:
Jan 7, 2017, 11:32:14 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Formated all project source files using Delphi formatter as original indentation and other formatting was really bad.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Direct.pas

    r2 r6  
    11{$INCLUDE switches}
    2 
    32unit Direct;
    43
    … …  
    1110
    1211const
    13 WM_GO = WM_USER;
    14 WM_CHANGECLIENT = WM_USER+1; // hand over control to other client
    15 WM_NEXTPLAYER = WM_USER+2; // active player's turn ended, next player
    16 WM_AIEXCEPTION = WM_USER+3;
     12  WM_GO = WM_USER;
     13  WM_CHANGECLIENT = WM_USER + 1; // hand over control to other client
     14  WM_NEXTPLAYER = WM_USER + 2; // active player's turn ended, next player
     15  WM_AIEXCEPTION = WM_USER + 3;
    1716
    1817type
    … …  
    3029    procedure SetInfo(x: string);
    3130    procedure SetState(x: integer);
    32     procedure OnGo(var m:TMessage); message WM_GO;
    33     procedure OnChangeClient(var m:TMessage); message WM_CHANGECLIENT;
    34     procedure OnNextPlayer(var m:TMessage); message WM_NEXTPLAYER;
    35     procedure OnAIException(var Msg:TMessage); message WM_AIEXCEPTION;
     31    procedure OnGo(var m: TMessage); message WM_GO;
     32    procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT;
     33    procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER;
     34    procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;
    3635  end;
    3736
    … …  
    4241
    4342uses
    44 ScreenTools,Protocol,GameServer,Start,LocalPlayer,NoTerm,Back,ShellAPI;
     43  ScreenTools, Protocol, GameServer, Start, LocalPlayer, NoTerm, Back, ShellAPI;
    4544
    4645{$R *.DFM}
    … …  
    4847procedure Notify(ID: integer);
    4948begin
    50 DirectDlg.DlgNotify(ID);
     49  DirectDlg.DlgNotify(ID);
    5150end;
    5251
    5352procedure TDirectDlg.DlgNotify(ID: integer);
    5453var
    55 hMem: Cardinal;
    56 p: pointer;
    57 s: string;
    58 begin
    59 case ID of
    60   ntInitLocalHuman:
     54  hMem: Cardinal;
     55  p: pointer;
     56  s: string;
     57begin
     58  case ID of
     59    ntInitLocalHuman:
     60      begin
     61        SetMainTextureByAge(-1);
     62        State := -1;
     63        Info := Phrases.Lookup('BUSY_MODLH');
     64        Show;
     65        Invalidate;
     66        Update;
     67      end;
     68    ntInitModule .. ntInitModule + maxBrain - 1:
     69      if visible then
     70      begin
     71        s := Format(Phrases.Lookup('BUSY_MOD'),
     72          [Brain[ID - ntInitModule].Name]);
     73        while BiColorTextWidth(Canvas, s) + 64 > ClientWidth do
     74          Delete(s, Length(s), 1);
     75        SetInfo(s);
     76      end;
     77    ntCreateWorld:
     78      if visible then
     79        SetInfo(Phrases.Lookup('BUSY_START'));
     80    ntInitPlayers:
     81      if visible then
     82        SetInfo(Phrases.Lookup('BUSY_INIT'));
     83    ntDeactivationMissing .. ntDeactivationMissing + nPl - 1:
     84      SimpleMessage(Format(Phrases.Lookup('MISSDEACT'),
     85        [ID - ntDeactivationMissing]));
     86    ntSetAIName .. ntSetAIName + nPl - 1:
     87      LocalPlayer.SetAIName(ID - ntSetAIName, NotifyMessage);
     88    ntException .. ntException + maxBrain - 1:
     89      PostMessage(Handle, WM_AIEXCEPTION, ID - ntException, 0);
     90    ntLoadBegin:
     91      begin
     92        Info := Phrases.Lookup('BUSY_LOAD');
     93        SetState(0);
     94      end;
     95    ntLoadState .. ntLoadState + 128:
     96      SetState(ID - ntLoadState);
     97    ntDLLError .. ntDLLError + 128:
     98      SimpleMessage(Format(Phrases.Lookup('DLLERROR'),
     99        [Brain[ID - ntDLLError].FileName]));
     100    ntAIError:
     101      SimpleMessage(Format(Phrases.Lookup('AIERROR'), [NotifyMessage]));
     102    ntClientError .. ntClientError + 128:
     103      SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),
     104        [Brain[ID - ntClientError].FileName]));
     105    ntEndInfo:
     106      begin
     107        Hide;
     108        background.Update
     109      end;
     110    ntLoadError:
     111      begin
     112        if OpenClipboard(Handle) then
     113        begin // copy file path to clipboard
     114          NotifyMessage := NotifyMessage + #0;
     115          hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,
     116            Length(NotifyMessage));
     117          p := GlobalLock(hMem);
     118          if p <> nil then
     119            move(NotifyMessage[1], p^, Length(NotifyMessage));
     120          GlobalUnlock(hMem);
     121          SetClipboardData(CF_TEXT, hMem);
     122          CloseClipboard;
     123        end;
     124        with MessgDlg do
     125        begin
     126          MessgText := Phrases.Lookup('LOADERROR');
     127          Kind := mkYesNo;
     128          ShowModal;
     129          if ModalResult = mrOK then
     130            ShellExecute(Handle, 'open',
     131              'http://c-evo.org/_sg/contact/cevobug.html', '', '',
     132              SW_SHOWNORMAL);
     133        end
     134      end;
     135    ntStartDone:
     136      if not Quick then
     137      begin
     138        StartDlg.Hide;
     139        background.Update
     140      end;
     141    ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
     142      if Quick then
     143        Close
     144      else
     145      begin
     146        if ID = ntStartGoRefresh then
     147          StartDlg.UpdateFormerGames
     148        else if ID = ntStartGoRefreshMaps then
     149          StartDlg.UpdateMaps;
     150        StartDlg.Show;
     151      end;
     152    ntChangeClient:
     153      PostMessage(Handle, WM_CHANGECLIENT, 0, 0);
     154    ntNextPlayer:
     155      PostMessage(Handle, WM_NEXTPLAYER, 0, 0);
     156    ntDeinitModule .. ntDeinitModule + maxBrain - 1:
     157      begin
     158        Info := Format(Phrases2.Lookup('BUSY_DEINIT'),
     159          [Brain[ID - ntDeinitModule].Name]);
     160        while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do
     161          Delete(Info, Length(Info), 1);
     162        SetMainTextureByAge(-1);
     163        State := -1;
     164        Show;
     165        Invalidate;
     166        Update;
     167      end;
     168    ntBackOn:
     169      begin
     170        background.Show;
     171        background.Update;
     172        sleep(50); // prevent flickering
     173      end;
     174    ntBackOff:
     175      background.Close;
     176  end;
     177end;
     178
     179procedure TDirectDlg.FormCreate(Sender: TObject);
     180begin
     181  Gone := false;
     182  State := -1;
     183  Info := '';
     184  GameServer.Init(Notify);
     185  Brain[bixNoTerm].Client := NoTerm.Client;
     186  Brain[bixSuper_Virtual].Client := nil;
     187  Brain[bixTerm].Client := LocalPlayer.Client;
     188  Brain[bixNoTerm].Name := Phrases.Lookup('AIT');
     189  Brain[bixSuper_Virtual].Name := Phrases.Lookup('SUPER');
     190  Brain[bixTerm].Name := Phrases.Lookup('HUMAN');
     191  Brain[bixRandom].Name := Phrases.Lookup('RANDOMAI');
     192  Canvas.Font.Assign(UniFont[ftNormal]);
     193  Canvas.Brush.Style := bsClear;
     194end;
     195
     196procedure TDirectDlg.FormShow(Sender: TObject);
     197begin
     198  if not Gone then
     199  begin
     200    PostMessage(Handle, WM_GO, 0, 0);
     201    Gone := true
     202  end
     203end;
     204
     205procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
     206begin
     207  GameServer.Done;
     208end;
     209
     210procedure TDirectDlg.OnGo(var m: TMessage);
     211var
     212  i: integer;
     213  s: string;
     214begin
     215  Hide;
     216  if nBrain = 3 then
     217  begin
     218    Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0);
     219    Close;
     220    exit
     221  end;
     222  Quick := false;
     223  if ParamCount > 0 then
     224  begin
     225    s := ParamStr(1);
     226    if (s[1] = '-') or (s[1] = '/') then
     227    begin // special mode
     228      Delete(s, 1, 1);
     229      for i := 1 to Length(s) do
     230        if s[i] in ['a' .. 'z'] then
     231          dec(s[i], 32);
     232      if s = 'MAN' then
     233      begin
     234        Quick := true;
     235        DirectHelp(cHelpOnly);
     236        Close
     237      end;
     238    end
     239    else if (FileExists(ParamStr(1))) then
    61240    begin
    62     SetMainTextureByAge(-1);
    63     State:=-1;
    64     Info:=Phrases.Lookup('BUSY_MODLH');
    65     Show; Invalidate; Update;
    66     end;
    67   ntInitModule..ntInitModule+maxBrain-1:
    68     if visible then
    69       begin
    70       s:=Format(Phrases.Lookup('BUSY_MOD'),[Brain[ID-ntInitModule].Name]);
    71       while BiColorTextWidth(Canvas,s)+64>ClientWidth do Delete(s,Length(s),1);
    72       SetInfo(s);
    73       end;
    74   ntCreateWorld:
    75     if visible then SetInfo(Phrases.Lookup('BUSY_START'));
    76   ntInitPlayers:
    77     if visible then SetInfo(Phrases.Lookup('BUSY_INIT'));
    78   ntDeactivationMissing..ntDeactivationMissing+nPl-1:
    79     SimpleMessage(Format(Phrases.Lookup('MISSDEACT'),[ID-ntDeactivationMissing]));
    80   ntSetAIName..ntSetAIName+nPl-1:
    81     LocalPlayer.SetAIName(ID-ntSetAIName, NotifyMessage);
    82   ntException..ntException+maxBrain-1:
    83     PostMessage(Handle,WM_AIEXCEPTION,ID-ntException,0);
    84   ntLoadBegin:
    85     begin Info:=Phrases.Lookup('BUSY_LOAD'); SetState(0); end;
    86   ntLoadState..ntLoadState+128:
    87     SetState(ID-ntLoadState);
    88   ntDLLError..ntDLLError+128:
    89     SimpleMessage(Format(Phrases.Lookup('DLLERROR'),[Brain[ID-ntDLLError].FileName]));
    90   ntAIError:
    91     SimpleMessage(Format(Phrases.Lookup('AIERROR'),[NotifyMessage]));
    92   ntClientError..ntClientError+128:
    93     SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),[Brain[ID-ntClientError].FileName]));
    94   ntEndInfo:
    95     begin Hide; background.update end;
    96   ntLoadError:
    97     begin
    98     if OpenClipboard(Handle) then
    99       begin // copy file path to clipboard
    100       NotifyMessage:=NotifyMessage+#0;
    101       hMem:=GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Length(NotifyMessage));
    102       p:=GlobalLock(hMem);
    103       if p<>nil then
    104         move(NotifyMessage[1],p^,Length(NotifyMessage));
    105       GlobalUnlock(hMem);
    106       SetClipboardData(CF_TEXT, hMem);
    107       CloseClipboard;
    108       end;
    109     with MessgDlg do
    110       begin
    111       MessgText:=Phrases.Lookup('LOADERROR');
    112       Kind:=mkYesNo;
    113       ShowModal;
    114       if ModalResult=mrOK then
    115         ShellExecute(Handle,'open','http://c-evo.org/_sg/contact/cevobug.html',
    116           '','',SW_SHOWNORMAL);
    117       end
    118     end;
    119   ntStartDone:
    120     if not Quick then
    121       begin StartDlg.Hide; background.Update end;
    122   ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
    123     if Quick then Close
    124     else
    125       begin
    126       if ID=ntStartGoRefresh then
    127         StartDlg.UpdateFormerGames
    128       else if ID=ntStartGoRefreshMaps then
    129         StartDlg.UpdateMaps;
    130       StartDlg.Show;
    131       end;
    132   ntChangeClient:
    133     PostMessage(Handle,WM_CHANGECLIENT,0,0);
    134   ntNextPlayer:
    135     PostMessage(Handle,WM_NEXTPLAYER,0,0);
    136   ntDeinitModule..ntDeinitModule+maxBrain-1:
    137     begin
    138     Info:=Format(Phrases2.Lookup('BUSY_DEINIT'),
    139       [Brain[ID-ntDeinitModule].Name]);
    140     while BiColorTextWidth(Canvas,Info)+64>ClientWidth do
    141       Delete(Info,Length(Info),1);
    142     SetMainTextureByAge(-1);
    143     State:=-1;
    144     Show;
    145     Invalidate;
    146     Update;
    147     end;
    148   ntBackOn:
    149     begin
    150     background.Show;
    151     background.update;
    152     sleep(50); // prevent flickering
    153     end;
    154   ntBackOff:
    155     background.Close;
    156   end;
    157 end;
    158 
    159 procedure TDirectDlg.FormCreate(Sender: TObject);
    160 begin
    161 Gone:=false;
    162 State:=-1;
    163 Info:='';
    164 GameServer.Init(Notify);
    165 Brain[bixNoTerm].Client:=NoTerm.Client;
    166 Brain[bixSuper_Virtual].Client:=nil;
    167 Brain[bixTerm].Client:=LocalPlayer.Client;
    168 Brain[bixNoTerm].Name:=Phrases.Lookup('AIT');
    169 Brain[bixSuper_Virtual].Name:=Phrases.Lookup('SUPER');
    170 Brain[bixTerm].Name:=Phrases.Lookup('HUMAN');
    171 Brain[bixRandom].name:=Phrases.Lookup('RANDOMAI');
    172 Canvas.Font.Assign(UniFont[ftNormal]);
    173 Canvas.Brush.Style:=bsClear;
    174 end;
    175 
    176 procedure TDirectDlg.FormShow(Sender: TObject);
    177 begin
    178 if not Gone then
    179   begin PostMessage(Handle,WM_GO,0,0); Gone:=true end
    180 end;
    181 
    182 procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
    183 begin
    184 GameServer.Done;
    185 end;
    186 
    187 procedure TDirectDlg.OnGo(var m:TMessage);
    188 var
    189 i: integer;
    190 s: string;
    191 begin
    192 Hide;
    193 if nBrain=3 then
    194   begin
    195   Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0);
    196   close;
    197   exit
    198   end;
    199 Quick:=false;
    200 if ParamCount>0 then
    201   begin
    202   s:=ParamStr(1);
    203   if (s[1]='-') or (s[1]='/') then
    204     begin // special mode
    205     Delete(s,1,1);
    206     for i:=1 to Length(s) do if s[i] in ['a'..'z'] then dec(s[i],32);
    207     if s='MAN' then
    208       begin Quick:=true; DirectHelp(cHelpOnly); Close end;
    209     end
    210   else if (FileExists(ParamStr(1))) then
    211     begin
    212     Quick:=true;
    213     if not LoadGame(ExtractFilePath(ParamStr(1)),ExtractFileName(ParamStr(1)),-1,false) then
    214       begin
    215       SimpleMessage(Phrases.Lookup('LOADERR'));
    216       Close
     241      Quick := true;
     242      if not LoadGame(ExtractFilePath(ParamStr(1)), ExtractFileName(ParamStr(1)
     243        ), -1, false) then
     244      begin
     245        SimpleMessage(Phrases.Lookup('LOADERR'));
     246        Close
    217247      end
    218248    end
    219249  end;
    220 if not Quick then
    221   begin background.Show; StartDlg.Show end
    222 end;
    223 
    224 procedure TDirectDlg.OnChangeClient(var m:TMessage);
    225 begin
    226 ChangeClient;
    227 end;
    228 
    229 procedure TDirectDlg.OnNextPlayer(var m:TMessage);
    230 begin
    231 NextPlayer;
    232 end;
    233 
    234 procedure TDirectDlg.OnAIException(var Msg:TMessage);
    235 begin
    236 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),
    237   [Brain[Msg.WParam].Name])), 'C-evo', 0);
     250  if not Quick then
     251  begin
     252    background.Show;
     253    StartDlg.Show
     254  end
     255end;
     256
     257procedure TDirectDlg.OnChangeClient(var m: TMessage);
     258begin
     259  ChangeClient;
     260end;
     261
     262procedure TDirectDlg.OnNextPlayer(var m: TMessage);
     263begin
     264  NextPlayer;
     265end;
     266
     267procedure TDirectDlg.OnAIException(var Msg: TMessage);
     268begin
     269  Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),
     270    [Brain[Msg.WParam].Name])), 'C-evo', 0);
    238271end;
    239272
    240273procedure TDirectDlg.FormPaint(Sender: TObject);
    241274begin
    242 PaintBackground(self,3,3,ClientWidth-6,ClientHeight-6);
    243 Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0);
    244 Frame(Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight,
    245   MainTexture.clBevelShade);
    246 Frame(Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight,
    247   MainTexture.clBevelShade);
    248 if State>=0 then
    249   RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Info)) div 2,16,Info)
    250 else RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Info)) div 2,
    251   (ClientHeight-Canvas.TextHeight(Info)) div 2,Info);
    252 if State>=0 then
    253   PaintProgressBar(Canvas,3,ClientWidth div 2 -64,40,State,0,128,MainTexture);
     275  PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
     276  Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
     277  Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
     278    MainTexture.clBevelLight, MainTexture.clBevelShade);
     279  Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
     280    MainTexture.clBevelLight, MainTexture.clBevelShade);
     281  if State >= 0 then
     282    RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info))
     283      div 2, 16, Info)
     284  else
     285    RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2,
     286      (ClientHeight - Canvas.TextHeight(Info)) div 2, Info);
     287  if State >= 0 then
     288    PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128,
     289      MainTexture);
    254290end;
    255291
    256292procedure TDirectDlg.SetInfo(x: string);
    257293begin
    258 Info:=x;
    259 Invalidate;
    260 Update;
     294  Info := x;
     295  Invalidate;
     296  Update;
    261297end;
    262298
    263299procedure TDirectDlg.SetState(x: integer);
    264300begin
    265 if (x<0)<>(State<0) then
    266   begin State:=x; Invalidate; Update end
    267 else if x<>State then
    268   begin
    269   State:=x;
    270   PaintProgressBar(Canvas,6,ClientWidth div 2 -64,40,State,128-State,128,MainTexture);
     301  if (x < 0) <> (State < 0) then
     302  begin
     303    State := x;
     304    Invalidate;
     305    Update
    271306  end
     307  else if x <> State then
     308  begin
     309    State := x;
     310    PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State,
     311      128, MainTexture);
     312  end
    272313end;
    273314
    274315end.
    275 
Note: See TracChangeset for help on using the changeset viewer.