{$I-,X+,O+,F+}
unit MapWin;

interface

uses Objects, Drivers, Views;

type
  PMapViewer = ^TMapViewer;
  TMapViewer = object(TScroller)
    MapLines: PCollection;
    constructor Init(var Bounds: TRect;
      AHScrollBar, AVScrollBar: PScrollBar);
    constructor Load(var S: TStream);
    destructor Done; virtual;
    function GetHelpCtx: Word; virtual;
    function GetPalette: PPalette; virtual;
    procedure Draw; virtual;
    procedure SetState(AState: Word; Enable: Boolean); virtual;
    procedure FillList;
  end;

  PMapWindow = ^TMapWindow;
  TMapWindow = object(TWindow)
    MapViewer: PMapViewer;
    constructor Init;
    constructor Load(var S: TStream);
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SizeLimits(var Min, Max: TPoint); virtual;
    procedure Store(var S: TStream);
  end;

const
  CMapViewer     = #6#7;
  CMapColor      = #$70#$7F#$7A#$31#$31#$70#$1E#$4E;
  CMapBlackWhite = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  CMapMonochrome = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  CMapWindow     = #128#129#130#131#132#133#134#135;

procedure RSRMapWindow(RSR: PResourceFile);
procedure Map;

implementation

uses Dos, Memory, App, MsgBox, EditMsg, StrCol, WinPos, CNWinPos, HeapUMB,
  TPString, Consts, Commands;

 type
   MCBType = Record
     BlockType   : Char;
     Owner       : Word;
     Size        : Word;
     Reserved    : array[0..2] of Byte;
     Name        : Array[1..9] of char;
   end;

   FileStr = String[67];

   PType  = record
      Offs, Segm : Word;
   end;

function DWordMul(X, Y: Integer): Longint; inline($5A/$58/$F7/$E2);

  Function GetNextBlock(BlockSeg : Word) : Word;
   var
    BlockPtr            : ^MCBType;
   begin
    BlockPtr := Ptr(BlockSeg,0);
    if (BlockPtr^.BlockType = 'M') or (BlockPtr^.BlockType = 'Z') then
      GetNextBlock := BlockSeg + BlockPtr^.Size +1
                                 else
      GetNextBlock := 0;
   end;

  Function GetBlockSize(BlockSeg : Word) : Word;
   var
    BlockPtr            : ^MCBType;
   begin
    BlockPtr := Ptr(BlockSeg,0);
    if (BlockPtr^.BlockType = 'M') or (BlockPtr^.BlockType = 'Z') then
      GetBlockSize := BlockPtr^.Size
    else
      GetBlockSize := 0;
   end;

 Function GetMasterBlock : Word;
  var
    Owner ,
    BlockSeg : Word;
  begin
      if Lo(DosVersion) < 4 then
       begin
        {Interrupt $2E points into COMMAND.COM}
        Owner := MemW[0:(2+4*$2E)];
        {Mcb points to memory control block for COMMAND}
        BlockSeg  := Owner-1;
        if (Mem[BlockSeg :0] <> Byte('M')) or
           (MemW[BlockSeg :1] <> Owner) then BlockSeg:=0;
        GetMasterBlock := BlockSeg;
       end
      else
       asm
        mov ah,52h
        int 21h
        mov ax,es:[bx-2]
        mov @Result,ax
       end;
   end;

  Function GetProgStr(PSPSegment : word) : FileStr;
    type
      PSPType           = Array[0..$100] of Byte;
      EnvType           = Array[0..1000] of char;
    var
      i : Integer;
      PtrPsp : ^PSPType;
      EnvSegPtr : ^Word;
      Env : ^EnvType;
      Ps : byte;
      Name : NameStr;
      Ext : ExtStr;
      Prog : FileStr;
      Dir : DirStr;
     begin
      GetProgStr := '';
      PtrPSP:=Ptr(PSPSegment,0);
      if not ((PtrPSP^[0] = $CD) and (PtrPSP^[1]=$20)) then Exit;
      if Lo(DosVersion) < 4 then
      begin
        EnvSegPtr:=Addr(PtrPSP^[$2C]);
        Env:=Ptr(EnvSegPtr^,0);
        Prog:='';
        for i:=0 to 1000 do
         if (Env^[i]=#0) and (Env^[i+1]=#0) then
           begin
            i:=i+4;
            While Env^[i] <> #0 do
             begin
              Prog:=Prog+Env^[i];
              i:=i+1;
             end;
            FSplit(Prog,Dir,Name,Ext);
            GetProgStr := Name+Ext;
            Exit;
           end;
      end
      else
       begin
        Prog := '';
        for Ps := 1 to 8 do
         begin
          Prog := Prog + MCBType(Ptr(PSPSegment-1,0)^).Name[Ps];
          if Prog[Ps] = #0 then Break;
         end;
         GetProgStr := Prog;
       end;
    end;

   Function GetVectors(BlockSeg: word;BlockSize : Longint) : String;
    var
     Vector  : Pointer;
     Abs_Addr : Longint;
     Vect    : Byte;
     VecStr  : String;
    begin
     VecStr := '';
     for Vect := 0 to 255 do
      begin
       GetIntVec(Vect,Vector);
       Abs_Addr := DWordMul(PType(Vector).Segm, 16) + PType(Vector).Offs;
       if (Abs_Addr >= DWordMul(BlockSeg, 16)) and
          (Abs_Addr <= DWordMul(BlockSeg, 16) + BlockSize) then
         VecStr := VecStr + HexB(Vect) + ' ';
      end;
     GetVectors := VecStr;
    end;

constructor TMapViewer.Init(var Bounds: TRect;
  AHScrollBar, AVScrollBar: PScrollBar);
begin
  TScroller.Init(Bounds, AHScrollbar, AVScrollBar);
  GrowMode := gfGrowHiX + gfGrowHiY;
  FillList;
end;

constructor TMapViewer.Load(var S: TStream);
begin
  TScroller.Load(S);
  FillList;
end;

destructor TMapViewer.Done;
begin
  if MapLines <> nil then Dispose(MapLines, Done);
  TScroller.Done;
end;

function TMapViewer.GetHelpCtx: Word;
begin
  if State and sfDragging <> 0 then
    GetHelpCtx := hcDragging
  else GetHelpCtx := hcSMemoryMap;
end;

function TMapViewer.GetPalette: PPalette;
const
  P: String[Length(CMapViewer)] = CMapViewer;
begin
  GetPalette := @P;
end;

procedure TMapViewer.Draw;
var
  P: PString;
  I: Integer;
  C: Byte;
  B: TDrawBuffer;
begin
  C := GetColor(1);
  for I := 0 to Size.Y - 1 do
  begin
    MoveChar(B, ' ', C, Size.X);
    if Delta.Y + I < MapLines^.Count then
    begin
      P := MapLines^.At(Delta.Y + I);
      if P <> nil then MoveStr(B, Copy(P^, Delta.X + 1, Size.X), C);
    end;
    WriteLine(0, I, Size.X, 1, B);
  end;
end;

procedure TMapViewer.SetState(AState: Word; Enable: Boolean);
begin
  TScroller.SetState(AState, Enable);
  if (AState and sfExposed <> 0) and Enable then
    SetLimit(Limit.X, Limit.Y);
end;

procedure TMapViewer.FillList;
 var
   Len:         Byte;
   MasterBlock,
   BlockSeg     : Word;
   BlockSize    : Longint;
   BlockName,
   SizeStr      : FileStr;
   MapStr       : String;
begin
  MapLines := New(PStringsCollection, Init(8, 8));
  MasterBlock := GetMasterBlock;
  BlockSeg := MasterBlock;
  Len := 0;
  while BlockSeg <> 0 do
  begin { просмотр памяти }
    BlockName := GetProgStr(BlockSeg+1);
    BlockSize := DWordMul(GetBlockSize(BlockSeg), 16);
    if (BlockName <> '') or (BlockSeg = MasterBlock) then
    begin
      if (Lo(DosVersion) < 4) and
         (BlockSeg = MasterBlock) then BlockName := 'COMMAND.COM';
      if (Lo(DosVersion) < 4) or (BlockSeg <> MasterBlock) then
      begin
        FormatStr(SizeStr, '%d', BlockSize);
        FillChar(MapStr,SizeOf(MapStr),' ');
        MapStr[0] := #32;
        Insert(HexW(BlockSeg+1),MapStr,1);
        Insert(SizeStr,MapStr,6);
        Insert(BlockName,MapStr,15);
        Insert(GetVectors(BlockSeg+1,BlockSize),MapStr,30);
        TrimSt(MapStr);
        if Length(MapStr) > Len then Len := Length(MapStr);
{        if MapStr <> '' then MapLines^.Insert(NewStr(MapStr));}
	if MapStr <> '' then MapLines^.Insert(NewStrUMB(MapStr));
      end;
    end;
    BlockSeg := GetNextBlock(BlockSeg);
  end;
  Limit.X := Size.X + Len;
  Limit.Y := MapLines^.Count;
end;

constructor TMapWindow.Init;
var
  R: TRect;
begin
  Desktop^.GetExtent(R); R.A.Y := R.B.Y - 8;
  TWindow.Init(R, 'Memory map', wnNoNumber);
  GetExtent(R);
  R.Grow(-1, -1);
  MapViewer := New(PMapViewer, Init(R,
    StandardScrollBar(sbHorizontal + sbHandleKeyboard),
    StandardScrollBar(sbVertical + sbHandleKeyboard)));
  Insert(MapViewer);
  WinPos := @MMapWinPos;
end;

constructor TMapWindow.Load(var S: TStream);
begin
  TWindow.Load(S);
  GetSubViewPtr(S, MapViewer);
  WinPos := @MMapWinPos;
end;

function TMapWindow.GetPalette: PPalette;
const
  P: String[Length(CMapWindow)] = CMapWindow;
begin
  GetPalette := @P;
end;

procedure TMapWindow.HandleEvent(var Event: TEvent);
begin
  if (Event.What = evKeyDown) and (Event.KeyCode = kbEsc) then
  begin
    Event.What := evCommand;
    Event.Command := cmClose;
    Event.InfoPtr := @Self;
  end
  else if Event.What = evBroadcast then
    case Event.Command of
      cmMap:
	begin
	  Deiconize;
	  Show;
	  Select;
          ClearEvent(Event);
        end;
    end;
  TWindow.HandleEvent(Event);
end;

procedure TMapWindow.SizeLimits(var Min, Max: TPoint);
begin
  TWindow.SizeLimits(Min, Max);
  Min.X := 22;
end;

procedure TMapWindow.Store(var S: TStream);
begin
  TWindow.Store(S);
  PutSubViewPtr(S, MapViewer);
end;

procedure RSRMapWindow(RSR: PResourceFile);
var
  W: PMapWindow;
begin
  W := New(PMapWindow, Init);
  RSR^.Put(W, 'MAPWINDOW');
  Dispose(W, Done);
end;

procedure Map;
var
  R: TRect;
  W: PMapWindow;
begin
  W := PMapWindow(Resource^.Get('MAPWINDOW'));
  if W <> nil then
  begin
    if (WinPosMask and wpMMap <> 0) and ValidWinPos(MMapWinPos) then
      SetWinPos(Desktop, MMapWinPos, R)
    else
    begin
      Desktop^.GetExtent(R);
      R.A.Y := R.B.Y - 8;
    end;
    W^.Locate(R);
    Application^.InsertWindow(W);
  end
  else ResourceNotFoundMsgBox('Map window');
end;

end.
