(*
   このプログラムは、ひのさんがお作りになった
    ｢HAPPyのための画面制御ライブラリ｣
   をPL/T用に書き換えたものです。
   なお、機種によって異なるものは、筆者の機種FM-TOWNS用になっています。
   PC-98系等をお使いの方は、書き換えて下さい。 (H.Asano)
*)
(*--------------------------------------------------------------------------
                            PLTcrt.plt

      PL/T のためのエスケープシーケンスを使った画面制御ライブラリ

　用意した手続き、定数、変数などの名前は、Turbo Pascal の Crt ユニット
のものをほぼ踏襲しましたが、定数、変数の中身はかなり異なります。

　用意されている手続きは以下の通りです。 * のついたものはPC9801以外の機種で、
変更が必要であったり、使えなかったりするものです。詳しくはソースの該当する部
分を参照してください。


 * procedure TextMode(Mode);                     画面モードの設定
   procedure GotoXY(X,Y);                        カーソルを指定座標に移動
   procedure ClrScr;                             画面消去
   procedure ClrEol;                             カーソル位置から行末までクリア
 * procedure InsLine;                            カーソル位置に１行挿入
 * procedure DelLine;                            カーソルのある行を削除
   procedure InitTextAttr;                       文字表示属性の初期化
   procedure TextColor(Color);                   文字色を設定
   procedure TextBlink(BlinkAttr);               ブリンク属性を設定
   procedure TextReverse(ReverseAttr);           反転属性を設定
   procedure TextUnder(UnderAttr);               下線を設定
   procedure TextVertical(VerticalAttr);         縦線を設定
 * procedure TextCursor(CAttr);                  カーソルの表示・非表示の設定
 * procedure Delay(MS);                          一定時間ウエイトをいれる

----------------------------------------------------------------------------*)

const

  ESC    = 27 ;        (* エスケースシーケンスコード *)

(* CRT modes PC9801 専用です。不要の方は削除してください *)
 ( N8020  ,            (* PC9801 80×20 / ファンクションキー非表示 *)
   N8025  ,            (* PC9801 80×25 / ファンクションキー非表示 *)
   N8020F ,            (* PC9801 80×20 / ファンクションキー表示   *)
   N8025F  )           (* PC9801 80×25 / ファンクションキー表示   *)

(* Foreground color constants *)
 ( Black,Red,Green,Yellow,Blue,Magenta,Cyan,White) ;

(* Character attribute constants *)
(* 高輝度属性、シークレット属性はサポートしていません *)

  Blink         = 5;      (* 点滅 *)
  Reverse       = 7;      (* 反転 *)
  UnderLine     = 4;      (* 下線添付 *)
  VerticalLine  = 2;      (* 縦線添付 *)
  NoVerticalLine= 0;
  NoUnderLine   = 0;
  NoReverse     = 0;
  NoBlink       = 0;

(* Cursor attribute constants *)
(* カーソルのＯＮ／ＯＦＦだけです *)
  DispCursor    = 1;             (* カーソル表示   *)
  NoDispCursor  = 0;             (* カーソル非表示 *)

var
(* Interface variables *)
  LastMode    ;                  (* Current text mode *)
  TextAttr[5] ;                  (* Current Attribute *)
   (*[0]:Color       : '0' or '7'
     [1]:Blink       : '0' or '5'
     [2]:Reverse     : '0' or '7'
     [3]:UnderLine   : '0' or '4'
     [4]:VerticalLine: '0' or '2'
   *)
  CursorAttr ;                   (* Current cursor on/off *)
(* end of interface variables *)


(* Interface procedures *)

(* これは PC9801 専用です。 *)
procedure TextMode(Mode);
begin
   (*  今のところ PL/Tでは case文をサポートしていない(^^);; *)
  LastMode := Mode;
  if Mode = N8020 then
    begin Write(ESC$,'[>3h'); WriteLn(ESC$,'[>1h'); end
  else if Mode = N8025 then
    begin Write(ESC$,'[>3l'); WriteLn(ESC$,'[>1h'); end
  else if Mode = N8020F then
    begin Write(ESC$,'[>3h'); WriteLn(ESC$,'[>1l'); end
  else (* N8025F *)
    begin Write(ESC$,'[>3l'); WriteLn(ESC$,'[>1l'); end;
end;

(* カーソルをX桁Y行に移動する *)
procedure GotoXY(X,Y);
begin
  Write(ESC$,'[',Y:1,';',X:1,'f');
end;

(* 画面の消去 *)
procedure ClrScr;
begin
  Write(ESC$,'[2J');
end;

(* カーソル位置から行末まで削除 *)
procedure ClrEol;
begin
  Write(ESC$,'[0K');
end;

(*-------------------------------------------------------------------------
 カーソル位置に１行空行を挿入する
 機種によって書き換えてください。
 J-3100, DOS/V では該当するエスケープシーケンスがないようなので使えません
--------------------------------------------------------------------------*)
procedure InsLine;
begin
(*Write(ESC$,'[1L');*)     (* 98,AX,if800 用 *)
  Write(ESC$,'E');         (* FM-R, TOWNS, if800 の場合 *)
end;

(*-------------------------------------------------------------------------
 カーソルのある行を削除する。
 機種によって書き換えてください。
 J-3100, DOS/V では該当するエスケープシーケンスがないようなので使えません
--------------------------------------------------------------------------*)
procedure DelLine;
begin
(*Write(ESC$,'[1M');*)     (* 98,AX,if800 用 *)
  Write(ESC$,'R');         (* FM-R, TOWNS, if800 の場合 *)
end;

(*-----------------------------------------------------------------
 カレントの文字表示属性に設定する。以下の手続きから呼び出される。
 InitTextAttr;
 TextColor(Color);
 TextBlink(BlinkAttr);
 TextReverse(ReverseAttr);
 TextUnder(UnderAttr);
 TextVertical(VerticalAttr);
特定の表示属性の変更だけを行うと、他の表示属性がリセットされてしまうので、
テキストの表示属性は TextAttr 変数で常に保持し、常に全ての表示属性をセット
するようにした。

-------------------------------------------------------------------- *)
procedure SetTextAttr;
begin
  Write(ESC$,'[',TextAttr[1]$,';',
                 TextAttr[2]$,';',
                 TextAttr[3]$,';',
                 TextAttr[4]$,';',
             '3',TextAttr[0]$,'m');
end;

(*-------------------------------------------------------------
文字表示属性の初期化。
文字色を白にし、反転・下線・縦線・点滅の各属性をキャンセルする。
変数 TextAttr の初期化に必要なので、文字属性を変更する手続きを
使う時は、その前に必ず１度はこの手続きを実行すること。
---------------------------------------------------------------*)
procedure InitTextAttr;
begin
  TextAttr[0] := '7';
  TextAttr[1] := '0';
  TextAttr[2] := '0';
  TextAttr[3] := '0';
  TextAttr[4] := '0';
  SetTextAttr;
end;

(* 表示色の設定 *)
procedure TextColor(Color) ;
begin
  TextAttr[0] := Color + '0';
  SetTextAttr;
end;

(* ブリンク属性の設定 *)
procedure TextBlink(BlinkAttr) ;
begin
  TextAttr[1] := BlinkAttr + '0';
  SetTextAttr;
end;

(* 反転属性の設定 *)
procedure TextReverse(ReverseAttr) ;
begin
  TextAttr[2] := ReverseAttr + '0';
  SetTextAttr;
end;

(* アンダーラインの設定 *)
procedure TextUnder(UnderAttr) ;
begin
  TextAttr[3] := UnderAttr + '0';
  SetTextAttr;
end;

(* バーティカルラインの設定 *)
procedure TextVertical(VerticalAttr) ;
begin
  TextAttr[4] := VerticalAttr + '0';
  SetTextAttr;
end;

(*-----------------------------------------------------------------
カーソルの表示／消去の設定
機種によって書き換えてください。
J-3100, DOS/V では該当するエスケープシーケンスがないようなので使えません。
-------------------------------------------------------------------*)
procedure TextCursor(CAttr) ;
begin
  if CAttr then
 (* Write(ESC$,'[>5l') *)  (* 98,AX *)
    Write(ESC$,'[0v')      (* FM-R, TOWNS *)
 (* Write(ESC$,'1')   *)   (* if800 *)
  else
 (* Write(ESC$,'[>5h');*)  (* 98,AX *)
    Write(ESC$,'[1v');     (* FM-R, TOWNS *)
 (* Write(ESC$,'0');   *)  (* if800 *)
  CursorAttr := CAttr;
end;

(*---------------------------------------------------------------------
一定時間ウエイトを入れる。
ダミーループを回しているだけなので、環境に合せて適当にループ回数を変更
してください。
-----------------------------------------------------------------------*)
procedure Delay(MS) ;
var
  i,j,k ;
begin
  for i := 1 to MS do
    for j := 1 to 100 do
      k := i + j;
end;

(*--------------------- end of interface procedures------------------------*)

(*------------------------------ Demo Routine ---------------------------*)

(*-----------------------------------------------------------------------
矩形消去。' 'で塗り潰すだけなので、リバース属性になっていると逆効果(^^;)
とっても遅いです(T_T)。
-----------------------------------------------------------------------*)
procedure BoxClr(x1, y1, x2, y2) ;
var
  x, y ;
begin
  for x := x1 to x2 do
    for y := y1 to y2 do begin
      GotoXY(x,y);
      Write(' ');
    end;
end;(* BoxClr *)

(*----------------------
 枠つきＢＯＸの描画
------------------------*)
procedure BoxFrame(x1, y1, x2, y2) ;
var
  i ;
begin
  for i := y1 to y2 do begin
    GotoXY(x1, i); Write('|');
    GotoXY(x2, i); Write('|');
  end;
  for i := x1 to x2 do begin
    GotoXY(i, y1); Write('-');
    GotoXY(i, y2); Write('-');
  end;
  GotoXY(x1, y1); Write('+');
  GotoXY(x1, y2); Write('+');
  GotoXY(x2, y1); Write('+');
  GotoXY(x2, y2); Write('+');
end;(* BoxFrame *)

(********************************)
(*         main program         *)
(********************************)
var i,x,y,z ;

begin (*main*)
  InitTextAttr;              (* なるべく最初にこの初期化を行なってください *)
  TextCursor(NoDispCursor);  (* カーソルを非表示にする。画面のチラツキ防止 *)
  ClrScr;                    (* 画面のクリア *)

  (* 色を変えながら、Boxを描く *)
  for i := 1 to 18 do begin
    TextColor(Cyan);
    TextReverse(NoReverse);
    BoxClr(3 * i, i, 3 * i + 20, i + 4);
    TextReverse(Reverse);
    BoxFrame(3 * i, i, 3 * i + 20, i + 4);
    TextColor(1 + i % 7);
    GotoXY(3 * i + 1, i + 1); Write('                   ');
    GotoXY(3 * i + 1, i + 2); Write('   PL/T CRT Demo   ');
    GotoXY(3 * i + 1, i + 3); Write('                   ');
    Delay(5);
  end;
  Delay(10);

  (* 画面中央にBoxを書き直す *)
  ClrScr;
  TextColor(Cyan);
  TextReverse(Reverse);
  BoxFrame(30, 10, 50, 14);
  TextColor(Yellow);
  GotoXY(31, 11); Write('                   ');
  GotoXY(31, 12); Write('   PL/T CRT Demo   ');
  GotoXY(31, 13); Write('                   ');
  Delay(5);
  TextColor(White);
  GotoXY(35,13);
  Write('Hit return.');
  ReadLn;

  (* InsLine DelLine で、Boxを上下に動かす *)
  GotoXY(1,1);
  for i := 1 to 10 do InsLine;
  for x := 1 to 5 do begin
    for y := 1 to 19 do DelLine;
    for y := 1 to 19 do InsLine;
  end;

  ClrScr;
  for X := 1 to 22 do begin
    TextColor(1 + X % 7);
    z :=  x % 5;
   (*  今のところ PL/Tでは case文をサポートしていない(^^);; *)
    if      z = 0 then InitTextAttr
    else if z = 1 then TextUnder(UnderLine)
    else if z = 2 then TextVertical(VerticalLine)
    else if z = 3 then TextReverse(Reverse)
    else (* z = 4 *)   TextBlink(Blink);
    GotoXY(2*x, x);
    Write('  PL/T CRT Demo ');
    GotoXY(2*x, 23 - x);
    Write('  PL/T CRT Demo ');
  end;
  Delay(5) ;
  InitTextAttr;
  for x := 1 to 5 do
    for y := 1 to 22 do begin
      TextColor(1 + y % 7);
      z := (x * 22 + y) % 3;
   (*  今のところ PL/Tでは case文をサポートしていない(^^);; *)
      if      z = 0 then
        begin TextUnder(NoUnderLine); TextBlink(Blink)     end
      else if z = 1 then
        begin TextBlink(NoBlink)    ; TextReverse(Reverse) end
      else
        begin TextReverse(NoReverse); TextUnder(UnderLine) end;
      if x % 2 then GotoXY(x*16-15, 23 - y)
               else GotoXY(x*16-15, y);
      Write('  PL/T CRT Demo ');
    end;(*for*)

  InitTextAttr;
  TextColor(Magenta); TextReverse(Reverse);
  BoxFrame(28, 8, 51, 18);
  TextColor(Yellow);
  GotoXY(29, 9); Write('                      ');
  GotoXY(29,10); Write('  EEEE  N   N  DDD    ');
  GotoXY(29,11); Write('  E     NN  N  D  D   ');
  GotoXY(29,12); Write('  EEE   N N N  D   D  ');
  GotoXY(29,13); Write('  E     N  NN  D  D   ');
  GotoXY(29,14); Write('  EEEE  N   N  DDD    ');
  GotoXY(29,15); Write('                      ');
  GotoXY(29,16); Write('      Hit return.     ');
  GotoXY(29,17); Write('                      ');
  TextColor(Cyan); TextReverse(Reverse); TextBlink(Blink);
  GotoXY(34,16); Write(' Hit return.');
  ReadLn;
  InitTextAttr;                (* 後始末 *)
  TextCursor(DispCursor);      (* 後始末 *)
  ClrScr;
end.