CP/M/CPM_CDROM.iso/mbug/mbug077.arc/SCRNHND.FWD

Text File | 1979-12-31 | 11KB | 502 lines

Procedure SCNSetUpColRAM;
Var B : Byte;
Begin
  B := Port[ COLPORT ];
  B := B or $40;
  Port[ COLPORT ] := B;
End;

Procedure SCNSetUpPCGRam;
Var b : Byte;
Begin
  B := Port[ COLPORT ];
  B := B and $6F;
  Port[ ColPort ] := B;
End;

Procedure SetWindowColours;
Var
  c,s,EndN,i : integer;
Begin
  If not SCNColour then exit;
  SCNSetUpColRAM;
  C := 16*BCol + FCol;
  S := ColSt + 80 * ( SCNYStart - 1 );
  EndN := ColSt + 80 * ( SCNYEnd - 1 );
  While S <= EndN do
    Begin
      For i:= ( ScnXstart - 1 ) to ( SCNXEnd - 1 ) do Mem[ S + i ] := C;
      S := S + 80;
    End;
  SCNSetUpPCGRam;
end;

Procedure SetUpCols;

Var i,
    S,
    EndN : integer;
    C   : Byte;
Begin
  If not SCNColour then exit;
  x1 := Pred( x1 + SCNXStart );
  x2 := Pred( x2 + SCNXStart );
  y1 := Pred( y1 + SCNYStart );
  y2 := Pred( y2 + SCNYStart );
  If ( X1 > X2 ) or ( Y1 > Y2 ) or ( x2 > 80 ) or ( y2 > 25 ) then Exit;
  SCNSetUpColRAM;
  C := 16*BCol + FCol;
  S := ColSt + 80 * ( Y1 - 1 );
  EndN := ColSt + 80 * ( Y2 - 1 );
  While S <= EndN do
    Begin
      For i:= ( X1 - 1 ) to ( X2 - 1 ) do Mem[ S + i ] := C;
      S := S + 80;
    End;
  SCNSetUpPCGRam;
End;

Procedure SCNTestColour;
Var a,b : byte;
Begin
  B := mem[ $F800 ];
  Mem[ $F800 ] := 0;
  SCNSetUpColRam;
  A := mem[ $F800 ];
  Mem[ $F800 ] := $FF;
  SCNSetUpPCGRam;
  SCNColour := Mem[ $F800 ] = 0;
  mem[ $F800 ] := B;
  If SCNColour then
    begin
      SCNSetUpColRam;
      Mem[ $F800 ] := A;
      SCNSetUpPCGRam;
    end;
End;

Function SCNReadPort;
Begin
  Port[ SelectPort ] := PortNo;
  SCNReadPort := Port[ DataPort ];
End;

Procedure SCNSetPort;
Begin
  Port[ SelectPort ] := PortNo;
  Port[ DataPort ] := Value;
End;

Procedure SCNInitSizes;
Begin
  SCNXStart := 1;
  SCNYStart := 1;
  SCNXEnd := 80;
  SCNYEnd := 24;
End;

Procedure TurnOnCurs;
Var B : byte;
Begin
  B := SCNStartLine;
  If SCNFlashing then B := B or $60;
  SCNSetPort( 10 , B );
  SCNSetPort( 11 , SCNEndLine );
End;

Procedure TurnOffCurs;
Var B : byte;
Begin
  B := $20;
  SCNSetPort( 10 , B );
End;

Function ActXStart;
Begin
  If SCNBorderMode then
    ActXStart := Succ( SCNXStart )
  Else
    ActXStart := SCNXStart;
End;

Function ActXEnd;
Begin
  If SCNBorderMode then
    ActXEnd := Pred( SCNXEnd )
  Else
    ActXEnd := SCNXEnd;
End;

Function ActYStart;
Begin
  If SCNBorderMode then
    ActYStart := Succ( SCNYStart )
  Else
    ActYStart := SCNYStart;
End;

Function ActYEnd;
Begin
  If SCNBorderMode then
    ActYEnd := Pred( SCNYEnd )
  Else
    ActYEnd := SCNYEnd;
End;

Procedure PutCurs;
Var Val : integer;
Begin
  SCNXPos := X;
  SCNYPos := Y;
  Val := $2000 or( Pred( RYPos ) * 80 + Pred( RXPos ) );
  SCNSetPort( 14 , Hi( Val ) );
  SCNSetPort( 15 , Lo( Val ) );
End;

Procedure ScreenInit;
Begin
  SCNTestColour;
  SCNFirstWindow := Nil;
  SCNRangeCheck := True;
  SCNInverse := False;
  SCNFlashing := True;
  SCNBorderMode := False;
  SCNStartLine := 0;
  SCNEndLine := 11;
  SCNInitSizes;
  PutCurs( 1,1 );
  TurnOnCurs;
  Gotoxy( 1,1 );
End;

Procedure ClearScreen;
Var y,
    Len,
    Start : byte;
Begin
  Start := ActXStart;
  Len := Succ( ActXEnd - Start );
  If SCNBorderMode then
      PutCurs( 2,2 )
  Else
      PutCurs( 1,1 );
  For y:= ActYStart to ACTYEnd do
    FillChar( ScnScreen[ Y , Start ] , Len , ' ' );
End;

Procedure ClearEOL;
Var Len : byte;
Begin
  Len := Succ( ActXEnd - RXPos );
  If Not SCNBorderMode then Len := Succ( Len );
  FillChar( ScnScreen[ RYPos , RXPos ] , Len , ' ' );
End;

Procedure InsertLine;
Var
  Y,
  Len,
  XStart : byte;
Begin
  XStart := ActXStart;
  Len := Succ( ActXEnd - ActXStart );
  For y := Pred( ActYEnd ) downto RYPos do
      Move( ScnScreen[ y , XStart ] , ScnScreen[ Succ(y) , XStart ] , Len );
  FillChar( ScnScreen[ RYPos , XStart ] , Len , ' ' );
End;

Procedure DeleteLine;
Var y,
    Len,
    XStart : byte;
Begin
  XStart := ACTXStart;
  Len := Succ( ActXEnd - XStart );
  For y := Succ( RYPos ) to ActYEnd do
    Move( ScnScreen[ y , XStart ] , ScnScreen[ Pred( y ) , XStart ] , Len );
  FillChar( ScnScreen[ ActYEnd , XStart ] , Len , ' ' );
End;

Procedure InsertChar;
Var YPos,
    x : byte;
Begin
  YPos := RYPos;
  For x := Pred( ActXEnd ) downto RXPos do ScnScreen[ YPos , Succ( X ) ] := ScnScreen[ YPos , X ];
  If RXPos <= ActXEnd then ScnScreen[ YPos , RXpos ] := ' ';
End;

Procedure DeleteChar;
Var YPos,
    X : byte;
Begin
  YPos := RYPos;
  For x := Succ( RXPos ) to ActXEnd do ScnScreen[ YPos , Pred( X ) ] := ScnScreen[ YPos , x ];
  If RXPos <= ActXEnd then ScnScreen[ YPos , ActXEnd ] := ' ';
End;

Procedure DoWrite;
Var Len,
    XStart,
    YStart,
    XEnd,
    YEnd : byte;
    Ch : char;
Begin
  If SCNBorderMode then
    Begin
      XStart := 2;
      YStart := 2;
      XEnd   := SCNXEnd - SCNXStart;
      YEnd   := SCNYEnd - SCNYStart;
    End
  Else
    Begin
      XStart := 1;
      YStart := 1;
      XEnd   := Succ( SCNXEnd - SCNXStart );
      YEnd   := Succ( SCNYEnd - SCNYStart );
    End;
  Len := 1;
  While Len <= Length( Str ) do
    Begin
      Ch := Str[ Len ];
      If Ch = ^H then
          SCNXPos := Pred( SCNXPos )
      Else
        If Ch = ^M then
            SCNXPos := XStart
        Else
          If Ch = ^J then
              SCNYPos := Succ( SCNYPos )
          Else
            If Ch = ^G then
              Write( ^G )
            Else
             Begin   {Print the char}
               If SCNInverse then Ch := Chr( Ord( Ch ) or $80 );
               ScnScreen[ RYPos , RXPos ] := Ch;
               SCNXPos := Succ( SCNXPos );
             End;
      If SCNRangeCheck then
        Begin
          If SCNXPos < XStart then
            Begin
              SCNXPos := XEnd;
              SCNYPos := Pred( SCNYPos );
            End;
          If SCNXPos > XEnd then
            Begin
              SCNYPos := Succ( SCNYPos );
              SCNXPos := XStart;
            End;
          If SCNYPos < YStart then
            Begin
              SCNYPos := YStart;
              SCNXPos := XStart;
            End;
          If SCNYPos > YEnd then
            Begin
              SCNYPos := YEnd;
              SCNXPos := XStart;
            End;
        End;
      Len := Succ( Len );
    End;
  PutCurs( SCNXPos , SCNYPos );
End;

Procedure DoWriteln;
Begin
  DoWrite( Str + ^J + ^M );
End;

Procedure NMDoWrite;
Var i : byte;
Begin
  If SCNInverse then
    For i:= 1 to Length( Str ) do Str[ I ] := Chr( Ord( Str[ I ] ) or 128 );
  Move( Str[ 1 ] , ScnScreen[ Pred( SCNYStart + Y ) , Pred( SCNXStart + X ) ] , Length( Str ) );
End;


Procedure RNMDoWrite;
Var i : byte;
Begin
  If SCNInverse then
    For i:= 1 to Length( Str ) do Str[ I ] := Chr( Ord( Str[ I ] ) or 128 );
  Move( Str[ 1 ] , ScnScreen[ Y , X ] , Length( Str ) );
End;

Procedure CentreText;
Var XPos : byte;
Begin
  If ( Y > Succ( ActYEnd - ActYStart ) ) then exit;
  XPos := ( Succ( ActXEnd - ActXStart ) - Length( Str ) ) div 2;
  If XPos < 0 then exit;
  PutCurs( XPos , y );
  DoWrite( Str );
End;

Procedure SetFlash;
Begin
  SCNFlashing := True;
  TurnOnCurs;
End;

Procedure SetBlock;
Begin
  SCNFlashing := False;
  TurnOnCurs;
End;

Procedure SetSize;
Begin
  SCNStartLine := TopLine;
  SCNEndLine := BotLine;
  TurnOnCurs;
End;

Function CreateWindow;
Var Ptr,
    Last : SCNNextWindowPtr;
    Num ,
    YCtr,
    y,
    Len : byte;
    NumBytes,
    Off : integer;
Begin
  Len := Succ( x2-x1 );
  NumBytes := Len * Succ( y2-y1 );
  If SCNColour then NumBytes := NumBytes * 2;
  If ( MemAvail > 0 ) and ( MemAvail - NumBytes < SCNMinMemReqd ) then
    Begin
      CreateWindow := 0;
      Exit;
    End;
  Num := 1;
  SCNXstart := x1;
  SCNYStart := Y1;
  SCNXEnd   := x2;
  SCNYEnd   := y2;
  If SCNFirstWindow = Nil then
    Begin
      New( SCNFirstWindow );
      Ptr := SCNFirstWindow;
    End
  Else
    Begin
      Num := Succ( Num );
      Last := SCNFirstWindow;
      Ptr := SCNFirstWindow^.NextWindow;
      While Ptr <> Nil do
        Begin
          Num := Succ( Num );
          Last := Ptr;
          Ptr := Ptr^.NextWindow;
        End;
      New( Ptr );
      Last^.NextWindow := Ptr;
    End;
  Ptr^.NextWindow := Nil;
  Ptr^.XStart := x1;
  Ptr^.YStart := y1;
  Ptr^.XEnd   := x2;
  Ptr^.YEnd   := y2;
  Ptr^.XCursPos := SCNXPos;
  Ptr^.YCursPos := SCNYPos;
  GetMem( Ptr^.Data , NumBytes );
  For y := Ptr^.YStart to Ptr^.YEnd do
    Move( ScnScreen[ y , Ptr^.XStart ] , Mem[ Addr( Ptr^.Data ) + (Y - Ptr^.YStart)*Len ] , Len );
  If SCNColour then
   begin
    SCNSetUpColRam;
    Off := Succ( NumBytes div 2 );
    For y := Ptr^.YStart to Ptr^.YEnd do
      Move( ScnColRam[ y , Ptr^.XStart ] , Mem[ Off + Addr( Ptr^.Data ) + (Y - Ptr^.YStart)*Len ] , Len );
    SCNsetUpPCGRam;
   end;
  ClearScreen;
  If SCNBorderMode then DrawBorder;
  CreateWindow := Num;
End;

Function RestoreWindow;
Var Ptr,
    LastWindow : SCNNextWindowPtr;
    Y,
    Num,
    Len : Byte;
    off : integer;
Begin
  If SCNFirstWindow = Nil then
    Begin
      SCNInitSizes;
      RestoreWindow := 0;
      Exit;
    End;
  Num := 1;
  LastWindow := SCNFirstWindow;
  Ptr := SCNFirstWindow;
  While Ptr^.NextWindow <> Nil do
    Begin
      Num := Succ( Num );
      LastWindow := Ptr;
      Ptr := Ptr^.NextWindow;
    End;
  With Ptr^ do
    Begin
      SCNXPos := XCursPos;
      SCNYPos := YCursPos;
      Len := Succ( XEnd - XStart );
      For y := YStart to YEnd do
        Move( Mem[ Addr( Ptr^.Data ) + (Y - YStart)*Len ] , ScnScreen[ y , XStart ] , Len );
      If SCNColour then
        begin
          off := Succ( len * succ( YEnd - YStart ) );
          SCNSetUpColRam;
          For y:= YStart to YEnd do
            Move( Mem[ off + Addr( Ptr^.Data ) + (Y - YStart)*Len ] , ScnColRam[ y , XStart ] , Len );
          SCNSetUpPCGRam;
        end;
    End;
  If Ptr = SCNFirstWindow then
    Begin
      SCNFirstWindow := Nil;
      SCNInitSizes;
    End
  Else
    Begin
      With LastWindow^ do
        Begin
          NextWindow := Nil;
          SCNXStart := XStart;
          SCNYStart := YStart;
          SCNXEnd   := XEnd;
          SCNYEnd   := YEnd;
        End;
    End;
  Release( Ptr );
  PutCurs( SCNXPos , SCNYPos );
  RestoreWindow := Num;
End;

Procedure DrawBorder;
Var i : byte;
Begin
  ScnScreen[ SCNYStart , SCNXStart ] := TL;
  ScnScreen[ SCNYStart , SCNXEnd ] := TR;
  ScnScreen[ SCNYEnd , SCNXStart ] := BL;
  ScnScreen[ SCNYEnd , SCNXEnd ] := BR;
  For i:= Succ( SCNYStart ) to Pred( SCNYEnd ) do
    Begin
      ScnScreen[ I , SCNXStart ] := LM;
      ScnScreen[ I , SCNXEnd ] := RM;
    End;
  For i:= Succ( SCNXStart ) to Pred( SCNXEnd ) do
    Begin
      ScnScreen[ SCNYStart , i ] := TM;
      ScnScreen[ SCNYEnd , i ] := BM;
    End;
End;