home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / microcrn / issue_38.arc / SCREEN38.FIG < prev    next >
Encoding:
Modula Definition  |  1987-09-21  |  9.1 KB  |  320 lines
  1.  
  2.  
  3. (* Figure  1 *)
  4.  
  5. DEFINITION MODULE ScreenBlocks;
  6. (* This module is system specific. This version is written for the IBM-PC
  7.    and clones using MS-DOS. *)
  8.  
  9. EXPORT QUALIFIED CutBlock,PasteBlock;
  10.  
  11. PROCEDURE CutBlock(    FirstRow,LastRow,FirstCol,LastCol : CARDINAL;
  12.                        Handle : ARRAY OF CHAR;
  13.                    VAR done : BOOLEAN);
  14. (* Cuts a block of screen characters and their attributes and saves them
  15.    for later retrieval. *)
  16.  
  17. PROCEDURE PasteBlock(    Handle : ARRAY OF CHAR ;
  18.                          UpperLeftX,UpperLeftY : CARDINAL;
  19.                          NewPosition : BOOLEAN;
  20.                      VAR done : BOOLEAN);
  21. (* Retrieves and pastes a block in a new position if new position is
  22.    true or replaces it in its old position if new position is false.  *)
  23.  
  24.  
  25. END ScreenBlocks.
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32. (* Figure 2 *)
  33.  
  34. TYPE NameArray   = ARRAY[0..24] OF CHAR;
  35.      ScreenBlock = RECORD
  36.                      Handle : NameArray;
  37.                      FirstRow,LastRow,FirstCol,LastCol: CARDINAL;
  38.                      Row : BlockType;
  39.                    END;
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46. (* Figure 3 *)
  47.  
  48. IMPLEMENTATION MODULE ScreenBlocks;
  49. (* This module is system specific. This version is written for the IBM-PC
  50.    and clones using MS-DOS. *)
  51.  
  52. FROM Storage IMPORT ALLOCATE,DEALLOCATE,Available;
  53. FROM Strings IMPORT Assign,CompareStr;
  54. FROM SYSTEM IMPORT AX,BX,CX,DX,SETREG,GETREG,CODE,SWI,TSIZE,BYTE,WORD;
  55.  
  56. CONST  rows    =  25;
  57.        cols    =  80;
  58.        NumBlocks = 10;
  59.        PUSHBP  =  0055H;
  60.        POPBP   =  005DH;
  61.        INT10   =  0010H;
  62.        READCH  =  0800H;
  63.        WRITECH =  0900H;
  64.        GETMODE =  0F00H;
  65.        CURSOR  =  0200H;
  66.        ROWINC  =  0100H;
  67.        NAMELENGTH = 24;
  68.  
  69. TYPE  CA  = ARRAY[0..1] OF BYTE; (* Contains char value and attribute. *)
  70.           (* CA[0] is the character and CA[1] is the attribute. *)
  71.       R = ARRAY[0..cols - 1] OF CA; (* Each line of the 80 col display. *)
  72.       RowPointer = POINTER TO R;
  73.       BlockType = ARRAY[0..rows - 1] OF RowPointer;
  74.       ScreenBlock = RECORD
  75.                       Handle : ARRAY[0..NAMELENGTH] OF CHAR;
  76.                       FirstRow,LastRow,FirstCol,LastCol : CARDINAL;
  77.                       Row : BlockType;
  78.                     END;
  79.       BlockPointer = POINTER TO ScreenBlock;
  80.       BlockArray = ARRAY[0..NumBlocks - 1] OF BlockPointer;
  81.  
  82. VAR BlockSpace : BlockArray;
  83.  
  84. PROCEDURE CutBlock(FirstRow,LastRow,FirstCol,LastCol : CARDINAL;
  85.                    Handle : ARRAY OF CHAR ; VAR done : BOOLEAN);
  86.  
  87. VAR I,J,K,NumCols,Position : CARDINAL;
  88.     A : BlockPointer;
  89.     MODE,PAGE,TEMP : WORD;
  90.  
  91. BEGIN
  92.     done := FALSE;
  93. (* Test for legitimate input. *)
  94.     IF (((FirstRow <= LastRow) AND (FirstCol <= LastCol))
  95.     AND ((LastRow < rows) AND (LastCol < cols))) THEN
  96.  
  97. (* Calculate the number of rows and the number of columns. *)
  98.       NumCols := LastCol - FirstCol + 1;
  99.  
  100. (* Now allocate the minimum space for the screen block. *)
  101.       IF Available(TSIZE(ScreenBlock)) THEN
  102.         NEW(A);
  103.   (* Initialize the screen block. *)
  104.         A^.FirstRow := FirstRow;
  105.         A^.LastRow := LastRow;
  106.         A^.FirstCol := FirstCol;
  107.         A^.LastCol := LastCol;
  108.         Assign(Handle,A^.Handle);
  109.         FOR I := 0 TO (rows - 1) DO A^.Row[I] := NIL; END;
  110.  
  111.   (* Calculate the needed space. *)
  112.         J := TSIZE(CA) * NumCols;
  113.  
  114.   (* Now allocate the needed space. *)
  115.         WITH A^ DO
  116.           FOR I := FirstRow TO LastRow DO
  117.             IF Available(J) THEN
  118.               ALLOCATE(Row[I],J);
  119.             ELSE
  120.               FOR K := I TO FirstRow BY -1 DO
  121.                 DEALLOCATE(Row[K],J);
  122.               END;
  123.               DISPOSE(A);
  124.               RETURN;
  125.             END;  (* FOR K *)
  126.           END;  (* For I *)
  127.         END; (* With *)
  128.  
  129.   (* Now read the screen blocks *)
  130.         CODE(PUSHBP);   (* Save the Base Pointer. *)
  131.   (* First find the currently displayed page and mode. *)
  132.         SETREG(AX,GETMODE);
  133.         SWI(INT10);
  134.         GETREG(AX,MODE);
  135.         GETREG(BX,PAGE);
  136.  
  137.   (* Now read each location. *)
  138.         FOR I := FirstRow TO LastRow DO
  139.           Position := (I * ROWINC) + FirstCol;
  140.           FOR J := 0 TO NumCols - 1 DO
  141.   (* First the cursor must be positioned. *)
  142.             SETREG(AX,CURSOR);
  143.             SETREG(BX,PAGE);
  144.             SETREG(DX,Position);
  145.             SWI(INT10);
  146.  
  147.   (* Now the character must be read. *)
  148.             SETREG(AX,READCH);
  149.             SETREG(BX,PAGE);
  150.             SWI(INT10);
  151.             GETREG(AX,TEMP);
  152.    (******** Warning the next statement is word size sensitive. *******)
  153.             A^.Row[I]^[J] := CA(TEMP);
  154.             INC(Position);
  155.           END;
  156.         END;
  157.         CODE(POPBP);
  158.   (* Now try to store the block *)
  159.         I := 0;
  160.   (* Find an open storage space. *)
  161.         WHILE ((I < NumBlocks) AND (BlockSpace[I] # NIL)) DO
  162.           INC(I);
  163.         END;
  164.   (* If one was open then store the block. *)
  165.         IF I < NumBlocks THEN BlockSpace[I] := A; done := TRUE; END;
  166.       END;  (* IF *)
  167.    ELSE
  168.      done := FALSE;
  169.    END;
  170. END CutBlock;
  171.  
  172. PROCEDURE FindBlock(Handle : ARRAY OF CHAR;
  173.                     VAR INDEX : CARDINAL;
  174.                     VAR A : BlockPointer;
  175.                     VAR found : BOOLEAN);
  176.  
  177. BEGIN
  178.   found := FALSE;
  179.   INDEX := 0;
  180.   WHILE INDEX < NumBlocks DO
  181.     IF BlockSpace[INDEX] # NIL THEN
  182.       IF CompareStr(BlockSpace[INDEX]^.Handle,Handle) = 0 THEN
  183.         found := TRUE;
  184.         A := BlockSpace[INDEX];
  185.         RETURN;
  186.       END;  (* IF CompareStr *)
  187.     END;  (* If BlockSpace *)
  188.     INDEX := INDEX + 1;
  189.   END;  (* WHILE *)
  190. END FindBlock;
  191.  
  192. PROCEDURE PasteBlock(    Handle : ARRAY OF CHAR;
  193.                          UpperLeftX,UpperLeftY : CARDINAL;
  194.                          NewPosition : BOOLEAN;
  195.                      VAR done : BOOLEAN);
  196. (* This can either paste the block in a new position if new position is
  197.    true or replace it in its old position if new position is false. *)
  198.  
  199. VAR I,J,K,NumRows,NumCols,Position,CH,PC,
  200.     FirstCol,LastCol,FirstRow,LastRow : CARDINAL;
  201.     A : BlockPointer;
  202.     MODE,PAGE : WORD;
  203.     found,checked : BOOLEAN;
  204.     chr : CHAR;
  205.     MASK,TEMP : BITSET;
  206.  
  207. BEGIN
  208. (* Find the Handle *)
  209.   done := FALSE;
  210.   found := FALSE;
  211.   checked := FALSE;
  212.   MASK := {15,14,13,12,11,10,9,8};
  213.   FindBlock(Handle,I,A,found);
  214.   IF found THEN
  215. (* Calculate the number of rows and the number of columns. *)
  216.     NumRows := A^.LastRow - A^.FirstRow + 1;
  217.     NumCols := A^.LastCol - A^.FirstCol + 1;
  218.     IF NewPosition THEN
  219. (* Check to see if the new position will fit *)
  220.       IF (((UpperLeftX + NumCols) < cols) AND
  221.           ((UpperLeftY + NumRows) < rows)) THEN
  222.           FirstCol := UpperLeftX;
  223.           FirstRow := UpperLeftY;
  224.           LastCol  := UpperLeftX + NumCols -1;
  225.           LastRow  := UpperLeftY + NumRows -1;
  226.           checked  := TRUE;
  227.       END;
  228.     ELSE
  229.       FirstRow := A^.FirstRow;
  230.       LastRow := A^.LastRow;
  231.       FirstCol := A^.FirstCol;
  232.       LastCol := A^.LastCol;
  233.       checked := TRUE;
  234.     END;
  235.     IF checked THEN
  236.       CODE(PUSHBP);   (* Save the Base Pointer. *)
  237. (* First find the currently displayed page and mode. *)
  238.       SETREG(AX,GETMODE);
  239.       SWI(INT10);
  240.       GETREG(AX,MODE);
  241.       GETREG(BX,PAGE);
  242. (* Now clear out the low byte in page. *)
  243.       TEMP := BITSET(PAGE)*MASK;
  244.       PAGE := WORD(TEMP);
  245.   (* Now write each location. *)
  246.       FOR I := FirstRow TO LastRow DO
  247.         Position := (I * ROWINC) + FirstCol;
  248.         FOR J := 0 TO NumCols - 1 DO
  249. (* First the cursor must be positioned. *)
  250.           SETREG(AX,CURSOR);
  251.           SETREG(BX,PAGE);
  252.           SETREG(DX,Position);
  253.           SWI(INT10);
  254. (* Now write a character. *)
  255.           chr := CHAR(A^.Row[I]^[J][0]);
  256.           CH := WRITECH + ORD(chr);
  257.           chr := CHAR(A^.Row[I]^[J][1]);
  258.           PC := CARDINAL(PAGE) + ORD(chr);
  259.           SETREG(AX,CH);
  260.           SETREG(BX,PC);
  261.           SETREG(CX,1);  (* Number of char to repeat. *)
  262.           SWI(INT10);
  263.           INC(Position);
  264.         END; (* FOR J *)
  265.       END;   (* FOR I *)
  266.       CODE(POPBP);
  267.       done := TRUE;
  268.     END; (* IF checked. *)
  269.   END; (* IF found. *)
  270. END PasteBlock;
  271.  
  272. END ScreenBlocks.
  273.  
  274.  
  275.  
  276.  
  277.  
  278. (* Figure  4 *)
  279.  
  280. MODULE SwapBlocks;
  281. (* Swaps two blocks of the screen. *)
  282. IMPORT Break;
  283. FROM InOut IMPORT WriteString,WriteCard,WriteLn;
  284. FROM ScreenBlocks IMPORT CutBlock,PasteBlock;
  285.  
  286. VAR done,NewPosition : BOOLEAN;
  287.     I,J,K : CARDINAL;
  288.  
  289. BEGIN
  290.   WriteLn;
  291.   FOR K := 0 TO 11 DO
  292.     FOR I := 0 TO 79 DO
  293.       WriteCard(1,1);
  294.     END;
  295.   END;
  296.   FOR K := 12 TO 24 DO
  297.     FOR I := 0 TO 79 DO
  298.       WriteCard(2,1);
  299.     END;
  300.   END;
  301.   NewPosition := TRUE;
  302.   CutBlock(5,10,22,42,`First',done);
  303.   IF NOT done THEN
  304.     WriteString(`First block not cut.');
  305.   END;
  306.   CutBlock(15,20,10,30,`Second',done);
  307.   IF NOT done THEN
  308.     WriteString(`Second block not cut.');
  309.   END;
  310.   PasteBlock(`Second',5,7,NewPosition,done);
  311.   IF NOT done THEN
  312.     WriteString(`Second block not pasted.');
  313.   END;
  314.   PasteBlock(`First',15,10,NewPosition,done);
  315.   IF NOT done THEN
  316.     WriteString(`First block not pasted.');
  317.   END;
  318. END SwapBlocks.
  319.  
  320.