home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / tasking / screenbi.mod < prev    next >
Text File  |  1986-03-10  |  11KB  |  405 lines
  1.  
  2. IMPLEMENTATION MODULE ScreenBIOS;
  3.  
  4.   FROM SYSTEM IMPORT SWI, SETREG, GETREG, AX, BX, CX, DX, CODE;
  5.  
  6. (*
  7.   This module will use screen coordinates as defined by Wirth  (0,0 is the
  8.   lower left hand corner of the page), FOR GRAPHICS ONLY. Text coordinates
  9.   are defined with 0,0 in the upper left hand corner of the screen.
  10.   Page refers to page number defined as 0 to 7 for lowResText, 0 to 3 for
  11.   hiResText, and 0 for graphics.
  12. *)
  13.  
  14.   TYPE
  15.     aRegister = RECORD
  16.       CASE BOOLEAN OF
  17.     TRUE: reg: CARDINAL;
  18.       | FALSE: lo, hi : CHAR;
  19.       END;
  20.     END;
  21.  
  22.   VAR
  23.     regA, regB, regC, regD: CARDINAL;
  24.     anyReg: aRegister;
  25.     initial: settings;
  26.     ch: CHAR;
  27.  
  28.   PROCEDURE SetScreenMode(newMode: screenMode);
  29.     BEGIN
  30.       CASE newMode OF
  31.     mono40x25, col40x25:
  32.       current.window.rightMargin := 39;
  33.       current.maxGraphX := -1;
  34.       current.maxGraphY := -1;
  35.       | col320x200, mono320x200:
  36.       current.window.rightMargin := 39;
  37.       current.maxGraphX := 319;
  38.       current.maxGraphY := 199;
  39.       | bw80x25, mono80x25, col80x25:
  40.       current.window.rightMargin := 79;
  41.       current.maxGraphX := -1;
  42.       current.maxGraphY := -1;
  43.       | mono640x200:
  44.       current.window.rightMargin := 79;
  45.       current.maxGraphX := 639;
  46.       current.maxGraphY := 199;
  47.       END;
  48.       anyReg.lo := CHR(ORD(newMode));
  49.       anyReg.hi := 0C; (* Function Code 0 *)
  50.       regA := anyReg.reg;
  51.       SETREG(AX, regA);
  52.       CODE (55H); (* Push BP *)
  53.       SWI(10H); (* Video I/O Functions *)
  54.       CODE (5DH); (* Pop BP *)
  55.       WITH current DO
  56.     GetVideoState(mode, numCols, page);
  57.       END;
  58.     END SetScreenMode;
  59.  
  60.   PROCEDURE SetCursorType(startScan, endScan : CARDINAL);
  61.     BEGIN
  62.       anyReg.hi := CHR(1); (* Function Code 1 *)
  63.       regA := anyReg.reg;
  64.       anyReg.lo := CHR(endScan);
  65.       anyReg.hi := CHR(startScan);
  66.       regC := anyReg.reg;
  67.       SETREG(AX,regA);
  68.       SETREG(CX,regC);
  69.       CODE (55H); (* Push BP *)
  70.       SWI(10H); (* Video I/O Functions *)
  71.       CODE (5DH); (* Pop BP *)
  72.     END SetCursorType;
  73.  
  74.   PROCEDURE PutCursor(row, col, page : CARDINAL);
  75.     BEGIN
  76.       anyReg.hi := CHR(2); (* Function Code 2 *)
  77.       regA := anyReg.reg;
  78.       anyReg.hi := CHR(page);
  79.       regB := anyReg.reg;
  80.       anyReg.lo := CHR(col);
  81.       anyReg.hi := CHR(row);
  82.       regD := anyReg.reg;
  83.       SETREG(AX, regA);
  84.       SETREG(BX, regB);
  85.       SETREG(DX, regD);
  86.       CODE (55H); (* Push BP *)
  87.       SWI(10H); (* Video I/O Functions *)
  88.       CODE (5DH); (* Pop BP *)
  89.     END PutCursor;
  90.  
  91.   PROCEDURE GetCursor(VAR row, column : CARDINAL;
  92.                  page : CARDINAL;
  93.                  VAR startScan, endScan : CARDINAL);
  94.     (* Returns both cursor position and cursor type. *)
  95.     BEGIN
  96.       anyReg.hi := CHR(3); (* Function Code 3 *)
  97.       regA := anyReg.reg;
  98.       anyReg.hi := CHR(page);
  99.       regB := anyReg.reg;
  100.       SETREG(AX, regA);
  101.       SETREG(BX, regB);
  102.       CODE (55H); (* Push BP *)
  103.       SWI(10H); (* Video I/O Functions *)
  104.       CODE (5DH); (* Pop BP *)
  105.       GETREG(CX, regC);
  106.       GETREG(DX, regD);
  107.       anyReg.reg := regC;
  108.       endScan := ORD(anyReg.lo);
  109.       startScan := ORD(anyReg.hi);
  110.       anyReg.reg := regD;
  111.       column := ORD(anyReg.lo);
  112.       row := ORD(anyReg.hi);
  113.     END GetCursor;
  114.  
  115.   PROCEDURE CursorOff;
  116.     BEGIN
  117.       WITH current DO (* save current settings for cursor on *)
  118.     GetCursor(cursY,cursX, page, cursorStart, cursorEnd);
  119.       END;
  120.       SetCursorType(26H,7H);
  121.     END CursorOff;
  122.  
  123.   PROCEDURE CursorOn;
  124.     BEGIN
  125.       SetCursorType(current.cursorStart, current.cursorEnd);
  126.     END CursorOn;
  127.  
  128.   PROCEDURE RestoreScreen; (* Restore screen to initial entry params *)
  129.     BEGIN
  130.       WITH initial DO
  131.     SelectActivePage(page);
  132.     SetScreenMode(mode);
  133.     ClearScreen(attrib);
  134.     SetCursorType(cursorStart, cursorEnd);
  135.       END;
  136.     END RestoreScreen;
  137.  
  138.   PROCEDURE ReadLightPenPosition(VAR x, y: CARDINAL);
  139.     (* Not implemented *)
  140.     BEGIN
  141.       (*
  142.       CODE (55H); (* Push BP *)
  143.       SWI(10H); (* Video I/O Functions *)
  144.       CODE (5DH); (* Pop BP *)
  145.       *)
  146.     END ReadLightPenPosition;
  147.  
  148.   PROCEDURE SelectActivePage(page : CARDINAL);
  149.     BEGIN
  150.       anyReg.lo := CHR(page);
  151.       anyReg.hi := CHR(5); (* Function Code 5 *)
  152.       regA := anyReg.reg;
  153.       SETREG(AX, regA);
  154.       CODE (55H); (* Push BP *)
  155.       SWI(10H); (* Video I/O Functions *)
  156.       CODE (5DH); (* Pop BP *)
  157.     END SelectActivePage;
  158.  
  159.   PROCEDURE ScrollUp(lines: CARDINAL; window: area; attr: CARDINAL);
  160.     BEGIN
  161.       WITH anyReg DO
  162.     lo := CHR(lines);
  163.     hi := CHR(6); (* Function Code 6 *)
  164.     regA := reg;
  165.     hi := CHR(attr);
  166.     regB := reg;
  167.     WITH window DO
  168.       lo := CHR(leftMargin);
  169.       hi := CHR(topMargin);
  170.       regC := reg; (* upper left *)
  171.       lo := CHR(rightMargin);
  172.       hi := CHR(bottomMargin);
  173.       regD := reg; (* lower right *)
  174.     END;
  175.       END;
  176.       SETREG(AX, regA);
  177.       SETREG(BX, regB);
  178.       SETREG(CX, regC);
  179.       SETREG(DX, regD);
  180.       CODE (55H); (* Push BP *)
  181.       SWI(10H); (* Video I/O Functions *)
  182.       CODE (5DH); (* Pop BP *)
  183.     END ScrollUp;
  184.  
  185.   PROCEDURE ClearScreen(attr: CARDINAL);
  186.     BEGIN
  187.       WITH current DO
  188.     PutCursor(0,0,page);
  189.     ScrollUp(0, window, attr);
  190.       END;
  191.     END ClearScreen;
  192.  
  193.   PROCEDURE ScrollDown(lines: CARDINAL; window: area; attr: CARDINAL);
  194.     BEGIN
  195.       WITH anyReg DO
  196.     lo := CHR(lines);
  197.     hi := CHR(7); (* Function Code 7 *)
  198.     regA := reg;
  199.     hi := CHR(attr);
  200.     regB := reg;
  201.     WITH window DO
  202.       lo := CHR(leftMargin);
  203.       hi := CHR(topMargin);
  204.       regC := reg; (* upper left *)
  205.       lo := CHR(rightMargin);
  206.       hi := CHR(bottomMargin);
  207.       regD := reg; (* lower right *);
  208.     END;
  209.       END;
  210.       SETREG(AX, regA);
  211.       SETREG(BX, regB);
  212.       SETREG(CX, regC);
  213.       SETREG(DX, regD);
  214.       CODE (55H); (* Push BP *)
  215.       SWI(10H); (* Video I/O Functions *)
  216.       CODE (5DH); (* Pop BP *)
  217.     END ScrollDown;
  218.  
  219.   PROCEDURE GetChar(VAR ch: CHAR; VAR attr: CARDINAL; page: CARDINAL);
  220.     (* Reads the character at the current cursor position *)
  221.     BEGIN
  222.       anyReg.hi := CHR(8); (* Function Code 8 *)
  223.       regA := anyReg.reg;
  224.       anyReg.hi := CHR(page);
  225.       regB := anyReg.reg;
  226.       SETREG(AX, regA);
  227.       SETREG(BX, regB);
  228.       CODE (55H); (* Push BP *)
  229.       SWI(10H); (* Video I/O Functions *)
  230.       CODE (5DH); (* Pop BP *)
  231.       GETREG(AX, regA);
  232.       anyReg.reg := regA;
  233.       ch := anyReg.lo;
  234.       attr := ORD(anyReg.hi);
  235.     END GetChar;
  236.  
  237.   PROCEDURE PutCharAttr(ch : CHAR; attr: CARDINAL; count, page: CARDINAL);
  238.     (* Writes the character at the current cursor position with attribute
  239.        for text or colour in graphics, count times *)
  240.     BEGIN
  241.       anyReg.lo := ch;
  242.       anyReg.hi := CHR(9); (* Function Code 9 *)
  243.       regA := anyReg.reg;
  244.       anyReg.lo := CHR(attr);
  245.       anyReg.hi := CHR(page);
  246.       regB := anyReg.reg;
  247.       regC := count;
  248.       SETREG(AX, regA);
  249.       SETREG(BX, regB);
  250.       SETREG(CX, regC);
  251.       CODE (55H); (* Push BP *)
  252.       SWI(10H); (* Video I/O Functions *)
  253.       CODE (5DH); (* Pop BP *)
  254.     END PutCharAttr;
  255.  
  256.   PROCEDURE PutChar(ch : CHAR; count, page: CARDINAL);
  257.     (* Writes the character at the current cursor position count times *)
  258.     BEGIN
  259.       anyReg.lo := ch;
  260.       anyReg.hi := CHR(10); (* Function Code 10 *)
  261.       regA := anyReg.reg;
  262.       anyReg.hi := CHR(page);
  263.       regB := anyReg.reg;
  264.       regC := count;
  265.       SETREG(AX, regA);
  266.       SETREG(BX, regB);
  267.       SETREG(CX, regC);
  268.       CODE (55H); (* Push BP *)
  269.       SWI(10H); (* Video I/O Functions *)
  270.       CODE (5DH); (* Pop BP *)
  271.     END PutChar;
  272.  
  273.   PROCEDURE SetPalette(ID, colour : CARDINAL);
  274.     (* medResGraphics ONLY *)
  275.     (* colour is 0 or 1 *)
  276.     BEGIN
  277.       IF current.mode = col320x200 THEN
  278.     anyReg.hi := CHR(11); (* Function Code 11 *)
  279.     regA := anyReg.reg;
  280.     anyReg.lo := CHR(colour);
  281.     anyReg.hi := CHR(ID);
  282.     regB := anyReg.reg;
  283.     SETREG(AX, regA);
  284.     SETREG(BX, regB);
  285.     CODE (55H); (* Push BP *)
  286.     SWI(10H); (* Video I/O Functions *)
  287.     CODE (5DH); (* Pop BP *)
  288.       END;
  289.     END SetPalette;
  290.  
  291.   PROCEDURE WritePixel(row, column, colour: CARDINAL);
  292.     BEGIN
  293.       IF (current.mode = col320x200) OR (current.mode = mono640x200) THEN
  294.     anyReg.lo := CHR(colour);
  295.     anyReg.hi := CHR(12); (* Function Code 12 *)
  296.     regA := anyReg.reg;
  297.     regC := column;
  298.     regD := 199 - row;
  299.     SETREG(AX, regA);
  300.     SETREG(CX, regC);
  301.     SETREG(DX, regD);
  302.     CODE (55H); (* Push BP *)
  303.     SWI(10H); (* Video I/O Functions *)
  304.     CODE (5DH); (* Pop BP *)
  305.       END;
  306.     END WritePixel;
  307.  
  308.   PROCEDURE ReadPixel(row, column: CARDINAL; VAR colour: CARDINAL);
  309.     BEGIN
  310.       IF (current.mode = col320x200) OR (current.mode = mono640x200) THEN
  311.     anyReg.hi := CHR(13); (* Function Code 13 *)
  312.     regA := anyReg.reg;
  313.     regC := column;
  314.     regD := 199 - row;
  315.     SETREG(AX, regA);
  316.     SETREG(CX, regC);
  317.     SETREG(DX, regD);
  318.     CODE (55H); (* Push BP *)
  319.     SWI(10H); (* Video I/O Functions *)
  320.     CODE (5DH); (* Pop BP *)
  321.     GETREG(AX, regA);
  322.     anyReg.reg := regA;
  323.     colour := ORD(anyReg.lo);
  324.       END;
  325.     END ReadPixel;
  326.  
  327.   PROCEDURE WriteChDTD(ch: CHAR; colour: CARDINAL; page: CARDINAL);
  328.     (* Checks for bs, cr, lf, bel and executes as commands. *)
  329.     BEGIN
  330.       WITH anyReg DO
  331.     lo := ch;
  332.     hi := CHR(14); (* Function Code 14 *)
  333.     regA := reg;
  334.     lo := CHR(colour);
  335.     hi := CHR(page);
  336.     regB := reg;
  337.       END;
  338.       SETREG(AX, regA);
  339.       SETREG(BX, regB);
  340.       CODE (55H); (* Push BP *)
  341.       SWI(10H); (* Video I/O Functions *)
  342.       CODE (5DH); (* Pop BP *)
  343.     END WriteChDTD;
  344.  
  345.   PROCEDURE GetVideoState( VAR mode : screenMode; VAR col: CARDINAL;
  346.                VAR page: CARDINAL);
  347.     BEGIN
  348.       anyReg.hi := CHR(15); (* Function Code 15 *)
  349.       regA := anyReg.reg;
  350.       SETREG(AX, regA);
  351.       CODE (55H); (* Push BP *)
  352.       SWI(10H); (* Video I/O Functions *)
  353.       CODE (5DH); (* Pop BP *)
  354.       GETREG(AX, regA);
  355.       GETREG(BX, regB);
  356.       anyReg.reg := regA;
  357.       mode := VAL(screenMode,ORD(anyReg.lo));
  358.       col := ORD(anyReg.hi);
  359.       anyReg.reg := regB;
  360.       page := ORD(anyReg.hi);
  361.     END GetVideoState;
  362.  
  363.   PROCEDURE SetScrollMode(mode: CARDINAL);
  364.     (* FOR Heath MS-DOS BIOS ONLY
  365.        0 = normal software, 1 = jump scroll (hardware), 2 = smooth *)
  366.     BEGIN
  367.       anyReg.lo := CHR(mode);
  368.       anyReg.hi := CHR(100); (* Function Code 100 *)
  369.       regA := anyReg.reg;
  370.       SETREG(AX, regA);
  371.       CODE (55H); (* Push BP *)
  372.       SWI(10H); (* Video I/O Functions *)
  373.       CODE (5DH); (* Pop BP *)
  374.     END SetScrollMode;
  375.  
  376.   BEGIN
  377.     WITH initial DO
  378.       GetVideoState(mode, numCols, page);
  379.       GetCursor(cursY, cursX, page, cursorStart, cursorEnd);
  380.       GetChar(ch, attrib, page);
  381.       CASE mode OF
  382.     mono40x25, col40x25:
  383.       window.rightMargin := 39;
  384.       maxGraphX := -1;
  385.       maxGraphY := -1;
  386.       | col320x200, mono320x200:
  387.       window.rightMargin := 39;
  388.       maxGraphX := 319;
  389.       maxGraphY := 199;
  390.       | bw80x25, mono80x25, col80x25:
  391.       window.rightMargin := 79;
  392.       maxGraphX := -1;
  393.       maxGraphY := -1;
  394.       | mono640x200:
  395.       window.rightMargin := 79;
  396.       maxGraphX := 639;
  397.       maxGraphY := 199;
  398.       END;
  399.       window.topMargin := 0;
  400.       window.bottomMargin := 24;
  401.       window.leftMargin := 0;
  402.     END;
  403.     current := initial;
  404.   END ScreenBIOS.
  405.