%
%  Save Game as Host Data
%
%  This saves your turn as host data. You can then run host.exe on it.
%  It attempts to restore as much as possible of the original data.
%  Of course, this is not always possible: missing information is
%  guessed (minerals on enemy planets, fcodes) or set to zero (enemy
%  ship cargo).
%
%  This code is ALPHA, read, it worked correctly on the test data set
%  I tested it on, and Host 3.22.020 / PHost 3.3d no longer complains.
%
%  Usage: either, run this on the command line using PCC or CCS:
%    cc GAMEDIR PLAYER /rk Load "savehost.q"
%  and answer the questions. This will save the specified game data as
%  host files in the current directory. Alternatively, fire up the PCC
%  GUI, load the game, and type at the console
%    Load "savehost.q"
%    sh.Interactive
%  This does the same, but also asks for the target directory, and is a
%  bit more colorful ;-)
%
%  Right now, this can only read one player's data. If you have multiple
%  RSTs, it would be nice to merge them, but right now this is not
%  completely possible. For planets, PCC's history does a pretty decent
%  job, but for ships and bases, we can't currently help.
%
%  This script requires PCC 1.0.14 or later. File I/O has bugs in 1.0.13
%  which crash PCC. This is also a neat benchmark & crash test for PCC ;)
%
%  Author: Stefan Reuther <Streu@gmx.de>
%
%  + August 2001: initial version
%  + March 2002: support for score blankers. Tried it with PHost -- works :)
%  + 03/Jul/2002: PCC 1.0.19 also supports console input
%  + 14/Jul/2002: fixed starbase storage
%

% Number of ships
Shared sh.NumShips = 500

% Output directory
Shared sh.Dir

% Tech level for foreign bases
Shared sh.Tech = 6

% If true, all players play
Shared sh.AllPlayers = 0

% Interactive Version. Asks for parameters, then start the conversion.
% Preferrably call this from the console so you see the messages.
Sub sh.Interactive
  Print "=== Save as Host... ==="

  %%% Query output directory %%%
  If System.Gui Or System.Version$ >= 100019 Then
    % UI.Input is not (yet?) supported on the console.
    UI.Input "Output directory:", "Save as Host...", 64, "", System.GameDirectory
    If IsEmpty(UI.Result) Then Return
    sh.Dir := UI.Result
  Else
    sh.Dir := System.GameDirectory
  EndIf
  If sh.Dir<>'' And Not Instr('\/:', Right(sh.Dir,1)) Then sh.Dir := sh.Dir & '\'

  %%% Host999? %%%
  UI.Message "Do you want this to be a Host999 game?", "Save as Host...", "Yes No"
  If UI.Result=1 Then
    sh.NumShips := 999
  Else
    sh.NumShips := 500
  EndIf

  %%% Registered? %%%
  UI.Message "Are your fellow players registered? (This is used for generating starbases.)", "Save as Host...", "Yes No"
  If UI.Result=1 Then
    sh.Tech := 10
  Else
    sh.Tech := 6
  EndIf

  %%% All players? %%%
  Local i, n=0
  For i:=1 To 11 Do If Players(i).Score Then n:=n+1
  If n<11 Then
    UI.Message "Do you use a score blanker? (If you say yes, I'll assume all players play even if the scores do not look like that.)", "Save as Host...", "Yes No"
    sh.AllPlayers := (UI.Result=1)
  EndIf

  sh.SaveHost
EndSub

% Save as host data. This does the actual conversion.
Sub sh.SaveHost
  Print "--- Configuration ---"
  Print "Output directory: ", If(sh.Dir, sh.Dir, '(current)')
  Print "Number of ships:  ", sh.NumShips
  Print "Foreign SB tech:  ", sh.Tech
  Print "--- Saving... ---"

  Print "Miscellaneous data..."
  sh.SaveTurntime sh.Dir & "nextturn.hst"
  sh.SaveTurntime sh.Dir & "lastturn.hst"
  sh.SaveRaceNames sh.Dir & "race.nm"
  sh.SaveGen sh.Dir & "gen.hst"
  sh.SaveGrey sh.Dir & "grey.hst"
  sh.ZapFile sh.Dir & "ufo.hst", 7800       % FIXME
  Print "Minefields..."
  sh.SaveMines sh.Dir & "mines.hst"
  Print "Planet coordinates..."
  %sh.SaveXYPlan sh.Dir & "xyplan.dat", 0
  sh.SaveXYPlan sh.Dir & "xyplan.hst", 1
  Print "Planets..."
  sh.SavePlanets sh.Dir & "pdata.hst"
  Print "Starbases..."
  sh.SaveBases sh.Dir & "bdata.hst"
  Print "Starships..."
  sh.SaveShips sh.Dir & "ship.hst"
  Print "Starship coordinates..."
  sh.SaveShipXY sh.Dir & "shipxy.hst"
EndSub

% Save XYPLAN file.
%   name = file name
%   ow   = 1 to store owners, 0 don't
Sub sh.SaveXYPlan (name, ow)
  Local i, s
  Open name For Output As #1
  For i:=1 To 500 Do 
    With Planets(i) Do
      SetWord s, 0, If(Loc.X, Loc.X, 0), If(Loc.Y, Loc.Y, 0), Owner$ * ow
      Put #1, s, 6
    EndWith
  Next
  Close #1
EndSub

% Save the planet file
Sub sh.SavePlanets (name)
  Local i, s
  Open name For Output As #1
  SetWord s, 0, 0
  Put #1, s, 2
  For i:=1 To 500 Do
    With Planets(i) Do
      SetWord s, 0, If(Owner$ And Colonists, Owner$, 0)
      SetWord s, 2, i
      SetStr  s, 3, 4, If(FCode, FCode, Chr(Random(64,91))+Chr(Random(64,91))+Chr(Random(64,91)))
      SetWord s, 7, If(Mines, Mines, 0), If(Factories, Factories, 0), If(Defense, Defense, 0)
      SetLong s, 13, If(Mined.N, Mined.N, Random(10, 100))
      SetLong s, 17, If(Mined.T, Mined.T, Random(10, 100))
      SetLong s, 21, If(Mined.D, Mined.D, Random(10, 100))
      SetLong s, 25, If(Mined.M, Mined.M, Random(10, 100))
      SetLong s, 29, If(Colonists, Colonists, 0)
      SetLong s, 33, If(Supplies, Supplies, 0), If(Money, Money, 0)
      SetLong s, 41, If(Ground.N, Ground.N, Random(100, 1000))
      SetLong s, 45, If(Ground.T, Ground.T, Random(100, 1000))
      SetLong s, 49, If(Ground.D, Ground.D, Random(100, 1000))
      SetLong s, 53, If(Ground.M, Ground.M, Random(100, 1000))
      SetWord s, 57, If(Density.N, Density.N, Random(5, 95))
      SetWord s, 59, If(Density.T, Density.T, Random(5, 95))
      SetWord s, 61, If(Density.D, Density.D, Random(5, 95))
      SetWord s, 63, If(Density.M, Density.M, Random(5, 95))
      SetWord s, 65, If(Colonists.Tax, Colonists.Tax, 0)
      SetWord s, 69, If(Colonists.Happy$, Colonists.Happy$, 100)
      If Natives Then
        SetWord s, 67, If(Natives.Tax, Natives.Tax, 0)
        SetWord s, 71, If(Natives.Happy$, Natives.Happy$, 100)
        SetWord s, 73, If(Natives.Gov$, Natives.Gov$, 5)
        SetLong s, 75, Natives
        SetWord s, 79, Natives.Race$
      Else
        SetWord s, 67, 0
        SetWord s, 71, 0, 0
        SetLong s, 75, 0
        SetWord s, 79, 0
      EndIf
      SetWord s, 81, If(Temp$, 100-Temp$, 50)
      If Base='Being built' Then
        SetWord s, 83, 1
      Else
        SetWord s, 83, 0
      EndIf
      Put #1, s, 85
    EndWith
  Next
  Close #1
EndSub

% Save the turntime file (nextturn/lastturn)
Sub sh.SaveTurntime (name)
  Local s
  Open Name For Output As #1
  SetStr s, 18, 0, Turn.Date & Turn.Time
  SetWord s, 18, Turn
  Put #1, s, 20
  Close #1
EndSub

% Save the starbase file
Sub sh.SaveBases (name)
  Local i, s, c, sid, s1, s2
  Open name For Output As #1
  SetWord s, 0, 0
  Put #1, s, 2
  For i:=1 To 500 Do
    s := z(0)                % this makes the unset fields come out as zero
    With Planets(i) Do
      If Base.YesNo Then
        If Owner$=My.Race$ Then
          % We own the base. Write it out.
          SetWord s, 0, i, Owner$, Defense.Base, Damage
          SetWord s, 8, Tech.Engine, Tech.Hull, Tech.Beam, Tech.Torpedo
          For c:=1 To 9 Do SetWord s, 14+2*c, Storage.Engines(c)
          For c:=1 To 20 Do If Truehull(c, Owner$) Then SetWord s, 32+2*c, Storage.Hulls(Truehull(c, Owner$))
          For c:=1 To 10 Do SetWord s, 72+2*c, Storage.Beams(c)
          For c:=1 To 10 Do SetWord s, 92+2*c, Storage.Launchers(c)
          For c:=1 To 11 Do SetWord s, 112+2*c, Storage.Ammo(c)

          % Shipyard order
          If Shipyard Then
            %% Ouch. PCC 1.0.13 doesn't let me access the "raw" shipyard
            %% order. The `Try' will fail accordingly, leaving `sid' zero.
            sid := 0
            Try sid := Shipyard.Id
            If Not sid Then
              % Guess the ship. Shipyard.Name has the form `name (#id)'.
              s1 := Right(Shipyard.Name, 4)
              If Right(s1, 1)=')' Then s1 := Mid(s1,1,Len(s1)-1)
              If Left(s1, 1)='(' Then s1 := Mid(s1,2)
              If Left(s1, 1)='#' Then s1 := Mid(s1,2)
              sid := Val(s1)
            EndIf
            If sid Then
              SetWord s, 136, If(Shipyard.Action='Fix', 1, 2), sid
            Else
              Print "WARNING: strange shipyard action `", Shipyard, "' on base ", i
              SetWord s, 136, 0, 0
            EndIf
          Else
            SetWord s, 136, 0, 0
          EndIf
          SetWord s, 140, Mission$
          If Build Then
            sid := 0
            For c:=1 To 20 Do If Truehull(c, Owner$)=Build.Hull$ Then sid:=c
            If Not sid Then Print "WARNING: invalid build order on base #", i
            SetWord s, 142, sid, Build.Engine$, Build.Beam$, Build.Beam.Count, Build.Torp$, Build.Torp.Count, 0
          Else
            SetWord s, 142, 0, 0, 0, 0, 0, 0, 0
          EndIf
        Else
          % Enemy/allied base. Just guess it.
          SetWord s, 0, i, Owner$, 100, 0
          SetWord s, 8, sh.Tech, sh.Tech, sh.Tech, sh.Tech
          If Natives.Race$=8 Then SetWord s, 8, 10
          If Natives.Race$=1 Then SetWord s, 10, 10
          If Natives.Race$=7 Then SetWord s, 12, 10
          If Natives.Race$=9 Then SetWord s, 14, 10
          %For c:=1 To 9+20+10+10+10 Do SetWord s, 14+2*c, 0
          SetWord s, 134, 60
          %SetWord s, 136, 0, 0, 0               % Shipyard, mission
          %SetWord s, 142, 0, 0, 0, 0, 0, 0, 0   % Build order
        EndIf
      Else
        % Enemy. Assume no base
        SetWord s, 0, i
      EndIf
      Put #1, s, 156
    EndWith
  Next
  SetWord s, 0, Turn
  Put #1, s, 2
  Close #1
EndSub

% Save ships file. Right now, only save own ships and visual contacts.
% Nonvisual contacts (=guessed, etc.) are ignored.
Sub sh.SaveShips (name)
  Local i, s, c
  Open name For Output As #1
  SetWord s, 0, 0
  Put #1, s, 2
  For i:=1 To sh.NumShips
    With Ships(i) Do
      s := z(0)
      SetWord s, 0, i
      If Hull$ And Owner$ And Loc.X And Loc.Y Then
        SetWord s, 2, Owner$
        SetStr s,3,4, If(FCode, FCode, Chr(Random(64,91))+Chr(Random(64,91))+Chr(Random(64,91)))
        SetWord s, 7, Speed$
        If Not IsEmpty(Waypoint.DX) Then
          SetWord s, 9, Waypoint.DX, Waypoint.DY
        EndIf
        SetWord s, 13, Loc.X, Loc.Y
        SetWord s, 17, If(Engine$, Engine$, Min(9, sh.Tech))
        SetWord s, 19, Hull$
        If Beam$ And Beam.Count Then
          SetWord s, 21, Beam$
          SetWord s, 23, Beam.Count
        Else
          If Beam.Max Then SetWord s, 21, sh.Tech, Beam.Max
        EndIf
        SetWord s, 25, Fighter.Bays
        If IsEmpty(Torp) Then
          If Torp.LMax Then
            SetWord s, 27, sh.Tech
            SetWord s, 31, Torp.LMax
          EndIf
        Else
          If Torp$ And Torp.LCount Then
            SetWord s, 27, Torp$
            SetWord s, 31, Torp.LCount
          EndIf
        EndIf
        SetWord s, 29, Aux.Ammo
        SetWord s, 33, Mission$
        SetWord s, 35, Enemy$
        SetWord s, 37, Mission.Tow
        SetWord s, 39, Damage
        SetWord s, 41, If(Crew, Crew, If(Crew.Normal, Crew.Normal, 10))
        SetWord s, 43, Cargo.Colonists
        SetStr s,20,45, If(Name, Name, 'Ship #' & i)
        SetWord s, 65, If(IsEmpty(Cargo.N), Cargo.MaxFuel/2, Cargo.N)
        SetWord s, 67, Cargo.T
        SetWord s, 69, Cargo.D
        SetWord s, 71, Cargo.M
        SetWord s, 73, Cargo.Supplies
        If Transfer.Unload Then
          SetWord s, 75, Transfer.Unload.N, Transfer.Unload.T, Transfer.Unload.D, Transfer.Unload.M
          SetWord s, 83, Transfer.Unload.Colonists, Transfer.Unload.Supplies, Transfer.Unload.Id
        EndIf
        If Transfer.Ship Then
          SetWord s, 89, Transfer.Ship.N, Transfer.Ship.T, Transfer.Ship.D, Transfer.Ship.M
          SetWord s, 97, Transfer.Ship.Colonists, Transfer.Ship.Supplies, Transfer.Ship.Id
        EndIf
        SetWord s, 103, Mission.Intercept
        SetWord s, 105, Cargo.Money
      EndIf
      Put #1, s, 107
    EndWith
  Next
  Close #1
EndSub

% Save SHIPXY file.
Sub sh.SaveShipXY (name)
  Local i, s, c
  Open name For Output As #1
  For i:=1 To sh.NumShips
    With Ships(i) Do
      If Hull$ And Owner$ And Loc.X And Loc.Y Then
        SetWord s, 0, Loc.X, Loc.Y, Mass, Owner$
      Else
        SetWord s, 0, 0, 0, 0, 0
      EndIf
    EndWith
    Put #1, s, 8
  Next
  Close #1
EndSub

% Save race names.
Sub sh.SaveRaceNames (name)
  Local i, s
  Open name For Output As #1
  For i:=1 To 11 Do
    SetStr s,30,0, Players(i).Race
    Put #1, s, 30
  Next
  For i:=1 To 11 Do
    SetStr s,20,0, Players(i).Race.Short
    Put #1, s, 20
  Next
  For i:=1 To 11 Do
    SetStr s,12,0, Players(i).Race.Adj
    Put #1, s, 12
  Next
  Close #1
EndSub

% Save `gen.hst'.
Sub sh.SaveGen (name)
  Local c, s, i
  Open name For Output As #1

  %% Players that play
  For i:=1 To 11 Do
    SetWord s, 44+2*i, If(sh.AllPlayers Or Players(i).Score, 1, 0)
  Next
  Put #1, s, 68

  %% Passwords. Give them no password. Hehe, tricky way ;-)
  SetStr s, 220, 0, String(11, 'NOPASSWORD')
  Put #1, s, 220

  %% Build Queue Pointer
  SetStr s, 448-288, 0, ''     % dummy bytes
  Put #1, s, 448-288

  SetWord s, 0, 1              % actual pointer
  Put #1, s, 2
  Close #1
EndSub

% Save grey.hst:
% - experience (zero)
% - ion storms
% - PBPs
% Missing: alliances (3.22.006), visibility (3.22.03x), some Host999 stuff
Sub sh.SaveGrey (name)
  Local c, s, i
  Open name For Output As #1

  %% Zero out experience values (500 words)
  s := String(250, Chr(0))
  Put #1, s, 250
  Put #1, s, 250
  Put #1, s, 250
  Put #1, s, 250

  %% Ion storms
  For i:=1 To 50 Do
    SetLong s, 0, 0, 0, 0, 0            % Zero out storm
    If Storms(i).Radius Then
      %% Currently, one cannot do `With Storms()' if the storm does not exist
      With Storms(i) Do
        SetWord s, 0, Loc.X, Loc.Y, Radius, Voltage, Heading$, Status$, 0, 0
      EndWith
    EndIf
    Put #1, s, 16
  Next

  %% PBPs
  For i:=1 To 11 Do
    SetWord s, 2*i-2, Players(i).PBPs
  Next
  Put #1, s, 22
  Close #1
EndSub

% Create a file name of specified size, containing only zeroes
Sub sh.ZapFile (name, size)
  Local s, now
  Open name For Output As #1
  Do While size > 0
    now := Min(250, size)
    s := String(now, Chr(0))
    Put #1, s, now
    size := size - now
  Loop
  Close #1
EndSub

% Save mine fields. Currently, don't bother supporting PHost's
% extmines.hst.
Sub sh.SaveMines (name)
  Dim s, i
  Open name For Output As #1
  For i:=1 To 500 Do
    SetWord s, 0, 0, 0, 0, 0, 0, 0              % 12 bytes
    If Minefields(i).Radius Then
      With Minefields(i) Do
        SetWord s, 0, Loc.X, Loc.Y, Owner$
        SetLong s, 6, Units
        SetWord s, 10, Type$
      EndWith
    EndIf
    Put #1, s, 12
  Next
  Close #1
EndSub

If (Not System.GUI) And (My.Race$) Then sh.Interactive