home *** CD-ROM | disk | FTP | other *** search
- unit generic;
-
-
-
- interface
-
- uses dos,crt;
-
-
- var m:array[0..25] of string; { used by menus and message boxes }
-
-
-
- {############################## dos routines ##############################}
-
- procedure formfeed; { sends formfeed to PRN }
- procedure chngdrv(c:char); { changes to drive c }
- function lastdrive:char; { returns last drive installed on machine }
- procedure copyfile(s,s2:string);
- { copies file s to s2. heap must be small enough for command.com to load. }
- function filefound(s:string):boolean; { returns true if file s is found }
- procedure renamefile(s,ss:string);
- { renames file s to ss. overwrites file ss if it already exists }
- procedure delfile(s:string); { deletes file s }
- procedure warmboot; { does a warm reboot (ctrl-alt-del). real mode only. }
- procedure coldboot; { does a cold reboot (reset button). real mode only. }
-
-
-
-
- {################################ sound routines ###########################}
-
- procedure beep(i,j:integer); { does a sound at freq i for j/1000 secs }
- procedure nogosound; { sound effect }
- procedure click1; { sound effect }
- procedure click2; { sound effect }
-
-
-
- {############################# mouse routines ############################}
-
- procedure sm; { shows mouse. text thru vga vidmodes only. }
- procedure hm; { hides mouse. text thru vga vidmodes only. }
- procedure resetmouse(setgrafmouse:boolean);
- { resets mouse. use resetmouse at program start &
- after switching between graphics & text modes.
- if setgrafmouse=true, sets mouse x and y bounds
- to getmaxx and getmaxy (for graphics mode). }
- procedure pause(doclick:boolean); { waits until a mouse button is pressed.
- if doclick is true, then does a click sound when button is pressed. }
- function hasmouse:boolean; { returns true if machine has a mouse }
- function mousex:integer; { returns current mouse x coord }
- function mousey:integer; { returns current mouse y coord }
- function mousebutton:integer;
- { returns current mouse button value.
- 0 = no buttons pressed.
- 1 = button 1 being pressed.
- 2 = button 2 being pressed.
- 3 = buttons 1 & 2 being pressed.
- 4 = button 3 being pressed.
- 5 = buttons 1 & 3 being pressed.
- 6 = butons 2 & 3 being pressed.
- 7 = buttons 1, 2, & 3 being pressed. }
- procedure putmouse(x,y:integer); { puts mouse to mouse coords x,y }
- procedure getmouse(var x,y,b:integer);
- { gets current mouse status. x=mousex, y=mousey, b=mousebutton. }
- procedure nobutton; { waits until no mouse buttons are being pressed }
-
-
-
-
-
-
- {########################## conversion routines ############################}
-
- function i2s(i:longint):string; { converts integer or longint to string }
- function r2s(r:real):string; { converts a real to a string }
- function s2i(s:string):integer; { converts string to integer }
- function noslash(s:string):string;
- { returns s without trailing backslash (except root dirs). s is a path or
- dir name. }
- function slash(s:string):string;
- { returns s with trailing backslash if needed. s is a path or dir name }
- procedure upit(var s:string); { converts a string to uppercase }
- function s2r(s:string):real; { converts a string to a real }
-
-
-
-
-
-
-
-
- {############################### math routines ############################}
-
- function isin(x,y,x1,y1,x2,y2:integer):boolean;
- { returns true if point x,y is in the area x1,y1 (UL corner),
- x2,y2 (LR corner). }
- procedure ulim2(var i:longint; j:longint); { upper limits longint i to j }
- procedure llim2(var i:longint; j:longint); { lower limit longint i to j }
- procedure llim(var i:integer; j:integer);
- { lower limits i to j. if i<j then i:=j }
- procedure ulim(var i:integer; j:integer);
- { upper limits i to j. if i>j then i:=j }
- function greaterof(i,j:integer):integer; { returns the greater of i and j }
- function lesserof(i,j:integer):integer; { returns the lesser of i and j }
- function inrng(i,lb,ub:integer):boolean; { returns true if lb<=i and i<=ub. }
- function dice(i:integer):integer;
- { returns roll of an i sided die. use randomize at program start. }
-
-
-
- {############################ joystick routines ###########################}
-
- procedure getstick(var x,y,b1,b2:integer);
- { gets current joystick status. x,y are stick cooords.
- b1,b2 are buttons 1 & 2 status. }
-
-
-
-
-
-
- {############################ text routines ###############################}
-
- procedure cursor(i:integer); { sets cursor. 0=off, 1=normal, 2=full block. }
- function iscolor:boolean; { returns true if machine supports color text. }
- procedure box(x1,y1,x2,y2:integer); { draws text box }
- procedure col(i,j:integer); { sets text colors to i on j }
- procedure cls(i,j:integer); { does a col(i,j) and then clears text screen }
- procedure say(i,j:integer; s:string);
- { writes S at i,j (x,y) using current text colors }
- procedure fill(x1,y1,x2,y2,color:integer); { fills text area }
- procedure fore(i:integer); { sets text foreground color }
- procedure bak(i:integer); { sets text background color }
- procedure center(i:integer; s:string);
- { writes s centered at row i in current text colors }
- function menu(i:integer):integer;
- { does text menu. returns option # selected. uses global array m.
- i is # of items in menu. m[0] is title. m[1] thru m[i] are
- options. }
- procedure msg(i:integer);
- { does text message box w/ pause. uses array m. i is # of lines in msg }
- function getstr(i:integer):string;
- { does string input box. uses array m. i is # of lines in prompt }
-
-
-
-
-
- {################################ keyboard routines #######################}
-
- function rshiftpressed:boolean; { returns true if right shift is pressed }
- function lshiftpressed:boolean; { returns true if left shift is pressed }
- function ctrlpressed:boolean; { returns true if ctrl is pressed }
- function altpressed:boolean; { returns true if alt is pressed }
- function scrolllockon:boolean; { returns true if scroll lock is on }
- function numlockon:boolean; { returns true if num lock is on }
- function capslockon:boolean; { returns true if caps lock is on }
- function inserton:boolean; { returns true if insert is on }
- procedure nokey; { waits until no keyboard keys are being pressed }
-
-
-
-
-
-
- implementation
-
-