{**************************************************************************** $Id$ Standard CRT unit. Free Pascal runtime library for OS/2. Copyright (c) 1997 Daniel Mantione. This file may be reproduced and modified under the same conditions as all other Free Pascal source code. ****************************************************************************} unit crt; interface {$i crth.inc} {cemodeset means that the procedure textmode has failed to set up a mode.} type cexxxx=(cenoerror,cemodeset); var crt_error:cexxxx; {Crt-status. RW} implementation {$i textrec.inc} const extkeycode:char=#0; var maxrows,maxcols:word; type Tkbdkeyinfo=record charcode,scancode:char; fbstatus,bnlsshift:byte; fsstate:word; time:longint; end; {if you have information on the folowing datastructure, please send them to me at d.s.p.mantione@twi.tudelft.nl} {This datastructure is needed when we ask in what video mode we are, or we want to set up a new mode.} viomodeinfo=record cb:word; { length of the entire data structure } fbtype, { bit mask of mode being set} color: byte; { number of colors (power of 2) } col, { number of text columns } row, { number of text rows } hres, { horizontal resolution } vres: word; { vertical resolution } fmt_ID, { attribute format ! more info wanted !} attrib: byte; { number of attributes } buf_addr, { physical address of videobuffer, e.g. $0b800} buf_length, { length of a videopage (bytes)} full_length, { total video-memory on video- card (bytes)} partial_length:longint; { ????? info wanted !} ext_data_addr:pointer; { ????? info wanted !} end; TVioCursorInfo=record case boolean of false:( yStart:word; {Cursor start (top) scan line (0-based)} cEnd:word; {Cursor end (bottom) scan line} cx:word; {Cursor width (0=default width)} Attr:word); {Cursor colour attribute (-1=hidden)} true:( yStartInt: integer; {integer variants can be used to specify negative} cEndInt:integer; {negative values (interpreted as percentage by OS/2)} cxInt:integer; AttrInt:integer); end; PVioCursorInfo=^TVioCursorInfo; {EMXWRAP.DLL has strange calling conventions: All parameters must have a 4 byte size.} function kbdcharin(var Akeyrec:Tkbdkeyinfo;wait,kbdhandle:longint):word; cdecl; external 'EMXWRAP' index 204; function kbdpeek(var Akeyrec:TkbdkeyInfo;kbdhandle:word):word; cdecl; external 'EMXWRAP' index 222; function dossleep(time:cardinal):word; cdecl; external 'DOSCALLS' index 229; function vioscrollup(top,left,bottom,right,lines:longint; var screl:word;viohandle:longint):word; cdecl; external 'EMXWRAP' index 107; function vioscrolldn(top,left,bottom,right,lines:longint; var screl:word;viohandle:longint):word; cdecl; external 'EMXWRAP' index 147; function viogetcurpos(var row,column:word;viohandle:longint):word; cdecl; external 'EMXWRAP' index 109; function viosetcurpos(row,column,viohandle:longint):word; cdecl; external 'EMXWRAP' index 115; function viowrtcharstratt(s:Pchar;len,row,col:longint;var attr:byte; viohandle:longint):word; cdecl; external 'EMXWRAP' index 148; function viogetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word; cdecl; external 'EMXWRAP' index 121; function viosetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word; cdecl; external 'EMXWRAP' index 122; function VioSetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl; external 'EMXWRAP' index 132; {external 'VIOCALLS' index 32;} function VioGetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl; external 'EMXWRAP' index 127; {external 'VIOCALLS' index 27;} procedure setscreenmode(mode:word); { This procedure sets a new videomode. Note that the constants passes to this procedure are different than in the dos mode.} const modecols:array[0..2] of word=(40,80,132); moderows:array[0..3] of word=(25,28,43,50); var newmode:viomodeinfo; begin newmode.cb:=8; newmode.fbtype:=1; {Non graphics colour mode.} newmode.color:=4; {We want 16 colours, 2^4=16.} newmode.col:=modecols[mode and 15]; newmode.row:=moderows[mode shr 4]; if viosetmode(newmode,0)=0 then crt_error:=cenoerror else crt_error:=cemodeset; maxcols:=newmode.col; maxrows:=newmode.row; end; procedure getcursor(var y,x:word); {Get the cursor position.} begin viogetcurpos(y,x,0) end; procedure setcursor(y,x:word); {Set the cursor position.} begin viosetcurpos(y,x,0) end; procedure scroll_up(top,left,bottom,right,lines:word;var screl:word); begin vioscrollup(top,left,bottom,right,lines,screl,0) end; procedure scroll_dn(top,left,bottom,right,lines:word;var screl:word); begin vioscrolldn(top,left,bottom,right,lines,screl,0) end; function keypressed:boolean; {Checks if a key is pressed.} var Akeyrec:Tkbdkeyinfo; begin kbdpeek(Akeyrec,0); keypressed:=(extkeycode<>#0) or ((Akeyrec.fbstatus and $40)<>0); end; function readkey:char; {Reads the next character from the keyboard.} var Akeyrec:Tkbdkeyinfo; c,s:char; begin if extkeycode<>#0 then begin readkey:=extkeycode; extkeycode:=#0 end else begin kbdcharin(Akeyrec,0,0); c:=Akeyrec.charcode; s:=Akeyrec.scancode; if (c=#224) and (s<>#0) then c:=#0; if c=#0 then extkeycode:=s; readkey:=c; end; end; procedure clrscr; {Clears the current window.} var screl:word; begin screl:=$20+textattr shl 8; scroll_up(hi(windmin),lo(windmin), hi(windmax),lo(windmax), hi(windmax)-hi(windmin)+1, screl); gotoXY(1,1); end; procedure gotoXY(x,y:byte); {Positions the cursor on (x,y) relative to the window origin.} begin if x<1 then x:=1; if y<1 then y:=1; if y+hi(windmin)-2>=hi(windmax) then y:=hi(windmax)-hi(windmin)+1; if x+lo(windmin)-2>=lo(windmax) then x:=lo(windmax)-lo(windmin)+1; setcursor(y+hi(windmin)-1,x+lo(windmin)-1); end; function whereX:byte; {Returns the x position of the cursor.} var x,y:word; begin getcursor(y,x); whereX:=x-lo(windmin)+1; end; function whereY:byte; {Returns the y position of the cursor.} var x,y:word; begin getcursor(y,x); whereY:=y-hi(windmin)+1; end; procedure clreol; {Clear from current position to end of line. Contributed by Michail A. Baikov} var i:byte; begin {not fastest, but compatible} for i:=wherex to lo(windmax) do write(' '); gotoxy(1,wherey); {may be not} end; procedure delline; {Deletes the line at the cursor.} var row,left,right,bot:longint; fil:word; begin row:=whereY; left:=lo(windmin)+1; right:=lo(windmax)+1; bot:=hi(windmax)+1; fil:=$20 or (textattr shl 8); scroll_up(row+1,left,bot,right,1,fil); end; procedure insline; {Inserts a line at the cursor position.} var row,left,right,bot:longint; fil:word; begin row:=whereY; left:=lo(windmin)+1; right:=lo(windmax)+1; bot:=hi(windmax); fil:=$20 or (textattr shl 8); scroll_dn(row,left,bot-1,right,1,fil); end; procedure textmode(mode:integer); { Use this procedure to set-up a specific text-mode.} begin textattr:=$07; lastmode:=mode; mode:=mode and $ff; setscreenmode(mode); windmin:=0; windmax:=(maxcols-1) or ((maxrows-1) shl 8); clrscr; end; procedure textcolor(color:byte); {All text written after calling this will have color as foreground colour.} begin textattr:=(textattr and $70) or (color and $f)+color and 128; end; procedure textbackground(color:byte); {All text written after calling this will have colour as background colour.} begin textattr:=(textattr and $8f) or ((color and $7) shl 4); end; procedure normvideo; {Changes the text-background to black and the foreground to white.} begin textattr:=$7; end; procedure lowvideo; {All text written after this will have low intensity.} begin textattr:=textattr and $f7; end; procedure highvideo; {All text written after this will have high intensity.} begin textattr:=textattr or $8; end; procedure delay(ms:word); {Waits ms microseconds.} begin dossleep(ms) end; procedure window(X1,Y1,X2,Y2:byte); {Change the write window to the given coordinates.} begin if (X1<1) or (Y1<1) or (X2>maxcols) or (Y2>maxrows) or (X1>X2) or (Y1>Y2) then exit; windmin:=(X1-1) or ((Y1-1) shl 8); windmax:=(X2-1) or ((Y2-1) shl 8); gotoXY(1,1); end; 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; i,n:integer; screl:word; ca:Pchar; begin i:=0; getcursor(y,x); while i<=len-1 do begin case s[i] of #8: x:=x-1; #9: x:=(x-lo(windmin)) and $fff8+8+lo(windmin); #10: ; #13: begin x:=lo(windmin); inc(y); end; else begin ca:=@s[i]; n:=1; while not(s[i+1] in [#8,#9,#10,#13]) and (x+n<=lo(windmax)) and (ilo(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; inc(i); end; setcursor(y,x); end; function crtread(var f:textrec):word; {Read a series of characters from the console.} var max,curpos:integer; c:char; clist:array[0..2] of char; begin max:=f.bufsize-2; curpos:=0; repeat c:=readkey; case c of #0: readkey; #8: if curpos>0 then begin clist:=#8' '#8; writePchar(@clist,3); dec(curpos); end; #13: begin f.bufptr^[curpos]:=#13; inc(curpos); f.bufptr^[curpos]:=#10; inc(curpos); f.bufpos:=0; f.bufend:=curpos; clist[0]:=#13; writePchar(@clist,1); break; end; #32..#255: if curpos