home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 8
/
CDASC08.ISO
/
VRAC
/
TVPROMPT.EXE
/
SCREEN.PKG
< prev
next >
Wrap
Text File
|
1992-05-29
|
4KB
|
106 lines
with Calendar,
CRT,
Letters;
package body Screen is
-- Copyright 1992 Tom Moran
Leading : constant:=1; -- number of blank scan lines between lines of text
task body Scroller is
Time_Per_Line: Duration
:= Initial_Scroll_Passage_Time / CRT.Logical_Screen_Height;
Next_Scroll_Time: Calendar.Time := Calendar.Clock;
Appearing_String: Scrollable_Strings;
Background_Is_Black: Boolean;
Text_Height: constant integer := Letters.Pattern'length(2)+Leading;
subtype Text_Lines is integer range 0 .. Text_Height;
Text_Line : Text_Lines := Text_Lines'last;
Next_Scan_Line : CRT.Full_Scan_Lines := (others => CRT.White);
Single_Byte : Letters.Byte_Bit_Pairs;
-- note that two bits in letter pattern expand into 8 on screen to
-- give big enough characters to read on the teleprompter
Show_Bit_Pair: constant array (Letters.Bit_Pairs) of CRT.Bytes
:= (0 => 16#FF#, 1 => 16#F0#, 2 => 16#0F#, 3 => 16#00#);
Reversed_Show_Bit_Pair: constant array (Letters.Bit_Pairs) of CRT.Bytes
:= (0 => 16#00#, 1 => 16#0F#, 2 => 16#F0#, 3 => 16#FF#);
function "+" (Left : in Calendar.Time;
Right : in Duration) return Calendar.Time
renames Calendar."+";
function "-" (Left, Right : in Calendar.Time) return Duration
renames Calendar."-";
begin
accept Start_Up;
CRT.Open_White_Screen;
Next_Scroll_Time := Calendar.Clock + Time_Per_Line;
Until_Told_Otherwise:
loop
-- we can accept Adjust_Speed or Wind_Up anytime
-- we will accept Put(string) anytime we are not still busy
-- rolling a previous string onto the screen.
-- if no external requests for action, we scroll lines onto the
-- screen and scroll the screen up at the desired rate
select
accept Adjust_Speed(Scroll_Passage_Time: in Duration) do
Time_Per_Line := Scroll_Passage_Time / CRT.Logical_Screen_Height;
end;
or
when Text_Line = Text_Height =>
accept Put(S : in Scrollable_Strings;
White_On_Black: in Boolean := False) do
Appearing_String := S;
Background_Is_Black := White_On_Black;
end;
Text_Line := 0;
or
accept Wind_Up;
CRT.Revert_To_Text;
exit;
or
delay Next_Scroll_Time - Calendar.Clock;
if Time_Per_Line = 0.0 then
-- paused
Next_Scroll_Time := Calendar.Clock + Time_Per_Line;
else
Next_Scroll_Time := Next_Scroll_Time + Time_Per_Line;
CRT.Scroll(Next_Scan_Line);
if Text_Line < Text_Height then
if Text_Line > Letters.Line_Numbers'last then
Next_Scan_Line := (Next_Scan_Line'range => CRT.White);
else -- we're in a letter: make scan line from letter patterns
declare
X : Integer:=Next_Scan_Line'first;
begin
for J in Appearing_String'range loop
Single_Byte
:= Letters.Pattern(Appearing_String(J),Text_Line);
if Background_Is_Black then
Next_Scan_Line(X) :=Reversed_Show_Bit_Pair(Single_Byte.A);
Next_Scan_Line(X+1):=Reversed_Show_Bit_Pair(Single_Byte.B);
Next_Scan_Line(X+2):=Reversed_Show_Bit_Pair(Single_Byte.C);
Next_Scan_Line(X+3):=Reversed_Show_Bit_Pair(Single_Byte.D);
else
Next_Scan_Line(X) := Show_Bit_Pair(Single_Byte.A);
Next_Scan_Line(X+1) := Show_Bit_Pair(Single_Byte.B);
Next_Scan_Line(X+2) := Show_Bit_Pair(Single_Byte.C);
Next_Scan_Line(X+3) := Show_Bit_Pair(Single_Byte.D);
end if;
X:=X+4;
end loop;
end;
end if;
Text_Line := Text_Line + 1;
end if;
end if;
end select;
end loop Until_Told_Otherwise;
end Scroller;
end Screen;