{$S-,R-,I-,V-,B-}

{Deactivate the following define if exploding windows are not desired,
 in order to save about 2200 bytes of code space.}
{$DEFINE ExplodingWindows}
{Deactivate the following define if shadowed windows are not desired,
 in order to save about 800 bytes of code space.}
{$DEFINE ShadowedWindows}

{*********************************************************}
{*                  TPWINDOW.PAS 4.03                    *}
{*        Copyright (c) TurboPower Software 1987.        *}
{* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
{*     and used under license to TurboPower Software     *}
{*                 All rights reserved.                  *}
{*********************************************************}

unit TPWindow;
  {-High level support for text windows}

interface

uses
  TPCrt;

  {$IFDEF ShadowedWindows}
const
  Shadow : Boolean = False;       {True to make shadowed windows}
  ShadowAttr : Byte = $07;        {Attribute to apply to shadow}
  {$ENDIF}

  {$IFDEF ExplodingWindows}
const
  Explode : Boolean = False;      {True to make exploding windows}
  ExplodeDelay : Word = 15;       {Milliseconds per stage of explosion}
  SoundFlagW : Boolean = True;    {True to make sound during explosions}
  {$ENDIF}

type
  WindowPtr = Pointer;            {Generic type of a window}
  WindowP = ^WindowRec;           {Detailed type of a window}

  BufferArray = array[0..$FFF0] of Char; {Will hold screen image}
  BufP = ^BufferArray;

  SaveRec =
    record
      WMin : Word;                {Window coordinates}
      WMax : Word;
      CS : Byte;                  {Cursor scan lines}
      CE : Byte;
      CX : Byte;                  {Absolute cursor position}
      CY : Byte;
      Attr : Byte;                {TextAttr}
      Frame : FrameArray;         {Frame characters}
    end;

  WindowRec =                     {Details of a window}
    record
      XL, YL : Byte;              {Turbo window coordinates (no frame included)}
      XH, YH : Byte;
      XL1, YL1 : Byte;            {Overall window coordinates (frame included)}
      XH1, YH1 : Byte;
      FAttr : Byte;               {Attribute for frame}
      WAttr : Byte;               {Attribute for window contents}
      HAttr : Byte;               {Attribute for header}
      Framed : Boolean;           {True to draw frame around window}
      Clear : Boolean;            {True to clear window when it is displayed}
      Save : Boolean;             {True to save contents when window is erased}
      Active : Boolean;           {True if window is currently on screen}
      DisplayedOnce : Boolean;    {True if window displayed at least once}
      Covers : BufP;              {Points to buffer of what window covers}
      Holds : BufP;               {Points to buffer of what window holds if Save is True}
      BufSize : Word;             {Size of screen buffers}
      HeaderP : ^string;          {Stores frame title, nil if none}
      Current : SaveRec;          {Values to restore when this window is displayed}
      Previous : SaveRec;         {Values to restore when this window is erased}

      {$IFDEF ExplodingWindows}
      Exploding : Boolean;        {True if window displays and erases in stages}
      ExploDelay : Word;          {Milliseconds per stage of explosion}
      {$ENDIF}
      {$IFDEF ShadowedWindows}
      Shadows : BufP;             {Points to buffer of what shadow covers}
      Shadowed : Boolean;         {True to draw shadow around window}
      SAttr : Byte;               {Attribute for window shadow}
      ShadowSize : Word;          {Size of buffer for shadow region}
      {$ENDIF}
    end;

var
  CurrentWindow : WindowPtr;      {Currently active window}

function MakeWindow
  (var W : WindowPtr;             {Window identifier returned}
   XLow, YLow : Byte;             {Window coordinates, including frame if any}
   XHigh, YHigh : Byte;           {Window coordinates, including frame if any}
   DrawFrame : Boolean;           {True to draw a frame around window}
   ClearWindow : Boolean;         {True to clear window when displayed}
   SaveWindow : Boolean;          {True to save window contents when erased}
   WindowAttr : Byte;             {Video attribute for body of window}
   FrameAttr : Byte;              {Video attribute for frame}
   HeaderAttr : Byte;             {Video attribute for header}
   Header : string                {Title for window}
   ) : Boolean;                   {Returns True if successful}
  {-Allocate and initialize, but do not display, a new window}

function DisplayWindow(W : WindowPtr) : Boolean;
  {-Display the specified window, returning true if successful}

function EraseTopWindow : WindowPtr;
  {-Erase the most recently displayed window, returning a pointer to it}

procedure DisposeWindow(W : WindowPtr);
  {-Deallocate heap space for specified window}

function WindowIsActive(W : WindowPtr) : Boolean;
  {-Return true if specified window is currently active}

procedure ScrollWindow(Up : Boolean; Lines : Byte);
  {-Scroll current window Up or down (Up=False) the designated number of Lines}

function MoveWindow(XDelta, YDelta : Integer) : Boolean;
  {-Move current window by specified distance. Positive means right or down.}

function SetTopWindow(W : WindowPtr) : Boolean;
  {-Make an already active, stacked window the current one}

function SelectTopWindow(W : WindowPtr) : Boolean;
  {-Make an already active, tiled window the current one}

function SelectTiledWindow(W : WindowPtr) : Boolean;
  {-Display or reselect (tiled) window}

  {==========================================================================}

implementation

type
  WindowStackP = ^WindowStackRec;
  WindowStackRec =
    record
      Top : WindowPtr;
      Next : WindowStackP;
    end;

  VScreen =
    record
      XLv, XHv, YLv, YHv : Byte;
      VSiz, VWid : Word;
      VP : BufP;
    end;

var
  WindowStack : WindowStackP;     {Stack of active windows}

  {$F+}
  function HeapFunc(Size : Word) : Integer;
    {-Return nil pointer if insufficient memory}
  begin
    HeapFunc := 1;
  end;
  {$F-}

  function GetMemCheck(var P; Bytes : Word) : Boolean;
    {-Allocate heap space, returning true if successful}
  var
    SaveHeapError : Pointer;
    Pt : Pointer absolute P;
  begin
    {Take over heap error control}
    SaveHeapError := HeapError;
    HeapError := @HeapFunc;
    GetMem(Pt, Bytes);
    GetMemCheck := (Pt <> nil);
    {Restore heap error control}
    HeapError := SaveHeapError;
  end;

  procedure FreeMemCheck(var P; Bytes : Word);
    {-Deallocate heap space}
  var
    Pt : Pointer absolute P;
  begin
    if Pt <> nil then
      FreeMem(Pt, Bytes);
  end;

  function StringFromHeap(P : Pointer) : string;
    {-Return a string, empty if pointer is nil}
  var
    Pt : ^string absolute P;
  begin
    if Pt = nil then
      StringFromHeap := ''
    else
      StringFromHeap := Pt^;
  end;

  function PushStack(var WindowStack : WindowStackP; W : WindowPtr) : Boolean;
    {-Put a new window onto specified stack}
  var
    WS : WindowStackP;
  begin
    if not GetMemCheck(WS, SizeOf(WindowStackRec)) then begin
      PushStack := False;
      Exit;
    end;
    WS^.Top := W;
    WS^.Next := WindowStack;
    WindowStack := WS;
    PushStack := True;
  end;

  function PopStack(var WindowStack : WindowStackP) : WindowPtr;
    {-Pop window stack and return window at top of stack}
  var
    WS : WindowStackP;
  begin
    PopStack := nil;
    if WindowStack = nil then
      Exit;
    WS := WindowStack;
    WindowStack := WS^.Next;
    FreeMemCheck(WS, SizeOf(WindowStackRec));
    if WindowStack <> nil then
      PopStack := WindowStack^.Top;
  end;

  procedure DisposeWindow(W : WindowPtr);
    {-Deallocate heap space for specified window}
  begin
    if W = nil then
      Exit;
    with WindowP(W)^ do begin
      FreeMemCheck(HeaderP, Succ(Length(HeaderP^)));
      FreeMemCheck(Holds, BufSize);
      FreeMemCheck(Covers, BufSize);
      {$IFDEF ShadowedWindows}
      FreeMemCheck(Shadows, ShadowSize);
      {$ENDIF}
    end;
    FreeMemCheck(W, SizeOf(WindowRec));
  end;

  procedure SaveCurrentState(W : WindowPtr; ResetXY : Boolean);
    {-Store window-relative state information}
  begin
    with WindowP(W)^, Current do begin
      CS := CursorStartLine;
      CE := CursorEndLine;
      if ResetXY then begin
        CX := XL;
        CY := YL;
      end else begin
        CX := WhereXAbs;
        CY := WhereYAbs;
      end;
    end;
  end;

  procedure SetCurrentState(W : WindowPtr);
    {-Set the parameters for the current window}
  begin
    with WindowP(W)^, Current do begin
      Window(XL, YL, XH, YH);
      GoToXYAbs(CX, CY);
      SetCursorSize(CS, CE);
    end;
    CurrentWindow := W;
  end;

  procedure SavePreviousState(var Previous : SaveRec);
    {-Get settings for the current screen state}
  begin
    with Previous do begin
      CS := CursorStartLine;
      CE := CursorEndLine;
      CX := WhereXAbs;
      CY := WhereYAbs;
      Attr := TextAttr;
      WMin := WindMin;
      WMax := WindMax;
      Frame := FrameChars;
    end;
  end;

  function MakeWindow
    (var W : WindowPtr;           {Window identifier returned}
     XLow, YLow : Byte;           {Window coordinates, including frame if any}
     XHigh, YHigh : Byte;         {Window coordinates, including frame if any}
     DrawFrame : Boolean;         {True to draw a frame around window}
     ClearWindow : Boolean;       {True to clear window when displayed}
     SaveWindow : Boolean;        {True to save window contents when erased}
     WindowAttr : Byte;           {Video attribute for body of window}
     FrameAttr : Byte;            {Video attribute for frame}
     HeaderAttr : Byte;           {Video attribute for header}
     Header : string              {Title for window}
     ) : Boolean;                 {Returns True if successful}
    {-Allocate and initialize, but do not display, a new window}
  var
    Wd, Ht : Word;
  begin
    {Prepare for the worst}
    MakeWindow := False;

    {Allocate the window descriptor}
    if not GetMemCheck(W, SizeOf(WindowRec)) then
      Exit;

    with WindowP(W)^ do begin
      {Compute screen buffer size}
      Wd := Succ(XHigh-XLow);
      Ht := Succ(YHigh-YLow);
      BufSize := 2*Wd*Ht;

      {Initialize pointers to screen buffers}
      Covers := nil;
      Holds := nil;
      HeaderP := nil;
      {$IFDEF ShadowedWindows}
      Shadows := nil;
      {$ENDIF}

      {Allocate the Covers buffer}
      if not GetMemCheck(Covers, BufSize) then begin
        DisposeWindow(W);
        Exit;
      end;

      {Allocate the Holds buffer if desired}
      if SaveWindow then
        if not GetMemCheck(Holds, BufSize) then begin
          DisposeWindow(W);
          Exit;
        end;

      {Store header string if specified}
      if Header <> '' then begin
        if not GetMemCheck(HeaderP, Succ(Length(Header))) then begin
          DisposeWindow(W);
          Exit;
        end;
        HeaderP^ := Header;
      end;

      {$IFDEF ShadowedWindows}
      if (XHigh+2 > CurrentWidth) or (YHigh > CurrentHeight) then
        {Shadow won't fit on screen}
        Shadowed := False
      else begin
        if Shadow then begin
          ShadowSize := 2*(Wd+2*Ht);
          if not GetMemCheck(Shadows, ShadowSize) then begin
            DisposeWindow(W);
            Exit;
          end;
          SAttr := MapColor(ShadowAttr);
        end;
        Shadowed := Shadow;
      end;
      {$ENDIF}

      {Initialize remaining fields}
      WAttr := MapColor(WindowAttr);
      HAttr := MapColor(HeaderAttr);
      if (Wd <= 2) or (Ht <= 2) then
        DrawFrame := False;
      if DrawFrame then begin
        {Correct for size of frame}
        XL := Succ(XLow);
        XH := Pred(XHigh);
        YL := Succ(YLow);
        YH := Pred(YHigh);
        {Store current frame array}
        Current.Frame := FrameChars;
        FAttr := MapColor(FrameAttr);
      end else begin
        XL := XLow;
        XH := XHigh;
        YL := YLow;
        YH := YHigh;
        Current.Frame := '      ';
        FAttr := WAttr;
      end;
      XL1 := XLow;
      XH1 := XHigh;
      YL1 := YLow;
      YH1 := YHigh;
      {Make sure window coordinates are legal}
      if (XL > XH) or (YL > YH) then begin
        DisposeWindow(W);
        Exit;
      end;
      Framed := DrawFrame;
      Clear := ClearWindow;
      Save := SaveWindow;
      Active := False;
      DisplayedOnce := False;
      with Current do begin
        WMin := XL or Swap(YL);
        WMax := XH or Swap(YH);
      end;

      {$IFDEF ExplodingWindows}
      {Initialize for exploding windows}
      if (XH1-XL1 < 2) and (YH1-YL1 < 2) then
        Exploding := False
      else
        Exploding := Explode;
      ExploDelay := ExplodeDelay;
      {$ENDIF}

      {Store initial state for this window}
      SaveCurrentState(W, True);
    end;

    {Success}
    MakeWindow := True;
  end;

  {$IFDEF ExplodingWindows}
  procedure RestoreRect(W : WindowPtr; XLc, YLc, XHc, YHc : Byte);
    {-Restore a rectangular screen chunk from the Covers buffer}
  var
    fBPR, cBPR, R : Byte;
    fOfs, cOfs : Word;
  begin
    with WindowP(W)^ do begin
      {Get the bytes per row in full window and in chunk}
      fBPR := 2*Succ(XH1-XL1);
      cBPR := Succ(XHc-XLc);
      {Get the first address to use in the Covers buffer}
      fOfs := fBPR*(YLc-YL1)+2*(XLc-XL1);
      {Get the first address on the screen to restore}
      cOfs := 2*(CurrentWidth*Pred(YLc)+Pred(XLc));
      {Restore row by row}
      for R := YLc to YHc do begin
        MoveScreen(Covers^[fOfs], MemW[VideoSegment:cOfs], cBPR);
        Inc(fOfs, fBPR);
        Inc(cOfs, 2*CurrentWidth);
      end;
    end;
  end;

  procedure ClearRegion(XL, YL, XH, YH, Attr : Byte);
    {-Clear a region with specified attribute}
  var
    WordsPerRow, Row : Word;
    Span : string;
  begin
    WordsPerRow := Succ(XH-XL);
    Span[0] := Chr(WordsPerRow);
    FillChar(Span[1], WordsPerRow, ' ');
    for Row := YL to YH do
      FastWrite(Span, Row, XL, Attr);
  end;

  procedure SetDeltas(var SD, BD : Real; var Frames : Integer);
    {-Compute dimensions for exploding frame}
  begin
    Frames := Round(BD);
    if SD < 1.0 then
      SD := 1.0/Succ(Frames);
    SD := SD/BD;
    BD := 1.0;
  end;

  procedure ComputeDeltas(W : WindowPtr;
                          var XD, YD : Real;
                          var Frames : Integer);
    {-Compute information for exploding frame boundaries}
  begin
    with WindowP(W)^ do begin
      XD := Succ(XH1-XL1)/2.0-0.55; {Fudge factor}
      YD := Succ(YH1-YL1)/2.0-0.55;
      if XD < YD then
        SetDeltas(XD, YD, Frames)
      else
        SetDeltas(YD, XD, Frames);
    end;
  end;

  procedure ExplodeWindow(W : WindowPtr);
    {-Explode a window}
  var
    XD, YD, dX, dY : Real;
    Frames, F : Integer;
    cXL, cXH, cYL, cYH : Byte;
  begin
    with WindowP(W)^ do begin
      {Compute the smallest frame that will fit}
      ComputeDeltas(W, XD, YD, Frames);
      {Draw a series of frames}
      FrameChars := Current.Frame;
      F := Pred(Frames);
      while F >= 0 do begin
        {Erase region}
        dX := F*XD;
        dY := F*YD;
        cXL := Trunc(XL1+dX);
        cYL := Trunc(YL1+dY);
        cXH := Round(XH1-dX);
        cYH := Round(YH1-dY);
        ClearRegion(cXL, cYL, cXH, cYH, WAttr);
        if Framed then
          {Draw frame around window}
          FrameWindow(cXL, cYL, cXH, cYH, FAttr, FAttr, '');
        {Make a sound}
        if SoundFlagW then
          Sound(1320-F*35);
        if (Frames > 10) and (F > 1) then
          {Use only half the frames for big windows}
          Dec(F);
        Dec(F);
        Delay(ExploDelay);
      end;
      NoSound;
    end;
  end;

  procedure ImplodeWindow(W : WindowPtr);
    {-Erase an exploding window from the screen}
  var
    XD, YD, dX, dY : Real;
    Frames, F : Integer;
    pXL, pXH, pYL, pYH : Byte;
    cXL, cXH, cYL, cYH : Byte;
  begin
    with WindowP(W)^ do begin
      {Compute the smallest frame that will fit}
      ComputeDeltas(W, XD, YD, Frames);
      {Restore underlying screen in stages}
      pXL := XL1;
      pXH := XH1;
      pYL := YL1;
      pYH := YH1;
      FrameChars := Current.Frame;
      F := 1;
      while F < Frames do begin
        dX := F*XD;
        dY := F*YD;
        cXL := Trunc(XL1+dX);
        cYL := Trunc(YL1+dY);
        cXH := Round(XH1-dX);
        cYH := Round(YH1-dY);
        if YL1 <> YH1 then begin
          RestoreRect(W, pXL, pYL, pXH, cYL);
          RestoreRect(W, pXL, cYH, pXH, pYH);
        end;
        if XL1 <> XH1 then begin
          RestoreRect(W, pXL, cYL, cXL, cYH);
          RestoreRect(W, cXH, cYL, pXH, cYH);
        end;
        if Framed then
          {Draw frame around window}
          FrameWindow(cXL, cYL, cXH, cYH, FAttr, HAttr, '');
        pXL := cXL;
        pXH := cXH;
        pYL := cYL;
        pYH := cYH;
        if SoundFlagW then
          {Make a sound}
          Sound(1320-F*35);
        if (Frames > 10) and (F < Frames-2) then
          {Use only half the frames for big windows}
          Inc(F);
        Inc(F);
        Delay(ExploDelay);
      end;
      {Assure core is restored}
      RestoreWindow(XL1, YL1, XH1, YH1, False, Pointer(Covers));
      NoSound;
    end;
  end;
  {$ENDIF}

  {$IFDEF ShadowedWindows}
  procedure SaveShadow(W : WindowPtr);
    {-Save the screen region under the window shadow}
  var
    P : Pointer;
  begin
    with WindowP(W)^ do begin
      {Save horizontal strip}
      P := Shadows;
      if SaveWindow(XL1+2, YH1+1, XH1+2, YH1+1, False, P) then ;
      {Save vertical strip}
      P := @Shadows^[2*(XH1-XL1+1)];
      if SaveWindow(XH1+1, YL1, XH1+2, YH1, False, P) then ;
    end;
  end;

  procedure ShadowWindow(W : WindowPtr);
    {-Shadow a window by changing the attributes of underlying text}
  var
    Row : Byte;
  begin
    with WindowP(W)^ do begin
      {Change attribute of horizontal strip}
      ChangeAttribute(XH1-XL1+1, YH1+1, XL1+2, SAttr);
      {Change attribute of vertical strip}
      for Row := YL1+1 to YH1 do
        ChangeAttribute(2, Row, XH1+1, SAttr);
    end;
  end;

  procedure RestoreShadow(W : WindowPtr);
    {-Restore screen region under shadow}
  var
    P : Pointer;
  begin
    with WindowP(W)^ do begin
      {Restore horizontal strip}
      P := Shadows;
      RestoreWindow(XL1+2, YH1+1, XH1+2, YH1+1, False, P);
      {Restore vertical strip}
      P := @Shadows^[2*(XH1-XL1+1)];
      RestoreWindow(XH1+1, YL1, XH1+2, YH1, False, P);
    end;
  end;
  {$ENDIF}

  function DisplayWindow(W : WindowPtr) : Boolean;
    {-Display the specified window, returning true if successful}
  begin
    DisplayWindow := False;

    if W = nil then
      Exit;

    with WindowP(W)^ do begin
      if Active then
        {Window already on screen - can't do it twice}
        Exit;

      {Put window on active stack}
      if not PushStack(WindowStack, W) then
        Exit;

      {Save window information prior to displaying current window}
      SavePreviousState(Previous);

      {Save what window will cover}
      if SaveWindow(XL1, YL1, XH1, YH1, False, Pointer(Covers)) then ;
      {$IFDEF ShadowedWindows}
      if Shadowed then
        SaveShadow(W);
      {$ENDIF}

      {Set the new text attribute and window coordinates}
      TextAttr := WAttr;
      FrameChars := Current.Frame;
      Window(XL, YL, XH, YH);

      if Save and DisplayedOnce then
        {Previous image of window available to restore}
        RestoreWindow(XL1, YL1, XH1, YH1, False, Pointer(Holds))
      else begin
        {No previous image to restore}
        {$IFDEF ExplodingWindows}
        if Exploding then
          ExplodeWindow(W);
        {$ENDIF}
        if Framed then
          {Draw frame around window}
          FrameWindow(XL1, YL1, XH1, YH1, FAttr, HAttr, StringFromHeap(HeaderP));
        if Clear then
          {Clear the window}
          ClrScr;
      end;
      {$IFDEF ShadowedWindows}
      if Shadowed then
        ShadowWindow(W);
      {$ENDIF}

      SetCurrentState(W);
      Active := True;
      DisplayedOnce := True;

    end;
    DisplayWindow := True;
  end;

  function EraseTopWindow : WindowPtr;
    {-Erase the most recently displayed window, returning a pointer to it}
  begin
    EraseTopWindow := CurrentWindow;
    if CurrentWindow = nil then
      {No Professional windows on screen now}
      Exit;

    with WindowP(CurrentWindow)^ do begin
      if Save then
        {Save what window currently holds}
        if SaveWindow(XL1, YL1, XH1, YH1, False, Pointer(Holds)) then ;

      {Save cursor information to restore when window is reselected}
      SaveCurrentState(CurrentWindow, Clear);

      {Remove window from screen}
      {$IFDEF ShadowedWindows}
      if Shadowed then
        RestoreShadow(CurrentWindow);
      {$ENDIF}
      {$IFDEF ExplodingWindows}
      if Exploding then
        ImplodeWindow(CurrentWindow)
      else
        {$ENDIF}
        {Restore screen}
        RestoreWindow(XL1, YL1, XH1, YH1, False, Pointer(Covers));

      {Restore settings as they were when this window popped up}
      with Previous do begin
        TextAttr := Attr;
        FrameChars := Frame;
        WindMin := WMin;
        WindMax := WMax;
        SetCursorSize(CS, CE);
        GoToXYAbs(CX, CY);
      end;
      Active := False;
    end;

    {Pop the window stack}
    CurrentWindow := PopStack(WindowStack);
  end;

  function WindowIsActive(W : WindowPtr) : Boolean;
    {-Return true if specified window is currently active}
  begin
    with WindowP(W)^ do
      WindowIsActive := Active;
  end;

  procedure ScrollWindow(Up : Boolean; Lines : Byte);
    {-Scroll current window Up or down (Up=False) the designated number of Lines}
  begin
    with WindowP(CurrentWindow)^ do
      if Up then
        ScrollWindowUp(XL, YL, XH, YH, Lines)
      else
        ScrollWindowDown(XL, YL, XH, YH, Lines);
  end;

  function ScreenPtr(R, C : Byte) : Pointer;
    {-Return pointer to screen memory at position R,C}
  begin
    ScreenPtr := Ptr(VideoSegment, 2*(CurrentWidth*(R-1)+C-1));
  end;

  function Min(A, B : Integer) : Integer;
    {-Return lesser of A and B}
  begin
    if A < B then
      Min := A
    else
      Min := B;
  end;

  function Max(A, B : Integer) : Integer;
    {-Return greater of A and B}
  begin
    if A > B then
      Max := A
    else
      Max := B;
  end;

  function InitVScreen(var V : VScreen; XL, YL, XH, YH : Byte) : Boolean;
    {-Allocate and initialize virtual screen}
  var
    Vofs : Word;
    R : Byte;
  begin
    InitVScreen := False;
    with V do begin
      XLv := XL;
      YLv := YL;
      XHv := XH;
      YHv := YH;
      VWid := 2*(XHv-XLv+1);
      VSiz := VWid*(YHv-YLv+1);
      {Allocate heap space}
      if not GetMemCheck(VP, VSiz) then
        Exit;
      {Copy existing screen to virtual buffer}
      Vofs := 0;
      for R := YLv to YHv do begin
        MoveScreen(ScreenPtr(R, XLv)^, VP^[Vofs], VWid shr 1);
        Inc(Vofs, VWid);
      end;
    end;
    InitVScreen := True;
  end;

  procedure UndoVScreen(var V : VScreen);
    {-Copy virtual screen to physical screen and deallocate its space}
  var
    R : Byte;
    Vofs : Word;
  begin
    with V do begin
      {Copy buffer back to screen}
      Vofs := 0;
      for R := YLv to YHv do begin
        MoveScreen(VP^[Vofs], ScreenPtr(R, XLv)^, VWid shr 1);
        Inc(Vofs, VWid);
      end;
      {Release virtual screen space}
      FreeMemCheck(VP, VSiz);
    end;
  end;

  procedure TransferVScreen(XL, YL, XH, YH : Byte; V : VScreen; P : BufP; ToV : Boolean);
    {-Transfer screen data from P^ into or out of the virtual screen}
  var
    R : Byte;
    POfs, Vofs : Word;
    Bytes : Word;
  begin
    with V do begin
      Vofs := VWid*(YL-YLv)+2*(XL-XLv);
      POfs := 0;
      Bytes := 2*(XH-XL+1);
      for R := YL to YH do begin
        if ToV then
          Move(P^[POfs], VP^[Vofs], Bytes)
        else
          Move(VP^[Vofs], P^[POfs], Bytes);
        Inc(POfs, Bytes);
        Inc(Vofs, VWid);
      end;
    end;
  end;

  {$IFDEF ShadowedWindows}
  procedure TransferVShadow(XL, YL, XH, YH : Byte; V : VScreen; Shadows : BufP; ToV : Boolean);
    {-Transfer window shadow to or from virtual window}
  var
    P : BufP;
  begin
    P := Shadows;
    TransferVScreen(XL+2, YH+1, XH+2, YH+1, V, P, ToV);
    P := @Shadows^[2*(XH-XL+1)];
    TransferVScreen(XH+1, YL, XH+2, YH, V, P, ToV);
  end;
  {$ENDIF}

  procedure AttrVScreen(XL, YL, XH, YH : Byte; V : VScreen; Attr : Byte);
    {-Set attributes in a rectangular region of virtual window}
  var
    R, C : Byte;
    Vofs, SOfs : Word;
  begin
    with V do begin
      Vofs := VWid*(YL-YLv)+2*(XL-XLv);
      for R := YL to YH do begin
        SOfs := Vofs;
        for C := XL to XH do begin
          VP^[Vofs+1] := Char(Attr);
          Inc(Vofs, 2);
        end;
        Vofs := SOfs+VWid;
      end;
    end;
  end;

  procedure CopyToVScreen(V : VScreen; W : WindowPtr);
    {-Copy window W to virtual screen V}
  begin
    with WindowP(W)^, V do begin
      {$IFDEF ShadowedWindows}
      if Shadowed then
        {Save the new Shadows buffer}
        TransferVShadow(XL1, YL1, XH1, YH1, V, Shadows, False);
      {$ENDIF}
      {Save the new Covers buffer from virtual buffer}
      TransferVScreen(XL1, YL1, XH1, YH1, V, Covers, False);
      {Write the window Save buffer to the virtual buffer}
      TransferVScreen(XL1, YL1, XH1, YH1, V, Holds, True);
      {$IFDEF ShadowedWindows}
      if Shadowed then begin
        {Draw new shadows}
        AttrVScreen(XL1+2, YH1+1, XH1+2, YH1+1, V, SAttr);
        AttrVScreen(XH1+1, YL1+1, XH1+2, YH1+1, V, SAttr);
      end;
      {$ENDIF}
    end;
  end;

  function MoveWindow(XDelta, YDelta : Integer) : Boolean;
    {-Move current window by specified distance. Positive means right or down.}
  var
    R, ShD : Byte;
    nXL1, nXH1, nYL1, nYH1 : Integer;
    XH2, YH2, nXH2, nYH2 : Integer;
    Wid, Vofs : Word;
    V : VScreen;
  begin
    MoveWindow := False;
    if CurrentWindow = nil then
      Exit;

    with WindowP(CurrentWindow)^, V do begin

      {Compute new window position}
      nXL1 := XL1+XDelta;
      nXH1 := XH1+XDelta;
      nYL1 := YL1+YDelta;
      nYH1 := YH1+YDelta;

      {Subscript 2 also includes space for shadow, if any}
      ShD := 0;
      {$IFDEF ShadowedWindows}
      if Shadowed then
        ShD := 1;
      {$ENDIF}
      YH2 := YH1+ShD;
      XH2 := XH1+2*ShD;
      nYH2 := nYH1+ShD;
      nXH2 := nXH1+2*ShD;

      {Assure legal window}
      if (nXL1 < 1) or (nYL1 < 1) then
        Exit;
      if (nXH2 > CurrentWidth) or (nYH2 > CurrentHeight+1) then
        Exit;

      {Initialize virtual screen}
      if not InitVScreen(V, Min(XL1, nXL1), Min(YL1, nYL1),
                         Max(XH2, nXH2), Max(YH2, nYH2)) then Exit;

      {Erase window from virtual buffer}
      TransferVScreen(XL1, YL1, XH1, YH1, V, Covers, True);

      {$IFDEF ShadowedWindows}
      if Shadowed then begin
        {Erase shadow from virtual buffer}
        TransferVShadow(XL1, YL1, XH1, YH1, V, Shadows, True);
        {Save the new Shadows buffer}
        TransferVShadow(nXL1, nYL1, nXH1, nYH1, V, Shadows, False);
      end;
      {$ENDIF}

      {Save the new Covers buffer from virtual buffer}
      TransferVScreen(nXL1, nYL1, nXH1, nYH1, V, Covers, False);

      {Copy contents of window to virtual buffer in new position}
      Vofs := VWid*(nYL1-YLv)+2*(nXL1-XLv);
      Wid := XH1-XL1+1;
      for R := YL1 to YH1 do begin
        MoveScreen(ScreenPtr(R, XL1)^, VP^[Vofs], Wid);
        Inc(Vofs, VWid);
      end;

      {$IFDEF ShadowedWindows}
      if Shadowed then begin
        {Draw new shadows}
        AttrVScreen(nXL1+2, nYH1+1, nXH1+2, nYH1+1, V, SAttr);
        AttrVScreen(nXH1+1, nYL1+1, nXH1+2, nYH1+1, V, SAttr);
      end;
      {$ENDIF}

      {Copy virtual screen back to physical, and deallocate virtual}
      UndoVScreen(V);

      {Update window information}
      with Current do begin
        CX := WhereXAbs;
        CY := WhereYAbs;
        if (CX >= XL) and (CX <= XH) and (CY >= YL) and (CY <= YH) then begin
          {Cursor is in window, shift it with the window}
          Inc(CX, XDelta);
          Inc(CY, YDelta);
        end;
      end;
      XL1 := nXL1;
      XH1 := nXH1;
      YL1 := nYL1;
      YH1 := nYH1;
      Inc(XL, XDelta);
      Inc(XH, XDelta);
      Inc(YL, YDelta);
      Inc(YH, YDelta);
      {Update window coordinates and cursor position}
      SetCurrentState(CurrentWindow);
    end;
    MoveWindow := True;
  end;

  function SetTopWindow(W : WindowPtr) : Boolean;
    {-Make an already active, stacked window the current one}
  var
    TempStack : WindowStackP;
    V : VScreen;
    T : WindowPtr;
    P, C : SaveRec;
  begin
    SetTopWindow := False;

    if not WindowIsActive(W) then
      {Specified window is nowhere on-screen}
      Exit;

    if WindowStack^.Top = W then begin
      {Specified window already on top of stack}
      SetTopWindow := True;
      Exit;
    end;

    {Initialize virtual screen to hide swapping activity}
    if not InitVScreen(V, 1, 1, CurrentWidth, CurrentHeight+1) then
      Exit;

    with V do begin

      {Pop windows onto a temporary stack}
      TempStack := nil;
      repeat
        T := WindowStack^.Top;
        with WindowP(T)^ do begin
          if Save then
            {Save contents of window}
            TransferVScreen(XL1, YL1, XH1, YH1, V, Holds, False);
          {Erase window from virtual buffer}
          TransferVScreen(XL1, YL1, XH1, YH1, V, Covers, True);
          {$IFDEF ShadowedWindows}
          if Shadowed then
            TransferVShadow(XL1, YL1, XH1, YH1, V, Shadows, True);
          {$ENDIF}
          if T = W then begin
            {Temporarily save state of screen underneath W}
            P := Previous;
            {Update screen state of W}
            Current := C;
          end else if not PushStack(TempStack, T) then
            {Shouldn't get here, force exit from loop in case}
            T := W;
          C := Previous;
        end;
        if PopStack(WindowStack) = nil then
          {Shouldn't get here, force exit from loop in case}
          T := W;
      until T = W;

      {Draw stacked windows back again}
      T := TempStack^.Top;
      WindowP(T)^.Previous := P;
      while T <> nil do begin
        {Straighten out state of underlying screens}
        {Put window on active stack}
        if PushStack(WindowStack, T) then
          CopyToVScreen(V, T);
        T := PopStack(TempStack);
      end;

      {Draw the new top window on the virtual screen}
      SavePreviousState(WindowP(W)^.Previous);
      if PushStack(WindowStack, W) then
        CopyToVScreen(V, W);

      {Copy virtual screen back to physical, and deallocate virtual}
      UndoVScreen(V);

      {Update window information}
      with WindowP(W)^ do begin
        TextAttr := WAttr;
        FrameChars := Current.Frame;
      end;
      SetCurrentState(W);

    end;

    SetTopWindow := True;
  end;

  function SelectTopWindow(W : WindowPtr) : Boolean;
    {-Make an already active, tiled window the current one}
  var
    TempStack : WindowStackP;
    U, V : WindowPtr;
  begin
    SelectTopWindow := False;
    if (W = nil) or not WindowIsActive(W) then
      Exit;
    if CurrentWindow <> W then begin
      {Save the state of the current window}
      SaveCurrentState(CurrentWindow, WindowP(CurrentWindow)^.Clear);
      {Remove windows from stack until desired window is taken off}
      TempStack := nil;
      repeat
        V := WindowStack^.Top;
        U := PopStack(WindowStack);
        if V <> W then
          if not PushStack(TempStack, V) then
            Exit;
      until V = W;
      {Put remaining windows back on stack}
      V := TempStack^.Top;
      while V <> nil do begin
        if not PushStack(WindowStack, V) then
          Exit;
        V := PopStack(TempStack);
      end;
      {Put desired window on top of stack}
      if not PushStack(WindowStack, W) then
        Exit;
      {Select the desired window for writing}
      with WindowP(W)^ do begin
        TextAttr := WAttr;
        FrameChars := Current.Frame;
      end;
      SetCurrentState(W);
    end;
    SelectTopWindow := True;
  end;

  function SelectTiledWindow(W : WindowPtr) : Boolean;
    {-Display or reselect tiled window}
  begin
    if WindowIsActive(W) then
      SelectTiledWindow := SelectTopWindow(W)
    else
      SelectTiledWindow := DisplayWindow(W);
  end;

begin
  {No windows are active}
  CurrentWindow := nil;
  WindowStack := nil;
end.
