
UNIT video;
// console, and text mode thrown together for simplicity

INTERFACE

{Though int 10h usually sets textMode and IS available to us, the only other use for it is to set graph mode, which
is done with graph and gvision units.

--Jazz 

  CRT modes 
  BW40          = 0;             40x25 B/W on Color Adapter 
  CO40          = 1;             40x25 Color on Color Adapter 
  BW80          = 2;             80x25 B/W on Color Adapter 
  CO80          = 3;             80x25 Color on Color Adapter
   graph mode set by graph unit.
 
	4			 graph (CGA) 320 x 200 color
	5			 graph (CGA) 320 x 200 black / white
	6			 graph (CGA) 640 x 200 black / white 
	F			 graph (EGA,VGA) 640x350 grey
	10			 graph (EGA,VGA) 640x350 16 colors
	11			 graph (VGA) 2 colors
	12			 graph (VGA) 16 colors
   
   see example below: setmode()
   INT 10h
   AX = 4F02h
   BX = mode (see below)
   note: still in 8bit color modes,16 bit and above uses color of type #rrggbbaa or #rrrggbbaaa where a is intensity.
 256=16x16 , again see megazux for an example. need 2-486 to run that.
 color types:
 [standard 0-15h]
 [indexed color pallette of 16x16 array [0-254]]  GIFs files use this a lot.

  ** No documentation at or above this level YET*

 [true color 65535 colors, use #rrggbb for access]
 [real color [32bit] and above, adds intensity attributes. X11 even has issues above 32bits]

 All modes is hex
 * are standard modes

100 h       				graph 640x400   256 colors
101 h			*	graph 640x480   256 colors
102 h				graph 800x600   16   colors
103 h			*	graph 800x600   256 colors
104 h				graph 1024x768   16   colors
105 h			*	graph 1024x768  256 colors
106 h				graph 1280x1024 16   colors
107 h			*	graph 1280x1024 256 colors
108 h				text 80x60
109 h				text 132x25
10A h				text 132x43
10B h				text 132x50
10C h				text 132x60 

example:

                mov ax,012h    ;VGA mode
                int 10h        ;640 x 480 16 colors.
                mov ax,0A000h
                mov es,ax      ;ES points to the video memory.
                mov dx,03C4h   ;dx = indexregister
                mov ax,0F02h   ;INDEX = MASK MAP,         --change here to 0102h to get blue screen.
                out dx,ax      ;write all the bitplanes.
                mov di,0       ;DI pointer in the video memory.
                mov cx,38400   ;(640 * 480)/8 = 38400
                mov ax,0FFh    ;write to every pixel.
                rep stosb      ;fill the screen
                mov ah,4ch 

--produces white screen

}


procedure WritePChar(P: PChar);
procedure WriteInt(i: Integer);
procedure WriteLong(l: LongWord);
procedure WritePCharLn(P: PChar);
procedure WriteIntLn(i: Integer);
procedure WriteLongLn(l: LongWord);
procedure InstallConsole;

procedure scroll_backwards(top,left,bottom,right,lines:word;var screl:word); assembler;
Procedure clreol; 
Procedure clrscr; 
procedure GotoXY ( x, y : byte ); 
function GetXY ( x, y : byte ): byte;

// use CursorPosX,CursorPosY,if you like, which are equal to what you need and give same.

Function KeyPressed: boolean; 
Function ReadKey: char; 
Procedure TextBackground(color: byte); 
Procedure TextColor(color:byte);

Procedure TextMode(mode: byte);
Procedure Window(x1, y1, x2, y2: byte);
Procedure Write_Real(num: real; field_size, decimal: byte);

procedure Scroll;
procedure BlinkCursor;
procedure WriteChar(const c: Char);
procedure writeln(const hstr:string); 

procedure Write(const s:string);
Procedure HighVideo;
Procedure LowVideo;
Procedure NormVideo;
procedure pause;
procedure CursorBig;
procedure CursorNormal; assembler;
procedure CursorOff; assembler;
procedure CursorOn; 
procedure nosound;
procedure sound(freq : longword);
procedure beep;
Procedure TABULATE;
  
IMPLEMENTATION

uses
	x86,timer,keybrd;
{why is this here? I tell you.

we need keymaps HERE as well to handle key display routines.I can't display key[scancode] without it.Like the loverly demo?

 --Jazz

}
type
	TKeyMap = array [0..127] of Char;
	 TCharAttr=packed record
	    ch   : char;
    	    attr : byte;
  	 end;
	TConsoleBuf=Array[0..1999] of TCharAttr;
        PConsoleBuf=^TConsoleBuf;
        
	fontSize = (font8,font14,font16, unknownFontSize);
	adapterType = (none,mda,cga,egaMono,egaColor,vgaMono,
	     		vgaColor,mcgaMono,mcgaColor);

   Tkbdkeyinfo=record
            charcode,scancode:char;
            fbstatus,bnlsshift:byte;
            fsstate:word;
            time:longint;
        end;
CONST
      ColorArray : array[0..7] of integer = (0,4,2,6,1,5,3,7);


  USKeyMap: TKeyMap = (
    #00,{ 0 }
    #27,{ 1 - Esc }
    '1','2','3','4','5','6','7','8','9','0','-','=',{ 13 }
    #08,{ 14 - Backspace }
    #09,{ 15 - Tab }
    'q','w','e','r','t','y','u','i','o','p','[',']',{ 27 }
    #10,{ 28 - Enter }
    #00,{ 29 - Ctrl }
    'a','s','d','f','g','h','j','k','l',';',{ 39 }
    '''',{ 40 - ' }
    '`',{ 41 }
    #00,{ 42 - Left Shift }
    '\','z','x','c','v','b','n','m',',','.','/',{ 53 }
    #00,{ 54 - Right Shift }
    '*',{ 55 }
    #00,{ 56 - Alt }
    ' ',{ 57 - Space bar }
    #0,{ 58 - Caps lock }
    #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,{ 59 - F1 up to 68 - F10 }
    #0,{ 69 - Num lock}
    #0,{ Scroll Lock }
    #0,{ Home key }
    #0,{ Up Arrow }
    #0,{ Page Up }
    '-',
    #0,{ Left Arrow }
    #0,
    #0,{ Right Arrow }
    '+',
    #0,{ 79 - End key}
    #0,{ Down Arrow }
    #0,{ Page Down }
    #0,{ Insert Key }
    #0,{ Delete Key }
    #0,#0,#0,{ 86 }
    #0,{ F11 Key }
    #0,{ F12 Key }
    #0,{ All other keys are undefined }
    #0,{ 90 }
    #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,{ 100 }
    #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,{ 110 }
    #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,{ 120 }
    #0,#0,#0,#0,#0,#0,#0{ 127 }
  );

{Foreground and background color constants }
  Black         = 0;
  Blue          = 1;
  Green         = 2;
  Cyan          = 3;
  Red           = 4;
  Magenta       = 5;
  Brown         = 6;
  LightGray     = 7;

{ Foreground color constants }
  DarkGray      = 8;
  LightBlue     = 9;
  LightGreen    = 10;
  LightCyan     = 11;
  LightRed      = 12;
  LightMagenta  = 13;
  Yellow        = 14;
  White         = 15;

 {Add-in for blinking} 
  Blink         = 128;
  ConsoleMaxX  = 25;
  ConsoleMaxY  = 80;


  ScreenHeight : longint = 25;
  ScreenWidth  : longint = 80; 
	   
VAR    
   textBufferOrigin  : pointer; {pointer to text buffer}
   textBufferSeg     : word;
   textBufferSize    : word;    {size in bytes of...}
   visibleX,visibleY : byte;
   fontLines         : byte;
   sint,cost : array [0..359] of double;
   extkeycode:char;
   ScrollDisabled:boolean;

  ActiveKeyMap,ActiveShiftedKeyMap: TKeyMap;
  x,y:integer;
  lastmode: word;            // text mode of CRT 
  textattr: byte;            // text and background colour 
  
  ConsoleBuf : PConsoleBuf;
  n,p : Integer;
  ch:char;
  VidMem: PChar = PChar($B8000); 
  CursorPosX: Word = 0;
  CursorPosY: Word = 0;
  Blank: Word = $32;
  CommandBuffer: String = '';
  s,hstr:string;
  CurrX,CurrY : Byte;
  WindMinX : DWord;
  WindMaxX : DWord;
  WindMinY : DWord;
  WindMaxY : DWord;
  color:byte;
  WindMin: Word  = $0;         //  Window upper left coordinates 
  WindMax: Word  = $184f;        //([78*80]=6223)   Window lower right coordinates 


{$ASMMODE INTEL}
//had a little help from another C kernel tut.... --Jazz


procedure WritePChar(P: PChar); [public, alias: 'WritePChar'];
//alias is REQUIRED.The routine is missing in sysfile.inc.
begin
  while P^<>#0 do begin
    WriteChar(P^);
    Inc(P);
    if ScrollDisabled then exit;
    scroll;
    blinkcursor;
  end;
end;

{ $ASMMODE INTEL
procedure writePchar(s:Pchar;len:word);

Write a series of characters to the screen.

 Not very fast, but is just text-mode isn't it?

var x,y:word;
    c:char;
    i,n:integer;
    screl:word;
    ca:Pchar;

begin
    i:=0;
    getcursor(y,x);
    while i<=len-1 do
        begin
            case s[i] of
                #7: asm
                     mov dl, 7
                     mov ah, 2
                     call syscall
                    end;
                #8: if X > Succ (Lo (WindMin)) then Dec (X);
         //      #9: x:=(x-lo(windmin)) and $fff8+8+lo(windmin);
                #10: inc(y);
                #13: x:=lo(windmin);
                else
                    begin
                        ca:=@s[i];
                        n:=1;
                        while not(s[i+1] in [#7,#8,#10,#13]) and
//                         (x+n<=lo(windmax)+1) and (i<len-1) do
                         (x+n<=lo(windmax)) and (i<len-1) do
                            begin
                                inc(n);
                                inc(i);
                            end;
                      
                            asm
                                mov ax, 1300h
                                mov bh, 0
                                mov bl, TEXTATTR
                                mov dh, byte ptr y
                                mov dl, byte ptr x
                                mov cx, n
                                push ebp
                                mov ebp, ca
                                int 10h
                                pop ebp
                            end;
                        x:=x+n;
                    end;
            end;
            if x>lo(windmax) then
                begin
                    x:=lo(windmin);
                    inc(y);
                end;
            if y>hi(windmax) then
                begin
                    screl:=$20+textattr shl 8;
                    scroll_up(hi(windmin),lo(windmin),
                              hi(windmax),lo(windmax),
                              1,screl);
                    y:=hi(windmax);
                end;
//           writeln(stderr,x,'  ',y);
            inc(i);
        end;
    setcursor(y,x);
end;}


procedure WriteInt(i: Integer);
var
  s: String;
begin
  Str(i,s);
  Write(s);
  if ScrollDisabled then exit;
  scroll;
  blinkcursor;
end;

procedure WriteLong(l: LongWord);
var
  s: String;
begin
  Str(l,s);
  Write(s);
  if ScrollDisabled then exit;
  scroll;
  blinkcursor;end;

procedure WritePCharLn(P: PChar);
begin
  WritePChar(P);
  WriteChar(#10);
  if ScrollDisabled then exit;
  scroll;
  blinkcursor;
end;

Procedure Pause;
Var Ch : Char;
Begin
 writeln('Press any key to continue...');
 repeat
 ch:=ReadKey;
 until keypressed;
End;

procedure WriteIntLn(i: Integer);
begin
  WriteInt(i);
  WriteChar(#10);
  if ScrollDisabled then exit;
  scroll;
end;

procedure WriteLongLn(l: LongWord);
begin
  WriteLong(l);
  WriteChar(#10);
  if ScrollDisabled then exit;
  scroll;
end;

procedure InstallConsole;
const
  FPC_OS_LOGO = 'FreePascal OS 0.30  ';
var
  i: Byte;
begin
  TextColor(LightGrey);
  ClrScr;
  Gotoxy(1,1);
  TextColor(LightGreen);
  writeln(FPC_OS_LOGO);
  TextColor(LightGrey);
  Writeln('Booting ');
  WriteLn('...');
  BlinkCursor;
  
end;


procedure GotoXY ( x, y : byte );
{ procedure to move the cursor to the specified coordinates }
var
 
 lines,cols:integer;
 pos:integer;



begin

if (X > 0) and (Y > 0) then
  begin
   Dec (X);
   Dec (Y);
   if (X <= 25) and (Y <= 84) then
	CursorPosX:=X; //YES, its that easy.
	CursorPosY:=Y;   
  end; 
  //else
  x:=1;
  y:=1;
  
  {
  	  asm
            mov ah, 2
            mov bh, 0
            mov dh, byte ptr y
            mov dl, byte ptr x
            int 10h
        end;
  }
  BlinkCursor;
end;

function GetXY ( x, y : byte ): byte;
{ replaces whereX and whereY in one procedure }

var
 
 lines,cols:integer;
 pos:integer;

begin
	x:=CurSorPosX;
	y:=CursorPosY;
	
	{
		asm
            movb $3,%ah
            movb $0,%bh
            int $0x10
            movl y,%eax
            movl x,%ebx
            movzbl %dh,%edi
            andw $255,%dx
            movw %di,(%eax)
            movw %dx,(%ebx)
        end;
	}
end; 



{$ASMMODE ATT}
function keypressed:boolean;

{Checks if a key is pressed.}
var
 ScanCode:byte;


begin
    //If pressed, our handler will trip.
      //ScanCode:=ReadPortB($60);
      if (ScanCode and $80)=0 then keypressed:=true else keypressed:=false;
end;

function readkey:char;

{Reads the next character from the keyboard.}

var
    c:char;
	ScanCode:byte;
	
	
begin 
  //shouldn't need to wait, as handler is only called on keyboard interrupt.
   asm
      cli //WAIT for interrupt.(Keypress)
       //  movb $0,%ah
   end;
                    
    ScanCode:=ReadPortB($60); 
    c:=USKeyMap[ScanCode];
	readkey:=c;
  
end;

procedure delline;

{Deletes the line at the cursor.}

var row,left,right,bot:longint;
    fil:word;

begin
    getxy(x,y);
    row:=Y;
    left:=lo(windmin);
    right:=lo(windmax);
    bot:=hi(windmax)+1;
    fil:=$20 or (textattr shl 8);
    scroll_backwards(row+1,left,bot,right,1,fil);
    blinkcursor;
end;

procedure insline;

{Inserts a line at the cursor position.}

var row,left,right,bot:longint;
    fil:word;

begin
    getxy(x,y);
    row:=Y;
    left:=lo(windmin);
    right:=lo(windmax);
    bot:=hi(windmax);
    fil:=$20 or (textattr shl 8);
    if ScrollDisabled then exit;
    scroll;
    blinkcursor;
end;


Function FullWin:boolean;

//  Check if Full Screen 80x25 Window(1,1,80,25) is used

begin
  FullWin:=(WindMinX=1) and (WindMinY=1) and
           (WindMaxX=80) and (WindMaxY=25);
end;

//this works,believe it or not.
Procedure clreol; 

var
  empcount:integer;

  blank_with_attribute : TCharAttr;
  empty:string[80];

begin
 empty:='';
 x:=CursorPosX;
 y:=CursorPosY;
 gotoxy(1,y); //6,y ..leave the 'FPOS> ' alone....
 repeat
     empty:=empty+' ';
     inc(empcount);
 until empcount=80;  //gives us a quick and dirty empty line very easily.

 CurSorPosY:=CurSorPosY+1; 
 writeln(empty);

 CursorPosY:=CursorPosY-1; //goes back to where we were
 blinkcursor;
END;


procedure textcolor(color:byte);

Begin
  TextAttr:=(Color and $f) or (TextAttr and $70);
  If (Color>15) Then TextAttr:=TextAttr Or Blink;
End;


// from gpc crt unit

function GetTextColor: Integer;
begin
  GetTextColor := TextAttr and $8f
end;

function GetTextBackground: Integer;
begin
  GetTextBackground := (TextAttr and $70) shr 4
end;




{ PUT ME IN MOUSE: size of icons and mouse [pointer] size...


const mouse_ptr_maxx = 15;
      mouse_ptr_maxy = 15;

type tmouse_ptr = array[0..mouse_ptr_maxx, 0..mouse_ptr_maxy] of longint;

}

{$ASMMODE INTEL}

FUNCTION GetCursorSize:WORD;ASSEMBLER;
ASM
  mov ah,3
  xor bh,bh
  int $10
  mov ax,cx
END;



{setmode allows for base text mode switching AND base graph mode setup
use mode $4f0h for SVGA VESA MODES...
  
CRT modes 

  CO40          = 1;             40x25 Color on Color Adapter 
  BW40		=  2;
  CO80          = 3;             80x25 Color on Color Adapter
  BW80		=  4;
   
these are graph modes set normally by graph unit.
 
	4			 graph (CGA) 320 x 200 color

^^--this mode commonly set on on image redraw for older code.


	5			 graph (CGA) 320 x 200 black / white
	6			 graph (CGA) 640 x 200 black / white 
	F			 graph (EGA,VGA) 640x350 grey

	10			 graph (EGA,VGA) 640x350 16 colors
	11			 graph (VGA) 2 colors
B/W AGAIN...

	12			 graph (VGA) 16 colors
	13(h)			 graph mode (VGA) 320x240x256 colors --(mode 13h)
   

this is here for completion, this is in the timer unit.SOMEWHAT FIXED.
some people have already asked for CRT code, so I had to put this in here. --Jazz



}


procedure SetMode(mode:byte); assembler;
//set low-res TEXT modes, see graph units for HIGHer RES--up to 1280x1024...

asm
	MOV AX,mode
	INT 10h // Vmode 3 (restore Vmode to DOS)
end;


procedure TextMode (Mode: byte);
 //Use this procedure to set-up a specific text-mode.
begin
 TextAttr := $07;
 LastMode := Mode;
 if Mode <7 then
 	SetMode(Mode)
 else begin
 	writeln('Invalid Text Mode.Must be graphics.Call InitGraph.');
	exit;
 end;
    	
 WindMin := 0;
 WindMaxX := Pred (80);
 WindMaxY := Pred (25);
 if WindMaxX >= 255 then
  WindMax := 255
 else
  WindMax := WindMaxX;
 if WindMaxY >= 255 then
  WindMax := WindMax or $FF00
 else
  WindMax := WindMax or (WindMaxY shl 8);
 ClrScr;
end;

function noecho(pmt : string) : string;
var
 ch : char;
 d : boolean;
 temp, st : string;
begin
 write(pmt);
 d := false;
 temp := '';
 st := '';
 repeat
  temp := st;
  repeat until keypressed;
  ch := readkey;
  if (ch = chr(8)) then st := temp;
  if (ch = chr(13)) then d := true;
  if not ((ch = chr(8)) and (ch = chr(13))) then st := st+ch; 
 until d = true;
 noecho := temp;
 writechar(#10);
end;

function pwcrypt(op : string) : string; //for use in password files OR :-) system auth. [never use clear text]
var
 ptr : integer;
 ip : string;
begin
 ip := '';
 ptr := 1;
 repeat
  ip := ip+chr(((ord(op[ptr])+ord(op[length(op)-ptr]) xor length(op))));
  ip[ptr] := chr(ord(ip[ptr])+2);
  inc(ptr);
 until ptr = length(op)+1;
 pwcrypt := ip;
end;

{
	fontcode,fontsize font8,14,16 need define
	
	
function getFontSize : fontSize;
var 
	regs  : registers;
   fs    : fontSize;
   at    : adapterType;
begin
   at := queryAdapterType;
	case at of
		cga 		: fs := font8;
		mda 		: fs := font14;
		mcgaMono,
		mcgaColor	: fs:= font16;
		egaMono,
		egaColor,
		vgaMono,
		vgaColor	: begin
					with regs do begin
               
						ah := $11; egavga call
						al := $30;
//						bl := $0;   
						bh := $0;   
					end; 
					intr($10,regs);
					fs := fontCode(regs.cl);
               if (fs = unknownFontSize) then
                  fs := font16;  
				end; 
	end; 
   getFontSize := fs;
end; 


function fontCode;
begin
	case h of 
		 8 : fontCode := font8;
		14 : fontCode := font14;
		16 : fontCode := font16;
      else fontCode := unknownFontSize; // unKnown, assume 8 
	end; case
end; 

function fontHeight(f : fontSize) : byte;
begin
	case f of
		font8  : fontHeight := 8;
		font14 : fontHeight := 14;
		font16 : fontHeight := 16;
	end;
end; 


}

Procedure Window(X1, Y1, X2, Y2: Byte);

//  Set screen window to the specified coordinates.

Begin
  if (X1>X2) or (X2>ScreenWidth) or (Y1>Y2) or (Y2>ScreenHeight) then
    exit;
  WindMinX:=X1;
  WindMaxX:=X2;
  WindMinY:=Y1;
  WindMaxY:=Y2;
  WindMin:=((Y1-1) Shl 8)+(X1-1);
  WindMax:=((Y2-1) Shl 8)+(X2-1);
  GoToXY(1,1);
End;

Procedure TextBackground(Color: Byte);
Begin
  TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
End;

procedure Scroll;
begin
  if CursorPosY>=24 then begin
    
    Move((VidMem+2*80)^,VidMem^,23*2*80);
    // Empty last line
    FillWord((VidMem+23*2*79)^,79,Blank);
    CursorPosX:=0;
    CursorPosY:=23;
  end;

{
	 asm
            mov ah, 6
            mov al, byte ptr lines
            mov edi, screl
            mov bh, [edi + 1]
            mov ch, byte ptr top
            mov cl, byte ptr left
            mov dh, byte ptr bottom
            mov dl, byte ptr right
            int 10h
        end;
}
end;

procedure scroll_backwards(top,left,bottom,right,lines:word;var screl:word); assembler;


        asm
            mov ah, 7
            mov al, byte ptr lines
            mov edi, screl
            mov bh, [edi + 1]
            mov ch, byte ptr top
            mov cl, byte ptr left
            mov dh, byte ptr bottom
            mov dl, byte ptr right
            int 10h
        end;

procedure BlinkCursor;
var
  Temp: LongWord;
begin
  // X,Y mapped to VidMem ( 1-dim array.remains that way through mode 13h. )
  Temp:=CursorPosY*80+CursorPosX;
  
  writeportb($3D4,14);
  writeportb($3D5,Temp shr 8);
  writeportb($3D4,15);
  writeportb($3D5,Temp);
end;


procedure WriteChar(const c: Char);
var
  Offset: Word;

  procedure Print(const c: Char);
  begin
    // First byte = character to print
    Offset:=(CursorPosX shl 1)+(CursorPosY*160);
    VidMem[Offset]:=c;
    // Second byte = color attributes
    Inc(Offset);
    VidMem[Offset]:=Char(TextAttr);
  end;

begin
  // Blank character based on current color attributes
  Blank:=$20 or (TextAttr shl 8);
  case c of
 	//leave the rest of these out of here, keyboard handler takes care of it.
    #10: begin
      CursorPosX:=0;
      if not ScrollDisabled then 
         scroll;
      Inc(CursorPosY);
      blinkcursor;
    end;
    // Carriage return
    #13: CursorPosX:=0; //here would be the effect of #10 again if we so desire.
    // Printable characters, starting from space
    #32..#255: begin
      Print(c);
      if not ScrollDisabled then
          scroll;
      Inc(CursorPosX);
      blinkcursor;
    end;
  end;
  // Whoops! Line limit, move on to the next line
  if CursorPosX>80 then begin
    CursorPosX:=0;
    Inc(CursorPosY);
    blinkcursor;
  end;
end;

// print a dword in decimal
procedure PrintDecimal(Value: DWORD);
var
	I, Len: Byte;
  S: string[32];
begin
	Len := 0;
  I := 10;
  if (Value and $80000000) = $80000000 then
  begin
  	asm
	    mov   eax, Value
	    not   eax
	    inc   eax
	    mov   Value, eax
	end;
	 	writeChar('-');
  end;
  if Value = 0 then
  begin
  	writechar('0');
  end else begin
  	while Value <> 0 do
    begin
    	S[I] := Chr((Value mod 10) + $30);
      Value := Value div 10;
      I := I-1;
      Len := Len+1;
    end;
    if (Len <> 10) then
    begin
    	S[0] := chr(Len);
      for I := 1 to Len do
      begin
      	S[I] := S[11-Len];
        Len := Len-1;
      end;
    end else begin
    	S[0] := chr(10);
    end;
    for I := 1 to ord(S[0]) do
    begin
    	writechar(S[I]);
    end;
  end;
end;

Function Hex_Char(Number: Word): Char;
Begin
If Number<10 then
Hex_Char:=Char(Number+48)
else
Hex_Char:=Char(Number+55);
end; { Function Hex_Char }

procedure PrintHex(Value: DWORD);
var
	C: Char;
  Hexa: Byte;
  I, Shift: Byte;
begin
  writechar('0');
  writechar('x');
  for I := 7 downto 0 do
  begin
  	Shift := I*4;
    Hexa := (Value shr Shift) and $0F;
    C := Hex_Char(Hexa);
    writechar(C);
  end;
end;



procedure Write(const s:string);

var
  i : longint;
begin
   
   for i:=1 to length(s) do
       writeChar(s[i]);
   blinkcursor;
end;

procedure writeln(const hstr:string);
var
  i : longint;
  y,where:integer;

begin
 //   if hstr='' then begin
  //      writechar(#10);
   // 	exit; //need to find out how to call this like writeln; for a null string... -Jazz
  //  end;
    write(hstr); 
    writechar(#10);
    if ScrollDisabled then exit;
    scroll;
    blinkcursor;
end;


procedure LowVideo;
begin
  TextAttr := TextAttr and not 8
end;

procedure HighVideo;
begin
  TextAttr := TextAttr or 8
end;

Procedure NormVideo;
begin
   textcolor(7);
   textbackground(0);
end;

{assumes no scroll buffer
--used for screen navigation

procedure Up;
      VAR
         LinesStr : string;

      BEGIN
         writechar(#30);
      END;

    procedure Down;
      VAR
         LinesStr : string;

      BEGIN
         writechar(#31);
      END;

   procedure Right;
      VAR
         ColsStr : string;

      BEGIN
         writechar(#28);
      END;

   procedure Left;
      VAR
         ColsStr : string;

      BEGIN
         writechar(#29);
      END;
}


procedure Clrscr; 

var
  i: Byte;
begin
 Blank:=$0 or (TextAttr shl 8);
  for i:=0 to 25 do //include the status line,otherwise its left behind.
  //we should assume this is done if we use one.
    FillWord((VidMem+i*2*80)^,80,Blank);

  CursorPosX:=1;
  CursorPosY:=1;
  BlinkCursor;
  blinkcursor;
end;




// sets cursor size in bytes 0..7
procedure CursorBig;
begin
	asm
		mov ch,$0
		mov cl,$7
		mov ah,1
		int 10h
	end;
end;


procedure CursorOff; assembler;


asm
		mov ch,$20
		mov cl,$20
		mov ah,1
		int 10h
end;


procedure CursorOn; //also turns it on, as well as restores.
begin
	CursorNormal;
end;

procedure CursorNormal; assembler;

asm
		mov ch,$6
		mov cl,$7
		mov ah,1
		int 10h
end;


{$ASMMODE INTEL}
//compliments DaphineOS -GPLv2

procedure NoSound;
var
  Temp: Byte;
begin
    Temp:=ReadPortB($61) and $FC;
  WritePortB($61,Temp);
end;


  procedure Sound(Freq: longword); 
  begin
  // Copyright (c) 2003 Ernesto De Spirito
  // Visit: http://www.latiumsoftware.com
  // Plays a tone thru the PC speaker using the 8253/8254
  // Counter/Timer chip and the 8255 Programmable Peripheral
  // Interface (PPI) chip on the motherboard.
  // NOTE: This code won't work under Windows NT/2000/XP. Use Beep.
  asm
    push edx          // Push Duration on the stack (for Sleep)
    mov cx, ax        // CX := Frequency;
    // Prepare the 8253/8254 to receive the frequency data
    mov al, $B6       // Function: Expect frequency data
    out $43, al       // Write to Timer Control Register
    // Compute the frequency data
    mov dx, $14       // DX:AX = $144F38
    mov ax, $4F38     //       = 1331000
    div cx            // AX := 1331000 / Frequency;
    // Send the frequency data to the 8253/8254 Counter/Timer chip
    out $42, al       // Write low byte to the Frequency Address
    mov al, ah        // AL := High byte of AX
    out $42, al       // Write high byte to the Frequency Address
    // Tell the 8255 PPI to start the sound
    in al, $61        // Read Port B of the 8255 PPI
    or al, $03        // Set bits 0 and 1:
                      // bit 0 --> use the 8253/8254
                      // bit 1 --> turn speaker on
    out $61, al       // Write to Port B of the 8255 PPI
     // Tell the 8255 PPI to stop the sound
   // in al, $61        // Read Port B of the 8255 PPI
   // and al, NOT 2     // Clear bit 1 (turn speaker off)
   // out $61, al       // Write to Port B of the 8255 PPI
  end;
end;



{$ASMMODE intel}

Procedure Write_Real(num: real; field_size, decimal: byte);
var
  line: string;
begin
  str(num: field_size: decimal, line);
  WriteLn(line);
 
 
END;

procedure beep;
   begin { a DOS-Like LOUD ASS beep }
//see http://social.msdn.microsoft.com/Forums/en-US/Vsexpressvb/thread/1e36c41a-ca28-462d-9f1f-c99af37fabb2/ for details
//says 800 for freq, but that can't be. 
	sound(850);
	delay(300);
	nosound;
   
   end;

 Procedure TABULATE;
  Var x:Integer;
  begin
     write('        ');  //eight spaces
     blinkcursor;
  end;

//mainloop
BEGIN
        textattr:= $07;       
	windmin := 0;
  	windmax := $1950; //80x25,least for now.
  	lastmode := 3;
END.
