Power-Programmierung/CD1.mdf/pascal/library/dos/window/wndwmsj/wndwmsj2.pas

Pascal/Delphi Source File | 1988-11-19 | 9.3 KB | 318 lines

{From Micro/Systems Journal, Dec 88}
{Advanced windowing package -
   by Stephen Randy Davis, 1988
 This windowing package does not suffer from the single-tasking
 limitations of many windowing packages.  Specifically, these
 windows may be scrolled independently, even windows that are
 not currently on top.
 }
{Toad Hall Tweaks:
 Using PRED(int) instead of int - 1, SUCC(int) instead of int + 1
 Using ShL 1 instead of *2
 Writing back to Turbo 3.0 (replacing 'word' with INTEGER)
 Changing test attributes to 'normal', 'underlined', and 'reverse'
 for mono screens.

}

TYPE
  datablock = ARRAY[0..1] OF INTEGER;
  Str80 = STRING[80];
  windowNodePtr = ^windowNode;
  masktype = INTEGER;  {TH}
  windowNode = RECORD
                 signature         : INTEGER;
                 deltaX,deltaY     : INTEGER;
                 winX,winY         : INTEGER;
                 color             : INTEGER;
                 currentX,currentY : INTEGER;
                 priority,mask     : masktype;
                 next              : windowNodePtr;
                 dsize             : INTEGER;
                 data              : ^datablock;
               END;

CONST
  CGA = $B800;      {offset of CGA/EGA}
  MONO = $B000;     {mono screen}
  WINSIG = $1234;

VAR
  head : windowNodePtr;  {pointer to the window list}
  screen : ARRAY[0..24] OF ARRAY[0..79] OF INTEGER
           absolute mono:0;  {currently set for mono}
  accessrights : ARRAY[0..24] OF ARRAY[0..79] OF masktype;


{These procedures are required internally}

PROCEDURE Sig_Check(w : windowNodePtr; Msg : Str80);
  {Check the node signature to make sure it's valid}
  BEGIN
    IF w^.signature <> WINSIG THEN BEGIN
      Writeln('Signature Error: ', Msg);
      Halt;
    END;
  END;  {of Sig_Check}


PROCEDURE Window_Add(before, w : windowNodePtr);
  {Add a window to the window list}
  BEGIN
    Sig_Check(w,      'Window Add W argument');
    Sig_Check(before, 'Window Add Before argument');
    w^.next := before^.next;
    before^.next := w;
  END;  {of Window_Add}


PROCEDURE Window_Remove(w : windowNodePtr);
  {Remove a window from the window list}
  VAR  pntr : windowNodePtr;
  BEGIN
    Sig_Check(w, 'WindowRemove W argument');
    pntr := head;
    WHILE pntr <> NIL DO BEGIN
      IF pntr^.next = w
      THEN pntr^.next := w^.next;
      pntr := pntr^.next;
    END;
  END;  {of Window_Remove}


FUNCTION _precedence (w : windowNodePtr) : masktype;
  {Calculate the precedence of a window in the list}
  VAR
    pntr : windowNodePtr;
    p    : masktype;
  BEGIN
    IF w <> NIL THEN Sig_Check(w, 'Precedence W argument');
    p := 0;
    pntr := head^.next;
    WHILE pntr <> w DO BEGIN
      Sig_Check(pntr, 'Precedence chain traversal');
      p := p OR pntr^.priority;
      pntr := pntr^.next;
    END;
    _precedence := p;
  END;  {of _precedence}


PROCEDURE New_Mask(VAR w : windowNodePtr);  {TH the VAR is mine}
  {Calculate a mask for the current window node}
  VAR
    mask,bit : masktype;
{    pntr : windowNodePtr; unused}
  BEGIN
    mask := _precedence(NIL);
    bit := 1;
    WHILE (bit AND mask) <> 0 DO
      bit := bit + bit;
    IF bit <> 0 THEN BEGIN
      w^.priority := bit;
      w^.mask := NOT (mask OR bit);
    END;
  END;  {of New_Mask}


PROCEDURE Set_Access(w : windowNodePtr);
  {Add the current window to the access list}
  VAR  x,y : INTEGER;  {TH}
  BEGIN
    Sig_Check(w, 'SetAccess window argument');
    WITH w^ DO
    FOR y := deltaY TO deltaY + PRED(winY) DO
    FOR x := deltaX TO deltaX + PRED(winX) DO
      accessrights [y][x] := accessrights [y][x] XOR priority;
  END;  {of Set_Access}


PROCEDURE Window_Paint (w : windowNodePtr);
  {Paint the current window to the screen}
  VAR x,y,offset : INTEGER;  {TH}
  wd,ht : INTEGER;  {TH}
  BEGIN
    Sig_Check(w, 'WindowPaint window argument');
    WITH w^ DO
    FOR ht := 0 TO PRED(winY) DO BEGIN  {TH}
      y := deltaY + ht;
      offset := ht * winX;
      FOR wd := 0 TO PRED(winX) DO BEGIN  {TH}
        x := deltaX + wd;
        IF (accessrights [y][x] AND mask) = 0
        THEN screen [y][x] := w^.data^ [offset + wd];
      END;  {for}
    END;  {for}
  END;  {of Window_Paint}


PROCEDURE Restack;
  {Restack the precedence of the windows in the list}
  VAR  pntr : windowNodePtr;
  BEGIN
    pntr := head^.next;
    WHILE pntr <> NIL DO BEGIN
      pntr^.mask := _precedence(pntr);
      Window_Paint(pntr);
      pntr := pntr^.next;
    END;  {while}
  END;  {of Restack}


PROCEDURE Window_Scroll(w : windowNodePtr; count : INTEGER);
  {Scroll the current window by 'count' lines}
  VAR  index,offset,total : INTEGER;  {TH}
  BEGIN
    WITH w^ DO
    IF count > 0 THEN BEGIN
      currentX := 0;                 {carriage return}
      currentY := currentY + count;  {line feed(s)}
      IF currentY >= winY            {if beyond window's end...}
      THEN BEGIN                     {... scroll window's contents}
        count := SUCC(currentY - winY);  {TH}
        currentY := PRED(winY);          {TH}
        offset := winX * count;
        total := winX * (winY - count);
        FOR index := 0 TO total DO
          data^[index] := data^[index + offset];

        FOR index := total TO PRED(total + offset) DO  {TH}
          data^[index] := color + INTEGER(' ');  {TH}
      END;  {if scrolling}
    END;  {with}
    Window_Paint(w);
  END;  {of Window_Scroll}

{User accessible functions are Window_Open, Window_Close, Window_Write,
 and Window_Pop}


FUNCTION window_Open (x,y,width,height,attr : INTEGER) : windowNodePtr;
  {Open a window of the given size and color}
  VAR
    w : windowNodePtr;
    i, j : INTEGER;  {TH}
  BEGIN
    NEW(w);
    WITH w^ DO BEGIN
      {Save data into window}
      signature := WINSIG;  {store signature field in first thing}
      deltaX := x;
      deltaY := y;
      winX := width;
      winY := height;
      color := attr;
      currentX := 0;  {set cursor to beginning of window}
      currentY := 0;

      {store off the section of screen into the windownode}
      dsize := (winY * winX) ShL 1;  {TH}
      GetMem(data,dsize);

      {Calculate priority of current window}
      New_Mask(w);

      {Set the access list for this window}
      Set_Access(w);

      {Now add window to the linked list}
      Window_Add(head,w);

      {Finally, clear window and write it to the screen}
      FOR i := 0 TO winY DO
      FOR j := 0 to winX DO
        data^[i * winX + j] := color;
      WIndow_Paint(w);
    END;
    Window_Open := w;  {return function result}
  END;  {of Window_Open}


PROCEDURE Window_Close(VAR w : windowNodePtr);
  {Close and remove the window from the window list}
  BEGIN
    Window_Remove(w);            {remove window from list}
    Set_Access(w);               {now remove its mask}
    FreeMem(w^.data, w^.dsize);  {free up its data memory}
    Dispose(w);                  {and its node}
    Restack;                     {repaint windows left}
    w := NIL;                    {and return a NULL}
  END;  {of Window_Close}


PROCEDURE Window_Pop(before, w : windowNodePtr);
  {Move the window 'w' after the window 'before' in the
   window list.
  }
  BEGIN
    Window_Remove(w);         {remove the window}
    Window_Add(before,w);     {now reposition it}
    Restack;                  {and redraw all windows}
  END;  {of Window_Pop}


PROCEDURE Window_Writeln(w : windowNodePtr; OutStr : Str80;
                         nlines : INTEGER);  {TH}
  {Write an ASCII string to the specified window}
  VAR
    i,vertoffset : INTEGER;  {TH}
    count : BYTE absolute OutStr;
  BEGIN
    WITH w^ DO BEGIN
      vertoffset := currentY * winX;
      FOR i := 1 TO count DO
      IF currentX < winX THEN BEGIN
        data^ [vertoffset + currentX] := color + INTEGER(Outstr[i]);
        currentX := SUCC(currentX);  {TH}
      END;
    END;  {with}
    Window_Scroll(w,nlines);
  END;  {of Window_Writeln}



PROCEDURE Exercise_W (w : windowNodePtr);
  {Test code to write to and scroll the specified window}
  VAR  i : INTEGER;
  BEGIN
    FOR i := 1 TO 100 DO
      Window_Writeln(w,'This''s just a string', SUCC(i MOD 3) );  {TH}
  END;  {of Exercise_W}


VAR
  background,w1,w2,w3 : windowNodePtr;
  x,y : INTEGER;  {TH}

BEGIN  {main}
  {Initialization section}
  New(head);                    {define a head structure}
  head^.signature := WINSIG;    {to point to the window list}
  head^.next := NIL;
  FOR y := 0 TO 24 DO           {clear the accessrights}
  FOR x := 0 TO 79 DO
    accessrights[y][x] := 0;
  background := Window_Open(0,0,80,25,$0700);

  {Open a few overlapping windows and exercise them --
   remove this to make this into an Advanced Window Unit}

  w1 := window_Open(10,10,50,10,$7000);   {1300H for CGA}
  Exercise_W(w1);
  w2 := window_Open(20,5,30,17,$0100);   {4200H for CGA}
  Exercise_W(w2);
  w3 := window_Open(30,7,20,8,$0700);    {2500H for CGA}
  Exercise_W(w3);

  Exercise_W(w1);              {scroll background window}

  {change the order of the windows}
  Window_Pop(w1,w2);           {pop window1 above window2}
  Exercise_W(w1);              {and scroll it again}

  {remember to close the windows to remove this from the display}
  Window_Close(w2);
  Window_Close(w3);
  Window_Close(w1);
END.