Category : Miscellaneous Language Source Code
Archive   : HDOS.ZIP
Filename : HDOS.PRO

/*------------------------------------------------------------------------*/
/* A somewhat helpful DOS Assistant 06/11/86 */
/*------------------------------------------------------------------------*/
/* This program demonstrates how one might create a simplistic interface */
/* to DOS for the neophyte DOS user. Its a little rough around the edges */
/* because I didn't intend on making a career out of the program. */
/* The program was a learning exercise for myself --- it is definitely */
/* not a bullet-proof program. Therefore, it is submitted here primarily */
/* for your amusement. Who knows? There might be some ideas here that */
/* you can use in other programs. */
/* */
/* Note: Just in case, this was written on an IBM PC w/512K, 2 Floppy */
/* drives, 20 meg Hard Disk, 2 Printers, 1 comm port, and monochrome */
/* monitor. */
/* */
/* When you run it, the selection menu uses the up/down arrows to move */
/* the hightlight bar; to make a selection, press the enter key. */
/* Mark C. Paxton */
/*------------------------------------------------------------------------*/
domains
file = editfile
stringlist = string*
list = symbol*
row,column,length = integer
key = cr; escape; up; down; other
register = integer
/*------------------------------------------------------------------------*/
database filename(string)
/*------------------------------------------------------------------------*/
predicates
confirm(string)
repeat
write_option_list(list)
append(stringlist,stringlist,stringlist)
maxlen(list,integer,integer)
listlen(list,integer)
getkey(key)
translate_key(key,char,integer)
get_next_key_code(key,integer)
create_main_menu(row,column,string,list,integer)
display_highlight_bar(row,list,row,integer,integer)
move_highlight_up_down(row,list,row,integer,integer,key)
memsize(integer)
dosver(register,register)
diskspace(integer,real,real)
mkdir(string)
rmdir(string)
find_files(string,string)
retrieve_the_file_name(register)
get_dta_file_name(string,register,integer,integer)
find_rest(register,register,register)
build_file_name(string,string,integer,integer,integer)
write_error(string)
pad_spaces(string,integer,string)
fix_minutes(integer,string)
edit_process(file,symbol)
display_process(file,symbol)
edit_file
display_file
get_file_name(symbol)
convert_drive(string,integer)
display_stats(integer)
get_path_name(string)
convert_blank_path(string,string)
fix_hours(integer,integer,string)
helpdos
mainmenu
process_selection(integer)
/*------------------------------------------------------------------------*/
goal helpdos.
/*------------------------------------------------------------------------*/
clauses
/*------------------------------------------------------------------------*/
/* General Purpose Predicates */
/*------------------------------------------------------------------------*/
append([],X,X).
append([H|T],L1,[H|L2]) :- append(T,L1,L2).
maxlen([H|T],X,Y) :- str_len(H,Length), Length > X,
!, maxlen(T,Length,Y).
maxlen([_|T],X,Y) :- maxlen(T,X,Y).
maxlen([],Length,Length).
listlen([],0).
listlen([_|T],N) :- listlen(T,X), N = X + 1.
write_option_list([H|[]]) :- write(H), !.
write_option_list([H|T]) :- write(H,"\n"), write_option_list(T).
repeat.
repeat :- repeat.
confirm("y") :- !.
confirm("Y").
/*------------------------------------------------------------------------*/
/* Miscellaneous */
/*------------------------------------------------------------------------*/
pad_spaces(X,0,X) :- !.
pad_spaces(FieldIn,Counter,FieldOut) :-
C = Counter - 1, fronttoken(ParmString,FieldIn," "),
pad_spaces(ParmString,C,FieldOut).

get_path_name(DosPathName) :-
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write("Enter path name or [ENTER]: "),
readln(PathName), removewindow,
convert_blank_path(PathName,DosPathName),
frontstr(1,DosPathName,Drive,_),
convert_drive(Drive,DiskNumber),
display_stats(DiskNumber).

convert_blank_path("",NewPathName) :-
!, disk(NewPathName).
convert_blank_path(NewPathName,NewPathName) :- !.

get_file_name(FileName) :- makewindow(4,7,7,"Select File",1,30,22,49),
dir("","*.*",FileName), removewindow.

convert_drive("A",1) :- !.
convert_drive("a",1) :- !.
convert_drive("B",2) :- !.
convert_drive("b",2) :- !.
convert_drive("C",3) :- !.
convert_drive("c",3) :- !.
convert_drive("D",4) :- !.
convert_drive("d",4) :- !.
convert_drive("" ,X) :-
disk(Path), frontstr(1,Path,Drive,_),
convert_drive(Drive,X).

display_stats(DiskNumber) :-
shiftwindow(2),
cursor(14,2), diskspace(DiskNumber,FreeSpace,TotalSpace),
dosver(Dos,SubVersion),
write("\n Dos Version: ",Dos,".",SubVersion),
disk(PathName), write("\n Directory: ",PathName),
write("\n Free Space: ",FreeSpace),
write("\n Total Space: ",TotalSpace),
PercentFree = (FreeSpace * 100.0) / TotalSpace,
write("\n Percent Free:",PercentFree,"%"),
memsize(MemorySize),
write("\n Memory Size: ",MemorySize,"k"),
date(Year,Month,Day),
write("\n ",Month,"/",Day,"/",Year," "),
time(H,Min,_,_), fix_hours(H,Hours,AMPM),
fix_minutes(Min,Minutes),
write(Hours,":",Minutes," ",AMPM).

fix_hours(H,Hours,"pm ") :-
H > 12, !, Hours = H - 12.
fix_hours(Hours,Hours,"am ").

fix_minutes(Min,Minutes) :-
str_int(X,Min), str_len(X,1),
!, fronttoken(Minutes,"0",X).
fix_minutes(Min,Minutes) :-
str_int(Minutes,Min).

write_error(ErrorMessage) :-
shiftwindow(1), clearwindow,
beep, write(ErrorMessage).
/*------------------------------------------------------------------------*/
create_main_menu(Row,Column,Text,OptionList,MenuSelection):-
maxlen(OptionList,0,Width),
listlen(OptionList,Length),
Length > 0, WindowHeight = Length + 2,
WindowWidth = Width + 4,
makewindow(3,7,7,Text,Row,Column,WindowHeight,WindowWidth),
write_option_list(OptionList),
HoldLength = Length,
cursor(0,0), PassWidth = Width + 2,
display_highlight_bar(0,OptionList,HoldLength,PassWidth,Option),
MenuSelection = 1 + Option,
removewindow, shiftwindow(2).

display_highlight_bar(Row,OptionList,Length,Width,MenuSelection) :-
field_attr(Row,0,Width,112),
cursor(Row,0), getkey(Key),
move_highlight_up_down(Row,OptionList,Length,Width,MenuSelection,Key).

move_highlight_up_down(Row,_,_,_,Selection,cr) :-
!, Selection = Row.
move_highlight_up_down(Row,OptionList,Length,Width,MenuSelection,up) :-
Row > 0, !,
field_attr(Row,0,Width,7),
Row1 = Row - 1, display_highlight_bar(Row1,OptionList,Length,Width,MenuSelection).
move_highlight_up_down(Row,OptionList,Length,Width,MenuSelection,down) :-
Row < Length - 1, !,
field_attr(Row,0,Width,7),
X1 = Row + 1, display_highlight_bar(X1,OptionList,Length,Width,MenuSelection).
move_highlight_up_down(Row,OptionList,Length,Width,MenuSelection,_) :-
display_highlight_bar(Row,OptionList,Length,Width,MenuSelection).

getkey(Key) :-
readchar(KeyboardCharacter),
char_int(KeyboardCharacter,Value),
translate_key(Key,KeyboardCharacter,Value).

translate_key(Key,_,0) :-
!, readchar(KeyboardCharacter),
char_int(KeyboardCharacter,Value),
get_next_key_code(Key,Value).
translate_key(cr,_,13).

get_next_key_code(up,72) :- !.
get_next_key_code(down,80) :- !.
get_next_key_code(other,_).
/*------------------------------------------------------------------------*/
memsize(MemSize) :-
bios($12,reg(0,0,0,0,0,0,0,0),reg(MemSize,_,_,_,_,_,_,_)).
/*------------------------------------------------------------------------*/
dosver(Dos,SubVersion):-
bios($21,reg($3000,0,0,0,0,0,0,0),reg(AX,_,_,_,_,_,_,_)),
bitleft(AX,8,T),
bitright(T,8,Dos),
bitright(AX,8,SubVersion).
/*------------------------------------------------------------------------*/
diskspace(Disk,FreeSpace,TotalSpace) :-
bios($21,reg($3600,0,0,Disk,0,0,0,0),reg(AX,BX,CX,DX,_,_,_,_)),
FreeSpace = 1.0 * BX * CX * AX,
TotalSpace = 1.0 * DX * CX * AX.
/*------------------------------------------------------------------------*/
mkdir(PathName) :- ptr_dword(PathName,DS,DX),
bios($21,reg($3900,0,0,DX,0,0,DS,0),_).
/*------------------------------------------------------------------------*/
rmdir(PathName) :- ptr_dword(PathName,DS,DX),
bios($21,reg($3A00,0,0,DX,0,0,DS,0),_).
/*------------------------------------------------------------------------*/
find_files(FileName,FileString) :- /* find file[s]; can handle global */
assert(filename("")), /* store null entry */
ptr_dword(FileName,DS,DX), /* point DS:DX to FileName */
bios($21,reg($4E00,0,0,DX,0,0,DS,0),reg(AX,_,_,_,_,_,_,_)), /* Find File */
retrieve_the_file_name(AX), /* go see if we found a file */
find_rest(AX,DS,DX), /* look for more matching files */
filename(FileString), /* retrieve string of file names */
retract(filename(FileString)). /* remove string of file names */

retrieve_the_file_name(0) :- /* file found */
!, /* don't look any further */
bios($21,reg($2F00,0,0,0,0,0,0,0),reg(_,BX,_,_,_,_,_,ES)), /* get dta address */
Offset = BX + 30, /* point Offset to Filename in DTA */
get_dta_file_name("",ES,Offset,13). /* pull file name from DTA */
retrieve_the_file_name(_). /* file not found */

find_rest(0,DS,DX) :- /* matching file was found */
!, /* don't look any further */
bios($21,reg($4F00,0,0,DX,0,0,DS,0),reg(AX1,_,_,_,_,_,_,_)), /* find other files */
retrieve_the_file_name(AX1), /* look for more matching files */
find_rest(AX1,DS,DX).
find_rest(_,_,_).

get_dta_file_name(FileString,_,_,0) :-/* done building name */
!, /* don't look any further */
filename(X), /* pull old string from database */
retract(filename(X)), /* remove old string */
fronttoken(NewFileString,X,FileString), /* add new file to string of file names */
asserta(filename(NewFileString)). /* place new string of file names in db */
get_dta_file_name(FileString,ES,Offset,Counter) :- /* build file name */
membyte(ES,Offset,Byte_value), /* pull character out of DTA */
build_file_name(NewFileString,FileString,Byte_value,Counter,AdjCounter),
NewOffset = Offset + 1, /* increment offset for next byte */
NewCounter = AdjCounter - 1, /* decrement counter for remaining bytes */
get_dta_file_name(NewFileString,ES,NewOffset,NewCounter).

build_file_name(NewFileString,FileString,0,_,1) :- /* end of build */
!,
str_len(FileString,Length), /* get length of file name */
NoBytes = 14 - Length, /* how much to pad name to 14 bytes? */
pad_spaces(FileString,NoBytes,NewFileString). /* pad the file name */

build_file_name(NewFileString,FileString,Byte_value,Counter,Counter) :-
char_int(Character,Byte_value),
frontchar(NewCharacter,Character,""),
fronttoken(NewFileString,FileString,NewCharacter).
/*------------------------------------------------------------------------*/
edit_file :-
makewindow(5,7,7,"Enter Response to Question Below:",5,5,3,72),
write(" Enter FILENAME to edit: "),
readln(DosFileName), removewindow,
shiftwindow(1), clearwindow,
write(" F1:Help F3:Find F4:Replace F5:Copy F6:Move F7:Del F8:Edit F9:ExtCopy F10:End"),
makewindow(5,7,7,DosFileName,0,0,24,80),
edit_process(editfile,DosFileName),
removewindow.

edit_process(editfile,DosFileName) :- /* Opens old file for edit */
existfile(DosFileName),
!, openread(editfile,DosFileName),
readdevice(editfile), file_str(DosFileName,Buffer),
closefile(editfile), edit(Buffer,TextBuffer),
openwrite(editfile,DosFileName),
writedevice(editfile),
write(TextBuffer), closefile(editfile).
edit_process(editfile,DosFileName) :- /* Creates new edit file */
not(existfile(DosFileName)),
!, openwrite(editfile,DosFileName),
edit("",TextBuffer), writedevice(editfile),
write(TextBuffer), closefile(editfile).
/*------------------------------------------------------------------------*/
display_file :- get_file_name(FileName),
shiftwindow(1), clearwindow,
makewindow(5,7,7,FileName,0,0,24,80),
display_process(editfile,FileName),
removewindow.

display_process(editfile,DosFileName) :-
existfile(DosFileName),
!, openread(editfile,DosFileName),
readdevice(editfile), file_str(DosFileName,Buffer),
closefile(editfile), display(Buffer).
display_process(editfile,DosFileName) :-
not(existfile(DosFileName)),
!, shiftwindow(1),
clearwindow, write_error(" File not found. ").
/*------------------------------------------------------------------------*/
/* Main Body of Program */
/*------------------------------------------------------------------------*/
helpdos :- makewindow(1,120,0,"",24,0,1,80),
makewindow(2,7,7,"A Funky DOS Assistant",0,0,24,80),
makewindow(6,7,7,"Directory",1,30,22,44),
disk(DosPathName), frontstr(1,DosPathName,Drive,_),
convert_drive(Drive,DiskNumber),
display_stats(DiskNumber),
cursor(2,2), mainmenu.
/*------------------------------------------------------------------------*/
mainmenu :- repeat,
disk(DosPathName), frontstr(1,DosPathName,Drive,_),
convert_drive(Drive,DiskNumber),
display_stats(DiskNumber),
shiftwindow(6), find_files("*.*",FileString),
clearwindow, write(FileString),
shiftwindow(1), write(" Select Option. "),
create_main_menu(0,1,"Options",
[ "Rename a File ", /*1*/
"Change Directories ", /*2*/
"Copy a File ", /*3*/
"Edit a File ", /*4*/
"Browse a File ", /*5*/
"Execute a DOS Command ", /*6*/
"Move a File ", /*7*/
"Make a Sub Directory ", /*8*/
"Remove a Sub Directory", /*9*/
"Invoke DOS ", /*10*/
"Directory ", /*11*/
"Delete File ", /*12*/
"Find a File ", /*13*/
"Exit " ], /*14*/
MenuSelection),
process_selection(MenuSelection),
fail.
/*------------------------------------------------------------------------*/
process_selection(1) :- /* Rename a File */
get_file_name(DosFileName),
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Enter New File Name: "),
readln(NewFileName), renamefile(DosFileName,NewFileName),
removewindow, !,
shiftwindow(1), clearwindow,
write(" File Renamed. ").
process_selection(1) :- write_error(" File was not Renamed. "),!.
/*------------------------------------------------------------------------*/
process_selection(2) :- /* Set path */
get_path_name(DosPathName),
shiftwindow(2), disk(DosPathName),
!, frontstr(1,DosPathName,Drive,_),
convert_drive(Drive,DiskNumber),
display_stats(DiskNumber),
shiftwindow(1), clearwindow.
process_selection(2) :- write_error(" Error -- Directory not changed. "),!.
/*------------------------------------------------------------------------*/
process_selection(3) :- /* Copy */
shiftwindow(1), get_file_name(DosFileName),
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Enter full name of new file : "),
readln(NewFileName), concat("copy ",DosFileName,St1),
concat(St1," ",St2), concat(St2,NewFileName,Command),
removewindow, system(Command),
shiftwindow(1), clearwindow,
existfile(NewFileName), write(" File copied. "),
!.
process_selection(3):-write_error(" File did not copy successfully. "),!.
/*------------------------------------------------------------------------*/
process_selection(4) :- /* Edit a file */
!, edit_file,
shiftwindow(1), clearwindow.
/*------------------------------------------------------------------------*/
process_selection(5) :- /* Browse a File */
!, display_file,
shiftwindow(1), clearwindow.
/*------------------------------------------------------------------------*/
process_selection(6) :- /* Execute Dos/program */
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Select Program to execute from window (Y/N): "),
readln(YesNo), confirm(YesNo),
removewindow, shiftwindow(1),
clearwindow, !,
get_file_name(Program), system(Program),
shiftwindow(1), clearwindow.
process_selection(6) :- makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Enter DOS Command or Program Name: "),
readln(Command), removewindow,
system(Command), shiftwindow(1),
clearwindow, !.
/*------------------------------------------------------------------------*/
process_selection(7) :- /* Move File */
shiftwindow(1), get_file_name(DosFileName),
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Enter destination of file: "),
readln(Destination), concat("copy ",DosFileName,St1),
concat(St1," ",St2), concat(St2,Destination,Command),
removewindow, system(Command),
shiftwindow(1), clearwindow,
deletefile(DosFileName),write(" File moved. "),
!.
process_selection(7):-write_error(" File was not moved successfully. "),!.
/*------------------------------------------------------------------------*/
process_selection(8) :- /* MkDir */
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Enter name of new Directory: "),
readln(Directory), mkdir(Directory),
!, removewindow,
shiftwindow(1), clearwindow,
write(" Directory created. ").
process_selection(8) :- write_error("Directory was not created. "),!.
/*------------------------------------------------------------------------*/
process_selection(9) :- /* RmDir */
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Enter name of Directory to remove: "),
readln(Directory), rmdir(Directory),
removewindow,
shiftwindow(1), clearwindow,
!, write(" Directory deleted. ").
process_selection(9) :- write_error(" Directory was not deleted. "),!.
/*------------------------------------------------------------------------*/
process_selection(10) :- /* Execute DOS */
!, system(""),
shiftwindow(1), clearwindow.
/*------------------------------------------------------------------------*/
process_selection(11) :- !, /* Directory */
system("dir > Temp.$$$"),
makewindow(5,7,7,"BROWSE CURRENT DIRECTORY",0,20,24,41),
display_process(editfile,"Temp.$$$"),
deletefile("Temp.$$$"), removewindow.
/*------------------------------------------------------------------------*/
process_selection(12) :- /* Delete File */
get_file_name(DosFileName),
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Confirm Delete (Y/N): "),
readln(Yes_No), confirm(Yes_No),
deletefile(DosFileName),removewindow,
shiftwindow(1), clearwindow,
write(" File Deleted. "), !.
process_selection(12) :- write_error(" Delete Aborted. "),!.
/*------------------------------------------------------------------------*/
process_selection(13) :- /* Find a File */
!,
makewindow(5,7,7,"Enter Response to Question:",5,5,3,70),
write(" Enter File Name or Mask (e.g.: *.dat): "),
readln(Mask), removewindow,
find_files(Mask,FileString),
makewindow(6,7,7,"File(s) Found:",2,20,21,44),
write(FileString), shiftwindow(1),
clearwindow,
write(" Press [ENTER] when ready to continue... "),
readln(_), clearwindow,
shiftwindow(6), removewindow,
shiftwindow(1), write(" Select Option. ").
/*------------------------------------------------------------------------*/
process_selection(14) :-
removewindow, removewindow,
exit. /* a non-elegant termination */
/*------------------------------------------------------------------------*/