Category : Files from Magazines
Archive   : ISSUE-38.ZIP
Filename : SCREEN38.FIG

(* Figure 1 *)

DEFINITION MODULE ScreenBlocks;
(* This module is system specific. This version is written for the IBM-PC
and clones using MS-DOS. *)

EXPORT QUALIFIED CutBlock,PasteBlock;

PROCEDURE CutBlock( FirstRow,LastRow,FirstCol,LastCol : CARDINAL;
Handle : ARRAY OF CHAR;
VAR done : BOOLEAN);
(* Cuts a block of screen characters and their attributes and saves them
for later retrieval. *)

PROCEDURE PasteBlock( Handle : ARRAY OF CHAR ;
UpperLeftX,UpperLeftY : CARDINAL;
NewPosition : BOOLEAN;
VAR done : BOOLEAN);
(* Retrieves and pastes a block in a new position if new position is
true or replaces it in its old position if new position is false. *)


END ScreenBlocks.






(* Figure 2 *)

TYPE NameArray = ARRAY[0..24] OF CHAR;
ScreenBlock = RECORD
Handle : NameArray;
FirstRow,LastRow,FirstCol,LastCol: CARDINAL;
Row : BlockType;
END;






(* Figure 3 *)

IMPLEMENTATION MODULE ScreenBlocks;
(* This module is system specific. This version is written for the IBM-PC
and clones using MS-DOS. *)

FROM Storage IMPORT ALLOCATE,DEALLOCATE,Available;
FROM Strings IMPORT Assign,CompareStr;
FROM SYSTEM IMPORT AX,BX,CX,DX,SETREG,GETREG,CODE,SWI,TSIZE,BYTE,WORD;

CONST rows = 25;
cols = 80;
NumBlocks = 10;
PUSHBP = 0055H;
POPBP = 005DH;
INT10 = 0010H;
READCH = 0800H;
WRITECH = 0900H;
GETMODE = 0F00H;
CURSOR = 0200H;
ROWINC = 0100H;
NAMELENGTH = 24;

TYPE CA = ARRAY[0..1] OF BYTE; (* Contains char value and attribute. *)
(* CA[0] is the character and CA[1] is the attribute. *)
R = ARRAY[0..cols - 1] OF CA; (* Each line of the 80 col display. *)
RowPointer = POINTER TO R;
BlockType = ARRAY[0..rows - 1] OF RowPointer;
ScreenBlock = RECORD
Handle : ARRAY[0..NAMELENGTH] OF CHAR;
FirstRow,LastRow,FirstCol,LastCol : CARDINAL;
Row : BlockType;
END;
BlockPointer = POINTER TO ScreenBlock;
BlockArray = ARRAY[0..NumBlocks - 1] OF BlockPointer;

VAR BlockSpace : BlockArray;

PROCEDURE CutBlock(FirstRow,LastRow,FirstCol,LastCol : CARDINAL;
Handle : ARRAY OF CHAR ; VAR done : BOOLEAN);

VAR I,J,K,NumCols,Position : CARDINAL;
A : BlockPointer;
MODE,PAGE,TEMP : WORD;

BEGIN
done := FALSE;
(* Test for legitimate input. *)
IF (((FirstRow <= LastRow) AND (FirstCol <= LastCol))
AND ((LastRow < rows) AND (LastCol < cols))) THEN

(* Calculate the number of rows and the number of columns. *)
NumCols := LastCol - FirstCol + 1;

(* Now allocate the minimum space for the screen block. *)
IF Available(TSIZE(ScreenBlock)) THEN
NEW(A);
(* Initialize the screen block. *)
A^.FirstRow := FirstRow;
A^.LastRow := LastRow;
A^.FirstCol := FirstCol;
A^.LastCol := LastCol;
Assign(Handle,A^.Handle);
FOR I := 0 TO (rows - 1) DO A^.Row[I] := NIL; END;

(* Calculate the needed space. *)
J := TSIZE(CA) * NumCols;

(* Now allocate the needed space. *)
WITH A^ DO
FOR I := FirstRow TO LastRow DO
IF Available(J) THEN
ALLOCATE(Row[I],J);
ELSE
FOR K := I TO FirstRow BY -1 DO
DEALLOCATE(Row[K],J);
END;
DISPOSE(A);
RETURN;
END; (* FOR K *)
END; (* For I *)
END; (* With *)

(* Now read the screen blocks *)
CODE(PUSHBP); (* Save the Base Pointer. *)
(* First find the currently displayed page and mode. *)
SETREG(AX,GETMODE);
SWI(INT10);
GETREG(AX,MODE);
GETREG(BX,PAGE);

(* Now read each location. *)
FOR I := FirstRow TO LastRow DO
Position := (I * ROWINC) + FirstCol;
FOR J := 0 TO NumCols - 1 DO
(* First the cursor must be positioned. *)
SETREG(AX,CURSOR);
SETREG(BX,PAGE);
SETREG(DX,Position);
SWI(INT10);

(* Now the character must be read. *)
SETREG(AX,READCH);
SETREG(BX,PAGE);
SWI(INT10);
GETREG(AX,TEMP);
(******** Warning the next statement is word size sensitive. *******)
A^.Row[I]^[J] := CA(TEMP);
INC(Position);
END;
END;
CODE(POPBP);
(* Now try to store the block *)
I := 0;
(* Find an open storage space. *)
WHILE ((I < NumBlocks) AND (BlockSpace[I] # NIL)) DO
INC(I);
END;
(* If one was open then store the block. *)
IF I < NumBlocks THEN BlockSpace[I] := A; done := TRUE; END;
END; (* IF *)
ELSE
done := FALSE;
END;
END CutBlock;

PROCEDURE FindBlock(Handle : ARRAY OF CHAR;
VAR INDEX : CARDINAL;
VAR A : BlockPointer;
VAR found : BOOLEAN);

BEGIN
found := FALSE;
INDEX := 0;
WHILE INDEX < NumBlocks DO
IF BlockSpace[INDEX] # NIL THEN
IF CompareStr(BlockSpace[INDEX]^.Handle,Handle) = 0 THEN
found := TRUE;
A := BlockSpace[INDEX];
RETURN;
END; (* IF CompareStr *)
END; (* If BlockSpace *)
INDEX := INDEX + 1;
END; (* WHILE *)
END FindBlock;

PROCEDURE PasteBlock( Handle : ARRAY OF CHAR;
UpperLeftX,UpperLeftY : CARDINAL;
NewPosition : BOOLEAN;
VAR done : BOOLEAN);
(* This can either paste the block in a new position if new position is
true or replace it in its old position if new position is false. *)

VAR I,J,K,NumRows,NumCols,Position,CH,PC,
FirstCol,LastCol,FirstRow,LastRow : CARDINAL;
A : BlockPointer;
MODE,PAGE : WORD;
found,checked : BOOLEAN;
chr : CHAR;
MASK,TEMP : BITSET;

BEGIN
(* Find the Handle *)
done := FALSE;
found := FALSE;
checked := FALSE;
MASK := {15,14,13,12,11,10,9,8};
FindBlock(Handle,I,A,found);
IF found THEN
(* Calculate the number of rows and the number of columns. *)
NumRows := A^.LastRow - A^.FirstRow + 1;
NumCols := A^.LastCol - A^.FirstCol + 1;
IF NewPosition THEN
(* Check to see if the new position will fit *)
IF (((UpperLeftX + NumCols) < cols) AND
((UpperLeftY + NumRows) < rows)) THEN
FirstCol := UpperLeftX;
FirstRow := UpperLeftY;
LastCol := UpperLeftX + NumCols -1;
LastRow := UpperLeftY + NumRows -1;
checked := TRUE;
END;
ELSE
FirstRow := A^.FirstRow;
LastRow := A^.LastRow;
FirstCol := A^.FirstCol;
LastCol := A^.LastCol;
checked := TRUE;
END;
IF checked THEN
CODE(PUSHBP); (* Save the Base Pointer. *)
(* First find the currently displayed page and mode. *)
SETREG(AX,GETMODE);
SWI(INT10);
GETREG(AX,MODE);
GETREG(BX,PAGE);
(* Now clear out the low byte in page. *)
TEMP := BITSET(PAGE)*MASK;
PAGE := WORD(TEMP);
(* Now write each location. *)
FOR I := FirstRow TO LastRow DO
Position := (I * ROWINC) + FirstCol;
FOR J := 0 TO NumCols - 1 DO
(* First the cursor must be positioned. *)
SETREG(AX,CURSOR);
SETREG(BX,PAGE);
SETREG(DX,Position);
SWI(INT10);
(* Now write a character. *)
chr := CHAR(A^.Row[I]^[J][0]);
CH := WRITECH + ORD(chr);
chr := CHAR(A^.Row[I]^[J][1]);
PC := CARDINAL(PAGE) + ORD(chr);
SETREG(AX,CH);
SETREG(BX,PC);
SETREG(CX,1); (* Number of char to repeat. *)
SWI(INT10);
INC(Position);
END; (* FOR J *)
END; (* FOR I *)
CODE(POPBP);
done := TRUE;
END; (* IF checked. *)
END; (* IF found. *)
END PasteBlock;

END ScreenBlocks.





(* Figure 4 *)

MODULE SwapBlocks;
(* Swaps two blocks of the screen. *)
IMPORT Break;
FROM InOut IMPORT WriteString,WriteCard,WriteLn;
FROM ScreenBlocks IMPORT CutBlock,PasteBlock;

VAR done,NewPosition : BOOLEAN;
I,J,K : CARDINAL;

BEGIN
WriteLn;
FOR K := 0 TO 11 DO
FOR I := 0 TO 79 DO
WriteCard(1,1);
END;
END;
FOR K := 12 TO 24 DO
FOR I := 0 TO 79 DO
WriteCard(2,1);
END;
END;
NewPosition := TRUE;
CutBlock(5,10,22,42,`First',done);
IF NOT done THEN
WriteString(`First block not cut.');
END;
CutBlock(15,20,10,30,`Second',done);
IF NOT done THEN
WriteString(`Second block not cut.');
END;
PasteBlock(`Second',5,7,NewPosition,done);
IF NOT done THEN
WriteString(`Second block not pasted.');
END;
PasteBlock(`First',15,10,NewPosition,done);
IF NOT done THEN
WriteString(`First block not pasted.');
END;
END SwapBlocks.