home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / window / wndwmsj / wndwmsj1.pas next >
Encoding:
Pascal/Delphi Source File  |  1988-11-19  |  4.4 KB  |  151 lines
  1. {From Micro/Systems Journal, Nov 88}
  2. {Simple windowing package -
  3.  Provide simple WindowOpen, WindowWrite, WindowWriteln, and
  4.  WindowClose procedures to allow user applications to readily
  5.  open and manipulate single windows (text mode only).  Note in
  6.  test code that while it is possible to open multiple windows,
  7.  only topmost window may be scrolled or written to.
  8.  }
  9. {Toad Hall Tweaks:
  10.  Using PRED(int) instead of int - 1
  11.  Using ShL 1 instead of *2
  12. }
  13.  
  14. TYPE
  15.   display = ARRAY[0..24] OF ARRAY[0..79] OF INTEGER;
  16.   datablock = ARRAY[0..1] OF INTEGER;
  17.   Str80 = STRING[80];
  18.   windowNodePtr = ^windowNode;
  19.   windowNode = RECORD
  20.                  deltaX,deltaY : INTEGER;
  21.                  winX,winY     : INTEGER;
  22.                  color         : INTEGER;
  23.                  currentX,currentY : INTEGER;
  24.                  data          : ^datablock;
  25.                END;
  26.  
  27. CONST
  28.   cga = $B800;      {offset of CGA/EGA}
  29.   mono = $B000;     {mono screen}
  30.  
  31. VAR
  32.   screen : display absolute mono:0;  {currently set for mono}
  33.  
  34. FUNCTION window_Open (x,y,width,height,attr : INTEGER) : windowNodePtr;
  35.   VAR
  36.     pntr : windowNodePtr;
  37.     size, i, j : INTEGER;
  38.  
  39.   BEGIN
  40.     NEW(pntr);
  41.     WITH pntr^ DO BEGIN
  42.       {Save data into window}
  43.       deltaX := x;
  44.       deltaY := y;
  45.       winX := width;
  46.       winY := height;
  47.       color := attr;
  48.       currentX := 0;  {set cursor to beginning of window}
  49.       currentY := 0;
  50.  
  51.       {store off section of screen into windownode}
  52.       size := (winY * winX) ShL 1;  {TH}
  53.       GetMem(data,size);
  54.  
  55.       FOR i := 0 to PRED(winY) DO
  56.       FOR j := 0 TO PRED(winX) DO BEGIN
  57.         data^[i * winX + j] := screen [deltaY + i][deltaX + j];
  58.         screen [deltaY + i][deltaX + j] := color + INTEGER(' ');
  59.       END;
  60.     END;  {with}
  61.     window_Open := pntr;  {return function result}
  62.   END;  {of window_Open}
  63.  
  64.  
  65. PROCEDURE Window_Close(w : windowNodePtr);
  66.   VAR  i,j : INTEGER;
  67.   BEGIN
  68.     WITH w^ DO BEGIN
  69.       {put original screen back}
  70.       FOR i := 0 TO PRED(winY) DO
  71.       FOR j := 0 TO PRED(winX) DO
  72.         screen [deltaY + i][deltaX +j] := data^[i * winX + j];
  73.       {now release memory to heap}
  74.       FreeMem(data,(winX * winY) ShL 1);  {TH}
  75.     END;  {with}
  76.     Dispose(w);
  77.   END;  {of Window_Close}
  78.  
  79.  
  80. PROCEDURE Window_Scroll(w : windowNodePtr; count : INTEGER);
  81.   VAR  index,xindex,yindex : INTEGER;
  82.   BEGIN
  83.     WITH w^ DO BEGIN
  84.       currentX := 0;                 {carriage return}
  85.       currentY := currentY + count;  {line feed(s)}
  86.       IF currentY >= winY            {if beyond window's end...}
  87.       THEN BEGIN                     {... scroll window's contents}
  88.         count := SUCC(currentY - winY);  {TH}
  89.         currentY := PRED(winY);          {TH}
  90.         FOR index := 0 TO PRED(winY - count) DO BEGIN
  91.           yindex := index + deltaY;
  92.           FOR xindex := deltaX to PRED(deltaX + winX) DO
  93.             screen [yindex][xindex]
  94.               := screen [yindex + count][xindex];
  95.         END;
  96.         FOR index := 1 TO count DO BEGIN  {blank bottom line(s)}
  97.           yindex := deltaY + (winY - index);
  98.           FOR xindex := deltaX TO PRED(deltaX + winX) DO
  99.             screen [yindex][xindex] := color + INTEGER(' ');
  100.         END;  {index loop}
  101.       END;  {if scrolling}
  102.     END;  {with}
  103.   END;  {of Window_Scroll}
  104.  
  105.  
  106. PROCEDURE Window_Write(w : windowNodePtr; OutStr : Str80);
  107.   VAR
  108.     i,offset,value : INTEGER;
  109.     count : byte Absolute OutStr;
  110.   BEGIN
  111.     WITH w^ DO
  112.     FOR i := 1 TO count DO
  113.     IF currentX < winX THEN BEGIN
  114.       value := color + INTEGER(outstr[i]);
  115.       screen [deltaY + currentY][deltaX + currentX] := value;
  116.       currentX := SUCC(currentX);  {TH}
  117.     END;  {if}
  118.   END;  {of Window_Write}
  119.  
  120.  
  121. PROCEDURE Window_Writeln(w : windowNodePtr; OutStr : Str80);
  122.   BEGIN
  123.     Window_Write(w,OutStr);
  124.     Window_Scroll(w,1);
  125.   END;  {of Window_Writeln);
  126.  
  127.  
  128. {give above routines a few trial calls}
  129.  
  130. PROCEDURE Exercise_W (w : windowNodePtr);
  131.   VAR  i : INTEGER;
  132.   BEGIN
  133.     FOR i := 1 TO 100 DO BEGIN
  134.       Window_Write(w, 'this is a silly string');
  135.       Window_Writeln(w,' continuation');
  136.       Window_writeln(w,'another string');
  137.     END;
  138.   END;  {of Exercise_W}
  139.  
  140. VAR  w1,w2 : windowNodePtr;
  141.  
  142. BEGIN  {main}
  143.   w1 := Window_Open(10,10,50,10,$1300);
  144.   Exercise_W(w1);
  145.   w2 := Window_Open(20,5,30,17,$4200);
  146.   Exercise_W(w2);
  147.   Window_Close(w2);
  148.   Exercise_W(w1);
  149.   Window_Close(w1);
  150. END.
  151.