OSDev.org

Code: Select all

type 
  TScreen = Array[1..25, 1..80] of record
    c    : Char;
    attr : Byte;
  end;

Code: Select all

procedure WriteChar(c : Char);
begin
  Screen^[X, Y].c := c;
  inc(Y);
end;

procedure WriteLn(s : String);
var i : Integer;
begin
  for i := 1 to Length(s) do
    WriteChar(s[i]);
end;

Code: Select all

procedure WriteLn(s : String);
var i : Integer;
begin
  for i := 1 to Length(s) do
    WriteChar('a');
end;

Code: Select all

unit system;

interface

type
  ValSInt = LongInt;
  SizeInt = LongInt;

procedure FPC_INITIALIZEUNITS; compilerproc;
procedure FPC_DO_EXIT; compilerproc;
procedure fpc_shortstr_assign(len: longint; src, dst: pointer);
function fpc_shortstr_concat(const s1, s2 : ShortString) : ShortString; compilerproc;
function fpc_shortstr_to_shortstr(len : LongInt; const sstr : ShortString) : ShortString; compilerproc;

implementation

procedure FPC_INITIALIZEUNITS; alias: 'FPC_INITIALIZEUNITS'; compilerproc;
begin

end;

...

Code: Select all

unit vgatxt;

interface

const
     C_Base=$000B8000;
     C_XSize=80;
     C_YSize=25;
     C_LENGTH=C_XSize*C_YSize;

     C_AT_BLACK=0;
     C_AT_BLUE=1;
     C_AT_GREEN=2;
     C_AT_CYAN=3;
     C_AT_RED=4;
     C_AT_MAGENTA=5;
     C_AT_YELLOW=6;
     C_AT_WHITE=7;
     C_crtc_adr =$3D4;


procedure C_Init;
procedure C_set_attribs(a:integer);
procedure C_set_colours(fg,bg:integer);
procedure C_scroll_up;
procedure C_scroll_down;
procedure C_clear;
procedure C_putchar(c:char);
function C_getchar:char;
procedure C_locate(x,y:longint);

function C_GetX:integer;
function C_GetY:integer;

implementation

uses includes, ports, interupts;

type
     vdu=packed array [1..C_LENGTH] of word;
     pvdu=^vdu;



var
     XPos,YPos:longint;
     Attribs:integer;
     screen:pvdu;

procedure setcursor;
var
        i:word;
begin
        i:=(xpos-1)+(ypos*C_XSize)-C_XSize;
        outb(14,C_crtc_adr);
        outb(i div 256, C_crtc_adr + 1);
        outb(15,C_crtc_adr + 0);
        outb(i and $ff,C_crtc_adr + 1);
end;

procedure C_clear;
var
     i:longint;
begin
     for i:=1 to C_LENGTH do
     begin
          screen^[i]:=$0720;
     end;
     XPos:=1;YPos:=1;
     setcursor;
end;

procedure C_Init;
var err:KRetCode;
        a:cardinal;
begin
     screen:=C_Base;
     C_clear;
     C_set_colours(C_AT_WHITE,C_AT_BLACK);
     setcursor;
     a:=inb_p($61);
     outb_p(a or $80,$61);
     outb(a,$61);
end;

procedure C_set_attribs(a:integer);
begin
     Attribs:=(a and 255)
end;

procedure C_set_colours(fg,bg:integer);
begin
     Attribs:=(bg and 15)*16 + (fg and 15)
end;

procedure C_scroll_up;
var
     i:longint;
begin
     for i:=C_XSize to C_LENGTH do screen^[i-C_XSize]:=screen^[i];
     for i:=(C_LENGTH-C_XSize)+1 to C_LENGTH do screen^[i]:=$20;
end;

procedure C_scroll_down;
var
     i:longint;
begin
     for i:=(C_LENGTH-C_XSize) downto 1 do screen^[i+C_XSize]:=screen^[i];
     for i:=1 to C_XSize do screen^[i]:=$20;
end;

procedure checkandscroll;
begin
     if XPos<1 then
     begin
          XPos:=C_XSize;
          YPos:=YPos-1
     end else if XPos>C_XSize then
     begin
          XPos:=1;
          YPos:=YPos+1
     end;
     if YPos<1 then
     begin
          YPos:=1;
          C_scroll_down
     end else if YPos>C_YSize then
     begin
          YPos:=C_YSize;
          C_scroll_up
     end;
     setcursor;
end;

procedure C_putchar(c:char);
var
     pos:longint;
     data:word;
begin
     if c=#13 then begin
             XPos:=1;
     end else if c=#10 then begin
             YPos:=Ypos+1;
     end else begin
             pos:=(YPos-1)*C_XSize+XPos;
             data:=ord(c)+256*attribs;
             screen^[pos]:=data;
             XPos:=XPos+1;
     end;

     checkandscroll;
end;

function C_getchar:char;
var
     pos:longint;
     data:word;
begin
     pos:=(YPos-1)*C_XSize+XPos;
     data:=screen^[pos];
     C_getchar:=char(data and $ff)
end;

function C_GetX:integer;
begin
     C_GetX:=XPos
end;

function C_GetY:integer;
begin
     C_GetY:=YPos
end;

procedure C_locate(x,y:longint);
begin
     if (x<1) then x:=1 else if (x>C_XSize) then x:=C_XSize;
     if (y<1) then y:=1 else if (y>C_YSize) then y:=C_YSize;
     XPos:=x;
     YPos:=y;
     setcursor;
end;


//initialization
//        C_init;

end.

Code: Select all

procedure readchar(params :PParameters);
begin
        params^[0]:=0;
        params^[1]:=cardinal(ord(inkey));
end;

procedure writechar(params :PParameters);
var
        c:char;
begin
        params^[0]:=0;
        c:=char(params^[1] and $ff);
        C_putchar(c);
end;

Code: Select all

type
  TScreen = Array[1..80, 1..25] of record
    c    : Char;
    attr : Byte;
  end; 

procedure WriteChar(c : Char);
begin
  Screen^[X, Y].c := c;
  inc(X);
end;

Code: Select all

procedure WriteLn(s : String); 
var i : Integer; 
begin 
  for i := 0 to (Length(s) -1) do 
    WriteChar(s[i]); 
end;