(*----------------------------------------------*)
(* CRLDEMO.PAS -demonstriert die Verwendung der *)
(* System-Routinen SCR CLR BOX, SCR CHAR INVERT *)
(* und in Verbindung mit SCR SET FLASHING die   *)
(* Umschaltung der Farben der PCW-Rechner.      *)
(* Progr.-Sprache: TURBO PASCAL 3.0             *)
(* Rechner:        JOYCE (PCW 8256/82512)       *)
(* CP/M-Version:   CP/M 3 (PLUS) Vers. 1.4      *)
(* (c) 1992 Norbert Finke & CPC International   *)
(*----------------------------------------------*)
PROGRAM clrdemo;

TYPE
  color = (green, black);

  win_pos = RECORD
              ls : 0..89;
              oz : 0..30;
              rs : 0..89;
              uz : 0..30;
            END;

CONST
  bios_userf     = $FC5A;
  scr_initialize = $14E0;

(* Fenster-Koordinaten f}rs L|schen: *)
  pos : ARRAY [0..9] OF win_pos =
                      ((ls:00;oz:00;rs:89;uz:30),
                       (ls:00;oz:15;rs:01;uz:15),
                       (ls:44;oz:00;rs:45;uz:00),
                       (ls:88;oz:15;rs:89;uz:15),
                       (ls:44;oz:30;rs:45;uz:30),
                       (ls:04;oz:10;rs:15;uz:20),
                       (ls:34;oz:02;rs:55;uz:07),
                       (ls:74;oz:10;rs:85;uz:20),
                       (ls:34;oz:23;rs:55;uz:28),
                       (ls:18;oz:09;rs:71;uz:21));

VAR
  i : INTEGER;         (* Z{hl-Variable *)
  c : color;           (* Farb-Variable *)

PROCEDURE set_flashing_off;

(*    schaltet den Farbwechsel-Interrupt aus    *)

CONST
  scr_set_flashing = $1736;

BEGIN
  INLINE(
  $21/$00/$00/          (* LD   HL,$0000        *)
  $CD/bios_userf/       (* CALL bios_userf      *)
  scr_set_flashing);    (* DEFW scr_set_flashing*)
END;
(*----------------------------------------------*)

PROCEDURE invert_screen;

(*     invertiert }ber die System-Routine       *)
(*  SCR CHAR INVERT den kompletten Bildschirm   *)

CONST
  scr_char_invert = $160A;

VAR
  x, y : INTEGER;

BEGIN
  FOR y := 0 TO 30 DO
    FOR x := 0 TO 89 DO
      INLINE(
      $3A/x/            (* LD   A,(x)           *)
      $5F/              (* LD   E,A             *)
      $3A/y/            (* LD   A,(y)           *)
      $57/              (* LD   D,A             *)
      $CD/bios_userf/   (* CALL bios_userf      *)
      scr_char_invert); (* DEFW scr_char_invert *)
END;
(*----------------------------------------------*)

PROCEDURE clear_box(xy_koord : win_pos);

(*  l|scht das mit xy_koord definierte Fenster  *)

CONST
  scr_clr_box = $1549;

VAR
  start_x, end_x,
  start_y, end_y : INTEGER;

BEGIN
  start_x := xy_koord.ls; (* Koordinaten setzen *)
  start_y := xy_koord.oz;
  end_x   := xy_koord.rs;
  end_y   := xy_koord.uz;
  INLINE(
  $3A/start_x/          (* LD   A,(start_x)     *)
  $5F/                  (* LD   E,A             *)
  $3A/start_y/          (* LD   A,(start_y)     *)
  $57/                  (* LD   D,A             *)
  $3A/end_x/            (* LD   A,(end_x)       *)
  $6F/                  (* LD   L,A             *)
  $3A/end_y/            (* LD   A,(end_y)       *)
  $67/                  (* LD   H,A             *)
  $CD/bios_userf/       (* CALL bios_userf      *)
  scr_clr_box);         (* DEFW scr_clr_box     *)
END;
(*----------------------------------------------*)

PROCEDURE change_color;

(*   {ndert direkt }ber den Port $F7 die Farbe  *)

BEGIN
  IF c = black
  THEN
    BEGIN
      PORT[$F7]:=$C0;   (* Hintergrund = hell   *)
      c:= green;
    END
  ELSE
    BEGIN
      PORT[$F7]:=$40;   (* Hintergrund = dunkel *)
      c:= black;
    END;
END;
(*----------------------------------------------*)

BEGIN
  c := black;            (* Grundfarbe = dunkel *)
  set_flashing_off;      (* Interrupt aus       *)
  WRITE(^[,'0');         (* Statuszeile aus     *)
  GOTOXY(0,32);          (* Meldung ausgeben    *)
  WRITE('ENDE => bitte Taste dr}cken...');
  REPEAT
    clear_box(pos[0]);   (* Bildschirm l|schen  *)
    invert_screen;       (* und invertieren     *)
    FOR i:= 1 TO 9 DO    (* Fenster l|schen     *)
      clear_box(pos[i]);
    DELAY(1000);         (* anschauen...        *)
    change_color;        (* Farbe wechseln      *)
  UNTIL KEYPRESSED;      (* Taste gedr}ckt?     *)

(*  Bildschirm mit SCR INITIALIZE wieder normal *)

  INLINE(
  $CD/bios_userf/
  scr_initialize);
  WRITE(^[,'1');        (* Statuszeile ein      *)
  CLRSCR;               (* Bildschirm l|schen   *)
END.
(*----------------------------------------------*)