{ _______________________________________________________________ | | | CopyRight (c) 1989,1990 Steven Lutrov | |_______________________________________________________________|____ | | | | program title : tpfast.pas | | ___ | author : Steven Lutrov | | | | revision : 4.00 | | | | date : 1990-07-16 | | | | language : turbo pascal 5.5 | | | | | | | | description : unit file for all the assembly routines | | | | | | | |_______________________________________________________________| | | | | | |________________________________________________________________| | | | |_________________________________________________________________| } unit tpfast; { ------------------------------------------------------------------------- } interface { ------------------------------------------------------------------------- } uses dos,crt; { ------------------------------------------------------------------------- } type { ------------------------------------------------------------------------- } stype = string; { you may want to svae memory and } { declare stype as string[80] , as it} { is mostly used for displaying one { line to the string, beware of pascal } { strict type checking } cardtype = (none,mda,cga,egamono,egacolour,vgamono, vgacolour,mcgamono,mcgacolour); const BackSpc = 3592; Tab = 3849; Lf = 10; Esc = 283; Ins = 21216; Del = 21472; Home = 18400; Endkey = 20448; PgUp = 18912; PgDn = 20960; Up = 18656; Down = 20704; Left = 19424; Right = 19936; nIns = 20992; nDel = 21248; nHome = 18176; nEnd = 20224; nPgUp = 18688; nPgDn = 20736; nUp = 18432; nDown = 20480; nLeft = 19200; nRight = 19712; n5 = 19456; F1 = 15104; F2 = 15360; F3 = 15616; F4 = 15872; F5 = 16128; F6 = 16384; F7 = 16640; F8 = 16896; F9 = 17152; F10 = 17408; F11 = 34048; F12 = 34304; Space = 14624; Enter = 7181; Null = 0; CtrlA = 7681; CtrlB = 12290; CtrlC = 11779; CtrlD = 8196; CtrlE = 4613; CtrlF = 8454; CtrlG = 8711; CtrlH = 8968; CtrlI = 5897; CtrlJ = 9226; CtrlK = 9483; CtrlL = 9740; CtrlM = 12813; CtrlN = 12558; CtrlO = 6159; CtrlP = 6416; CtrlQ = 4113; CtrlR = 4882; CtrlS = 7955; CtrlT = 5140; CtrlU = 5653; CtrlV = 12054; CtrlW = 4375; CtrlX = 11544; CtrlY = 5401; CtrlZ = 11290; CtrlBackSpc = 3711; CtrlTab = 37888; CtrlIns = 1024; CtrlDel = 1536; CtrlHome = 30688; CtrlEnd = 30176; CtrlPgUp = 34016; CtrlPgDn = 30432; CtrlUp = 36320; CtrlDown = 37344; CtrlLeft = 29664; CtrlRight = 29920; CtrlnIns = 1024; CtrlnDel = 1536; CtrlnHome = 30464; CtrlnEnd = 29952; CtrlnPgUp = 33792; CtrlnPgDn = 30208; CtrlnUp = 36096; CtrlnDown = 37120; CtrlnLeft = 29664; CtrlnRight = 29696; Ctrln5 = 36608; CtrlF1 = 24064; CtrlF2 = 24320; CtrlF3 = 24576; CtrlF4 = 24832; CtrlF5 = 25088; CtrlF6 = 25344; CtrlF7 = 25600; CtrlF8 = 25856; CtrlF9 = 26112; CtrlF10 = 26368; CtrlF11 = 35072; CtrlF12 = 35328; CtrlSpace = 14624; CtrlEnter = 7178; Alt0 = 33024; Alt1 = 30720; Alt2 = 30976; Alt3 = 31232; Alt4 = 31488; Alt5 = 31744; Alt6 = 32000; Alt7 = 32256; Alt8 = 32512; Alt9 = 32768; AltA = 7680; AltB = 12288; AltC = 11776; AltD = 8192; AltE = 4608; AltF = 8448; AltG = 8704; AltH = 8960; AltI = 5888; AltJ = 9216; AltK = 9472; AltL = 9728; AltM = 12800; AltN = 12544; AltO = 6144; AltP = 6400; AltQ = 4096; AltR = 4864; AltS = 7936; AltT = 5120; AltU = 5632; AltV = 12032; AltW = 4352; AltX = 11520; AltY = 5376; AltZ = 11264; AltBackSpc = 3584; AltTab = 42240; AltIns = 41472; AltDel = 41728; AltHome = 38656; AltEnd = 40704; AltPgUp = 39168; AltPgDn = 41216; AltUp = 38912; AltDown = 40960; AltLeft = 39680; AltRight = 40192; AltF1 = 26624; AltF2 = 26880; AltF3 = 27136; AltF4 = 27392; AltF5 = 27648; AltF6 = 27904; AltF7 = 28160; AltF8 = 28416; AltF9 = 28672; AltF10 = 28928; AltF11 = 35584; AltF12 = 35840; AltSpace = 512; AltEnter = 7168; AtlEsc = 256; Shift0 = 2857; Shift1 = 545; Shift2 = 832; Shift3 = 1059; Shift4 = 1316; Shift5 = 1573; Shift6 = 1886; Shift7 = 2086; Shift8 = 2346; Shift9 = 2600; ShiftBackSpc = 3592; ShiftTab = 3840; ShiftIns = 1280; ShiftDel = 1792; ShiftF1 = 21504; ShiftF2 = 21760; ShiftF3 = 22016; ShiftF4 = 22272; ShiftF5 = 22528; ShiftF6 = 27904; ShiftF7 = 23040; ShiftF8 = 23296; ShiftF9 = 23552; ShiftF10 = 23808; ShiftF11 = 34560; ShiftF12 = 34816; _black = black; _blue = blue shl 4; _green = green shl 4; _cyan = cyan shl 4; _red = red shl 4; _magenta = magenta shl 4; _brown = yellow shl 4; _lightgary = lightgray shl 4; { e.g. blue+_green = blue foreground on green background } var TPFError :byte; { global error monitor } video_buff :word; { address of video buffer } snow_check :boolean; { snow check for CGA } video_page :byte; { default video page } startline :byte; { cursor start scanline} stopline :byte; { cursor start scanline} { ------------------------------------------------------------------------- } function bytetohex(num :byte): stype; function rotatewordleft(num: word; nbits :byte): word; function rotatebyteright(num,nbits :byte) :byte; function rotatebyteleft(num,nbits :byte) :byte; function rotatewordright(num: word; nbits :byte): word; function wordtohex(num: word): stype; function fclose(handle :integer):boolean; function fcreate(fname:string; attribute :integer) :integer; function ferase(name:string) :integer; function fseek(handle,mode :integer;offset:longint;var location: longint):boolean; function getverify: boolean; function fopen(name:string; access :integer) :integer; function fread(handle:word; amount:word; var buff) :integer; procedure readsector(segment,offset,drive,sector,number: word); procedure setverify(setting: boolean); function fwrite(handle :integer; nwrite:word; var buff) :integer; procedure writesector(segment,offset,drive,sector,number: word); procedure copyclear(box :pointer; x,y,xx,yy,colour :byte); procedure drawbox(char_x ,char_y :char;x,y,xx,yy,colour :byte); procedure fillscreen(ch :char; x,y,xx,yy,colour :byte); procedure restorescreen(box :pointer; x,y,xx,yy :byte); procedure savescreen(box :pointer; x,y,xx,yy :byte); procedure screendown(box :pointer; var x,y :byte; xx,yy :byte); procedure screenleft(box :pointer; var x,y :byte; xx,yy :byte); procedure screenright(box :pointer; var x,y :byte; xx,yy :byte); procedure screenup(box :pointer; var x,y :byte; xx,yy :byte); procedure scrollx(where :char; x,y,xx,yy,cols,colour :byte); procedure scrolly(where :char; x,y,xx,yy,lines,colour :byte); function altkeydown: boolean; function capslockdown: boolean; function capslockon: boolean; procedure clearbuffer; procedure clearcapslock; procedure clearins; procedure clearnumlock; procedure clearscrolllock; function ctrlkeydown: boolean; function ekeypressed :boolean; function getekey :word; function getkey :word; function freshchar :char; function inskeydown: boolean; function inskeyon: boolean; procedure keypause(code :char; ascii: boolean; wait_a,wait_b :byte); function lastkey :char; function leftshiftdown: boolean; function nextkey :char; function numlockdown: boolean; function numlockon: boolean; function rightshiftdown: boolean; function scrolllockdown: boolean; function scrolllockon: boolean; procedure setcapslock; procedure setins; procedure setnumlock; procedure setscrolllock; procedure background(code :char); procedure blinkoff; procedure blinkon; procedure clearpage(pagenumber,colour :byte); procedure colourx(x,y,y,colour :byte); procedure cursordown(y :integer); procedure cursorleft(columns :integer); procedure cursoroff; procedure cursoron; procedure cursorright(columns :integer); procedure cursorup(y :integer); procedure dsp(strx: stype); procedure dspat(strx: stype; x,y,colour :byte); procedure dspcolour(strx: stype; colour :byte); procedure dspend(strx: stype; x,y,length,colour :byte); procedure dspjust(strx: stype; x,y,colour :byte); procedure dspln(strx: stype); procedure dsplncolour(strx: stype; colour :byte); procedure dsppart(strx: stype; start,numch,x,y,colour :byte); procedure dspvert(strx: stype; x,y,colour :byte); procedure foreground(code :char); procedure formatleft(strx: stype; how_many :integer; colour :byte); procedure formatright(strx: stype; how_many :integer; colour :byte); function getcolour(x,y :byte) :byte; function getpage :integer; procedure intenseoff; procedure intenseon; procedure normal; procedure reverse; procedure rowcolour(x,y,xx,colour :byte); procedure screencolour(x,y,xx,y,colour :byte); procedure setcolour(x,y,colour :byte); procedure setpage(pagenumber :integer); procedure swappage(box :pointer; pagenumber :byte); procedure changechar(var strx: stype; search,replace :char); function compare(strg1,strg2: stype): boolean; procedure deletechar(var strx: stype; ch :char); procedure deleteleft(var strx: stype; border :char); procedure deleteright(var strx: stype; border :char); function leftend(var strx: stype; border :char): stype; procedure lowercase(var strx: stype); procedure overwrite(var strx: stype; substrg: stype; position :integer); procedure padcentre(var strx: stype; ch :char; position,length :integer); procedure padends(var strx: stype; ch :char; length :integer); procedure padleft(var strx: stype; ch :char; length :integer); procedure padright(var strx: stype; ch :char; length :integer); procedure replace(var strx: stype; substrg: stype; position,chars :integer); function rightend(var strx: stype; border :char): stype; function seekstring(strx,substrg: stype; startpt :integer) :integer; function stringend(strx: stype; numberchars :integer): stype; function stringof(substrg: stype; length :integer): stype; procedure uppercase(var strx: stype); function wordcount(strx: stype) :integer; { routines that are partially assembly written } procedure dspc(strx : stype ;y,colour :byte); { ------------------------------------------------------------------------- } implementation { ------------------------------------------------------------------------- } {$F+} { force far call linking } {$L TPFBIT.OBJ} function bytetohex;external; function rotatewordleft;external; function rotatebyteright;external; function rotatebyteleft;external; function rotatewordright;external; function wordtohex;external; {$L TPFFILE.OBJ} function fclose;external; function fcreate;external; function ferase;external; function fseek;external; function getverify;external; function fopen;external; function fread;external; procedure readsector;external; procedure setverify;external; function fwrite;external; procedure writesector;external; {$L TPFSCRN.OBJ} procedure clearpage;external; procedure copyclear;external; procedure drawbox;external; procedure fillscreen;external; procedure restorescreen;external; procedure savescreen;external; procedure screendown;external; procedure screenleft;external; procedure screenright;external; procedure screenup;external; procedure scrollx;external; procedure scrolly;external; procedure swappage;external; {$L TPFKBD.OBJ} function altkeydown ;external; function capslockdown ;external; function capslockon ;external; procedure clearbuffer ;external; procedure clearcapslock ;external; procedure clearins ;external; procedure clearnumlock ;external; procedure clearscrolllock ;external; function ctrlkeydown ;external; function ekeypressed ;external; function getekey ;external; function getkey ;external; function freshchar ;external; function inskeydown ;external; function inskeyon ;external; procedure keypause ;external; function lastkey ;external; function leftshiftdown ;external; function nextkey ;external; function numlockdown ;external; function numlockon ;external; function rightshiftdown ;external; function scrolllockdown ;external; function scrolllockon ;external; procedure setcapslock ;external; procedure setins ;external; procedure setnumlock ;external; procedure setscrolllock ;external; {$L TPFVIDEO.OBJ} procedure background;external; procedure blinkoff;external; procedure blinkon;external; procedure colourx;external; procedure cursordown;external; procedure cursorleft;external; procedure cursoroff;external; procedure cursoron;external; procedure cursorright;external; procedure cursorup;external; procedure dsp;external; procedure dspat;external; procedure dspcolour;external; procedure dspend;external; procedure dspjust;external; procedure dspln;external; procedure dsplncolour;external; procedure dsppart;external; procedure dspvert;external; procedure foreground;external; procedure formatleft;external; procedure formatright;external; function getcolour;external; function getpage;external; procedure intenseoff;external; procedure intenseon;external; procedure normal;external; procedure reverse;external; procedure rowcolour;external; procedure screencolour;external; procedure setcolour;external; procedure setpage;external; {$L TPFSTR.OBJ} procedure changechar;external; function compare;external; procedure deletechar;external; procedure deleteleft;external; procedure deleteright;external; function leftend;external; procedure lowercase;external; procedure overwrite;external; procedure padcentre;external; procedure padends;external; procedure padleft;external; procedure padright;external; procedure replace;external; function rightend;external; function seekstring;external; function stringend;external; function stringof;external; procedure uppercase;external; function wordcount;external; {$F-} { restore call linking } { ------------------------------------------------------------------------- } procedure dspc (strx : stype ;y,colour :byte); begin dspat(strx,40 - length(strx) div 2,y,colour); end; { ------------------------------------------------------------------------- } function whatcard : cardtype; var code :byte; regs : registers; begin regs.ah := $1A; { attempt to call vga identify card function } regs.al := $00; { must clear al to 0 ... } intr($10,regs); if regs.al = $1A then { so that if $1a comes back in al... } begin { we know a ps/2 video bios is out there. } case regs.bl of { code comes back in bl. } $00 : whatcard := none; $01 : whatcard := mda; $02 : whatcard := cga; $04 : whatcard := egacolour; $05 : whatcard := egamono; $07 : whatcard := vgamono; $08 : whatcard := vgacolour; $0a,$0c : whatcard := mcgacolour; $0b : whatcard := mcgamono; else whatcard := cga end { case } end else { if it's not ps/2 we have to check for } begin { the presence of an ega bios: } regs.ah := $12; { select alternate function service } regs.bx := $10; { bl=$10 means return ega information } intr($10,regs); { do it } if regs.bx <> $10 then { bx unchanged means ega is not there... } begin regs.ah := $12; { once we know alt function exists... } regs.bl := $10; { ...we call it again to see if it's... } intr($10,regs); { ...ega colour or ega monochrome. } if (regs.bh = 0) then whatcard := egacolour else whatcard := egamono end else { now we know its a cga or mda bastard !} begin intr($11,regs); { $11 = equipment determination service } code := (regs.al and $30) shr 4; case code of 1 : whatcard := cga; 2 : whatcard := cga; 3 : whatcard := mda else whatcard := none end { case } end end; end; { ------------------------------------------------------------------------- } { unit initialisation } { ------------------------------------------------------------------------- } begin video_buff := $b800; case whatcard of cga, mcgacolour, egacolour, vgacolour : video_buff := $b800; mda, mcgamono, egamono, vgamono : video_buff := $b000; end; { case } snow_check := false; { set to true for snow prone monitors } video_page := 0; { default video page, 0-7 for EGA/VGA } startline := 11; { normal cursor } stopline := 12; { normal cursor } end.