home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / oberon / screen.mod < prev    next >
Text File  |  1991-02-24  |  3KB  |  117 lines
  1. MODULE Screen ;         (* ERV, 1989/91 *)
  2.   IMPORT SYS:=SYSTEM;
  3.  
  4. CONST  minrow * = 0 ;   maxrow * = 24 ;
  5.        mincol * = 0 ;   maxcol * = 79 ;
  6.  
  7. TYPE maptyp = ARRAY maxrow+1, maxcol+1 OF INTEGER ;
  8.      Styp = POINTER TO maptyp ;
  9.  
  10. VAR S : Styp ;  Color * : INTEGER;
  11.     ColorScreen * : BOOLEAN;
  12.  
  13. PROCEDURE SetAddr ;
  14. TYPE ptyp = POINTER TO ARRAY 1 OF SET;
  15. VAR cr:RECORD low, high : INTEGER END;
  16.     p:ptyp;
  17. BEGIN
  18.   cr.low := 10H;  cr.high := 40H; (*equipflag in bios*)
  19.   p := SYS.VAL(ptyp,cr);
  20.   IF (5 IN p^) & (4 IN p^) THEN cr.high := 0B000H (*monochrome screen*);
  21.     ColorScreen := FALSE
  22.   ELSE cr.high := 0B800H (*color screen*); ColorScreen := TRUE
  23.   END;
  24.   cr.low := 0;  S := SYS.VAL(Styp,cr)
  25. END SetAddr;
  26.  
  27.  
  28. PROCEDURE WrtCh * (ch:CHAR; row, col : INTEGER);
  29. BEGIN S[row,col] := 07H * 256 + ORD(ch)
  30. END WrtCh;
  31.  
  32. PROCEDURE WrtStr * (s:ARRAY OF CHAR; row, col : INTEGER);
  33. VAR i,cl:INTEGER;
  34. BEGIN cl := Color * 256;
  35.   i := 0;
  36.   WHILE s[i] # 00X DO S[row,col] := cl + ORD(s[i]);
  37.     INC(i);  INC(col);
  38.     IF col > maxcol THEN INC(row); col := mincol;
  39.        IF row > maxrow THEN row := minrow END
  40.     END
  41.   END
  42. END WrtStr;
  43.  
  44. PROCEDURE WrtHi * (s:ARRAY OF CHAR; row, col : INTEGER);
  45. VAR i:INTEGER;
  46. BEGIN
  47.   i := 0;
  48.   WHILE s[i] # 00X DO S[row,col] := 70H * 256 + ORD(s[i]);
  49.     INC(i);  INC(col);
  50.     IF col > maxcol THEN INC(row); col := mincol;
  51.        IF row > maxrow THEN row := minrow END
  52.     END
  53.   END
  54. END WrtHi;
  55.  
  56. PROCEDURE WrtSp * (VAR s:ARRAY OF SYS.BYTE;
  57.                    index,limit:INTEGER; row,col:INTEGER);
  58. VAR ch:CHAR; i,j:INTEGER;  cl:INTEGER;
  59. BEGIN cl := Color * 256;
  60.   ch := CHR(s[index]);  j := limit - index ;
  61.   IF j > maxcol THEN j := maxcol END;
  62.   WHILE (j > 0) & (ch # 0X) DO
  63.     S[row,col] := cl + ORD(ch);
  64.     INC(index);  INC(col);  DEC(j);
  65.     ch := CHR(s[index])
  66.   END ;
  67.   WHILE col < maxcol DO S[row,col] := cl + ORD(" "); INC(col) END
  68. END WrtSp;
  69.  
  70.  
  71. PROCEDURE Clear * ;
  72. VAR cl:INTEGER;
  73. BEGIN cl := Color * 256;
  74. SYS.CODE(
  75.  0B8H, 00H,06H,     (*   mov ax,0600h  ;scroll entire screen down*)
  76.  0B9H, 00H,00H,     (*   mov cx,0            *)
  77.  0BAH, 4FH,18H,     (*   mov dx,(24*256) + 79*)
  78.  8BH, 5EH, 0FCH,    (*   mov bx,[bp-4];get color cl into bh*)
  79.  0CDH, 10H          (*   int 10h             *)
  80.  )
  81. END Clear;
  82.  
  83. PROCEDURE EraseLine * (row:INTEGER);
  84. VAR col,cl:INTEGER;
  85. BEGIN col := mincol;  cl := Color * 256;
  86.   WHILE col < maxcol DO S[row,col] := cl + ORD(" "); INC(col) END
  87. END EraseLine;
  88.  
  89. PROCEDURE SetCursorOn *;
  90. BEGIN SYS.CODE(
  91.  0B4H, 01H,     (*mov ah,1      ;set cursor size *)
  92.  0B9H, 07H,06H, (*mov cx, 0607h ; start/end lines(visible on color)*)
  93.  0CDH, 10H      (*int 10h  *)
  94. )
  95. END SetCursorOn;
  96.  
  97. PROCEDURE SetCursorOff *;
  98. BEGIN SYS.CODE(
  99.  0B4H, 01H,     (*mov ah,1      ;set cursor size *)
  100.  0B9H, 01H,0FH, (*mov cx, 0F01h ; start/end lines(invisible)*)
  101.  0CDH, 10H      (*int 10h  *)
  102.  )
  103. END SetCursorOff;
  104.  
  105. PROCEDURE MoveCursor * (row,col:INTEGER);
  106. BEGIN col := row*256 + col;
  107. SYS.CODE(
  108.  0B4H, 02H,     (* mov ah,2      ;set cursor position                    *)
  109.  8BH, 56H, 06H, (* mov dx,word ptr[bp+6] ; get parm for row/col position *)
  110.  0B7H, 00H,     (* mov bh,0      ;page number                            *)
  111.  0CDH, 10H      (* int 10h                                               *)
  112. )
  113. END MoveCursor;
  114.  
  115. BEGIN SetAddr;  Color := 07H
  116. END Screen.
  117.