From 22280020dc4449b45ba27e240f1b25dd7cb50e13 Mon Sep 17 00:00:00 2001 From: peter Date: Sat, 8 Aug 1998 21:56:45 +0000 Subject: [PATCH] * updated crt with new delay, almost like bp7 routine --- rtl/dos/crt.pp | 1769 +++++++++++++++++++++++++----------------------- 1 file changed, 911 insertions(+), 858 deletions(-) diff --git a/rtl/dos/crt.pp b/rtl/dos/crt.pp index 5be62cf83e..462fef9af7 100644 --- a/rtl/dos/crt.pp +++ b/rtl/dos/crt.pp @@ -12,883 +12,936 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} -{ - history: - 29th may 1994: version 1.0 - unit is completed - 14th june 1994: version 1.01 - the address from which startaddr was read wasn't right; fixed - 18th august 1994: version 1.1 - the upper left corner of winmin is now 0,0 - 19th september 1994: version 1.11 - keypressed handles extended keycodes false; fixed - 27th february 1995: version 1.12 - * crtinoutfunc didn't the line wrap in the right way; - fixed - 20th january 1996: version 1.13 - - unused variables removed - 21th august 1996: version 1.14 - * adapted to newer FPKPascal versions - * make the comments english - 6th november 1996: version 1.49 - * some stuff for DPMI adapted - 15th november 1996: version 1.5 - * bug in screenrows fixed - 13th november 1997: removed textrec definition, is now included from - textrec.inc -} - unit crt; +interface + + var + DelayCnt : longint; {$I os.inc} - interface - - uses - go32; - - const - { screen modes } - bw40 = 0; - co40 = 1; - bw80 = 2; - co80 = 3; - mono = 7; - font8x8 = 256; - - { screen color, fore- and background } - black = 0; - blue = 1; - green = 2; - cyan = 3; - red = 4; - magenta = 5; - brown = 6; - lightgray = 7; - - { only foreground } - darkgray = 8; - lightblue = 9; - lightgreen = 10; - lightcyan = 11; - lightred = 12; - lightmagenta = 13; - yellow = 14; - white = 15; - - { blink flag } - blink = $80; - - const - {$ifndef GO32V2} - directvideo:boolean=true; - {$else GO32V2} - { direct video generates a GPF in DPMI of setcursor } - directvideo:boolean=false; - {$endif GO32V2} - - var - { for compatibility } - checkbreak,checkeof,checksnow : boolean; - - lastmode : word; { screen mode} - textattr : byte; { current text attribute } - windmin : word; { upper right corner of the CRT window } - windmax : word; { lower left corner of the CRT window } - - function keypressed : boolean; - function readkey : char; - procedure gotoxy(x,y : byte); - procedure window(left,top,right,bottom : byte); - procedure clrscr; - procedure textcolor(color : byte); - procedure textbackground(color : byte); - procedure assigncrt(var f : text); - function wherex : byte; - function wherey : byte; - procedure delline; - procedure delline(line : byte); - procedure clreol; - procedure insline; - procedure cursoron; - procedure cursoroff; - procedure cursorbig; - procedure lowvideo; - procedure highvideo; - procedure nosound; - procedure sound(hz : word); - procedure delay(ms : longint); - procedure textmode(mode : integer); - procedure normvideo; - - implementation - - var - maxcols,maxrows : longint; - - { definition of textrec is in textrec.inc} - - {$i textrec.inc} - - { low level routines } - - function getscreenmode : byte; - - begin - dosmemget($40,$49,getscreenmode,1); - end; - - procedure setscreenmode(mode : byte); - - var regs : trealregs; - - begin -{$ifdef GO32V2} - regs.realeax:=mode; - realintr($10,regs); -{$else GO32V2} - asm - movb 8(%ebp),%al - xorb %ah,%ah - pushl %ebp - int $0x10 - popl %ebp - end; -{$endif GO32V2} - end; - - function screenrows : byte; - - begin - dosmemget($40,$84,screenrows,1); - { don't forget this: } - inc(screenrows); - end; - - function screencols : byte; - - begin - dosmemget($40,$4a,screencols,1); - end; - - function get_addr(row,col : byte) : word; - - begin - get_addr:=((row-1)*maxcols+(col-1))*2; - end; - - procedure screensetcursor(row,col : longint); - - var - cols : byte; - pos : word; - -{$ifdef GO32V2} - regs : trealregs; -{$endif GO32V2} - begin - if directvideo then - begin - { set new position for the BIOS } - dosmemput($40,$51,row,1); - dosmemput($40,$50,col,1); - - { calculates screen position } - dosmemget($40,$4a,cols,1); - { FPKPascal calculates with 32 bit } - pos:=row*cols+col; - - { direct access to the graphics card registers } - outportb($3d4,$0e); - outportb($3d5,hi(pos)); - outportb($3d4,$0f); - outportb($3d5,lo(pos)); - end - else -{$ifndef GO32V2} - asm - movb $0x02,%ah - movb $0,%bh - movb row,%dh - movb col,%dl - pushl %ebp - int $0x10 - popl %ebp - end; -{$else GO32V2} - regs.realeax:=$0200; - regs.realebx:=0; - regs.realedx:=row*$100+col; - realintr($10,regs); -{$endif GO32V2} - end; - - procedure screengetcursor(var row,col : longint); - - begin - col:=0; - row:=0; - dosmemget($40,$50,col,1); - dosmemget($40,$51,row,1); - end; - - { exported routines } - - procedure cursoron; - -{$ifdef GO32V2} - var regs : trealregs; -{$endif GO32V2} - begin -{$ifndef GO32V2} - asm - movb $1,%ah - movb $10,%cl - movb $9,%ch - pushl %ebp - int $0x10 - popl %ebp - end; -{$else GO32V2} - regs.realeax:=$0100; - regs.realecx:=$90A; - realintr($10,regs); -{$endif GO32V2} - end; - - procedure cursoroff; - -{$ifdef GO32V2} - var regs : trealregs; -{$endif GO32V2} - begin -{$ifndef GO32V2} - asm - movb $1,%ah - movb $-1,%cl - movb $-1,%ch - pushl %ebp - int $0x10 - popl %ebp - end; -{$else GO32V2} - regs.realeax:=$0100; - regs.realecx:=$ffff; - realintr($10,regs); -{$endif GO32V2} - end; - - procedure cursorbig; - -{$ifdef GO32V2} - var regs : trealregs; -{$endif GO32V2} - begin -{$ifdef GO32V2} - regs.realeax:=$0100; - regs.realecx:=$10A; - realintr($10,regs); -{$else GO32V2} - asm - movb $1,%ah - movb $10,%cl - movb $1,%ch - pushl %ebp - int $0x10 - popl %ebp - end; -{$endif GO32V2} - end; - - var - is_last : boolean; - last : char; - - function readkey : char; - - var - char2 : char; - char1 : char; -{$ifdef GO32V2} - var regs : trealregs; -{$endif GO32V2} - - begin - if is_last then - begin - is_last:=false; - readkey:=last; - end - else - begin -{$ifdef GO32V2} - regs.realeax:=$0000; - realintr($16,regs); - byte(char1):=regs.realeax and $ff; - byte(char2):=(regs.realeax and $ff00) div $100; -{$else GO32V2} - asm - movb $0,%ah - pushl %ebp - int $0x16 - popl %ebp - movw %ax,-2(%ebp) - end; -{$endif GO32V2} - if char1=#0 then - begin - is_last:=true; - last:=char2; - end; - readkey:=char1; - end; - end; - - function keypressed : boolean; - -{$ifdef GO32V2} - var regs : trealregs; -{$endif GO32V2} - begin - if is_last then - begin - keypressed:=true; - exit; - end - else -{$ifdef GO32V2} - begin - regs.realeax:=$0100; - realintr($16,regs); - if (regs.realflags and zeroflag) = 0 then - keypressed:=true - else keypressed:=false; - end; -{$else GO32V2} - asm - movb $1,%ah - pushl %ebp - int $0x16 - popl %ebp - setnz %al - movb %al,__RESULT - end; -{$endif GO32V2} - end; - - procedure gotoxy(x,y : byte); - - 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; - screensetcursor(y+hi(windmin)-1,x+lo(windmin)-1); - end; - - function wherex : byte; - - var - row,col : longint; - - begin - screengetcursor(row,col); - wherex:=col-lo(windmin)+1; - end; - - function wherey : byte; - - var - row,col : longint; - - begin - screengetcursor(row,col); - wherey:=row-hi(windmin)+1; - end; - - procedure window(left,top,right,bottom : byte); - - begin - if (left<1) or - (right>screencols) or - (bottom>screenrows) or - (left>right) or - (top>bottom) then - exit; - windmin:=(left-1) or ((top-1) shl 8); - windmax:=(right-1) or ((bottom-1) shl 8); - gotoxy(1,1); - end; - - procedure clrscr; - - var - fil : word; - row : longint; - - begin - fil:=32 or (textattr shl 8); - for row:=hi(windmin) to hi(windmax) do - dosmemfillword($b800,get_addr(row+1,lo(windmin)+1),lo(windmax)-lo(windmin)+1,fil); - gotoxy(1,1); - end; - - procedure textcolor(color : Byte); - - begin - textattr:=(textattr and $70) or color; - end; - - procedure lowvideo; - - begin - textattr:=textattr and $f7; - end; - - procedure highvideo; - - begin - textattr:=textattr or $08; - end; - - procedure textbackground(color : Byte); - - begin - textattr:=(textattr and $8f) or ((color and $7) shl 4); - end; - - var - startattrib : byte; - - procedure normvideo; - - begin - textattr:=startattrib; - end; - - procedure delline(line : byte); - - var - row,left,right,bot : longint; - fil : word; - - begin - row:=line+hi(windmin); - left:=lo(windmin)+1; - right:=lo(windmax)+1; - bot:=hi(windmax)+1; - fil:=32 or (textattr shl 8); - while (rowrow) do - begin - dosmemmove($b800,get_addr(bot-1,left),$b800,get_addr(bot,left),(right-left+1)*2); - dec(bot); - end; - dosmemfillword($b800,get_addr(row,left),right-left+1,fil); - end; - - procedure clreol; - - var - row,col : longint; - fil : word; - - begin - screengetcursor(row,col); - inc(row); - inc(col); - fil:=32 or (textattr shl 8); - dosmemfillword($b800,get_addr(row,col),lo(windmax)-col+2,fil); - end; - - - Function CrtWrite(var f : textrec):integer; - - var - i,col,row : longint; - c : char; - va,sa : word; - - begin - screengetcursor(row,col); - inc(row); - inc(col); - va:=get_addr(row,col); - for i:=0 to f.bufpos-1 do - begin - c:=f.buffer[i]; - case ord(c) of - 10 : begin - inc(row); - va:=va+maxcols*2; - end; - 13 : begin - col:=lo(windmin)+1; - va:=get_addr(row,col); - end; - 8 : if col>lo(windmin)+1 then - begin - dec(col); - va:=va-2; - end; - 7 : begin - { beep } - end; - else - begin - sa:=textattr shl 8 or ord(c); - dosmemput($b800,va,sa,sizeof(sa)); - inc(col); - va:=va+2; - end; - end; - if col>lo(windmax)+1 then - begin - col:=lo(windmin)+1; - inc(row); - { it's easier to calculate the new address } - { it don't spend much time } - va:=get_addr(row,col); - end; - while row>hi(windmax)+1 do - begin - delline(1); - dec(row); - va:=va-maxcols*2; - end; - end; - f.bufpos:=0; - screensetcursor(row-1,col-1); - CrtWrite:=0; - end; - - Function CrtClose(Var F: TextRec): Integer; - Begin - F.Mode:=fmClosed; - CrtClose:=0; - End; - - Function CrtOpen(Var F: TextRec): Integer; - Begin - If F.Mode = fmOutput Then - CrtOpen:=0 - Else - CrtOpen:=5; - End; - - Function CrtRead(Var F: TextRec): Integer; - Begin - {$IFDEF GO32V2} - f.bufend:=do_read(f.handle,longint(f.bufptr),f.bufsize); - {$ENDIF} - f.bufpos:=0; - CrtRead:=0; - End; - - Function CrtInOut(Var F: TextRec): Integer; - Begin - Case F.Mode of - fmInput: CrtInOut:=CrtRead(F); - fmOutput: CrtInOut:=CrtWrite(F); - End; - End; - - procedure assigncrt(var f : text); - begin - TextRec(F).Mode:=fmClosed; - TextRec(F).BufSize:=SizeOf(TextBuf); - TextRec(F).BufPtr:=@TextRec(F).Buffer; - TextRec(F).BufPos:=0; - TextRec(F).OpenFunc:=@CrtOpen; - TextRec(F).InOutFunc:=@CrtInOut; - TextRec(F).FlushFunc:=@CrtInOut; - TextRec(F).CloseFunc:=@CrtClose; - TextRec(F).Name[0]:='.'; - TextRec(F).Name[1]:=#0; - end; - - procedure sound(hz : word); - - begin - if hz=0 then - begin - nosound; - exit; - end; - asm - movzwl hz,%ecx - movl $1193046,%eax - cdq - divl %ecx - movl %eax,%ecx - movb $0xb6,%al - outb %al,$0x43 - movb %cl,%al - outb %al,$0x42 - movb %ch,%al - outb %al,$0x42 - inb $0x61,%al - orb $0x3,%al - outb %al,$0x61 - end ['EAX','ECX','EDX']; - end; - - procedure nosound; - - begin - asm - inb $0x61,%al - andb $0xfc,%al - outb %al,$0x61 - end ['EAX']; - end; - - var - calibration : longint; - - procedure delay(ms : longint); - - var - i,j : longint; - - begin - for i:=1 to ms do - for j:=1 to calibration do - begin - end; - end; - - function get_ticks:longint; - - begin - dosmemget($40,$6c,get_ticks,4); - end; - - procedure initdelay; - - { From the mailling list, - by Jonathan Anderson (sarlok@geocities.com) } - - const - threshold=3; - { Raise this to increase speed but decrease accuracy } - { currently the calibration will be no more than 7 off } - { and shave a few ticks off the most accurate setting of 0 } - { The best values to pick are powers of 2-1 (0,1,3,7,15...) } - { but any non-negative value will work. } - - var - too_small : boolean; - first, - incval : longint; - - begin - calibration:=0; - { wait for new tick } - first:=get_ticks; - while get_ticks=first do - begin - end; - first:=get_ticks; - - { this estimates calibration } - while get_ticks=first do - inc(calibration); - - { calculate this to ms } - { calibration:=calibration div 70; } - { this is a very bad estimation because } - { the loop above calls a function } - { and the dealy loop does not } - calibration:=calibration div 3; - - { The ideal guess value is about half of the real value } - { although a value lower than that take a large performance } - { hit compared to a value higher than that because it has to } - { go through the loop a few times. } - - if calibration<(threshold+1)*2 then - calibration:=(threshold+1)*2; - - { If calibration is not at least this value, an } - { infinite loop will result. } - - repeat - incval:=calibration; - if calibration<0 then - begin - calibration:=$7FFFFFFF; - exit; - end; - { If calibration becomes less than 0, then } - { the maximum value was not long enough, so } - { assign it the maximum value and exit. } - { Without this code, an infinite loop would } - { result on superfast computers about 315800 } - { times faster (oh yeah!) than my Pentium 75. } - { If you don't think that will happen, take } - { out the if and save a few clock cycles. } - - too_small:=true; { Assumed true at beginning } - - while incval>threshold do - begin - incval:=incval div 2; - first:=get_ticks; - while get_ticks=first do - begin - end; - first:=get_ticks; - delay(55); - if first=get_ticks then - begin - calibration:=calibration+incval; - end - else - begin - calibration:=calibration-incval; - too_small:=false; - { If you have to decrement calibration, } - { the initial value was not too small to } - { result in an accurate measurement. } - end; - end; - until not too_small; - end; - - - procedure textmode(mode : integer); - - var - set_font8x8 : boolean; - - begin - lastmode:=mode; - set_font8x8:=(mode and font8x8)<>0; - mode:=mode and $ff; - setscreenmode(mode); - windmin:=0; - windmax:=(screencols-1) or ((screenrows-1) shl 8); - maxcols:=screencols; - maxrows:=screenrows; - end; +{$I386_ATT} + +const +{ 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 } + Mono = 7; { 80x25 on Monochrome Adapter } + Font8x8 = 256; { Add-in for ROM font } + +{ Mode constants for 3.0 compatibility } + C40 = CO40; + C80 = CO80; + +{ 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; var - col,row : longint; +{ Interface variables } + CheckBreak: Boolean; { Enable Ctrl-Break } + CheckEOF: Boolean; { Enable Ctrl-Z } + DirectVideo: Boolean; { Enable direct video addressing } + CheckSnow: Boolean; { Enable snow filtering } + LastMode: Word; { Current text mode } + TextAttr: Byte; { Current text attribute } + WindMin: Word; { Window upper left coordinates } + WindMax: Word; { Window lower right coordinates } + +{ Interface procedures } +procedure AssignCrt(var F: Text); +function KeyPressed: Boolean; +function ReadKey: Char; +procedure TextMode(Mode: Integer); +procedure Window(X1,Y1,X2,Y2: Byte); +procedure GotoXY(X,Y: Byte); +function WhereX: Byte; +function WhereY: Byte; +procedure ClrScr; +procedure ClrEol; +procedure InsLine; +procedure DelLine; +procedure TextColor(Color: Byte); +procedure TextBackground(Color: Byte); +procedure LowVideo; +procedure HighVideo; +procedure NormVideo; +procedure Delay(MS: Word); +procedure Sound(Hz: Word); +procedure NoSound; + +{Extra Functions} +procedure cursoron; +procedure cursoroff; +procedure cursorbig; + + +implementation + +uses + go32; + +{$I386_ATT} {can be removed in the future} + +{$ASMMODE ATT} + +var + ScreenWidth, + ScreenHeight : longint; + + +{ + definition of textrec is in textrec.inc +} +{$i textrec.inc} + + +{**************************************************************************** + Low level Routines +****************************************************************************} + +procedure setscreenmode(mode : byte); +{$ifdef GO32V2} +var + regs : trealregs; +{$endif GO32V2} begin - is_last:=false; +{$ifdef GO32V2} + regs.realeax:=mode; + realintr($10,regs); +{$else GO32V2} + asm + movb 8(%ebp),%al + xorb %ah,%ah + pushl %ebp + int $0x10 + popl %ebp + end; +{$endif GO32V2} +end; - { load system variables to temporary variables to save time } - maxcols:=screencols; - maxrows:=screenrows; - { set output window } - windmax:=(maxcols-1) or ((maxrows-1) shl 8); +function GetScreenHeight : longint; +begin +{$ifdef GO32V2} + getscreenheight:=mem[$40:$84]+1; +{$else} + dosmemget($40,$84,getscreenheight,1); + inc(getscreenheight); +{$endif} +end; - { save the current settings to restore the old state after the exit } - screengetcursor(row,col); - dosmemget($b800,get_addr(row+1,col+1)+1,startattrib,1); - lastmode:=getscreenmode; - textattr:=startattrib; - { redirect the standard output } - assigncrt(Output); - TextRec(Output).mode:=fmOutput; -{$IFDEF GO32V2} - assigncrt(Input); - TextRec(Input).mode:=fmInput; -{$ENDIF GO32V2} +function GetScreenWidth : longint; +begin +{$ifdef GO32V2} + getscreenwidth:=mem[$40:$4a]; +{$else} + dosmemget($40,$4a,getscreenwidth,1); +{$endif} +end; - { calculates delay calibration } - initdelay; + +procedure SetScreenCursor(x,y : longint); +{$ifdef GO32V2} +var + regs : trealregs; +{$endif GO32V2} +begin +{$ifdef GO32V2} + regs.realeax:=$0200; + regs.realebx:=0; + regs.realedx:=(y-1) shl 8+(x-1); + realintr($10,regs); +{$else GO32V2} + asm + movb $0x02,%ah + movb $0,%bh + movb y,%dh + movb x,%dl + subw $0x0101,%dx + pushl %ebp + int $0x10 + popl %ebp + end; +{$endif GO32V2} +end; + + +procedure GetScreenCursor(var x,y : longint); +begin +{$ifdef Go32V2} + x:=mem[$40:$50]+1; + y:=mem[$40:$51]+1; +{$else Go32V2} + x:=0; + y:=0; + dosmemget($40,$50,x,1); + dosmemget($40,$51,y,1); + inc(x); + inc(y); +{$endif GO32V2} +end; + + +{**************************************************************************** + Helper Routines +****************************************************************************} + +Function WinMinX: Byte; +{ + Current Minimum X coordinate +} +Begin + WinMinX:=(WindMin and $ff)+1; +End; + + + +Function WinMinY: Byte; +{ + Current Minimum Y Coordinate +} +Begin + WinMinY:=(WindMin shr 8)+1; +End; + + + +Function WinMaxX: Byte; +{ + Current Maximum X coordinate +} +Begin + WinMaxX:=(WindMax and $ff)+1; +End; + + + +Function WinMaxY: Byte; +{ + Current Maximum Y coordinate; +} +Begin + WinMaxY:=(WindMax shr 8) + 1; +End; + + + +Function FullWin:boolean; +{ + Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines +} +begin + FullWin:=(WindMax-WindMin=$184f); +end; + + +{**************************************************************************** + Public Crt Functions +****************************************************************************} + + +procedure textmode(mode : integer); +begin + lastmode:=mode; + mode:=mode and $ff; + setscreenmode(mode); + screenwidth:=getscreenwidth; + screenheight:=getscreenheight; + windmin:=0; + windmax:=(screenwidth-1) or ((screenheight-1) shl 8); +end; + + +Procedure TextColor(Color: Byte); +{ + Switch foregroundcolor +} +Begin + TextAttr:=(Color and $8f) or (TextAttr and $70); +End; + + + +Procedure TextBackground(Color: Byte); +{ + Switch backgroundcolor +} +Begin + TextAttr:=(Color shl 4) or (TextAttr and $0f); +End; + + + +Procedure HighVideo; +{ + Set highlighted output. +} +Begin + TextColor(TextAttr Or $08); +End; + + + +Procedure LowVideo; +{ + Set normal output +} +Begin + TextColor(TextAttr And $77); +End; + + + +Procedure NormVideo; +{ + Set normal back and foregroundcolors. +} +Begin + TextColor(7); + TextBackGround(0); +End; + + +Procedure GotoXy(X: Byte; Y: Byte); +{ + Go to coordinates X,Y in the current window. +} +Begin + If (X>0) and (X<=WinMaxX- WinMinX+1) and + (Y>0) and (Y<=WinMaxY-WinMinY+1) Then + Begin + Inc(X,WinMinX-1); + Inc(Y,WinMinY-1); + SetScreenCursor(x,y); + 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; + WindMin:=((Y1-1) Shl 8)+(X1-1); + WindMax:=((Y2-1) Shl 8)+(X2-1); + GoToXY(1,1); +End; + + +Procedure ClrScr; +{ + Clear the current window, and set the cursor on 1,1 +} +var + fil : word; + y : longint; +begin + fil:=32 or (textattr shl 8); + if FullWin then + DosmemFillWord($b800,0,ScreenHeight*ScreenWidth,fil) + else + begin + for y:=WinMinY to WinMaxY do + DosmemFillWord($b800,((y-1)*ScreenWidth+(WinMinX-1))*2,WinMaxX-WinMinX+1,fil); + end; + Gotoxy(1,1); +end; + + +Procedure ClrEol; +{ + Clear from current position to end of line. +} +var + x,y : longint; + fil : word; +Begin + GetScreenCursor(x,y); + fil:=32 or (textattr shl 8); + if x=y) do + begin + dosmemmove($b800,(((WinMinY+my-1)-1)*ScreenWidth+(WinMinX-1))*2, + $b800,(((WinMinY+my)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2); + dec(my); + end; + dosmemfillword($b800,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil); +end; + + + + +{**************************************************************************** + Extra Crt Functions +****************************************************************************} + +procedure cursoron; +{$ifdef GO32V2} +var + regs : trealregs; +{$endif GO32V2} +begin +{$ifndef GO32V2} + asm + movb $1,%ah + movb $10,%cl + movb $9,%ch + pushl %ebp + int $0x10 + popl %ebp + end; +{$else GO32V2} + regs.realeax:=$0100; + regs.realecx:=$90A; + realintr($10,regs); +{$endif GO32V2} +end; + + +procedure cursoroff; +{$ifdef GO32V2} +var + regs : trealregs; +{$endif GO32V2} +begin +{$ifdef GO32V2} + regs.realeax:=$0100; + regs.realecx:=$ffff; + realintr($10,regs); +{$else GO32V2} + asm + movb $1,%ah + movb $-1,%cl + movb $-1,%ch + pushl %ebp + int $0x10 + popl %ebp + end; +{$endif GO32V2} +end; + + +procedure cursorbig; +{$ifdef GO32V2} +var + regs : trealregs; +{$endif GO32V2} +begin +{$ifdef GO32V2} + regs.realeax:=$0100; + regs.realecx:=$10A; + realintr($10,regs); +{$else GO32V2} + asm + movb $1,%ah + movw $110,%cx + pushl %ebp + int $0x10 + popl %ebp + end; +{$endif GO32V2} +end; + + +{***************************************************************************** + Read and Write routines +*****************************************************************************} + +var + CurrX,CurrY : longint; + +Procedure WriteChar(c:char); +var +{$ifdef GO32V2} + regs : trealregs; +{$else} + chattr : word; +{$endif} +begin + case c of + #10 : inc(CurrY); + #13 : CurrX:=WinMinX; + #8 : begin + if CurrX>WinMinX then + dec(CurrX); + end; + #7 : begin { beep } +{$ifdef GO32V2} + regs.dl:=7; + regs.ah:=2; + realintr($21,regs); +{$endif} + end; + else + begin +{$ifdef GO32V2} + memw[$b800:((CurrY-1)*ScreenWidth+(CurrX-1))*2]:=(textattr shl 8) or byte(c); +{$else} + chattr:=(textattr shl 8) or byte(c); + dosmemput($b800,((CurrY-1)*ScreenWidth+(CurrX-1))*2,chattr,2); +{$endif} + inc(CurrX); + end; + end; + if CurrX>WinMaxX then + begin + CurrX:=WinMinX; + inc(CurrY); + end; + while CurrY>WinMaxY do + begin + removeline(1); + dec(CurrY); + end; +end; + + +Function CrtWrite(var f : textrec):integer; +var + i : longint; +begin + GetScreenCursor(CurrX,CurrY); + for i:=0 to f.bufpos-1 do + WriteChar(f.buffer[i]); + SetScreenCursor(CurrX,CurrY); + f.bufpos:=0; + CrtWrite:=0; +end; + + +Function CrtRead(Var F: TextRec): Integer; + + procedure BackSpace; + begin + if (f.bufpos>0) and (f.bufpos=f.bufend) then + begin + WriteChar(#8); + WriteChar(' '); + WriteChar(#8); + dec(f.bufpos); + dec(f.bufend); + end; + end; + +var + ch : Char; +Begin + f.bufpos:=0; + f.bufend:=0; + repeat + if f.bufpos>f.bufend then + f.bufend:=f.bufpos; + SetScreenCursor(CurrY,CurrX); + ch:=readkey; + case ch of + #0 : case readkey of + #71 : while f.bufpos>0 do + begin + dec(f.bufpos); + WriteChar(#8); + end; + #75 : if f.bufpos>0 then + begin + dec(f.bufpos); + WriteChar(#8); + end; + #77 : if f.bufpos0 do + BackSpace; + end; + #13 : begin + WriteChar(#13); + WriteChar(#10); + f.bufptr^[f.bufend]:=#13; + f.bufptr^[f.bufend+1]:=#10; + inc(f.bufend,2); + break; + end; + #26 : if CheckEOF then + begin + f.bufptr^[f.bufend]:=#26; + inc(f.bufend); + break; + end; + else + begin + if f.bufpos