diff --git a/tests/webtbs/tu2002.pp b/tests/webtbs/tu2002.pp new file mode 100644 index 0000000000..bbdaf103cf --- /dev/null +++ b/tests/webtbs/tu2002.pp @@ -0,0 +1,22 @@ +unit {vidutil}tu2002; + Interface + uses + video; + Procedure TextOut(X,Y : Word;Const S : + String); + Implementation + + Procedure TextOut(X,Y : Word;Const S : + String); + Var + W,P,I,M : Word; + begin + P:=((X-1)+(Y-1)*ScreenWidth); + M:=Length(S); + If P+M>ScreenWidth*ScreenHeight then + M:=ScreenWidth*ScreenHeight-P; + For I:=1 to M do + VideoBuf^[P+I-1]:=Ord(S[i])+($07 shl 8); + end; + + end. diff --git a/tests/webtbs/tw2002.pp b/tests/webtbs/tw2002.pp new file mode 100644 index 0000000000..5f0a59ab71 --- /dev/null +++ b/tests/webtbs/tw2002.pp @@ -0,0 +1,22 @@ +{ %INTERACTIVE } + +program testvideo; + uses video,keyboard,{vidutil}tu2002; + Var + i : longint; + k : TkeyEvent; + + begin + InitVideo; + InitKeyboard; + For I:=1 to 10 do + TextOut(i,i, 'Press any key to clear screen'); + UpdateScreen(false); + K:=GetKeyEvent; + ClearScreen; + TextOut(1,1,'Cleared screen. Press any key to end'); + UpdateScreen(true); + K:=GetKeyEvent; + DoneKeyBoard; + DoneVideo; + end.