PROGRAM BIOSdemo;

TYPE

  iAPX     = RECORD CASE Boolean OF
    False:  (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags:  INTEGER);
    True:   (AL, AH, BL, BH, CL, CH, DL, DH:             Byte)
  END;  { RECORD iAPX }

  vBoard   = (MDA, CGA, EGA, PCjr);
  vBoards  = SET OF vBoard;
  halfstring = STRING[127];


CONST { TYPED }

  color_boards:  vBoards = [CGA..PCjr];
  mono_boards:   vBoards = [MDA, EGA];


VAR

  registers:      iAPX;
  boardsPresent:  vBoards;
  boardInUse:     vBoard;
  i, y:           Byte;
  x:              Integer;


FUNCTION findBoards(VAR present:  vBoards):  vBoard;

  CONST
    MDA_CRTC_Data = $03B5;
    CGA_CRTC_Data = $03D5;
    CGA_Palette   = $03D9;
    EGA_Seg_MSB   = $C0;
    PCjr_ID       = $FD;

  VAR
    INT10segMSB:  Byte ABSOLUTE $0000:$0043;
    PCjrID:       Byte ABSOLUTE $FFFF:$000E;
    BIOSvmode:    Byte ABSOLUTE $0040:$0049;  BEGIN

  present := [];
  IF  Port [MDA_CRTC_Data] < $FF THEN  present := present + [MDA];
  IF (Port [CGA_CRTC_Data] < $FF) AND (Port [CGA_Palette] = $FF)
     THEN  present := present + [CGA];
  IF INT10segMSB AND $F0 = EGA_Seg_MSB THEN  present := present + [EGA];

  IF PCjrID = PCjr_ID THEN  BEGIN
    present := [PCjr];
    findBoards := PCjr
  END   { IF }

  ELSE  IF (MDA IN present) AND (BIOSvmode = 7) THEN  findBoards := MDA

  ELSE  IF BIOSvmode <> 7 THEN  BEGIN
    IF CGA IN present THEN  findBoards := CGA  ELSE
    IF EGA IN present THEN  findBoards := EGA
  END   { IF }

END;  { FUNCTION findBoards }


PROCEDURE BIOSvideo (Func:  Byte;  VAR registers:  iAPX);  BEGIN
  registers.AH := Func;
  Intr ($10, registers)
END;  { PROCEDURE BIOSvideo }


PROCEDURE center (row:  Byte;  line:  halfstring);

  VAR  BIOSvcols:  Byte ABSOLUTE $0040:$004A;  BEGIN

  GotoXY (Succ((BIOSvcols - Length(line)) SHR 1), row);
  Write (line)

END;  { PROCEDURE center }


PROCEDURE waitForSpaceBar (attribute:  Byte);

  VAR
    saveX, saveY:  Byte;
    junque:  CHAR;  BEGIN

  saveX := WhereX;  saveY := WhereY;
  TextColor (attribute AND $0F OR ((attribute AND $80) SHR 3));
  TextBackground (attribute AND $70 SHR 4);
  Center (25, '  PRESS [ SPACE BAR ] TO CONTINUE:  ');
  REPEAT  Read (Kbd, junque)  UNTIL  junque = #32;
  NormVideo;  TextBackground (Black);
  GotoXY (1, 25);  ClrEOL;
  GotoXY (saveX, saveY)

END;  { PROCEDURE waitForSpaceBar }


PROCEDURE clearOnSpaceBar (attribute:  Byte);  BEGIN
  waitForSpaceBar (attribute);
  TextMode;  ClrScr;  LowVideo
END;  { PROCEDURE clearOnSpaceBar }


PROCEDURE initialize  BEGIN
  boardInUse := findBoards(boardsPresent)
END;  { PROCEDURE initialize }


PROCEDURE demoFunc0;  BEGIN
  registers.AL := $01;
  BIOSvideo ($00, registers);
  LowVideo;
  WriteLn ('   Welcome to 40-column color text mode.');
  waitForSpaceBar ($9E);
  registers.AL := $03;
  BIOSvideo ($00, registers);
  LowVideo;
  WriteLn ('   We are now back to the wonderful world of 80-column text.');
  clearOnSpaceBar ($9E)
END;  { PROCEDURE demoFunc0 }


PROCEDURE demoFunc1;

  VAR
    cursorStart, cursorEnd:  Byte;
    oldCursor:               INTEGER ABSOLUTE cursorEnd;  BEGIN

  BIOSvideo ($03, registers);  oldCursor := registers.CX;

  WITH registers DO  BEGIN
    CX := $1F1F;
    BIOSvideo ($01, registers);
    waitForSpaceBar ($9E);
    CH := $00;
    BIOSvideo ($01, registers);
    waitForSpaceBar ($9E);
    CX := oldCursor;
  END;  { WITH registers }

  BIOSvideo ($01, registers);
  clearOnSpaceBar ($9E);

END;  { PROCEDURE demoFunc1 }


PROCEDURE demoFunc2;  BEGIN

  waitForSpaceBar ($9E);
  Randomize;
  registers.BH := 0;

  REPEAT
    registers.DH := Random(25);
    registers.DL := Random(80);
    BIOSvideo ($02, registers);
    Delay (250)
  UNTIL KeyPressed;

  clearOnSpaceBar ($9E)

END;  { PROCEDURE demoFunc2 }


PROCEDURE demoFunc3;  BEGIN

  randomize;

  WITH registers DO  BEGIN

    BH := 0;

    REPEAT
      GotoXY (Succ(Random(80)), Succ(Random(25)));
      BIOSvideo ($03, registers);
      GotoXY (30, 25);
      Write ('(', DH:2, ',', DL:2, ')  [', CH:2, ',', CL:2, ']');
      GotoXY (Succ(DL), Succ(DH));  Delay (1000)
    UNTIL KeyPressed

  END;  { WITH registers }

  clearOnSpaceBar ($9E)

END;  { PROCEDURE demoFunc3 }


PROCEDURE demoFunc5;

  VAR
    screen:          ARRAY [1..8, 0..$0FFF] OF Byte  ABSOLUTE $B800:$1000;
    page, maxPages:  Byte;  BEGIN

  IF (boardInUse = MDA) AND (boardsPresent <> [MDA]) THEN  BEGIN
    WriteLn ('   Because you are using an MDA, you can only have one display page.  Thus, we');
    WriteLn ('will not be able to demonstrate this function until you re-run this program with');
    WriteLn ('your color video adapter board enabled.');
    clearOnSpaceBar ($9E)

  END  ELSE  IF boardsPresent = [MDA] THEN  BEGIN
    WriteLn ('  Because you have only an MDA which has only one diplay page, we cannot demo');
    WriteLn ('this function on your system.');
    clearOnSpaceBar ($9E)

  END;  { IF }

  IF boardInUse IN color_Boards THEN  BEGIN

    maxPages := 3 + 4 * Ord(boardInUse = EGA);
    FOR page := 1 TO maxPages DO  FillChar (screen[page], 4000, 48+page);
    waitForSpaceBar ($9E);

    FOR page := 0 TO maxPages DO  BEGIN
      registers.AL := page;
      BIOSvideo ($05, registers);
      Delay (500)
    END;  { FOR page }

    registers.AL := 0;  BIOSvideo ($05, registers);
    clearOnSpaceBar ($9E)

  END   { IF }

END;  { PROCEDURE demoFunc5 }


PROCEDURE demoFuncs6and7;  BEGIN

  FOR I := 1 TO 25 DO  Center (i, 'This is a test of the "Initialize Window and Scroll Window Contents" BIOS calls.');
  waitForSpaceBar ($9E);

  WITH registers DO  BEGIN

    CH := 4;  DH := 19;  CL := 9;  DL := 69;  BH := $1B;

    FOR i := 1 TO 15 DO  BEGIN
      AL := i;  BIOSvideo ($06 OR Ord(Odd(AL)), registers);  Delay (500)
    END;  { FOR i }

    AL := 0;  BIOSvideo ($06, registers)

  END;  { WITH registers }

  waitForSpaceBar ($9E)

END;  { PROCEDURE demoFuncs6and7 }


PROCEDURE demoFunc8;  BEGIN

  randomize;

  WITH registers DO  BEGIN

    BH := 0;

    REPEAT
      x := Succ(Random(80));  y := Succ(Random(25));
      GotoXY (x, y);  BIOSvideo ($08, registers);
      GotoXY (35, 25);
      Write (AL:3, ',', AH:3);
      GotoXY (x, y);  Delay (1000)
    UNTIL KeyPressed

  END;  { WITH registers }

  clearOnSpaceBar ($9E)

END;  { PROCEDURE demoFunc8 }


PROCEDURE demoFunc9;  BEGIN

  WITH registers DO  BEGIN

    BH := 0;  CX := 1;

    FOR y := 0 TO 15 DO
      FOR x := 0 TO 15 DO  BEGIN
        GotoXY (x SHL 1 + 42, y + 9);
        AL := y SHL 4 + x;  BL := AL;
        BIOSvideo ($09, registers)
      END   { FOR x }

  END;  { WITH registers }

  clearOnSpaceBar ($9E)

END;  { PROCEDURE demoFunc9 }


PROCEDURE demoFuncA;  BEGIN

  WITH registers DO  BEGIN

    AL := Ord('x');  BH := 0;  CX := 1;

    FOR y := 0 TO 15 DO
      FOR x := 0 TO 15 DO  BEGIN
        GotoXY (x SHL 1 + 42, y + 9);
        BL := Random(256);
        BIOSvideo ($09, registers)
      END;  { FOR x }

    waitForSpaceBar ($9E);

    FOR y := 0 TO 15 DO
      FOR x := 0 TO 15 DO  BEGIN
        GotoXY (x SHL 1 + 42, y + 9);
        AL := y SHL 4 + x;
        BIOSvideo ($0A, registers)
      END   { FOR x }

  END;  { WITH registers }

  clearOnSpaceBar ($9E)

END;  { PROCEDURE demoFuncA }


PROCEDURE demoFuncB;  BEGIN

  WITH registers DO  BEGIN

    BH := 0;

    FOR i := 0 TO 15 DO  BEGIN
      BL := i;  BIOSvideo ($B, registers);  Delay (250)
    END;  { FOR i }

    waitForSpaceBar ($9E);  GraphColorMode;  BH := 1;

    FOR i := 1 TO 24 DO  BEGIN
      TextColor (Succ(i MOD 3));  Center (i, 'This is a color palette test.')
    END;  { FOR i }

    FOR i := 1 TO 8  DO  BEGIN
      BL := Ord(Odd(i));  BIOSvideo($0B, registers);  Delay (500)
    END   { FOR i }

  END;  { WITH registers }

  clearOnSpaceBar ($03)

END;  { PROCEDURE demoFuncB }


PROCEDURE demoFuncC;  BEGIN

  WITH registers DO  REPEAT
    x  := Random(200);  y := Random(200);  AL := Random(4);
    CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
    CX := y + 60;  DX := x;  BIOSvideo ($0C, registers);
    x  := 199 - x;
    CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
    CX := y + 60;  DX := x;  BIOSvideo ($0C, registers);
    y  := 199 - y;
    CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
    CX := y + 60;  DX := x;  BIOSvideo ($0C, registers);
    x  := 199 - x;
    CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
    CX := y + 60;  DX := x;  BIOSvideo ($0C, registers)
  UNTIL KeyPressed;

  clearOnSpaceBar ($03)

END;  { PROCEDURE demoFuncC }


PROCEDURE demoFuncD;  BEGIN

  waitForSpaceBar ($9E);  GraphMode;  Palette (1);  TextColor ($13);

  FOR i := 0 TO 2 DO
    FOR x := i * 80 TO i * 80 + 79 DO  Draw (x, 0, x + 80, 199, Succ(i));

  WITH registers DO  REPEAT

    CX := Random(320);  DX := Random(200);
    BIOSvideo ($D, registers);  GotoXY (12, 25);
    Write ('(', CX:3, ',', DX:3, ')', AL:3);  y := AL;  AL := $83;

    FOR i := 1 TO 8 DO  BEGIN
      Delay (125);  BIOSvideo ($C, registers)
    END;   { FOR i }

    GotoXY (12, 25);
    Write ('(', CX:3, ',', DX:3, ')', y:3)

  UNTIL keyPressed;

  clearOnSpaceBar ($83)

END;  { PROCEDURE demoFuncD }


PROCEDURE demoFuncE;

  VAR  c:  CHAR;  BEGIN

  waitForSpaceBar ($0E);
  registers.BH := 0;  ClrScr;

  REPEAT
    Read (KBD, c);  registers.AL := Ord(c);  BIOSvideo ($E, registers)
  UNTIL c = ^[;

  clearOnSpaceBar ($0E);

END;  { PROCEDURE demoFuncE }


PROCEDURE demoFuncF;  BEGIN
  BIOSvideo ($F, registers);
  WriteLn ('Current BIOS video mode:  ', registers.AL);
  WriteLn ('# of character columns:   ', registers.AH);
  WriteLn ('Active display page:      ', registers.BH, ^J);
  clearOnSpaceBar  ($9E)
END;  { PROCEDURE demoFuncF }



BEGIN { PROGRAM BIOSdemo }

initialize;
demoFunc0;
demoFunc1;
demoFunc2;
demoFunc3;
demoFunc5;
demoFuncs6and7;
demoFunc8;
demoFunc9;
demoFuncA;

IF boardInUse = MDA THEN  BEGIN
  WriteLn ('  BIOS video functions 0Bh ("Set Color Palette"), 0Ch ("Write Graphics Pixel")');
  WriteLn ('and 0Dh ("Read Graphics Pixel") are useless on an MDA, so they will be skipped.');
  IF boardsPresent <> [MDA] THEN
     WriteLn ('Re-run this demo with your color graphics card enabled to see these demos.');
  clearOnSpaceBar ($9E)

END  ELSE  BEGIN
  demoFuncB;
  demoFuncC;
  demoFuncD
END;  { IF }

demoFuncE;
demoFuncF

END.  { PROGRAM BIOSdemo }
