home *** CD-ROM | disk | FTP | other *** search
/ Big Blue Disk 11 / bbd11.zip / BIOSDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1987-06-15  |  11KB  |  454 lines
  1. PROGRAM BIOSdemo;
  2.  
  3. TYPE
  4.  
  5.   iAPX     = RECORD CASE Boolean OF
  6.     False:  (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags:  INTEGER);
  7.     True:   (AL, AH, BL, BH, CL, CH, DL, DH:             Byte)
  8.   END;  { RECORD iAPX }
  9.  
  10.   vBoard   = (MDA, CGA, EGA, PCjr);
  11.   vBoards  = SET OF vBoard;
  12.   halfstring = STRING[127];
  13.  
  14.  
  15. CONST { TYPED }
  16.  
  17.   color_boards:  vBoards = [CGA..PCjr];
  18.   mono_boards:   vBoards = [MDA, EGA];
  19.  
  20.  
  21. VAR
  22.  
  23.   registers:      iAPX;
  24.   boardsPresent:  vBoards;
  25.   boardInUse:     vBoard;
  26.   i, y:           Byte;
  27.   x:              Integer;
  28.  
  29.  
  30. FUNCTION findBoards(VAR present:  vBoards):  vBoard;
  31.  
  32.   CONST
  33.     MDA_CRTC_Data = $03B5;
  34.     CGA_CRTC_Data = $03D5;
  35.     CGA_Palette   = $03D9;
  36.     EGA_Seg_MSB   = $C0;
  37.     PCjr_ID       = $FD;
  38.  
  39.   VAR
  40.     INT10segMSB:  Byte ABSOLUTE $0000:$0043;
  41.     PCjrID:       Byte ABSOLUTE $FFFF:$000E;
  42.     BIOSvmode:    Byte ABSOLUTE $0040:$0049;  BEGIN
  43.  
  44.   present := [];
  45.   IF  Port [MDA_CRTC_Data] < $FF THEN  present := present + [MDA];
  46.   IF (Port [CGA_CRTC_Data] < $FF) AND (Port [CGA_Palette] = $FF)
  47.      THEN  present := present + [CGA];
  48.   IF INT10segMSB AND $F0 = EGA_Seg_MSB THEN  present := present + [EGA];
  49.  
  50.   IF PCjrID = PCjr_ID THEN  BEGIN
  51.     present := [PCjr];
  52.     findBoards := PCjr
  53.   END   { IF }
  54.  
  55.   ELSE  IF (MDA IN present) AND (BIOSvmode = 7) THEN  findBoards := MDA
  56.  
  57.   ELSE  IF BIOSvmode <> 7 THEN  BEGIN
  58.     IF CGA IN present THEN  findBoards := CGA  ELSE
  59.     IF EGA IN present THEN  findBoards := EGA
  60.   END   { IF }
  61.  
  62. END;  { FUNCTION findBoards }
  63.  
  64.  
  65. PROCEDURE BIOSvideo (Func:  Byte;  VAR registers:  iAPX);  BEGIN
  66.   registers.AH := Func;
  67.   Intr ($10, registers)
  68. END;  { PROCEDURE BIOSvideo }
  69.  
  70.  
  71. PROCEDURE center (row:  Byte;  line:  halfstring);
  72.  
  73.   VAR  BIOSvcols:  Byte ABSOLUTE $0040:$004A;  BEGIN
  74.  
  75.   GotoXY (Succ((BIOSvcols - Length(line)) SHR 1), row);
  76.   Write (line)
  77.  
  78. END;  { PROCEDURE center }
  79.  
  80.  
  81. PROCEDURE waitForSpaceBar (attribute:  Byte);
  82.  
  83.   VAR
  84.     saveX, saveY:  Byte;
  85.     junque:  CHAR;  BEGIN
  86.  
  87.   saveX := WhereX;  saveY := WhereY;
  88.   TextColor (attribute AND $0F OR ((attribute AND $80) SHR 3));
  89.   TextBackground (attribute AND $70 SHR 4);
  90.   Center (25, '  PRESS [ SPACE BAR ] TO CONTINUE:  ');
  91.   REPEAT  Read (Kbd, junque)  UNTIL  junque = #32;
  92.   NormVideo;  TextBackground (Black);
  93.   GotoXY (1, 25);  ClrEOL;
  94.   GotoXY (saveX, saveY)
  95.  
  96. END;  { PROCEDURE waitForSpaceBar }
  97.  
  98.  
  99. PROCEDURE clearOnSpaceBar (attribute:  Byte);  BEGIN
  100.   waitForSpaceBar (attribute);
  101.   TextMode;  ClrScr;  LowVideo
  102. END;  { PROCEDURE clearOnSpaceBar }
  103.  
  104.  
  105. PROCEDURE initialize  BEGIN
  106.   boardInUse := findBoards(boardsPresent)
  107. END;  { PROCEDURE initialize }
  108.  
  109.  
  110. PROCEDURE demoFunc0;  BEGIN
  111.   registers.AL := $01;
  112.   BIOSvideo ($00, registers);
  113.   LowVideo;
  114.   WriteLn ('   Welcome to 40-column color text mode.');
  115.   waitForSpaceBar ($9E);
  116.   registers.AL := $03;
  117.   BIOSvideo ($00, registers);
  118.   LowVideo;
  119.   WriteLn ('   We are now back to the wonderful world of 80-column text.');
  120.   clearOnSpaceBar ($9E)
  121. END;  { PROCEDURE demoFunc0 }
  122.  
  123.  
  124. PROCEDURE demoFunc1;
  125.  
  126.   VAR
  127.     cursorStart, cursorEnd:  Byte;
  128.     oldCursor:               INTEGER ABSOLUTE cursorEnd;  BEGIN
  129.  
  130.   BIOSvideo ($03, registers);  oldCursor := registers.CX;
  131.  
  132.   WITH registers DO  BEGIN
  133.     CX := $1F1F;
  134.     BIOSvideo ($01, registers);
  135.     waitForSpaceBar ($9E);
  136.     CH := $00;
  137.     BIOSvideo ($01, registers);
  138.     waitForSpaceBar ($9E);
  139.     CX := oldCursor;
  140.   END;  { WITH registers }
  141.  
  142.   BIOSvideo ($01, registers);
  143.   clearOnSpaceBar ($9E);
  144.  
  145. END;  { PROCEDURE demoFunc1 }
  146.  
  147.  
  148. PROCEDURE demoFunc2;  BEGIN
  149.  
  150.   waitForSpaceBar ($9E);
  151.   Randomize;
  152.   registers.BH := 0;
  153.  
  154.   REPEAT
  155.     registers.DH := Random(25);
  156.     registers.DL := Random(80);
  157.     BIOSvideo ($02, registers);
  158.     Delay (250)
  159.   UNTIL KeyPressed;
  160.  
  161.   clearOnSpaceBar ($9E)
  162.  
  163. END;  { PROCEDURE demoFunc2 }
  164.  
  165.  
  166. PROCEDURE demoFunc3;  BEGIN
  167.  
  168.   randomize;
  169.  
  170.   WITH registers DO  BEGIN
  171.  
  172.     BH := 0;
  173.  
  174.     REPEAT
  175.       GotoXY (Succ(Random(80)), Succ(Random(25)));
  176.       BIOSvideo ($03, registers);
  177.       GotoXY (30, 25);
  178.       Write ('(', DH:2, ',', DL:2, ')  [', CH:2, ',', CL:2, ']');
  179.       GotoXY (Succ(DL), Succ(DH));  Delay (1000)
  180.     UNTIL KeyPressed
  181.  
  182.   END;  { WITH registers }
  183.  
  184.   clearOnSpaceBar ($9E)
  185.  
  186. END;  { PROCEDURE demoFunc3 }
  187.  
  188.  
  189. PROCEDURE demoFunc5;
  190.  
  191.   VAR
  192.     screen:          ARRAY [1..8, 0..$0FFF] OF Byte  ABSOLUTE $B800:$1000;
  193.     page, maxPages:  Byte;  BEGIN
  194.  
  195.   IF (boardInUse = MDA) AND (boardsPresent <> [MDA]) THEN  BEGIN
  196.     WriteLn ('   Because you are using an MDA, you can only have one display page.  Thus, we');
  197.     WriteLn ('will not be able to demonstrate this function until you re-run this program with');
  198.     WriteLn ('your color video adapter board enabled.');
  199.     clearOnSpaceBar ($9E)
  200.  
  201.   END  ELSE  IF boardsPresent = [MDA] THEN  BEGIN
  202.     WriteLn ('  Because you have only an MDA which has only one diplay page, we cannot demo');
  203.     WriteLn ('this function on your system.');
  204.     clearOnSpaceBar ($9E)
  205.  
  206.   END;  { IF }
  207.  
  208.   IF boardInUse IN color_Boards THEN  BEGIN
  209.  
  210.     maxPages := 3 + 4 * Ord(boardInUse = EGA);
  211.     FOR page := 1 TO maxPages DO  FillChar (screen[page], 4000, 48+page);
  212.     waitForSpaceBar ($9E);
  213.  
  214.     FOR page := 0 TO maxPages DO  BEGIN
  215.       registers.AL := page;
  216.       BIOSvideo ($05, registers);
  217.       Delay (500)
  218.     END;  { FOR page }
  219.  
  220.     registers.AL := 0;  BIOSvideo ($05, registers);
  221.     clearOnSpaceBar ($9E)
  222.  
  223.   END   { IF }
  224.  
  225. END;  { PROCEDURE demoFunc5 }
  226.  
  227.  
  228. PROCEDURE demoFuncs6and7;  BEGIN
  229.  
  230.   FOR I := 1 TO 25 DO  Center (i, 'This is a test of the "Initialize Window and Scroll Window Contents" BIOS calls.');
  231.   waitForSpaceBar ($9E);
  232.  
  233.   WITH registers DO  BEGIN
  234.  
  235.     CH := 4;  DH := 19;  CL := 9;  DL := 69;  BH := $1B;
  236.  
  237.     FOR i := 1 TO 15 DO  BEGIN
  238.       AL := i;  BIOSvideo ($06 OR Ord(Odd(AL)), registers);  Delay (500)
  239.     END;  { FOR i }
  240.  
  241.     AL := 0;  BIOSvideo ($06, registers)
  242.  
  243.   END;  { WITH registers }
  244.  
  245.   waitForSpaceBar ($9E)
  246.  
  247. END;  { PROCEDURE demoFuncs6and7 }
  248.  
  249.  
  250. PROCEDURE demoFunc8;  BEGIN
  251.  
  252.   randomize;
  253.  
  254.   WITH registers DO  BEGIN
  255.  
  256.     BH := 0;
  257.  
  258.     REPEAT
  259.       x := Succ(Random(80));  y := Succ(Random(25));
  260.       GotoXY (x, y);  BIOSvideo ($08, registers);
  261.       GotoXY (35, 25);
  262.       Write (AL:3, ',', AH:3);
  263.       GotoXY (x, y);  Delay (1000)
  264.     UNTIL KeyPressed
  265.  
  266.   END;  { WITH registers }
  267.  
  268.   clearOnSpaceBar ($9E)
  269.  
  270. END;  { PROCEDURE demoFunc8 }
  271.  
  272.  
  273. PROCEDURE demoFunc9;  BEGIN
  274.  
  275.   WITH registers DO  BEGIN
  276.  
  277.     BH := 0;  CX := 1;
  278.  
  279.     FOR y := 0 TO 15 DO
  280.       FOR x := 0 TO 15 DO  BEGIN
  281.         GotoXY (x SHL 1 + 42, y + 9);
  282.         AL := y SHL 4 + x;  BL := AL;
  283.         BIOSvideo ($09, registers)
  284.       END   { FOR x }
  285.  
  286.   END;  { WITH registers }
  287.  
  288.   clearOnSpaceBar ($9E)
  289.  
  290. END;  { PROCEDURE demoFunc9 }
  291.  
  292.  
  293. PROCEDURE demoFuncA;  BEGIN
  294.  
  295.   WITH registers DO  BEGIN
  296.  
  297.     AL := Ord('x');  BH := 0;  CX := 1;
  298.  
  299.     FOR y := 0 TO 15 DO
  300.       FOR x := 0 TO 15 DO  BEGIN
  301.         GotoXY (x SHL 1 + 42, y + 9);
  302.         BL := Random(256);
  303.         BIOSvideo ($09, registers)
  304.       END;  { FOR x }
  305.  
  306.     waitForSpaceBar ($9E);
  307.  
  308.     FOR y := 0 TO 15 DO
  309.       FOR x := 0 TO 15 DO  BEGIN
  310.         GotoXY (x SHL 1 + 42, y + 9);
  311.         AL := y SHL 4 + x;
  312.         BIOSvideo ($0A, registers)
  313.       END   { FOR x }
  314.  
  315.   END;  { WITH registers }
  316.  
  317.   clearOnSpaceBar ($9E)
  318.  
  319. END;  { PROCEDURE demoFuncA }
  320.  
  321.  
  322. PROCEDURE demoFuncB;  BEGIN
  323.  
  324.   WITH registers DO  BEGIN
  325.  
  326.     BH := 0;
  327.  
  328.     FOR i := 0 TO 15 DO  BEGIN
  329.       BL := i;  BIOSvideo ($B, registers);  Delay (250)
  330.     END;  { FOR i }
  331.  
  332.     waitForSpaceBar ($9E);  GraphColorMode;  BH := 1;
  333.  
  334.     FOR i := 1 TO 24 DO  BEGIN
  335.       TextColor (Succ(i MOD 3));  Center (i, 'This is a color palette test.')
  336.     END;  { FOR i }
  337.  
  338.     FOR i := 1 TO 8  DO  BEGIN
  339.       BL := Ord(Odd(i));  BIOSvideo($0B, registers);  Delay (500)
  340.     END   { FOR i }
  341.  
  342.   END;  { WITH registers }
  343.  
  344.   clearOnSpaceBar ($03)
  345.  
  346. END;  { PROCEDURE demoFuncB }
  347.  
  348.  
  349. PROCEDURE demoFuncC;  BEGIN
  350.  
  351.   WITH registers DO  REPEAT
  352.     x  := Random(200);  y := Random(200);  AL := Random(4);
  353.     CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
  354.     CX := y + 60;  DX := x;  BIOSvideo ($0C, registers);
  355.     x  := 199 - x;
  356.     CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
  357.     CX := y + 60;  DX := x;  BIOSvideo ($0C, registers);
  358.     y  := 199 - y;
  359.     CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
  360.     CX := y + 60;  DX := x;  BIOSvideo ($0C, registers);
  361.     x  := 199 - x;
  362.     CX := x + 60;  DX := y;  BIOSvideo ($0C, registers);
  363.     CX := y + 60;  DX := x;  BIOSvideo ($0C, registers)
  364.   UNTIL KeyPressed;
  365.  
  366.   clearOnSpaceBar ($03)
  367.  
  368. END;  { PROCEDURE demoFuncC }
  369.  
  370.  
  371. PROCEDURE demoFuncD;  BEGIN
  372.  
  373.   waitForSpaceBar ($9E);  GraphMode;  Palette (1);  TextColor ($13);
  374.  
  375.   FOR i := 0 TO 2 DO
  376.     FOR x := i * 80 TO i * 80 + 79 DO  Draw (x, 0, x + 80, 199, Succ(i));
  377.  
  378.   WITH registers DO  REPEAT
  379.  
  380.     CX := Random(320);  DX := Random(200);
  381.     BIOSvideo ($D, registers);  GotoXY (12, 25);
  382.     Write ('(', CX:3, ',', DX:3, ')', AL:3);  y := AL;  AL := $83;
  383.  
  384.     FOR i := 1 TO 8 DO  BEGIN
  385.       Delay (125);  BIOSvideo ($C, registers)
  386.     END;   { FOR i }
  387.  
  388.     GotoXY (12, 25);
  389.     Write ('(', CX:3, ',', DX:3, ')', y:3)
  390.  
  391.   UNTIL keyPressed;
  392.  
  393.   clearOnSpaceBar ($83)
  394.  
  395. END;  { PROCEDURE demoFuncD }
  396.  
  397.  
  398. PROCEDURE demoFuncE;
  399.  
  400.   VAR  c:  CHAR;  BEGIN
  401.  
  402.   waitForSpaceBar ($0E);
  403.   registers.BH := 0;  ClrScr;
  404.  
  405.   REPEAT
  406.     Read (KBD, c);  registers.AL := Ord(c);  BIOSvideo ($E, registers)
  407.   UNTIL c = ^[;
  408.  
  409.   clearOnSpaceBar ($0E);
  410.  
  411. END;  { PROCEDURE demoFuncE }
  412.  
  413.  
  414. PROCEDURE demoFuncF;  BEGIN
  415.   BIOSvideo ($F, registers);
  416.   WriteLn ('Current BIOS video mode:  ', registers.AL);
  417.   WriteLn ('# of character columns:   ', registers.AH);
  418.   WriteLn ('Active display page:      ', registers.BH, ^J);
  419.   clearOnSpaceBar  ($9E)
  420. END;  { PROCEDURE demoFuncF }
  421.  
  422.  
  423.  
  424. BEGIN { PROGRAM BIOSdemo }
  425.  
  426. initialize;
  427. demoFunc0;
  428. demoFunc1;
  429. demoFunc2;
  430. demoFunc3;
  431. demoFunc5;
  432. demoFuncs6and7;
  433. demoFunc8;
  434. demoFunc9;
  435. demoFuncA;
  436.  
  437. IF boardInUse = MDA THEN  BEGIN
  438.   WriteLn ('  BIOS video functions 0Bh ("Set Color Palette"), 0Ch ("Write Graphics Pixel")');
  439.   WriteLn ('and 0Dh ("Read Graphics Pixel") are useless on an MDA, so they will be skipped.');
  440.   IF boardsPresent <> [MDA] THEN
  441.      WriteLn ('Re-run this demo with your color graphics card enabled to see these demos.');
  442.   clearOnSpaceBar ($9E)
  443.  
  444. END  ELSE  BEGIN
  445.   demoFuncB;
  446.   demoFuncC;
  447.   demoFuncD
  448. END;  { IF }
  449.  
  450. demoFuncE;
  451. demoFuncF
  452.  
  453. END.  { PROGRAM BIOSdemo }
  454.