12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037 |
- {
- Copyright (C) 2005 Remco Mulder
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- For source notes please refer to Notes.txt
- For license terms please refer to GPL.txt.
- These files should be stored in the root of the compression you
- received this source in.
- }
- // This unit controls all processing and recording of data
- unit
- Process;
- interface
- uses
- Core,
- Observer,
- SysUtils,
- DataBase,
- Classes;
- type
- TSectorPosition = (spNormal, spPorts, spPlanets, spShips, spMines, spTraders);
- TDisplay = (dNone, dSector, dDensity, dWarpLane, dCIM, dPortCIM, dPort, dWarpCIM);
- TModExtractor = class(TTWXModule, IModExtractor)
- private
- FCurrentSectorIndex : Integer;
- FSectorPosition : TSectorPosition;
- FCurrentDisplay : TDisplay;
- FLastWarp : Integer;
- FSectorSaved : Boolean;
- FCurrentTrader : TTrader;
- FCurrentShip : TShip;
- FCurrentMessage : string;
- FTraderList,
- FShipList,
- FPlanetList : TList;
- FCurrentLine,
- FCurrentANSILine : string;
- FCurrentSector : TSector;
- FInAnsi : Boolean;
- FMenuKey : Char;
- procedure SectorCompleted;
- procedure ResetSectorLists;
- procedure ProcessPrompt(Line : string);
- procedure AddWarp(SectNum, Warp : Integer);
- procedure ProcessWarpLine(Line : String);
- procedure ProcessCIMLine(Line : String);
- procedure ProcessSectorLine(Line : String);
- procedure ProcessLine(Line : String);
- procedure ProcessPortLine(Line : String);
- procedure StripANSI(var S : string);
- protected
- function GetMenuKey: Char;
- procedure SetMenuKey(Value: Char);
- public
- procedure AfterConstruction; override;
- procedure BeforeDestruction; override;
- procedure Reset;
- procedure ProcessInBound(var InData : string);
- function ProcessOutBound(OutData : string; ClientIndex : Byte) : Boolean;
- property CurrentLine: string read FCurrentLine write FCurrentLine;
- property CurrentANSILine: string read FCurrentANSILine write FCurrentANSILine;
- published
- property MenuKey: Char read GetMenuKey write SetMenuKey;
- end;
- implementation
- uses
- Global,
- Utility,
- Ansi;
- procedure TModExtractor.AfterConstruction;
- begin
- inherited;
- // Create lists to store ships, traders and planets
- FShipList := TList.Create;
- FTraderList := TList.Create;
- FPlanetList := TList.Create;
- MenuKey := '$';
- end;
- procedure TModExtractor.BeforeDestruction;
- begin
- ResetSectorLists;
- FShipList.Free;
- FTraderList.Free;
- FPlanetList.Free;
- inherited;
- end;
- procedure TModExtractor.Reset;
- begin
- // Reset state values
- CurrentLine := '';
- CurrentANSILine := '';
- FInAnsi := FALSE;
- ResetSectorLists;
- end;
- function TModExtractor.GetMenuKey: Char;
- begin
- Result := FMenuKey;
- end;
- procedure TModExtractor.SetMenuKey(Value: Char);
- begin
- FMenuKey := Value;
- end;
- // ********************************************************************
- // Process inbound data
- procedure TModExtractor.ResetSectorLists;
- begin
- // Reset all ship, planet and trader lists
- while (FShipList.Count > 0) do
- begin
- FreeMem(FShipList[0], SizeOf(TShip));
- FShipList.Delete(0);
- end;
- while (FPlanetList.Count > 0) do
- begin
- FreeMem(FPlanetList[0], SizeOf(TPlanet));
- FPlanetList.Delete(0);
- end;
- while (FTraderList.Count > 0) do
- begin
- FreeMem(FTraderList[0], SizeOf(TTrader));
- FTraderList.Delete(0);
- end;
- end;
- procedure TModExtractor.SectorCompleted;
- var
- I,
- WarpIndex : Integer;
- begin
- if (FCurrentSectorIndex = 0) then
- Exit;
- FCurrentSector.UpDate := Now;
- FCurrentSector.Explored := etHolo;
- FSectorSaved := TRUE;
- WarpIndex := 0;
- for I := 1 to 6 do
- if (FCurrentSector.Warp[I] = 0) then
- begin
- WarpIndex := I;
- Break;
- end;
- if (WarpIndex = 0) then
- FCurrentSector.Warps := 0
- else if (FCurrentSector.Warp[WarpIndex] = 0) then
- FCurrentSector.Warps := WarpIndex - 1
- else
- FCurrentSector.Warps := 6;
- TWXDatabase.SaveSector(FCurrentSector, FCurrentSectorIndex, FShipList, FTraderList, FPlanetList);
- FCurrentSectorIndex := 0;
- ResetSectorLists;
- end;
- procedure TModExtractor.ProcessPrompt(Line : string);
- begin
- // This procedure checks command prompts. It is called from both
- // processline and processinbound, as it can come in as part of
- // a large packet or still be waiting for the user.
- if (Copy(Line, 1, 12) = 'Command [TL=') then
- begin
- // Save current sector if not done already
- if not (FSectorSaved) then
- SectorCompleted;
- // No displays anymore, all done
- FCurrentDisplay := dNone;
- FLastWarp := 0;
- end
- else if (Copy(Line, 1, 23) = 'Probe entering sector :') or (Copy(Line, 1, 20) = 'Probe Self Destructs') then
- begin
- // mid probe - save the sector
- if not (FSectorSaved) then
- SectorCompleted;
- // No displays anymore, all done
- FCurrentDisplay := dNone;
- end
- else if (Copy(Line, 1, 21) = 'Computer command [TL=') then
- begin
- // in computer prompt, kill all displays and clear warp data
- FCurrentDisplay := dNone;
- FLastWarp := 0;
- end
- else if (Copy(Line, 1, 25) = 'Citadel treasury contains') then
- begin
- // In Citadel - Save current sector if not done already
- if not (FSectorSaved) then
- SectorCompleted;
- // No displays anymore, all done
- FCurrentDisplay := dNone;
- end
- else if (Copy(Line, 1, 19) = 'Stop in this sector') or (Copy(Line, 1, 21) = 'Engage the Autopilot?') then
- begin
- // Save current sector if not done already
- if not (FSectorSaved) then
- SectorCompleted;
- // No displays anymore, all done
- FCurrentDisplay := dNone;
- end
- else if (Copy(Line, 1, 2) = ': ') then
- begin
- // at the CIM prompt
- if (FCurrentDisplay <> dCIM) then
- FCurrentDisplay := dNone;
- FLastWarp := 0;
- end;
- TWXInterpreter.TextEvent(CurrentLine, FALSE);
- end;
- procedure TModExtractor.AddWarp(SectNum, Warp : Integer);
- var
- S : TSector;
- I,
- X,
- Pos : Integer;
- begin
- // Used by ProcessWarpLine to add a warp to a sector
- S := TWXDatabase.LoadSector(SectNum);
- // see if the warp is already in there
- for I := 1 to 6 do
- if (S.Warp[I] = Warp) then
- Exit;
- // find where it should fit
- Pos := 7;
- for I := 1 to 6 do
- if (S.Warp[I] > Warp) or (S.Warp[I] = 0) then
- begin
- Pos := I;
- Break;
- end;
- if (Pos = 1) then
- X := 2
- else
- X := Pos;
- // move them all up one
- if (Pos < 6) then
- for I := 6 downto X do
- S.Warp[I] := S.Warp[I - 1];
- if (Pos < 7) then
- S.Warp[Pos] := Warp;
- if (S.Explored = etNo) then
- begin
- S.Constellation := '???' + ANSI_9 + ' (warp calc only)';
- S.Explored := etCalc;
- S.Update := Now;
- end;
- TWXDatabase.SaveSector(S, SectNum, nil, nil, nil);
- end;
- procedure TModExtractor.ProcessWarpLine(Line : String);
- var
- I,
- CurSect,
- LastSect : Integer;
- S : String;
- begin
- // A WarpLine is a line of warps plotted using the ship's computer. Add new warps to
- // any sectors listed in the warp lane (used extensively for ZTM).
- // e.g: 3 > 300 > 5362 > 13526 > 149 > 434
- LastSect := FLastWarp;
- StripChar(Line, ')');
- StripChar(Line, '(');
- I := 1;
- S := GetParameter(Line, I);
- while (S <> '') do
- begin
- if (S <> '>') then
- begin
- CurSect := StrToIntSafe(S);
- if (CurSect < 1) or (CurSect > TWXDatabase.DBHeader.Sectors) then
- // doesn't look like this line is what we thought it was.
- // Best to leave it alone
- exit;
- if (LastSect > 0) then
- AddWarp(LastSect, CurSect);
- LastSect := CurSect;
- FLastWarp := CurSect;
- end;
- Inc(I);
- S := GetParameter(Line, I);
- end;
- end;
- procedure TModExtractor.ProcessCIMLine(Line : String);
- function GetCIMValue(M : String; Num : Integer) : Integer;
- var
- S : String;
- begin
- S := GetParameter(M, Num);
- if (S = '') then
- Result := 0
- else
- try
- Result := StrToInt(S);
- except
- Result := -1;
- end;
- end;
- var
- Sect : Integer;
- S : TSector;
- X,
- I,
- Len,
- Ore,
- Org,
- Equip,
- POre,
- POrg,
- PEquip : Integer;
- M : String;
- begin
- if (FCurrentDisplay = dWarpCIM) then
- begin
- // save warp CIM data
- Sect := GetCIMValue(Line, 1);
- if (Sect <= 0) or (Sect > TWXDatabase.DBHeader.Sectors) then
- begin
- FCurrentDisplay := dNone;
- Exit;
- end;
- S := TWXDatabase.LoadSector(Sect);
- for I := 1 to 6 do
- begin
- X := GetCIMValue(Line, I + 1);
- if (X < 0) or (X > TWXDatabase.DBHeader.Sectors) then
- begin
- FCurrentDisplay := dNone;
- Exit;
- end
- else
- S.Warp[I] := X;
- end;
- if (S.Explored = etNo) then
- begin
- S.Constellation := '???' + ANSI_9 + ' (warp calc only)';
- S.Explored := etCalc;
- S.Update := Now;
- end;
- TWXDatabase.SaveSector(S, Sect, nil, nil, nil);
- end
- else
- begin
- // save port CIM data
- Sect := GetCIMValue(Line, 1);
- Len := Length(IntToStr(TWXDatabase.DBHeader.Sectors));
- if (Sect <= 0) or (Sect > TWXDatabase.DBHeader.Sectors) or (Length(Line) < Len + 36) then
- begin
- FCurrentDisplay := dNone;
- Exit;
- end;
- M := StringReplace(Line, '-', '', [rfReplaceAll]);
- M := StringReplace(M, '%', '', [rfReplaceAll]);
- S := TWXDatabase.LoadSector(Sect);
- Ore := GetCIMValue(M, 2);
- Org := GetCIMValue(M, 4);
- Equip := GetCIMValue(M, 6);
- POre := GetCIMValue(M, 3);
- POrg := GetCIMValue(M, 5);
- PEquip := GetCIMValue(M, 7);
- if (Ore < 0) or (Org < 0) or (Equip < 0)
- or (POre < 0) or (POre > 100)
- or (POrg < 0) or (POrg > 100)
- or (PEquip < 0) or (PEquip > 100) then
- begin
- FCurrentDisplay := dNone;
- Exit;
- end;
- S.SPort.ProductAmount[ptFuelOre] := Ore;
- S.SPort.ProductAmount[ptOrganics] := Org;
- S.SPort.ProductAmount[ptEquipment] := Equip;
- S.SPort.ProductPercent[ptFuelOre] := POre;
- S.SPort.ProductPercent[ptOrganics] := POrg;
- S.SPort.ProductPercent[ptEquipment] := PEquip;
- S.SPort.UpDate := Now;
- if (S.SPort.Name = '') then
- begin
- // port not saved/seen before - get its details
- if (Line[Len + 2] = '-') then
- S.SPort.BuyProduct[ptFuelOre] := TRUE
- else
- S.SPort.BuyProduct[ptFuelOre] := FALSE;
- if (Line[Len + 14] = '-') then
- S.SPort.BuyProduct[ptOrganics] := TRUE
- else
- S.SPort.BuyProduct[ptOrganics] := FALSE;
- if (Line[Len + 26] = '-') then
- S.SPort.BuyProduct[ptEquipment] := TRUE
- else
- S.SPort.BuyProduct[ptEquipment] := FALSE;
- if (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 8
- else if (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 1
- else if (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 2
- else if not (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 3
- else if not (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 4
- else if not (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 5
- else if (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 6
- else if not (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
- S.SPort.ClassIndex := 7;
- S.SPort.Name := '???';
- end;
- if (S.Explored = etNo) then
- begin
- S.Constellation := '???' + ANSI_9 + ' (port data/calc only)';
- S.Explored := etCalc;
- S.Update := Now;
- end;
- TWXDatabase.SaveSector(S, Sect, nil, nil, nil);
- end;
- end;
- procedure TModExtractor.ProcessSectorLine(Line : String);
- var
- S : String;
- I : Integer;
- NewPlanet : PPlanet;
- NewShip : PShip;
- NewTrader : PTrader;
- begin
- if (Copy(Line, 1, 10) = 'Beacon : ') then
- begin
- // Get beacon text
- FCurrentSector.Beacon := Copy(Line, 11, length(Line) - 10);
- end
- else if (Copy(Line, 1, 10) = 'Ports : ') then
- begin
- // Save port data
- if (Pos('<=-DANGER-=>', Line) > 0) then
- // Port is destroyed
- FCurrentSector.SPort.Dead := TRUE
- else
- begin
- FCurrentSector.SPort.Dead := FALSE;
- FCurrentSector.SPort.BuildTime := 0;
- FCurrentSector.SPort.Name := Copy(Line, 11, Pos(', Class', Line) - 11);
- FCurrentSector.SPort.ClassIndex := StrToIntSafe(Copy(Line, Pos(', Class', Line) + 8, 1));
- if (Line[length(Line) - 3] = 'B') then
- FCurrentSector.SPort.BuyProduct[ptFuelOre] := TRUE
- else
- FCurrentSector.SPort.BuyProduct[ptFuelOre] := FALSE;
- if (Line[length(Line) - 2] = 'B') then
- FCurrentSector.SPort.BuyProduct[ptOrganics] := TRUE
- else
- FCurrentSector.SPort.BuyProduct[ptOrganics] := FALSE;
- if (Line[length(Line) - 1] = 'B') then
- FCurrentSector.SPort.BuyProduct[ptEquipment] := TRUE
- else
- FCurrentSector.SPort.BuyProduct[ptEquipment] := FALSE;
- end;
- FSectorPosition := spPorts;
- end
- else if (Copy(Line, 1, 10) = 'Planets : ') then
- begin
- // Get planet data
- NewPlanet := AllocMem(SizeOf(TPlanet));
- TWXDatabase.NULLPlanet(NewPlanet^);
- NewPlanet^.Name := Copy(Line, 11, length(Line) - 10);
- FPlanetList.Add(NewPlanet);
- FSectorPosition := spPlanets;
- end
- else if (Copy(Line, 1, 10) = 'Traders : ') then
- begin
- // Save traders
- I := Pos(', w/', Line);
- FCurrentTrader.Name := Copy(Line, 11, I - 11);
- S := Copy(Line, I + 5, Pos(' ftrs', Line) - I - 5);
- StripChar(S, ',');
- FCurrentTrader.Figs := StrToIntSafe(S);
- FSectorPosition := spTraders;
- end
- else if (Copy(Line, 1, 10) = 'Ships : ') then
- begin
- // Save ships
- I := Pos('[Owned by]', Line);
- FCurrentShip.Name := Copy(Line, 11, I - 12);
- FCurrentShip.Owner := Copy(Line, I + 11, Pos(', w/', Line) - I - 11);
- I := Pos(', w/', Line);
- S := Copy(Line, I + 5, Pos(' ftrs,', Line) - I - 5);
- StripChar(S, ',');
- FCurrentShip.Figs := StrToIntSafe(S);
- FSectorPosition := spShips;
- end
- else if (Copy(Line, 1, 10) = 'Fighters: ') then
- begin
- // Get fig details
- S := GetParameter(Line, 2);
- StripChar(S, ',');
- FCurrentSector.Figs.Quantity := StrToIntSafe(S);
- I := GetParameterPos(Line, 3) + 1;
- FCurrentSector.Figs.Owner := Copy(Line, I, Pos(')', Line) - I);
- if (Copy(Line, length(Line) - 5, 6) = '[Toll]') then
- FCurrentSector.Figs.FigType := ftToll
- else if (Copy(Line, length(Line) - 10, 11) = '[Defensive]') then
- FCurrentSector.Figs.FigType := ftDefensive
- else
- FCurrentSector.Figs.FigType := ftOffensive;
- end
- else if (Copy(Line, 1, 10) = 'NavHaz : ') then
- begin
- S := GetParameter(Line, 3);
- S := Copy(S, 1, length(S) - 1);
- FCurrentSector.NavHaz := StrToIntSafe(S);
- end
- else if (Copy(Line, 1, 10) = 'Mines : ') then
- begin
- // Save mines
- FSectorPosition := spMines;
- I := GetParameterPos(Line, 7) + 1;
- S := Copy(Line, I, length(Line) - I);
- if (GetParameter(Line, 6) = 'Armid)') then
- begin
- FCurrentSector.Mines_Armid.Quantity := StrToIntSafe(GetParameter(Line, 3));
- FCurrentSector.Mines_Armid.Owner := S;
- end
- else
- begin
- FCurrentSector.Mines_Limpet.Quantity := StrToIntSafe(GetParameter(Line, 3));
- FCurrentSector.Mines_Limpet.Owner := S;
- end;
- end
- else if (Copy(Line, 1, 8) = ' ') then
- begin
- // Continue from last occurance
- if (FSectorPosition = spMines) then
- begin
- I := GetParameterPos(Line, 6) + 1;
- FCurrentSector.Mines_Limpet.Quantity := StrToIntSafe(GetParameter(Line, 2));
- FCurrentSector.Mines_Limpet.Owner := Copy(Line, I, length(Line) - I);
- end
- else if (FSectorPosition = spPorts) then
- FCurrentSector.SPort.BuildTime := StrToIntSafe(GetParameter(Line, 4))
- else if (FSectorPosition = spPlanets) then
- begin
- // Get planet data
- NewPlanet := AllocMem(SizeOf(TPlanet));
- TWXDatabase.NULLPlanet(NewPlanet^);
- NewPlanet^.Name := Copy(Line, 11, length(Line) - 10);
- FPlanetList.Add(NewPlanet);
- end
- else if (FSectorPosition = spTraders) then
- begin
- if (GetParameter(Line, 1) = 'in') then
- begin
- // Still working on one trader
- NewTrader := AllocMem(SizeOf(TTrader));
- I := GetParameterPos(Line, 2);
- NewTrader^.ShipName := Copy(Line, I, Pos('(', Line) - I - 1);
- I := Pos('(', Line);
- NewTrader^.ShipType := Copy(Line, I + 1, Pos(')', Line) - I - 1);
- NewTrader^.Name := FCurrentTrader.Name;
- NewTrader^.Figs := FCurrentTrader.Figs;
- FTraderList.Add(NewTrader);
- end
- else
- begin
- // New trader
- I := Pos(', w/', Line);
- FCurrentTrader.Name := Copy(Line, 11, I - 11);
- S := Copy(Line, I + 5, Pos(' ftrs', Line) - I - 5);
- StripChar(S, ',');
- FCurrentTrader.Figs := StrToIntSafe(S);
- end;
- end
- else if (FSectorPosition = spShips) then
- begin
- if (Copy(Line, 12, 1) = '(') then
- begin
- // Get the rest of the ship info
- NewShip := AllocMem(SizeOf(TShip));
- NewShip^.Name := FCurrentShip.Name;
- NewShip^.Owner := FCurrentShip.Owner;
- NewShip^.Figs := FCurrentShip.Figs;
- NewShip^.ShipType := Copy(Line, 13, Pos(')', Line) - 13);
- FShipList.Add(NewShip);
- end
- else
- begin
- // New ship
- I := Pos('[Owned by]', Line);
- FCurrentShip.Name := Copy(Line, 11, I - 12);
- FCurrentShip.Owner := Copy(Line, I + 11, Pos(', w/', Line) - I - 11);
- I := Pos(', w/', Line);
- S := Copy(Line, I + 5, Pos(' ftrs,', Line) - I - 5);
- StripChar(S, ',');
- FCurrentShip.Figs := StrToIntSafe(S);
- FSectorPosition := spShips;
- end;
- end;
- end
- else if (Copy(Line, 9, 1) = ':') then
- FSectorPosition := spNormal
- else if (Copy(Line, 1, 20) = 'Warps to Sector(s) :') then
- begin
- StripChar(Line, '(');
- StripChar(Line, ')');
- // Get sector warps
- FCurrentSector.Warp[1] := StrToIntSafe(GetParameter(Line, 5));
- FCurrentSector.Warp[2] := StrToIntSafe(GetParameter(Line, 7));
- FCurrentSector.Warp[3] := StrToIntSafe(GetParameter(Line, 9));
- FCurrentSector.Warp[4] := StrToIntSafe(GetParameter(Line, 11));
- FCurrentSector.Warp[5] := StrToIntSafe(GetParameter(Line, 13));
- FCurrentSector.Warp[6] := StrToIntSafe(GetParameter(Line, 15));
- // sector done
- if not (FSectorSaved) then
- SectorCompleted;
- // No displays anymore, all done
- FCurrentDisplay := dNone;
- FSectorPosition := spNormal;
- end;
- end;
- procedure TModExtractor.ProcessPortLine(Line : String);
- begin
- // Process a line from the CR port display
- end;
- procedure TModExtractor.ProcessLine(Line : String);
- var
- S,
- X : String;
- I : Integer;
- Sect : TSector;
- begin
- // Every line is passed to this procedure to be processed and recorded
- if (FCurrentMessage <> '') then
- begin
- if (Line <> '') then
- begin
- if (FCurrentMessage = 'Figs') then
- TWXGUI.AddToHistory(htFighter, TimeToStr(Time) + ' ' + StripChars(Line))
- else if (FCurrentMessage = 'Comp') then
- TWXGUI.AddToHistory(htComputer, TimeToStr(Time) + ' ' + StripChars(Line))
- else
- TWXGUI.AddToHistory(htMsg, TimeToStr(Time) + ' ' + StripChars(Line));
- FCurrentMessage := '';
- end;
- end
- else if (Copy(Line, 1, 2) = 'R ') or (Copy(Line, 1, 2) = 'F ') then
- TWXGUI.AddToHistory(htMsg, TimeToStr(Time) + ' ' + StripChars(Line))
- else if (Copy(Line, 1, 2) = 'P ') then
- begin
- if (GetParameter(Line, 2) <> 'indicates') then
- TWXGUI.AddToHistory(htMsg, TimeToStr(Time) + ' ' + StripChars(Line))
- end
- else if (Copy(Line, 1, 26) = 'Incoming transmission from') or (Copy(Line, 1, 28) = 'Continuing transmission from') then
- begin
- // Transmission with ansi off
- I := GetParameterPos(Line, 4);
- if (Copy(Line, Length(Line) - 9, 10) = 'comm-link:') then
- begin
- // Fedlink
- FCurrentMessage := 'F ' + Copy(Line, I, Pos(' on Federation', Line) - I) + ' ';
- end
- else if (GetParameter(Line, 5) = 'Fighters:') then
- begin
- // Fighters
- FCurrentMessage := 'Figs';
- end
- else if (GetParameter(Line, 5) = 'Computers:') then
- begin
- // Computer
- FCurrentMessage := 'Comp';
- end
- else if (Pos(' on channel ', Line) <> 0) then
- begin
- // Radio
- FCurrentMessage := 'R ' + Copy(Line, I, Pos(' on channel ', Line) - I) + ' ';
- end
- else
- begin
- // hail
- FCurrentMessage := 'P ' + Copy(Line, I, Length(Line) - I) + ' ';
- end
- end
- else if (Copy(Line, 1, 31) = 'Deployed Fighters Report Sector') then
- TWXGUI.AddToHistory(htFighter, TimeToStr(Time) + ' ' + Copy(Line, 19, Length(Line)))
- else if (Copy(Line, 1, 20) = 'Shipboard Computers ') then
- TWXGUI.AddToHistory(htComputer, TimeToStr(Time) + ' ' + Copy(Line, 21, Length(Line)))
- else if (Copy(Line, 1, 19) = 'The shortest path (') or (Copy(Line, 1, 7) = ' TO > ') then
- begin
- FCurrentDisplay := dWarpLane;
- FLastWarp := 0;
- end
- else if (FCurrentDisplay = dWarpLane) then
- ProcessWarpLine(Line)
- else if (FCurrentDisplay = dWarpCIM) or (FCurrentDisplay = dPortCIM) then
- ProcessCIMLine(Line)
- else if (FCurrentDisplay = dCIM) then
- begin
- // find out what kind of CIM this is
- if (Length(Line) > 2) then
- begin
- if (Line[Length(Line) - 1] = '%') then
- begin
- TWXDatabase.LastPortCIM := Now;
- FCurrentDisplay := dPortCIM;
- end
- else
- FCurrentDisplay := dWarpCIM;
- ProcessCIMLine(Line);
- end;
- end
- else if (Copy(Line, 1, 10) = 'Sector : ') then
- begin
- // Check if this is a probe or holoscan (no warp pickup)
- if not (FSectorSaved) then
- SectorCompleted;
- // Begin recording of sector data
- FCurrentDisplay := dSector;
- FSectorSaved := FALSE;
- // Clear sector variables
- TWXDatabase.NULLSector(FCurrentSector);
- FCurrentSectorIndex := StrToIntSafe(GetParameter(Line, 3));
- I := GetParameterPos(Line, 5);
- FCurrentSector.Constellation := Copy(Line, I, length(Line) - I + 1);
- end
- else if (FCurrentDisplay = dSector) then
- ProcessSectorLine(Line)
- else if (FCurrentDisplay = dPort) then
- ProcessPortLine(Line)
- else if (Copy(Line, 27, 16) = 'Relative Density') then
- begin
- // A density scanner is being used - lets grab some data
- FCurrentDisplay := dDensity;
- end
- else if (FCurrentDisplay = dDensity) and (Copy(Line, 1, 6) = 'Sector') then
- begin
- // Save all density data into sector database
- X := Line;
- StripChar(X, '(');
- StripChar(X, ')');
- I := StrToIntSafe(GetParameter(X, 2));
- Sect := TWXDatabase.LoadSector(I);
- S := GetParameter(X, 4);
- StripChar(S, ',');
- Sect.Density := StrToIntSafe(S);
- if (GetParameter(X, 13) = 'Yes') then
- // Sector has anomoly
- Sect.Anomoly := TRUE
- else
- Sect.Anomoly := FALSE;
- S := GetParameter(X, 10);
- S := Copy(S, 1, length(S) - 1);
- Sect.NavHaz := StrToIntSafe(S);
- Sect.Warps := StrToIntSafe(GetParameter(X, 7));
- if (Sect.Explored in [etNo, etCalc]) then
- begin
- // Sector hasn't been scanned or seen before
- Sect.Constellation := '???' + ANSI_9 + ' (Density only)';
- Sect.Explored := etDensity;
- Sect.Update := Now;
- end;
- TWXDatabase.SaveSector(Sect, I, nil, nil, nil);
- end
- else if (Copy(Line, 1, 28) = 'What sector is the port in? ') then
- begin
- // begin port data download
- end
- else if (Copy(Line, 1, 2) = ': ') then
- begin
- // begin CIM download
- FCurrentDisplay := dCIM;
- end;
- TWXInterpreter.TextLineEvent(Line, FALSE);
- ProcessPrompt(Line);
- // Reactivate script triggers
- TWXInterpreter.ActivateTriggers;
- end;
- procedure TModExtractor.StripANSI(var S : String);
- var
- I : Integer;
- X : String;
- begin
- // Remove ANSI codes from text
- X := '';
- for I := 1 to length(S) do
- begin
- if (S[I] = #27) then
- FInAnsi := TRUE;
- if (FInAnsi = FALSE) then
- X := X + S[I];
- if ((Byte(S[I]) >= 65) and (Byte(S[I]) <= 90)) or ((Byte(S[I]) >= 97) and (Byte(S[I]) <= 122)) then
- FInAnsi := FALSE;
- end;
- S := X;
- end;
- procedure TModExtractor.ProcessInBound(var InData : String);
- var
- X : Integer;
- I : Integer;
- S,
- ANSIS,
- ANSILine,
- Line : string;
- begin
- S := InData;
- // Remove null chars
- StripChar(S, #0);
- // strip the ANSI
- AnsiS := S;
- StripANSI(S);
- TWXLog.DoLogData(S, InData);
- // Remove linefeed
- StripChar(S, #10);
- StripChar(AnsiS, #10);
- // Form and process lines out of data
- I := 1;
- Line := CurrentLine + S;
- AnsiLine := CurrentANSILine + AnsiS;
- while (I <= Length(Line)) do
- begin
- if (Line[I] = #13) then
- begin
- // find the matching carriage return in the ansi line
- X := 1;
-
- if (Length(ANSILine) > 0) then
- while (ANSILine[X] <> #13) and (X < Length(ANSILine)) do
- Inc(X);
- CurrentLine := Copy(Line, 1, I - 1);
- CurrentANSILine := Copy(ANSILine, 1, X - 1);
- ProcessLine(CurrentLine);
- if (I < Length(Line)) then
- begin
- Line := Copy(Line, I + 1, Length(Line) - I);
- ANSILine := Copy(ANSILine, X + 1, Length(ANSILine) - X);
- end
- else
- begin
- Line := '';
- ANSILine := '';
- Break;
- end;
- I := 0;
- end;
- Inc(I);
- end;
- // Process what we have left
- CurrentLine := Line;
- CurrentANSILine := ANSILine;
- ProcessPrompt(CurrentLine);
- end;
- // ********************************************************************
- // Process outbound data
- function TModExtractor.ProcessOutBound(OutData : string; ClientIndex : Byte) : Boolean;
- begin
- Result := TRUE;
- if (OutData[1] = MenuKey) and (TWXMenu.CurrentMenu = nil) then
- begin
- // Activate menu
- if not (TWXClient.Connected) then
- begin
- // User trying to access database while not connected
- if not (TWXDatabase.DataBaseOpen) then
- TWXServer.ClientMessage(endl + ANSI_12 + 'Warning: This database is corrupt or does not exist. No data is available.' + ANSI_7 + endl);
- end;
- TWXMenu.OpenMenu('TWX_MAIN', ClientIndex);
- // run the rest of the text through the menus
- if (Length(OutData) > 1) then
- ProcessOutBound(Copy(OutData, 2, Length(OutData)), ClientIndex);
- Result := FALSE;
- end
- else if (TWXMenu.CurrentMenu <> nil) then
- begin
- if (OutData[1] = MenuKey) then
- // De-activate menu
- TWXMenu.CloseMenu(TRUE)
- else
- // Send commands to menu
- TWXMenu.MenuText(OutData, ClientIndex);
- Result := FALSE;
- end;
- // don't return a value if trigger had this key
- if (Result) and (OutData <> '') then
- Result := not TWXInterpreter.TextOutEvent(OutData, nil);
- end;
- end.
|