home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / VSCREEN.ZIP / VSCREEN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-08-09  |  27.1 KB  |  784 lines
  1.  
  2. unit VScreen;      (* Unit to handle VirtualScreens on the Heap     *)
  3.  
  4. interface
  5.  
  6. {$F+}
  7.  
  8. const
  9.   Rows = 25;       (* Change for EGA 43 x 80, or VGA 50 x 80 lines  *)
  10.   Collumns = 80;
  11.   VsWordSize = Rows * Collumns;
  12.   VsByteSize = Rows * Collumns * 2;
  13.  
  14. type
  15.   FnString = string[12];      (* FileName string size               *)
  16.   VsPtr = ^VirtualScreenArray; (* Virtual-screen pointer type       *)
  17.   VirtualScreenArray = array[1..VsWordSize] of word;
  18.   Xstring = string[Collumns]; (* Xaxis length string-type           *)
  19.   Ystring = string[Rows];     (* Yaxis length string-type           *)
  20.   ScrollTypes = (Up, Down, Left, Right, FlipY, FlipX);
  21.  
  22. var
  23.   MainScreen : VsPtr;        (* Pointer to use Vscreen routines     *)
  24.                              (* directly on the video-memory        *)
  25.   ColorMode  : boolean;
  26.  
  27.                    (* Procedure to initialize a Vscreen pointer on  *)
  28.                    (* the Heap                                      *)
  29.   procedure VsInit(var VsPointer : VsPtr);
  30.  
  31.                    (* Procedure to re-initialize the Vscreen unit   *)
  32.   procedure ReInitVsUnit;
  33.  
  34.                    (* Procedure to clear a Vscreen, with a          *)
  35.                    (* color-attribute.                              *)
  36.   procedure ClrVscr(VsPointer: VsPtr; CAttr : byte);
  37.  
  38.                    (* Procedure to clear a window within a Vscreen  *)
  39.                    (* with a color-attribute.                       *)
  40.   procedure ClrVscrWindow(VsPointer : VsPtr;
  41.                           LxAxis, RxAxis,
  42.                           TopYaxis, BotYaxis, CAttr : byte);
  43.  
  44.                    (* Procedure to write an integer to a Vscreen    *)
  45.   procedure WriteIntVs(VsPointer : VsPtr;
  46.                        IntNum : longint;
  47.                        Width, Xaxis,
  48.                        Yaxis, CAttr : byte);
  49.  
  50.                    (* Procedure to vertically write an integer to a *)
  51.                    (* Vscreen                                       *)
  52.   procedure VwriteIntVs(VsPointer : VsPtr;
  53.                         IntNum : longint;
  54.                         Width, Xaxis,
  55.                         Yaxis, CAttr : byte);
  56.  
  57.                    (* Procedure to write a real to a Vscreen        *)
  58.   procedure WriteRealVs(VsPointer : VsPtr;
  59.                         RealNum : real;
  60.                         Width, Decimals,
  61.                         Xaxis, Yaxis, CAttr : byte);
  62.  
  63.                    (* Procedure to vertically write a real to a     *)
  64.                    (* Vscreen                                       *)
  65.   procedure VwriteRealVs(VsPointer : VsPtr;
  66.                          RealNum : real;
  67.                          Width, Decimals,
  68.                          Xaxis, Yaxis, CAttr : byte);
  69.  
  70.                   (* Procedure to write a string to a Vscreen       *)
  71.                   (* Wrap defines whether a string will wrap around *)
  72.                   (* to the next line, it is not the bottom-line.   *)
  73.   procedure WriteStringVs(VsPointer : VsPtr;
  74.                           InString: Xstring;
  75.                           Wrap : boolean;
  76.                           Xaxis, Yaxis, CAttr : byte);
  77.  
  78.                    (* Procedure to vertically write a string to a   *)
  79.                    (* Vscreen                                       *)
  80.   procedure VWriteStringVs(VsPointer : VsPtr;
  81.                            InString: Ystring;
  82.                            Xaxis, Yaxis, CAttr : byte);
  83.  
  84.                    (* Procedure to save the current-screen display  *)
  85.                    (* to a Vscreen                                  *)
  86.   procedure SaveToVs(VsPointer : VsPtr);
  87.  
  88.                    (* Procedure to display a Vscreen                *)
  89.   procedure DisplayVs(VsPointer : VsPtr);
  90.  
  91.                    (* Procedure to change AttrsToChange number of   *)
  92.                    (* Vscreen color-attributes                      *)
  93.   procedure SetVsXYattr(VsPointer : VsPtr;
  94.                         AttrsToChange, Xaxis,
  95.                         Yaxis, CAttr : byte);
  96.  
  97.                    (* Procedure to vertically change AttrsToChange  *)
  98.                    (* number of Vscreen color-attributes            *)
  99.   procedure VSetVsXYattr(VsPointer : VsPtr;
  100.                          AttrsToChange, Xaxis,
  101.                          Yaxis, CAttr : byte);
  102.  
  103.                   (* Procedure to change a window-block of Vscreen  *)
  104.                   (* color-attributes                               *)
  105.   procedure SetVsWindowAttr(VsPointer : VsPtr;
  106.                             LxAxis, RxAxis,
  107.                             TopYaxis, BotYaxis, CAttr : byte);
  108.  
  109.                    (* Procedure to set the color-attribute for      *)
  110.                    (* the entire Vscreen                            *)
  111.   procedure SetVsAttr(VsPointer : VsPtr; CAttr : byte);
  112.  
  113.                    (* Procedure to Save a Vscreen to a disk-file.   *)
  114.                    (* ScreenNumber is the Vscreen record-number     *)
  115.   procedure SaveVsToDisk(VsPointer : VsPtr;
  116.                          FileName : FnString;
  117.                          ScreenNumber : word);
  118.  
  119.                    (* Procedure to Load a Vscreen from a disk-file. *)
  120.                    (* ScreenNumber is the Vscreen record-number     *)
  121.   procedure LoadVsFromDisk(VsPointer : VsPtr;
  122.                            FileName : FnString;
  123.                            ScreenNumber : word);
  124.  
  125.                    (* Function that returns the attribute byte of   *)
  126.                    (* a Vscreen char at position X,Y.               *)
  127.   function GetVsXYattr(VsPointer : VsPtr; Xaxis, Yaxis : byte) : byte;
  128.  
  129.                    (* Function that returns a text-char from a      *)
  130.                    (* Vscreen                                       *)
  131.   function GetVsXYchar(VsPointer : VsPtr; Xaxis, Yaxis : byte) : char;
  132.  
  133.                    (* Function that returns a StringSize text-      *)
  134.                    (* string from a Vscreen                         *)
  135.   function GetVsXYstring(VsPointer : VsPtr;
  136.                          Xaxis, Yaxis, StringSize : byte) : string;
  137.  
  138.                    (* Function that returns a vertical StringSize   *)
  139.                    (* text-string from a Vscreen                    *)
  140.   function VGetVsXYstring(VsPointer : VsPtr;
  141.                           Xaxis, Yaxis, StringSize : byte) : string;
  142.  
  143.                    (* Procedure to scroll a Vscreen by ScrollNum    *)
  144.                    (* in one of the folling directions: Up, Down,   *)
  145.                    (* Right, Left. Two other options are available. *)
  146.                    (* FlipY : which will reverse the order of the   *)
  147.                    (* Vscreen rows.
  148.                    (*   ie: Row 1 becomes Row 25, ect...            *)
  149.                    (* FlipX : which will reverse the order of the   *)
  150.                    (* Vscreen collumns.                             *)
  151.                    (*   ie: Collumn 1 becomes Collumn 80, ect...    *)
  152.                    (* ScrollNum is ignored with these routines...   *)
  153.   procedure ScrollVs(VsPointer1 : VsPtr;
  154.                      VsPointer2 : VsPtr;
  155.                      Direction  : ScrollTypes;
  156.                      ScrollNum  : word);
  157.  
  158.                    (* Procedure to move a character from Vscreen1   *)
  159.                    (* to Vscreen2.                                  *)
  160.   procedure MoveVsChar(VsPointer1 : VsPtr; Xaxis1, Yaxis1 : byte;
  161.                        VsPointer2 : VsPtr; Xaxis2, Yaxis2 : byte);
  162.  
  163.                    (* Procedure to move a block of Vscreen1 to      *)
  164.                    (* Vscreen2. CharsToMove determines the block-   *)
  165.                    (* size.                                         *)
  166.   procedure MoveVsBlock(VsPointer1 : VsPtr; Xaxis1, Yaxis1 : byte;
  167.                         VsPointer2 : VsPtr; Xaxis2, Yaxis2 : byte;
  168.                         CharsToMove : word);
  169.  
  170.                   (* Procedure to move a window-block from Vscreen1 *)
  171.                   (* Vscreen2.                                      *)
  172.   procedure MoveVsWindowBlock(VsPointer1 : VsPtr;
  173.                               LxAxis1, RxAxis1,
  174.                               TopYaxis1, BotYaxis1 : byte;
  175.                               VsPointer2 : VsPtr;
  176.                               LxAxis2, RxAxis2,
  177.                               TopYaxis2, BotYaxis2 : byte);
  178.  
  179. implementation
  180.  
  181. uses
  182.   Crt;
  183.  
  184. var                          (* Pointer to VideoDisplay Address     *)
  185.   VideoAddress : VsPtr;
  186.  
  187.   procedure VsInit(var VsPointer : VsPtr);
  188.   begin
  189.     if VsPointer = Nil then
  190.       begin
  191.         New(VsPointer);      (* Allocate array on the Heap          *)
  192.         FillChar(VsPointer^, SizeOf(VirtualScreenArray), 0)
  193.       end;
  194.   end;
  195.  
  196.   procedure ClrVscr(VsPointer: VsPtr; CAttr : byte);
  197.   type
  198.     ClrArrayType = array[1..(VsWordSize - 1)] of word;
  199.   var
  200.     ClrPtr1,
  201.     ClrPtr2 : ^ClrArrayType;
  202.   begin
  203.     if VsPointer <> Nil then
  204.       begin
  205.         if CAttr = 0 then
  206.           FillChar(VsPointer^, VsByteSize, 0)
  207.         else
  208.           begin
  209.             ClrPtr1 := Addr(VsPointer^[1]);
  210.             ClrPtr2 := Addr(VsPointer^[2]);
  211.             ClrPtr1^[1] := (32 + (CAttr Shl 8));
  212.             ClrPtr2^ := ClrPtr1^;
  213.           end;
  214.       end;
  215.   end;
  216.  
  217.   procedure WriteIntVs(VsPointer : VsPtr;
  218.                        IntNum : longint;
  219.                        Width, Xaxis,
  220.                        Yaxis, CAttr : byte);
  221.   const
  222.     TempString : Xstring = '';
  223.   var
  224.     TsIndex  : byte;
  225.     VsOffset : word;
  226.   begin
  227.     if VsPointer <> Nil then
  228.       begin
  229.         if (Yaxis > Rows) then
  230.           Yaxis := Rows;
  231.         Str(IntNum:Width, TempString);
  232.         if (Yaxis = Rows)
  233.           and ((length(TempString) + Xaxis) > Collumns) then
  234.             TempString[0] := char((Collumns + 1) - Xaxis);
  235.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  236.         for TsIndex := 0 to (length(TempString) - 1) do
  237.           VsPointer^[VsOffset + TsIndex] :=
  238.                        (byte(TempString[(TsIndex + 1)]) + (CAttr Shl 8))
  239.       end;
  240.   end;
  241.  
  242.   procedure VwriteIntVs(VsPointer : VsPtr;
  243.                         IntNum : longint;
  244.                         Width, Xaxis,
  245.                         Yaxis, CAttr : byte);
  246.   const
  247.     TempString : Ystring = '';
  248.   var
  249.     TSindex  : byte;
  250.     VsOffset : word;
  251.   begin
  252.     if VsPointer <> Nil then
  253.       begin
  254.         if (Yaxis > Rows) then
  255.           Yaxis := Rows;
  256.         if (Xaxis > Collumns) then
  257.           Xaxis := Collumns;
  258.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  259.         Str(IntNum:Width, TempString);
  260.         if ((length(TempString) + Yaxis) > Rows) then
  261.           TempString[0] := char((Rows + 1) - Yaxis);
  262.         for TSindex := 0 to (length(TempString) - 1) do
  263.           VsPointer^[VsOffset + (TSindex * Collumns)] :=
  264.                        (byte(TempString[(TSindex + 1)]) + (CAttr Shl 8))
  265.       end;
  266.   end;
  267.  
  268.   procedure WriteRealVs(VsPointer : VsPtr;
  269.                         RealNum : real;
  270.                         Width, Decimals,
  271.                         Xaxis, Yaxis, CAttr : byte);
  272.   const
  273.     TempString : Xstring = '';
  274.   var
  275.     TsIndex  : byte;
  276.     VsOffset : word;
  277.   begin
  278.     if VsPointer <> Nil then
  279.       begin
  280.         if (Yaxis > Rows) then
  281.           Yaxis := Rows;
  282.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  283.         Str(RealNum:Width:Decimals, TempString);
  284.         if (Yaxis = Rows)
  285.           and ((length(TempString) + Xaxis) > Collumns) then
  286.             TempString[0] := char((Collumns + 1) - Xaxis);
  287.         for TsIndex := 0 to (length(TempString) - 1) do
  288.           VsPointer^[VsOffset + TsIndex] :=
  289.                        (byte(TempString[(TsIndex + 1)]) + (CAttr Shl 8))
  290.       end
  291.   end;
  292.  
  293.   procedure VwriteRealVs(VsPointer : VsPtr;
  294.                          RealNum : real;
  295.                          Width, Decimals,
  296.                          Xaxis, Yaxis, CAttr : byte);
  297.   const
  298.     TempString : Ystring = '';
  299.   var
  300.     TSindex  : byte;
  301.     VsOffset : word;
  302.   begin
  303.     if VsPointer <> Nil then
  304.       begin
  305.         if (Yaxis > Rows) then
  306.           Yaxis := Rows;
  307.         if (Xaxis > Collumns) then
  308.           Xaxis := Collumns;
  309.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  310.         Str(RealNum:Width:Decimals, TempString);
  311.         if ((length(TempString) + Yaxis) > Rows) then
  312.           TempString[0] := char((Rows + 1) - Yaxis);
  313.         for TSindex := 0 to (length(TempString) - 1) do
  314.           VsPointer^[VsOffset + (TSindex * Collumns)] :=
  315.                        (byte(TempString[(TSindex + 1)]) + (CAttr Shl 8))
  316.       end
  317.   end;
  318.  
  319.   procedure WriteStringVs(VsPointer : VsPtr;
  320.                           InString: Xstring;
  321.                           Wrap : boolean;
  322.                           Xaxis, Yaxis, CAttr : byte);
  323.   var
  324.     ISindex  : byte;
  325.     VsOffset : word;
  326.   begin
  327.     if VsPointer <> Nil then
  328.       begin
  329.         if (Yaxis > Rows) then
  330.           Yaxis := Rows;
  331.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  332.         if (Yaxis = Rows) then
  333.           Wrap := false;
  334.         if NOT Wrap then
  335.           if ((length(InString) + Xaxis) > Collumns) then
  336.             InString[0] := char((Collumns + 1) - Xaxis);
  337.         for ISindex := 0 to (length(InString) - 1) do
  338.           VsPointer^[VsOffset + ISindex] :=
  339.                          (byte(InString[(ISindex + 1)]) + (CAttr Shl 8))
  340.       end
  341.   end;
  342.  
  343.   procedure VWriteStringVs(VsPointer : VsPtr;
  344.                            InString: Ystring;
  345.                            Xaxis, Yaxis, CAttr : byte);
  346.   var
  347.     IsIndex  : byte;
  348.     VsOffset : word;
  349.   begin
  350.     if VsPointer <> Nil then
  351.       begin
  352.         if (Yaxis > Rows) then
  353.           Yaxis := Rows;
  354.         if (Xaxis > Collumns) then
  355.           Xaxis := Collumns;
  356.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  357.         if ((length(InString) + Yaxis) > Rows) then
  358.           InString[0] := char((Rows + 1) - Yaxis);
  359.         for IsIndex := 0 to (length(InString) - 1) do
  360.           VsPointer^[VsOffset + (IsIndex * Collumns)] :=
  361.                          (byte(InString[(IsIndex + 1)]) + (CAttr Shl 8));
  362.       end;
  363.   end;
  364.  
  365.   procedure ClrVscrWindow(VsPointer : VsPtr;
  366.                           LxAxis, RxAxis,
  367.                           TopYaxis, BotYaxis, CAttr : byte);
  368.   var
  369.     VsIndex,
  370.     LineSize,
  371.     VsOffset : word;
  372.   begin
  373.     if VsPointer <> Nil then
  374.       begin
  375.         VsOffset := (((TopYaxis - 1) * Collumns) + LxAxis);
  376.         LineSize := (RxAxis - LxAxis) + 1;
  377.         for VsIndex := 0 to (LineSize - 1) do
  378.           VsPointer^[VsOffset + VsIndex] := (32 + (CAttr Shl 8));
  379.         for VsIndex := 1 to (BotYaxis - TopYaxis) do
  380.           move(VsPointer^[VsOffset], VsPointer^[VsOffset +
  381.                (VsIndex * Collumns)], (LineSize * 2));
  382.       end;
  383.   end;
  384.  
  385.   procedure SaveToVs(VsPointer : VsPtr);
  386.   begin
  387.     if VsPointer <> Nil then
  388.       begin
  389.         if VsPointer <> Nil then
  390.           VsPointer^ := VideoAddress^
  391.       end;
  392.   end;
  393.  
  394.   procedure DisplayVs(VsPointer : VsPtr);
  395.   begin
  396.     if VsPointer <> Nil then
  397.       begin
  398.         if VsPointer <> Nil then
  399.           VideoAddress^ := VsPointer^
  400.       end;
  401.   end;
  402.  
  403.   procedure SetVsXYattr(VsPointer : VsPtr;
  404.                           AttrsToChange, Xaxis,
  405.                           Yaxis, CAttr : byte);
  406.   var
  407.     AttrIndex : byte;
  408.     VsOffset  : word;
  409.   begin
  410.     if VsPointer <> Nil then
  411.       begin
  412.         if (Yaxis > Rows) then
  413.           Yaxis := Rows;
  414.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  415.         if (Yaxis = Rows) and ((AttrsToChange + Xaxis) > Collumns) then
  416.           AttrsToChange := ((Collumns + 1) - Xaxis);
  417.         for AttrIndex := 0 to (AttrsToChange - 1) do
  418.           begin
  419.             VsPointer^[VsOffset + AttrIndex] :=
  420.               Lo(VsPointer^[VsOffset + AttrIndex]) + (CAttr Shl 8);
  421.           end;
  422.       end;
  423.   end;
  424.  
  425.   procedure VSetVsXYattr(VsPointer : VsPtr;
  426.                          AttrsToChange, Xaxis,
  427.                          Yaxis, CAttr : byte);
  428.   var
  429.     AttrIndex : byte;
  430.     VsOffset  : word;
  431.   begin
  432.     if VsPointer <> Nil then
  433.       begin
  434.         if (Yaxis > Rows) then
  435.           Yaxis := Rows;
  436.         if (Xaxis > Collumns) then
  437.           Xaxis := Collumns;
  438.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  439.         if ((AttrsToChange + Yaxis) > Rows) then
  440.           AttrsToChange := ((Rows + 1) - Yaxis);
  441.         for AttrIndex := 0 to (AttrsToChange - 1) do
  442.           begin
  443.             VsPointer^[VsOffSet + (AttrIndex * Collumns)] :=
  444.               Lo(VsPointer^[VsOffSet + (AttrIndex * Collumns)]) +
  445.                                                          (CAttr Shl 8);
  446.           end;
  447.       end;
  448.   end;
  449.  
  450.   procedure SetVsWindowAttr(VsPointer : VsPtr;
  451.                             LxAxis, RxAxis,
  452.                             TopYaxis, BotYaxis, CAttr : byte);
  453.   var
  454.     LineSize,
  455.     VsOffSet,
  456.     VsIndex1,
  457.     VsIndex2 : word;
  458.   begin
  459.     if VsPointer <> Nil then
  460.       begin
  461.         VsOffset := (((TopYaxis - 1) * Collumns) + LxAxis);
  462.         LineSize := (RxAxis - LxAxis);
  463.         for VsIndex1 := 0 to (BotYaxis - TopYaxis) do
  464.           begin
  465.             for VsIndex2 := 0 to LineSize do
  466.               VsPointer^[VsOffset + VsIndex2] :=
  467.                     Lo(VsPointer^[VsOffset + VsIndex2]) + (CAttr Shl 8);
  468.             Inc(VsOffset,  Collumns);
  469.           end;
  470.       end;
  471.   end;
  472.  
  473.   procedure SetVsAttr(VsPointer : VsPtr; CAttr : byte);
  474.   type
  475.     VsAttrArray =  array[1..VsByteSize] of byte;
  476.   var
  477.     VsAaPtr       : ^VsAttrArray;
  478.     AttrIndex     : word;
  479.   begin
  480.     if VsPointer <> Nil then
  481.       begin
  482.         VsAaPtr := Addr(VsPointer^);
  483.         For AttrIndex := 1 to VsWordSize do
  484.           VsAaPtr^[AttrIndex * 2] := CAttr
  485.       end
  486.   end;
  487.  
  488.   procedure SaveVsToDisk(VsPointer : VsPtr;
  489.                          FileName : FnString;
  490.                          ScreenNumber : word);
  491.   var
  492.     ScreenFile : file of VirtualScreenArray;
  493.   begin
  494.     if VsPointer <> Nil then
  495.       begin
  496.         Assign(ScreenFile, FileName);
  497.         {$I-}
  498.         ReSet(ScreenFile);
  499.         {$I+}
  500.         if IoResult <> 0 then
  501.           begin
  502.             {$I-}
  503.             ReWrite(ScreenFile);
  504.             {$I+}
  505.             if IoResult <> 0 then
  506.               Exit;
  507.           end;
  508.         Seek(ScreenFile, (ScreenNumber - 1));
  509.         Write(ScreenFile, VsPointer^);
  510.         Close(ScreenFile)
  511.       end
  512.   end;
  513.  
  514.   procedure LoadVsFromDisk(VsPointer : VsPtr;
  515.                            FileName : FnString;
  516.                            ScreenNumber : word);
  517.   var
  518.     ScreenFile : file of VirtualScreenArray;
  519.   begin
  520.     if VsPointer <> Nil then
  521.       begin
  522.         Assign(ScreenFile, FileName);
  523.         {$I-}
  524.         ReSet(ScreenFile);
  525.         {$I+}
  526.         if IoResult <> 0 then
  527.           Exit;
  528.         Seek(ScreenFile, (ScreenNumber - 1));
  529.         Read(ScreenFile, VsPointer^);
  530.         Close(ScreenFile)
  531.      end
  532.   end;
  533.  
  534.   function GetVsXYattr(VsPointer : VsPtr; Xaxis, Yaxis : byte) : byte;
  535.   var
  536.     VsOffset : word;
  537.   begin
  538.     if VsPointer <> Nil then
  539.       begin
  540.         if (Yaxis > Rows) then
  541.           Yaxis := Rows;
  542.         if (Xaxis > Collumns) then
  543.           Xaxis := Collumns;
  544.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  545.         GetVsXYattr := Hi(VsPointer^[VsOffset]);
  546.       end
  547.   end;
  548.  
  549.   function GetVsXYchar(VsPointer : VsPtr; Xaxis, Yaxis : byte) : char;
  550.   var
  551.     VsOffset : word;
  552.   begin
  553.     if VsPointer <> Nil then
  554.       begin
  555.         if (Yaxis > Rows) then
  556.           Yaxis := Rows;
  557.         if (Xaxis > Collumns) then
  558.           Xaxis := Collumns;
  559.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  560.         GetVsXYchar := char(Lo(VsPointer^[VsOffset]));
  561.       end
  562.   end;
  563.  
  564.   function GetVsXYstring(VsPointer : VsPtr;
  565.                          Xaxis, Yaxis, StringSize : byte) : string;
  566.   const
  567.     TempString : Xstring = '';
  568.   var
  569.     TsIndex,
  570.     VsOffset : word;
  571.   begin
  572.     if VsPointer <> Nil then
  573.       begin
  574.         if (Yaxis > Rows) then
  575.           Yaxis := Rows;
  576.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  577.         if (Yaxis = Rows) and ((Xaxis + StringSize) > Collumns) then
  578.           TempString[0] := char((Collumns + 1) - Xaxis)
  579.         else
  580.           TempString[0] := char(StringSize);
  581.         for TsIndex := 0 to (length(TempString) - 1) do
  582.           TempString[(TsIndex + 1)] :=
  583.                                char(Lo(VsPointer^[VsOffset + TsIndex]));
  584.         GetVsXYstring := TempString;
  585.       end
  586.   end;
  587.  
  588.   function VGetVsXYstring(VsPointer : VsPtr;
  589.                           Xaxis, Yaxis, StringSize : byte) : string;
  590.   const
  591.     TempString : Ystring = '';
  592.   var
  593.     TsIndex,
  594.     VsOffset : word;
  595.   begin
  596.     if VsPointer <> Nil then
  597.       begin
  598.         if (Yaxis > Rows) then
  599.           Yaxis := Rows;
  600.         if (Xaxis > Collumns) then
  601.           Xaxis := Collumns;
  602.         VsOffset := (((Yaxis - 1) * Collumns) + Xaxis);
  603.         if ((StringSize + Yaxis) > Rows) then
  604.           TempString[0] := char((Rows + 1) - Yaxis)
  605.         else
  606.           TempString[0] := char(StringSize);
  607.         for TsIndex := 0 to (length(TempString) - 1) do
  608.           TempString[(TsIndex + 1)] := char(Lo(VsPointer^[VsOffset +
  609.                                              (TsIndex * Collumns)]));
  610.         VGetVsXYstring := TempString;
  611.       end
  612.   end;
  613.  
  614.   procedure ScrollVs(VsPointer1 : VsPtr;
  615.                      VsPointer2 : VsPtr;
  616.                      Direction  : ScrollTypes;
  617.                      ScrollNum  : word);
  618.   var
  619.     S1, S2 : word;
  620.   begin
  621.     if (VsPointer1 <> Nil)
  622.       and (VsPointer2 <> Nil)
  623.         and (VsPointer1 <> VsPointer2) then
  624.       begin
  625.         case Direction of
  626.           Up    : move(VsPointer1^[(ScrollNum * Collumns) + 1],
  627.                        VsPointer2^[1], (VsByteSize - (ScrollNum *
  628.                        Collumns * 2)));
  629.           Down  : move(VsPointer1^[1],
  630.                        VsPointer2^[(ScrollNum * Collumns) + 1],
  631.                        (VsByteSize - (ScrollNum * Collumns * 2)));
  632.           Right : for S1 := 0 to (Rows - 1) do
  633.                     move(VsPointer1^[1 + (S1 * Collumns)],
  634.                          VsPointer2^[1 + (S1 * Collumns) + ScrollNum],
  635.                          ((Collumns - ScrollNum) * 2));
  636.           Left  : for S1 := 0 to (Rows - 1) do
  637.                     move(VsPointer1^[1 + (S1 * Collumns) + ScrollNum],
  638.                          VsPointer2^[1 + (S1 * Collumns)],
  639.                          ((Collumns - ScrollNum) * 2));
  640.           FlipX : for S1 := 0 to (Rows - 1) do
  641.                     for S2 := 0 to (Collumns - 1) do
  642.                       VsPointer2^[(Collumns - S2) + (S1 * Collumns)] :=
  643.                         VsPointer1^[(S2 + 1) + (S1 * Collumns)];
  644.           FlipY : for S1 := 0 to (Rows - 1) do
  645.                     move(VsPointer1^[1 + (S1 * Collumns)],
  646.                          VsPointer2^[1 + ((Rows - (S1 + 1))
  647.                          * Collumns)], (Collumns * 2));
  648.         end;       (* case Direction of...                           *)
  649.       end;
  650.   end;
  651.  
  652.   procedure MoveVsChar(VsPointer1 : VsPtr; Xaxis1, Yaxis1 : byte;
  653.                        VsPointer2 : VsPtr; Xaxis2, Yaxis2 : byte);
  654.   var
  655.     VsOffset1,
  656.     VsOffset2 : word;
  657.   begin
  658.     if (VsPointer1 <> Nil)
  659.       and (VsPointer2 <> Nil)
  660.         and (VsPointer1 <> VsPointer2) then
  661.       begin
  662.         if (Yaxis1 > Rows) then
  663.           Yaxis1 := Rows;
  664.         if (Xaxis1 > Collumns) then
  665.           Xaxis1 := Collumns;
  666.         if (Yaxis2 > Rows) then
  667.           Yaxis2 := Rows;
  668.         if (Xaxis2 > Collumns) then
  669.           Xaxis2 := Collumns;
  670.         VsOffset1 := (((Yaxis1 - 1) * Collumns) + Xaxis1);
  671.         VsOffset2 := (((Yaxis2 - 1) * Collumns) + Xaxis2);
  672.         VsPointer2^[VsOffset2] := VsPointer1^[VsOffset1];
  673.       end
  674.   end;
  675.  
  676.   procedure MoveVsBlock(VsPointer1 : VsPtr; Xaxis1, Yaxis1 : byte;
  677.                         VsPointer2 : VsPtr; Xaxis2, Yaxis2 : byte;
  678.                         CharsToMove : word);
  679.   var
  680.     VsOffset1,
  681.     VsOffset2 : word;
  682.   begin
  683.     if (VsPointer1 <> Nil)
  684.       and (VsPointer2 <> Nil)
  685.         and (VsPointer1 <> VsPointer2) then
  686.       begin
  687.         if (Yaxis1 > Rows) then
  688.           Yaxis1 := Rows;
  689.         if (Yaxis2 > Rows) then
  690.           Yaxis2 := Rows;
  691.         if (Xaxis1 > Collumns) then
  692.           Xaxis1 := Collumns;
  693.         if (Xaxis2 > Collumns) then
  694.           Xaxis2 := Collumns;
  695.         VsOffset1 := (((Yaxis1 - 1) * Collumns) + Xaxis1);
  696.         VsOffset2 := (((Yaxis2 - 1) * Collumns) + Xaxis2);
  697.         if VsOffset1 > VsOffset2 then
  698.           begin
  699.             if CharsToMove > (VsWordSize - VsOffSet2) then
  700.               CharsToMove := (VsWordSize - VsOffSet2);
  701.           end
  702.         else
  703.           begin
  704.             if CharsToMove > (VsWordSize - VsOffSet1) then
  705.               CharsToMove := (VsWordSize - VsOffSet1);
  706.           end;
  707.         move(VsPointer1^[VsOffset1], VsPointer2^[VsOffset2],
  708.                                                      (CharsToMove * 2));
  709.       end;
  710.   end;
  711.  
  712.   procedure MoveVsWindowBlock(VsPointer1 : VsPtr;
  713.                               LxAxis1, RxAxis1,
  714.                               TopYaxis1, BotYaxis1 : byte;
  715.                               VsPointer2 : VsPtr;
  716.                               LxAxis2, RxAxis2,
  717.                               TopYaxis2, BotYaxis2 : byte);
  718.   var
  719.     LineSize,
  720.     RowIndex,
  721.     VsOffset1,
  722.     VsOffset2,
  723.     MoveIndex : word;
  724.   begin
  725.     if (VsPointer1 <> Nil)
  726.       and (VsPointer2 <> Nil)
  727.         and (VsPointer1 <> VsPointer2) then
  728.       begin
  729.         if (BotYaxis1 > Rows) then
  730.           BotYaxis1 := Rows;
  731.         if (BotYaxis2 > Rows) then
  732.           BotYaxis2 := Rows;
  733.         if (RxAxis1 > Collumns) then
  734.           RxAxis1 := Collumns;
  735.         if (RxAxis2 > Collumns) then
  736.           RxAxis2 := Collumns;
  737.         VsOffset1 := (((TopYaxis1 - 1) * Collumns) + LxAxis1);
  738.         VsOffset2 := (((TopYaxis2 - 1) * Collumns) + LxAxis2);
  739.         if (RxAxis1 - LxAxis1) > (RxAxis2 - LxAxis2) then
  740.           LineSize := (RxAxis2 - LxAxis2)
  741.         else
  742.           LineSize := (RxAxis1 - LxAxis1);
  743.         if (BotYaxis1 - TopYaxis1) > (BotYaxis2 - TopYaxis2) then
  744.           RowIndex := (BotYaxis2 - TopYaxis2)
  745.         else
  746.           RowIndex := (BotYaxis1 - TopYaxis1);
  747.         for MoveIndex := 0 to RowIndex do
  748.           move(VsPointer1^[VsOffset1 + (MoveIndex * Collumns)],
  749.                VsPointer2^[VsOffset2 + (MoveIndex * Collumns)],
  750.                                                         (LineSize * 2));
  751.       end;
  752.   end;
  753.  
  754. {$F-}
  755.                    (* Procedure to set the initial VideoAddress     *)
  756.                    (* Determines either Color or B&W mode.          *)
  757.   procedure SetVideoAddress;
  758.   begin
  759.     if ((Mem[$0000:$0410] and $30) <> $30) then
  760.       begin
  761.         VideoAddress := Ptr($B800, $0000);
  762.         MainScreen := Ptr($B800, $0000);
  763.         ColorMode := true
  764.       end
  765.     else
  766.       begin
  767.         VideoAddress := Ptr($B000, $0000);
  768.         MainScreen := Ptr($B000, $0000);
  769.         ColorMode := false
  770.       end;
  771.   end;
  772.  
  773.                    (* Procedure initialize/re-initialize the        *)
  774.                    (* Vscreen unit.                                 *)
  775.   procedure ReInitVsUnit;
  776.   begin
  777.     SetVideoAddress;
  778.   end;
  779.  
  780. BEGIN
  781.   SetVideoAddress  (* Initialize VideoAddress                       *)
  782. END.
  783.  
  784.