home *** CD-ROM | disk | FTP | other *** search
- {$M 16384,8192,327680}
- program TDir;
-
- USES DOS;
-
- { ──────────────────────────────────────────────────────────────── }
- { Name: TDir.pas -> Tdir.exe }
- { Version: 0.92 }
- { Date: December 23, 1990 }
- { Rev Date: March 3, 1992 }
- { Purpose: Interactive Tree Directory & text file browser }
- { Compiler: Turbo Pascal 6.00 }
- { Hardware: XT,AT,386,486 or PS/2 }
- { Video: CGA,MDA,Herc,EGA or VGA }
- { Video Modes: 2, 3 or 7 }
- { By: J. Rockford Cogar }
- { Address: 119 Oklahoma Avenue Oak Ridge, TN 37830 }
- { Rights: FREEWARE. Use this program any way you want. }
- { ──────────────────────────────────────────────────────────────── }
-
- { ────────────────────────── Constants ──────────────────────────────────────────────────── }
- CONST
- { -------------------- Typed Constants ------------------------------------------------------------------------ }
- PMLOC : string[21] = 'File Manager Name is:';
- FileManager : string[65] = 'c:\UTIL\CO.COM';
- WRITEERROR : string[11] = 'Write Error';
- OPENERROR : string[10] = 'Open Error';
- NOFILE : string[14] = 'File Not Found';
- READERROR : string[10] = 'Read Error';
- RAMERROR : string[14] = 'Not Enough RAM';
- NORMAL : string[1] = ' ';
- WRONGVIDEO : string[14] = 'Text mode only';
- SEARCHING : string[9] = 'Searching';
- SPROMPT : string[5] = 'Find:';
- WRIT : string[16] = 'Turbo Pascal 6.0';
- LINEPR : string[15] = 'Reading Record:';
- STAT1 : string[65] = 'Row: 0 Col: Left Column: 0 Right Column:';
- STAT2 : string[77] = 'TreeDir 0.92 Up = | Down = | Left = - Right = - Exit = Esc';
- STAT3 : string[69] = 'By: J. Rockford Cogar Help = F1 Save File = F2 String Search = F9';
- HELP1 : string[31] = 'Ctrl PgUp = Move to Top of File';
- HELP2 : string[31] = 'Ctrl PgDn = Move to End of File';
- HELP3 : string[32] = 'F8 = Repeat String Search';
- HELP4 : string[22] = 'F2 = Print File' ;
- HELP5 : string[45] = 'RETURN = Jump to the selected Subdirectory';
- HELP6 : string[70] = 'F4 = Run the File Manager (CO.COM) on the selected Subdirectory';
- HELP8 : string[59] = 'J. Rockford Cogar, 119 Oklahoma Avenue, Oak Ridge, TN 37830.';
- PROGNAME : string[66] = 'TreeDir 0.92 (3/4/92) Shows File Storage on a Subdirectory Basis.';
- PROGBY : string[48] = 'By: J. Rockford Cogar, Oak Ridge TN USA 3/4/92';
- PROMPT1 : string[23] = 'Processing Directory: \';
- PROMPT2 : string[28] = 'Subdirectory Storage in KB';
- F1STR : string[2] = 'F1';
- F2STR : string[2] = 'F2';
- F9STR : string[2] = 'F9';
- ESCSTR : string[3] = 'Esc';
- { -------------------- Untyped Constants --------------------------------------------------------------------- }
- carry = 1;
- directory = $10; { directory attribute }
- NumberDirs = 1024; { 1024 records should be enough room for directory data }
- ActiveCol = 23; { output column during 'explore' }
- SIDEJUMP = 20; { columns to scroll sideways }
- SEARLEN = 20; { number of bytes in a search string }
- NORMALEXIT = 0; { normal exit code to DOS }
- ERROREXIT = 1; { error exit code to DOS }
- VIDEOEXIT = 2; { wrong video EXIT }
- CHANGEDEXIT = 3; { CHDIR Exit }
- NUMBLINES = 4096; { max number of allowed lines }
- TEXTCOLOR = 31; { color to show normal text in }
- HELPCOLOR = 30; { color to show Help text in }
- STATUSCOLOR = 49; { command/status color }
- CTRCOLOR = 63; { color to show counters in }
- BLINKCOLOR = 207; { blinking color }
- FINDCOLOR = 95; { color of found strings }
- BARCOLOR = 79; { bounce bar color }
- DIRCOLOR = 14; { DIR Name color }
- PAGESIZE = 21; { pageup/pagedown line lengths }
- COL_LOC = 15; { location of column index }
- ROW_LOC = 5; { location of row index }
- _ESC = 1; { Esc scan code }
- _PGUP = 73; { Page Up key }
- _PGDN = 81; { Page DN key }
- _UPAR = 72; { Up arrow key }
- _DNAR = 80; { down arrow key }
- _CTRLF5 = 98; { ctrl f5 key }
- _F8 = 66; { f8 key. repeat string search }
- _F9 = 67; { F9 key. string search }
- _F1 = 59; { F1 key. help key }
- _F2 = 60; { F2 key. save buffers to disk }
- _F3 = 61; { F3 Key. Print buffers }
- _F4 = 62; { Run CO.COM }
- _RIAR = 77; { right arrow key }
- _LEAR = 75; { left arraow key }
- _HOME = 71; { Home key }
- _END = 79; { End key }
- _CTRL_PGUP = 132; { control pageup }
- _CTRL_PGDN = 118; { control pageup }
- _DEL = 83; { delete key }
- _BKSPC = 14; { backspace key }
- _INSERT = 82; { insert key }
- _RET = 28; { return key. jump to selected DIR }
- _X = 45; { X key }
- LEFTMAX = 175; { greatest allowed left edge of the display }
- X1_ = 0; { corners locations for the TreeDir explore screen }
- X2_ = 79;
- Y1_ = 8;
- Y2_ = Y1_ + 5;
- XWIDE_ = X2_ - X1_ - 4;
- SCLRLEN_ = XWIDE_ - ActiveCol;
- FILEMODE = 1; { running as a text file browser }
- TREEDIRMODE = 2; { use a TreeDir }
- { ────────────────────────── Constants ──────────────────────────────────────────────────── }
-
- { ────────────────────────── Data Types ──────────────────────────────────────────────────── }
- TYPE
- BUFF_TYPE = string[254]; { the type that a buffer line is }
- BUFFER_PTR = ^BUFF_TYPE; { pointer to a 254 byte string }
- SEARCH_TYPE = string[SEARLEN]; { string of a specified length for string search uses }
- STRING128 = string[128]; { filename string type. (command line params can be this long) }
-
- fname = array[1..80] of char;
- str80 = string[80]; { generic string }
-
- DTransA_ = record
- filler : array[1..21] of byte;
- attribute : byte;
- file_time : word;
- file_date : word;
- file_size : array[1..2] of word;
- file_name : fname;
- end;
-
- SubDir_ = record
- Size : longint; { bytes in the subdir 4 }
- Index : integer; { index of the previous record 2 }
- Level : integer; { depth in the tree 2 }
- Name : string[13]; { name of a subdirectory 13 }
- end; { Total bytes: 21 }
-
- { ────────────────────────── Data Types ──────────────────────────────────────────────────── }
-
- { ────────────────────────── Global Data ──────────────────────────────────────────────────── }
- VAR
- acty : integer; { row being edited }
- actx : integer; { column being edited }
- curx : integer; { cursor column }
- cury : integer; { cursor row }
- linestr : SEARCH_TYPE; { processed search string }
- iname : STRING128; { filename var }
- buffer : array [0..NUMBLINES] of BUFFER_PTR; { pointers to 4096 strings }
- cpybuff : array [0..NUMBLINES] of BUFFER_PTR; { pointers to 4096 strings }
- max : integer; { loop stop point }
- key : integer; { keyboard scan code value }
- refresh : boolean; { refresh the screen }
- star : integer; { first text line to display }
- row : integer; { row to display }
- left : integer; { left edge of screen }
- find : integer; { set to -1 if no string was found }
- actbuff : BUFF_TYPE; { buffer of line being edited }
- asc : byte; { ascii key code }
- raw : integer; { raw key code }
- SubDir : array[0..NumberDirs] of SubDir_; { array of recs to store dir info in }
- filestorage : longint; { temp var to store bytes in a subdir }
- pattern : string[70]; { directory search pattern }
- sdir : str80; { scaler string for filenames }
- OldDir : str80; { current subdirectory at startup }
- fir : integer; { index for subdirectories }
- CurDir : str80; { explore time current directory }
- by : byte; { generic byte }
- level : integer; { level in the dir tree }
- prev : integer; { previous subdirectory index }
- next : integer; { next subdirectory index }
- curr : integer; { current subdirectory index }
- ostr : str80; { final output string }
- spstr : str80; { string of space chars }
- maxlen : integer; { max filename length }
- maxlevel : integer; { max level reached }
- padlen : integer; { numb spaces to padd with }
- maxsize : longint; { largest amount storage in a dir }
- CurNumbLen : integer; { length of the current number string }
- NumbPad : integer; { length of the largest number string }
- vmode : byte; { video mode at startup }
- color : integer; { text color }
- clrstr : str80; { clear string }
- curtype : integer; { cursor size }
- SysMode : byte; { 'FileMode' or 'TreeDirMode' }
- GlobalDrvStr : string[3]; { specified drive string ie: 'c:' }
- { ────────────────────────── Global Data ──────────────────────────────────────────────────── }
-
- { ---- link in assembly language functions (faster & smaller than using standard libraries) ---- }
- procedure snowputc(col, row, color, outch, numb: word); external;
- procedure cursorxy(col, row: byte); external;
- function getscode: integer; external;
- procedure puts(strg :string); external;
- function getvmode: integer; external;
- function readkbd: integer; external;
- function cgets(VAR strg : SEARCH_TYPE): integer; external;
- procedure snowwrite(col, row: integer; color: byte; ptr: buffer_ptr; soff, maxchars, clrchar: integer); external;
- {$L conio.obj } { assemble CONIO.ASM (with Turbo Assembler) to make CONIO.OBJ }
-
- { a proc to write a screen width string. (saves 19 bytes per call) }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure snow(col, row: integer; color: byte; ptr: buffer_ptr);
- begin
- snowwrite(col, row, color, ptr, 0, 80, 80);
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { changes the display attributes for a specified section the CRT whether it is a CGA, MDA or EGA type display }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure PutAttr(col, row: integer; color: byte; wide: integer);
- begin
- ASM
- push ds { save data seg }
- cld { clear direction flag }
- sub ax,ax { zero out AX }
- mov es,ax { put zero in for extra segment }
- mov al,es:[0449h] { offset of 449h is needed }
- cmp al,7 { is value in al 7 ? }
- je @mdacattr { if 7 then its monochrome }
- mov ax,0b800h { if not then use CGA for base address }
- jmp @asgncatt { goto assign: label }
- @mdacattr: { label: where MDA address is put in AX }
- mov ax,0b000h { MDA adapter }
- @asgncatt: { label: where extra seg is assigned }
- mov es,ax { point to address in video buffer }
- mov bl,byte ptr color { get the attribute }
- mov cx,word ptr col { column address }
- mov ax,word ptr row { row address }
- mov dx,160 { bytes per line in CGA }
- mul dx { 160 * row number }
- add ax,cx { add column number to offset in CGA buffer }
- add ax,cx { add column number to offset in CGA: again }
- mov di,ax { put address in CGA into DI }
- inc di { offset by one byte to the ATTRIBUTE }
- mov cx,word ptr wide { get the count of chars to write }
- mov ax,es { refetch extra seg address }
- cmp ax,0b800h { is it MDA or CGA ? }
- mov al,bl { put in an attribute byte in AL (one time !) }
- @mcattr: { top of for loop }
- stosb { move the number of attributes }
- inc di { skip to next attribute (not character) }
- loop @mcattr { end of for loop }
- pop ds { restore data seg }
- end;
-
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { init global data }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure init;
- begin { procedure init() }
- fillchar(SubDir,sizeof(SubDir_) * NumberDirs, #0);
- SubDir[0].Name:='ROOT'#0;
- pattern:='*.*'#0;
- fillchar(clrstr[1],79 - ActiveCol,' ');
- clrstr[0]:=chr(79 - ActiveCol);
-
- ASM
- xor ax,ax { zero a register }
- mov word ptr level,ax { zero out: level }
- mov word ptr prev,ax { zero out: prev }
- mov word ptr next,ax { zero out: next }
- mov word ptr curr,ax { zero out: curr }
- mov word ptr fir,ax { zero out: fir }
- end;
-
- end; { procedure init() }
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { Get Cursor type }
- { ─────────────────────────────────────────────────────────────────────────── }
- function GetCurType: integer;
- VAR
- retv: integer;
- begin
- ASM
- mov ah,03h { read cursor position function }
- mov bh,00h { video page zero }
- int 10h { call VIDEO BIOS }
- mov word ptr retv,cx { copy to a temp VAR }
- end;
- GetCurType:=retv;
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { Set Cursor type }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure SetCurType(ctype: integer);
- begin
- ASM
- mov ah,01h { set cursor type function }
- mov cx,word ptr ctype { fetch cursor type }
- int 10h { call VIDEO BIOS }
- end;
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { initialize the video }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure VideoInit;
- begin
- curtype:=GetCurType; { get the current cursor type }
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { 'make' a long string of spaces have 'numb' length }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure padstr(numb : integer; VAR ostr : str80);
- begin
- if (numb < 0) then exit; { range check }
- if (numb > 0) then fillchar(ostr,numb + 1,' ');
- ostr[0]:=chr(numb); { init length byte }
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { get the current directory string. Without the volume letter }
- { ─────────────────────────────────────────────────────────────────────────── }
- function GetCurDir(VAR DirStr : str80): integer;
- VAR
- rg : registers;
- i : integer;
- begin { function GetCurDir() }
-
- rg.dx := 0; { get current directory. use default drive }
- rg.ds := seg(DirStr[1]);
- rg.si := ofs(DirStr[1]);
- rg.ax := $4700;
- msdos(rg);
-
- i:=0;
-
- while (DirStr[i+1] <> #0) do inc(i); { calc 'C' string length }
-
- DirStr[0]:=chr(i); { insert the string length }
- GetCurDir:=i; { ret string length }
- end; { function GetCurDir }
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { convert a 'C' string into a Turbo Pascal string }
- { ─────────────────────────────────────────────────────────────────────────── }
- function BuildString(VAR instr: fname; size : integer) : str80;
- VAR
- i : integer; { loop index }
- outstr : str80; { output string }
- begin
- i := 1; { start at offset of 1 }
-
- while (instr[i] <> #0) and (i <= size) do
- begin
- outstr[i]:=instr[i]; { copy the byte }
- Inc(i); { inc the loop counter }
- end;
-
- outstr[0]:=chr(i - 1); { set the length byte }
- BuildString := outstr; { 'return' the result }
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { explore all directories on this volume. fill the record(s) SubDir[] with data for all subdirectories }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure explore;
- VAR
- DTransA : DTransA_; { data transfer record }
- Regs : registers; { standard interrupt 'union' }
- SubDirStr : string[70]; { current subdirectory string }
- dta_save : array[1..2] of integer; { DTA address }
- LowWord : word; { low word of the file size }
- HighWord : word; { high word of the file size }
- fbytes : longint; { bytes in a subdirectory }
- { ─────────────────────────────────────────────────────────────────────────── }
- begin
-
- with Regs,DTransA do
- begin
- ax := $2F00; { get DTA }
- msdos(Dos.Registers(Regs));
- dta_save[1] := es;
- dta_save[2] := bx;
- ax := $1A00; { set DTA }
- ds := seg(DTransA);
- dx := ofs(DTransA);
- msdos(Regs);
- ds := seg(pattern[1]);
- dx := ofs(pattern[1]);
- ax := $4E00; { find 1st file }
- cx := $FF;
- msdos(Regs);
-
- while (flags and carry) = 0 do { loop through everything }
- begin
- SubDirStr:= BuildString(file_name, sizeof(file_name) );
-
- if ((attribute and directory) <> 0) and (SubDirStr <> '.') and ( SubDirStr <> '..') then
- begin { -------------- if the filename has a directory attribute -------------- }
- SubDirStr := SubDirStr+chr(0); { makes the string 'extra long' }
- ax := $3B00; { CHDIR }
- ds := seg(SubDirStr[1]);
- dx := ofs(SubDirStr[1]);
- msdos(Regs); { drop down into that directory }
- inc(fir);
- inc(level);
-
- prev:=curr; { save this subdir index }
- curr:=next + 1; { bump down to the next subdir }
- SubDir[curr].Index:=prev; { save index for later }
- next:=curr;
- SubDir[curr].Level:=Level; { save tree level }
-
- if (curr > NumberDirs) then exit; { range check }
-
- SubDir[curr].Name:=SubDirStr; { setup to update the status line }
- LowWord:=GetCurDir(CurDir);
- snowwrite(ActiveCol + 2, Y1_ + 4, DIRCOLOR, addr(CurDir), 0, SCLRLEN_, SCLRLEN_);
-
- explore; { call this proc to dig down into the next subdir }
-
- ax := $3B00; { back up to parent subdir }
- SubDirStr := '..'#0;
- ds := seg(SubDirStr[1]);
- dx := ofs(SubDirStr[1]);
- msdos(Regs);
-
- LowWord:=GetCurDir(CurDir);
- if (CurDir[0] = #0) then CurDir:='ROOT';
- snowwrite(ActiveCol + 2, Y1_ + 4, DIRCOLOR, addr(CurDir), 0, SCLRLEN_, SCLRLEN_);
-
- dec(level); { we are now one level higher }
- curr:=prev; { set index to the previous subdir }
- prev:=SubDir[curr].Index
-
- end { -------------- if the filename has a directory attribute -------------- }
- else
- begin { -------------- For regular filenames -------------- }
- LowWord:= file_size[1];
- HighWord:= file_size[2];
-
- fbytes:=(HighWord * 65536) + LowWord;
-
- if (GetCurDir(CurDir) > 0) then { not root dir }
- begin
- SubDir[curr].Size:= SubDir[curr].Size + fbytes; { sum used storage }
- end
- else { root dir }
- begin
- SubDir[0].Size:= SubDir[0].Size + fbytes; { sum used storage }
- end;
-
- end; { -------------- For regular filenames -------------- }
-
- ax := $4F00; { get next file }
- msdos(Regs);
- end; { end of the WHILE loop }
-
- ax := $1A00; { reset DTA }
- ds := dta_save[1];
- dx := dta_save[2];
- msdos(Regs);
-
- end; { end of the WITH block }
-
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { setup a different heap error handler }
- { ------------------------- Begin HeapFunc --------------------------------------- }
- {$F+} function HeapFunc(Size: word): integer; {$F-}
- begin
- HeapFunc:=1;
- end;
- { ------------------------- End HeapFunc --------------------------------------- }
-
- { ------------------------- Begin AdjustCursor --------------------------------------- }
- procedure AdjustCursor;
- begin
- cursorxy(curx,cury); { move the cursor }
- end;
- { ------------------------- End AdjustCursor --------------------------------------- }
-
- { ------------------------- Begin ShowColRow --------------------------------------- }
- procedure ShowColRow;
- Var
- dstr : string[17];
- begin
- str(acty,dstr); { convert row index to string }
- snowwrite(ROW_LOC,0,CTRCOLOR,addr(dstr),0,5,5);
- str(actx,dstr); { convert column index to string }
- snowwrite(COL_LOC,0,CTRCOLOR,addr(dstr),0,5,5);
- end;
- { ------------------------- End ShowColRow --------------------------------------- }
-
- { clear the screen, write exit msg & go to DOS }
- { ------------------------- Begin ExiToDos --------------------------------------- }
- procedure ExitToDos(ret :integer; msg: string);
- begin
-
- if (ret <> VIDEOEXIT) then
- begin
- snowputc(0,0,color,32,2000); { clear the screen }
- end;
-
- cursorxy(0,0); { home the cursor }
- if (ret <> NORMALEXIT) then puts(msg); { display exit msg }
- halt(ret); { return an errorlevel code }
- end;
- { ------------------------- End ExitToDos --------------------------------------- }
-
- { this draws the help screen }
- { ------------------------- Begin Help --------------------------------------- }
- procedure help;
- VAR
- ky : integer; { dummy var for readkbd() }
- begin
- { all messages are global typed constants }
- snowputc(0,1,color,32,1760); { clear the data area }
-
- snow(0, 1, color,addr(PROGNAME)); { program Name }
- snow(0, 4, color,addr(HELP1)); { Help message #1 }
- snow(0, 6, color,addr(HELP2)); { Help message #2 }
- snow(0, 8, color,addr(HELP3)); { Help message #3 }
- snow(0, 10, color,addr(HELP4)); { Help message #4 }
- snow(0, 12, color,addr(HELP5)); { Help message #5 }
- snow(0, 14, color,addr(HELP6)); { Help message #6 }
- snow(0, 21,color,addr(HELP8)); { Help message #7 }
-
- refresh:=TRUE; { redraw screen later }
- ky:=readkbd; { pause for a scan code from kbd }
- end;
- { ------------------------- End Help --------------------------------------- }
-
- { backwards POS(). return the offset into STRING str of CHAR ch. ret -1 if not found }
- { ------------------------- Begin rpos --------------------------------------- }
- function rpos(str: string; ch: char): integer;
- Var i: integer; { loop index }
- loc: integer; { location of the find }
- begin
- i:=length(str); { string length }
- loc:=-1; { assume failure! }
-
- { ---------------------- search loop ------------------------------- }
- while (i > 0) and (loc = -1) do { loop backwards through the string }
- begin
-
- if (str[i] = ch) then { got a match }
- begin
- loc:=i; { save the index of the location }
- end;
-
- dec(i); { look one byte leftwards }
- end;
- { ---------------------- search loop ------------------------------- }
-
- rpos:=loc; { the location of the find. -1 if no find }
- end;
- { ------------------------- End rpos --------------------------------------- }
-
- { this draws the screen for the text file browser }
- { ------------------------- begin video_setup --------------------------------------- }
- procedure Video_Setup;
- Var
- vmode: integer; { current video mode }
- begin
- vmode:=getvmode; { get current video mode }
- color:=TEXTCOLOR; { set a default color }
-
- if (vmode < 2) or (vmode > 7) or (vmode = 4) or (vmode = 5) or (vmode = 6) then
- begin
- ExitToDos(VIDEOEXIT,WRONGVIDEO);
- end;
-
- if (vmode = 7) then { get the color of the screen }
- begin
- color:= integer(mem[$b000:0001]);
- end
- else
- begin
- color:= integer(mem[$b800:0001]);
- end;
-
- end;
- { ------------------------- End video_setup --------------------------------------- }
-
- { draw the main interactive screen }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure DrawScreen;
- begin
- snowputc(0,1,color,32,1760); { clear the screen }
- snow(0, 0,STATUSCOLOR,addr(STAT1)); { status message #1 }
- snowputc(0,23,STATUSCOLOR,32,20);
- snow(0,23,STATUSCOLOR,addr(STAT2)); { status message #2 }
- snowputc(29,23,CTRCOLOR,24,1); { ascii 24 up }
- snowputc(40,23,CTRCOLOR,25,1); { ascii 25 down }
- snowputc(51,23,CTRCOLOR,27,1); { ascii 27 left }
- snowputc(63,23,CTRCOLOR,26,1); { ascii 26 right }
- snowwrite(74,23,CTRCOLOR,addr(ESCSTR),0,3,3);
- snowputc(0,24,STATUSCOLOR,32,20);
- snow(0,24,STATUSCOLOR,addr(STAT3)); { status message #3 }
- snowwrite(31,24,CTRCOLOR,addr(F1STR),0,2,2);
- snowwrite(47,24,CTRCOLOR,addr(F2STR),0,2,2);
- snowwrite(67,24,CTRCOLOR,addr(F9STR),0,2,2);
- cursorxy(0,1); { home the cursor }
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { this initializes a filename variable }
- { ------------------------- begin Set_Filename --------------------------------------- }
- function Set_Filename(VAR ifname: STRING128): integer;
- Var
- dotloc : integer; { location of the dot in the filename }
- retv : integer; { bool: TRUE if there was a cmd line param, else FALSE }
- tempstr: STRING128; { generic temp string }
- begin
-
- retv:=0;
-
- if (paramcount > 0) then { if there were cmd line params }
- begin
- tempstr:=paramstr(1); { fetch com line parameter #1 }
-
- if (tempstr[1] = '-') and (tempstr[2] = 'f') then { test for '-f<name>' syntax }
- begin
- retv:=length(tempstr) - 2; { string length less one }
- tempstr:=copy(tempstr,3,retv); { reset string without the '-f' prefix }
-
- if (length(tempstr) > 0) then { if the string is still valid }
- begin
- retv:=1; { we will run in browse mode }
- ifname:=tempstr; { set name of file to browse }
- end;
-
- end;
- end;
-
- Set_Filename:=retv;
- end;
- { ------------------------- End Set_Filename --------------------------------------- }
-
- { this reads the file from disk into global variable: buffer[] }
- { ------------------------- Begin Read_File --------------------------------------- }
- function Read_File(ifname: string): integer;
- Var
- inf : text; { file pointer }
- strg : string; { scaler string var }
- line : integer; { line index }
- len : integer; { line length }
- linestr : string[20]; { str to show current line # }
- begin
- line:= 0; { zero line counter }
-
- assign(inf,ifname);
- {$I-} reset(inf); {$I+}
- if (IOResult <> 0) then ExitToDos(ERROREXIT,NOFILE); { no file. exit }
- snowwrite(24,12,color,addr(LINEPR),0,15,15); { status msg }
-
- { ------- write the root of the filename on the CRT ------ }
- if (length(ifname) < 19) then
- begin
- snowwrite(0,23,STATUSCOLOR,addr(ifname),0,19,19); { write the filename on the screen }
- end
- else { a complex filename is being processed }
- begin
- len:=rpos(ifname,'\'); { get offset into string of '\' }
- linestr:=copy(ifname, len + 1, 19); { copy just the root into linestr }
- snowwrite(0,23,STATUSCOLOR,addr(linestr),0,19,19); { write the filename on the screen }
- end;
-
- { ---- Read lines from file Loop ---- }
- while NOT EOF(inf) and (line < NUMBLINES) and (MaxAvail > 1024) do
- begin
- {$I-}
- readln(inf,strg); { read a line from the file }
- {$I+}
-
- if (IOResult <> 0) then { read error }
- begin
- close(inf);
- ExitToDos(ERROREXIT,READERROR); { Read error. exit }
- end;
-
- len:=length(strg) + 1; { get line length }
- getmem(buffer[line], len); { get heap RAM for the array line }
-
- if (buffer[line] = NIL) then { if getmem() failed }
- begin
- close(inf);
- ExitToDos(ERROREXIT,RAMERROR);
- end;
-
- move(strg,buffer[line]^,len); { copy the scaler string to the array }
-
- if ( (line mod 64) = 0) then { every 64 lines update count on the CRT }
- begin
- str(line,linestr); { convert line index to string }
- snowwrite(40,12,color,addr(linestr),0,6,6);
- end;
-
- inc(line); { inc the line counter }
- end; { while end }
-
- close(inf);
-
- { strg:=' '; reinit to a known state }
-
- { ----------- padd lines for very short text files ---------------- }
- while (line <= PAGESIZE) do
- begin
- getmem(buffer[line], 3); { get heap RAM for the ' ' empty array lines }
- move(strg,buffer[line]^,3); { copy the scaler string to the array }
- inc(line); { inc the line counter }
- end;
- { ----------- padd lines for very short text files ---------------- }
-
- snowputc(0,10,color,32,240); { clear out the counter area of the CRT }
-
- Read_File:=line - 1; { ret the #of lines read }
- end;
- { ------------------------- End Read_File --------------------------------------- }
-
- { this displays the text data on the CRT }
- { ------------------------- Begin Write_Data --------------------------------------- }
- procedure Write_Data(star, left, find: integer);
- Var
- starstr: string[34]; { counter display string }
- line : integer; { data buffer index }
- row : integer; { CRT row index }
- lstop : integer; { loop stop point }
- tcolor : integer; { color to write the text }
- begin
- { note: buffer[] is a global variable }
-
- ShowColRow; { display active row & column indices }
- str(left,starstr); { left edge column }
- snowwrite(48,0,CTRCOLOR,addr(starstr),0,3,3);
- str(left + 79,starstr); { Right edge column }
- snowwrite(66,0,CTRCOLOR,addr(starstr),0,3,3);
- row:=1; { first line to write text to }
- lstop:=star + PAGESIZE; { set loop stop point }
-
- for line:=star to lstop do
- begin
-
- if (find > -1) and (line = find) then tcolor:=FINDCOLOR { select correct color }
- else tcolor:=color;
-
- if (line <= max) then snowwrite(0,row,tcolor,addr(buffer[line]^),left,80,80); { write the text to the CRT }
- inc(row); { next CRT row }
- end;
-
- end;
- { ------------------------- End Write_Data --------------------------------------- }
-
- { this writes the file to disk from the global variable: buffer[] }
- { ------------------------- Begin Write_File --------------------------------------- }
- procedure Write_File(ifname: string);
- Var
- inf : text; { file pointer }
- line : integer; { line index }
- len : integer; { length of text line }
- strg : string; { scaler string var }
- key : char;
- begin
- line:= 0; { zero line counter }
- assign(inf,ifname);
-
- {$I-} rewrite(inf); {$I+}
- if (IOResult <> 0) then ExitToDos(ERROREXIT,OPENERROR); { open() err. exit }
-
- { ---- Write lines to file Loop ---- }
- while (line <= max) do
- begin
- len:=length(buffer[line]^) + 1; { get number of bytes to copy }
- move(buffer[line]^,strg,len); { copy a line to the scaler string }
-
- {$I-}
- writeln(inf, strg ); { write a line to the file }
- {$I+}
-
- if (IOResult <> 0) then { write error }
- begin
- close(inf);
- ExitToDos(ERROREXIT,WRITEERROR); { write error. exit }
- end;
-
- inc(line); { inc the line counter }
- end; { while end }
-
- close(inf);
-
- end;
- { ------------------------- End Write_File --------------------------------------- }
-
- { this does the string search. (case sensitive) }
- { ------------------------- Begin Search --------------------------------------- }
- function search(start, max : integer; sstr: string) : integer;
- VAR
- i : integer; { loop index }
- ok: byte; { position of the substring }
- begin
- { note: buffer[] is a global variable }
-
- ok:=0; { assume failure }
- i:=start; { loop start point }
-
- { search through the buffer for the string }
- while (ok = 0) and (i <= max) do
- begin
- ok:=pos(sstr, buffer[i]^); { search the text line }
- inc(i); { point to the next text line }
- end;
-
- if (i <= (max + 1) ) and (ok > 0) then
- begin
- search:=i - 1; { return line of the find }
- end
- else
- begin
- search:=-1; { no find }
- end;
-
- end;
- { ------------------------- End Search --------------------------------------- }
-
- { prompt user for string to search, then do the search }
- { ------------------------- Begin String_Search --------------------------------------- }
- function String_Search(key: integer; VAR refresh: boolean; VAR star: integer): integer;
- Var
- off_set : integer; { offset in start of string search }
- len : integer; { line length }
- lfind : integer; { line of the search find }
- searchstr : SEARCH_TYPE; { ascii search string }
- begin
- { linestr is a global variable }
-
- if (key <> _F8) then
- begin
- cursorxy(6,24); { home the cursor }
- snowwrite(0,24,STATUSCOLOR,addr(SPROMPT),0,20,20); { write prompt }
- searchstr[0]:=#14; { max numb bytes of input }
- len:=cgets(searchstr); { get string from the user }
- AdjustCursor;
- linestr:=copy(searchstr,2,len); { copy the useful data to another string }
- off_set:=0; { start search on the current line }
- end
- else
- begin
- off_set:=1; { start search on line below current one }
- end;
-
- snowwrite(0,24,BLINKCOLOR,addr(SEARCHING),0,20,20); { searching msg }
- len:=search(star + off_set,max,linestr);
-
- if (len > -1) then { if string was found }
- begin
- refresh:=TRUE; { set to refresh the data on the CRT }
- star:=len; { first line to display }
- lfind:=len; { line of the find }
- if (lfind < 0) then lfind:=0; { range check find }
- if (star > (max - PAGESIZE)) then star:=max - PAGESIZE; { last page case for starting line }
- end
- else
- begin
- lfind:=-1; { no string was found }
- end;
-
- snowputc(0,24,STATUSCOLOR,32,20);
- snow(20,24,STATUSCOLOR,addr(STAT3)); { status message #3 }
-
- String_Search:=lfind; { return the line number of the search find }
- end;
- { ------------------------- End String_Search --------------------------------------- }
-
- { ------------------------- Begin Init_Globals --------------------------------------- }
- procedure Init_Globals;
- begin
- HeapError:=@HeapFunc; { set up our own getmem() error handler }
- find:=-1; { no find yet }
-
- ASM { doing this in ASM saves 4 bytes per VAR }
- mov ax,1 { init a register to 1 }
- mov word ptr cury,ax { cursor row }
- mov word ptr actx,ax { column being edited }
- xor ax,ax { zero a register }
- mov word ptr curx,ax { cursor column }
- mov word ptr acty,ax { row being edited }
- mov word ptr left,ax { initial left edge is zero }
- mov word ptr star,ax { start at first line }
- mov word ptr key,ax { init scan code to zero }
- mov byte ptr refresh,al { no refresh yet }
- end;
-
- end;
- { ------------------------- End Init_Globals --------------------------------------- }
-
- { ─────────────────────────────────────────────────────────────────────────── }
- Procedure TreeDirScreen;
- VAR
- y: integer;
- begin
- snowputc(0,0,color,32,2000); { clear the screen }
-
- snowputc(X1_ + 1, Y1_, color, 196, 78);
- snowputc(X1_ + 1, Y1_ + 3, color, 196, 78);
- snowputc(X1_ + 1, Y2_, color, 196, 78);
-
- for y:=Y1_ + 1 to Y2_ - 1 do
- begin
- snowputc(X1_, y, color, 179, 1);
- snowputc(X2_, y, color, 179, 1);
- end;
-
- snowputc(X1_, Y1_, color, 218, 1);
- snowputc(X1_, Y1_ + 3, color, 195, 1);
- snowputc(X1_, Y2_, color, 192, 1);
-
- snowputc(X2_, Y1_, color, 191, 1);
- snowputc(X2_, Y1_ + 3, color, 180, 1);
- snowputc(X2_, Y2_, color, 217, 1);
-
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { Fill the buffers with Tree Directory Data }
- { ─────────────────────────────────────────────────────────────────────────── }
- function TreeDir: integer;
- VAR
- linectr: integer; { count of lines going into the buffers }
- stlen : integer; { length of a line going into the buffers }
- DrvStr : STRING128; { string to hold the disk drive string }
- begin
- init; { initialize global data }
- VideoInit; { initialize the video }
- linectr:=0; { zero the buffer index }
-
- snowwrite(X1_ + 2, Y1_ + 1, color, addr(PROGNAME), 0, XWIDE_, XWIDE_);
- snowwrite(X1_ + 2, Y1_ + 2, color, addr(PROGBY), 0, XWIDE_, XWIDE_);
- snowwrite(X1_ + 2, Y1_ + 4, color, addr(PROMPT1), 0, XWIDE_, XWIDE_);
- snowputc(ActiveCol + 1, Y1_ + 4, color - 1, ord('\'), 1);
-
- getdir(0,OldDir); { save the current directory }
-
- if (SysMode = TREEDIRMODE) and (paramcount > 0) then { if there was a parameter string }
- begin
- DrvStr:=paramstr(1);
-
- if ( DrvStr[2] = ':') then { the expected value }
- begin
- DrvStr[0]:=#2; { force length to 2 bytes }
- GlobalDrvStr:=DrvStr; { copy to the global var }
- end
- else { unexpected value }
- begin
- DrvStr[0]:=#0; { force length to NO bytes }
- GlobalDrvStr[0]:=#0; { make it a nil string }
- end;
-
- if (DrvStr[0] = #2) then chdir( DrvStr ); { change to the specifed directory }
- end;
-
- chdir('\'); { switch to the root directory }
-
- SetCurType($3800); { off the cursor }
- explore; { explore all directories on the current volume }
- SetCurType(curtype); { restore the cursor }
-
- chdir(OldDir); { restore the old directory }
- maxsize:=0;
-
- ASM
- xor ax,ax { zero a register }
- mov word ptr prev,ax { zero out: prev }
- mov word ptr maxlevel,ax { zero out: maxlevel }
- mov word ptr maxlen,ax { zero out: maxlen }
- end;
-
- for fir:=0 to next do { find max level and name length }
- begin
- if (SubDir[fir].Level > maxlevel) then maxlevel:=SubDir[fir].Level;
- if (length(SubDir[fir].Name) > maxlen) then maxlen:=length(SubDir[fir].Name);
- if (SubDir[fir].Size > maxsize) then maxsize:=SubDir[fir].Size;
- end;
-
- maxsize:=maxsize div 1024;
- str(maxsize, pattern); { int to string }
- NumbPad:=length(pattern) + 1; { length of the largest number string }
-
- stlen:=length(PROMPT2) + 1; { get line length }
- getmem(buffer[linectr], stlen); { get heap RAM for the array line }
- move(PROMPT2,buffer[linectr]^,stlen); { copy the scaler string to the array }
- Inc(linectr); { add to count of lines in the buffer }
-
- fillchar(clrstr[1],29,#196); { make a divider bar }
- clrstr[0]:=#28;
- stlen:=29; { get line length }
- getmem(buffer[linectr], stlen); { get heap RAM for the array line }
- move(clrstr,buffer[linectr]^,stlen); { copy the scaler string to the array }
- Inc(linectr); { add to count of lines in the buffer }
-
- for fir:=0 to next do { loop through the whole list }
- begin
- ostr[0]:=#0;
- filestorage:= SubDir[fir].Size div 1024; { bytes to KiloBytes }
- padstr(SubDir[fir].Level * 2, ostr); { init string to 'level' spaces Times 2 }
- sdir:=SubDir[fir].Name; { copy name to a scaler }
- by:=byte(sdir[0]); { adjust for trailing }
- sdir[0]:=chr(by - 1); { nulls }
- ostr:= ostr + '\' + sdir; { add the filename }
-
- str(filestorage,pattern); { int to string }
- CurNumbLen:=length(pattern); { length of the current number string }
-
- padlen:= (maxlen + (2 * maxlevel)) - length(ostr); { calc pad length }
- padlen:=padlen + (NumbPad - CurNumbLen); { to right justify the numbers }
-
- padstr(padlen,spstr); { build a pad string }
- ostr:=ostr + spstr; { add the pad string }
-
- ostr:=ostr + pattern; { add number string }
-
- stlen:=length(ostr) + 1; { get line length }
- getmem(buffer[linectr], stlen); { get heap RAM for the array line }
-
- if (buffer[linectr] = NIL) then { if getmem() failed }
- begin
- ExitToDos(ERROREXIT,RAMERROR);
- end;
-
- move(ostr,buffer[linectr]^,stlen); { copy the scaler string to the array }
-
- Inc(linectr); { add to count of lines in the buffer }
- end; { loop end }
-
- TreeDir:=linectr - 1; { return the number of lines put in the buffers }
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { crude String Copy: just copy until a space char is found in the source string }
- { ─────────────────────────────────────────────────────────────────────────── }
- Procedure CopyTilSpace(VAR Dest, Sou : STRING128; Fir, Max : integer );
- VAR
- idx, kdx : integer; { string index }
- begin
- idx:=1;
- kdx:=Fir;
-
- while ( Sou[kdx] > ' ') and (idx <= Max) do
- begin
- Dest[idx]:=Sou[kdx];
- inc(idx);
- inc(kdx);
- end;
-
- Dest[0]:=chr(idx - 1);
- end;
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { build a pascal string of the selected dir. it's harder than you might think! }
- { ─────────────────────────────────────────────────────────────────────────── }
- procedure GetSelectedDir( idx : integer; VAR SelDir : STRING128 );
- VAR
- Subs : array[1..5] of STRING128; { array of subdir level strings }
- Loc : integer; { index of '\' }
- Level : integer; { depth in tree }
- NewLoc : integer; { new location of '\' }
- begin
- Level:=1; { start subdir index }
- Subs[1]:=#0; Subs[2]:=#0; Subs[3]:=#0; Subs[4]:=#0; Subs[5]:=#0;
- SelDir[0]:=#0; { init to indicate failure }
- Loc:=pos('\', buffer[idx]^ ); { get index of '\' }
- if ( Loc > 15 ) or (Loc < 3) then exit; { limit checking }
-
- while ( Loc > 3 ) do { loop 'leftward' }
- begin
- CopyTilSpace( Subs[Level], buffer[idx]^, Loc, 12 ); { copy the dir name }
- inc(Level); { bump subdir array index }
- NewLoc:=Loc; { copy location index }
-
- while (NewLoc >= Loc) do { loop while no difference }
- begin
- dec(idx); { search previous subdir }
- NewLoc:=pos('\', buffer[idx]^ ); { get index of '\' }
- end;
- Loc:=Loc - 2; { now go left two bytes }
- end;
-
- if (Loc = 3) then { now at level 1 subdir }
- begin
- CopyTilSpace( SelDir, buffer[idx]^ , 3, 12 ); { copy level 1 name }
- dec(Level); { adjust index to last USED }
-
- while (Level >= 1) do { loop to concatenate }
- begin
- SelDir:=SelDir + Subs[Level]; { the subdir names }
- dec(Level); { into one string }
- end;
- end;
-
- end; { end proc }
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { recalc bytes used in the subdir that was just processed by CO.COM }
- { ─────────────────────────────────────────────────────────────────────────── }
- Procedure UpdateDirLine( VAR DirLine : STRING128 );
- VAR
- DirInfo : SearchRec; { record for DIR search code }
- ByteSum : longint; { storage in the DIR }
- KStr : string[34]; { new size KBytes in string }
- idx, kdx : integer; { string indices }
- begin
- ByteSum:=0;
- FindFirst( '*.*', AnyFile, DirInfo ); { start the DIR *.* }
-
- while ( DosError = 0 ) do { loop til no more files }
- begin
- ByteSum:=ByteSum + DirInfo.Size; { add this one's size }
- FindNext( DirInfo ); { next file }
- end;
-
- ByteSum:=ByteSum DIV 1024; { convert to KBytes }
- str( ByteSum, KStr ); { convert to string }
- idx:=length( DirLine ); { current line length }
-
- while ( DirLine[idx] > ' ' ) AND ( idx > 0 ) do { loop to space out the old number }
- begin
- DirLine[idx]:=' '; { make a space char }
- dec( idx ); { next left }
- end;
-
- idx:=length( KStr ); { current size length }
- kdx:=length( DirLine ); { current line length };
-
- while (idx > 0) do { loop leftwards }
- begin
- DirLine[kdx]:=KStr[idx]; { copy from end of new number to dirline }
- dec( idx ); { dec both indices }
- dec( kdx );
- end;
- end; { end proc }
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { call CO.COM to work on the selected DIR }
- { ─────────────────────────────────────────────────────────────────────────── }
- Procedure ExecFileManager( acty : integer );
- VAR
- SelDir : STRING128; { buffer for selected DIR }
- OldDir : STRING128; { save of current DIR }
- curloc : array[1..2] of integer; { cursor save buffers }
- ErrStr : STRING128; { error string }
- FullDir : STRING128;
- begin
- GetSelectedDir( acty, SelDir ); { build a pascal string of the selected dir }
-
- if ( SelDir[0] > #0) then { if a valid dir name was generated }
- begin
-
- if ( GlobalDrvStr[0] = #2 ) then { A drive was specified }
- begin
- FullDir:=SelDir;
- SelDir:=GlobalDrvStr;
- SelDir:=SelDir + FullDir;
- end;
-
- getdir( 0, OldDir); { save the current directory }
- chdir( SelDir ); { change to new DIR }
- exec( FileManager, ''); { call CO.COM }
-
- if (DosError <> 0) then { if there was an exec() error }
- begin
- ErrStr:='EXEC() Error:'; { root of error string }
- snowwrite(0,1,CTRCOLOR,addr(ErrStr),0,80,80); { where is sprintf() ??? }
- str( DosError, ErrStr); { convert error code to string }
- snowwrite(14,1,CTRCOLOR,addr(ErrStr),0,63,63); { write rest of error string }
- raw:=getscode; { pause }
- end;
-
- UpdateDirLine( buffer[acty]^ ); { recalc bytes used in the subdir }
- chdir( OldDir ); { restore the current directory }
- curloc[1]:=cury; { save cursor position }
- curloc[2]:=curx;
- DrawScreen; { draw the main screen }
- cury:=curloc[1]; { restore cursor position }
- curx:=curloc[2];
- AdjustCursor; { reset the cursor location }
- refresh:=TRUE; { redisplay the DIR List }
- end; { end valid DIR string if block }
- end; { end proc }
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { Exit into the selected DIR }
- { ─────────────────────────────────────────────────────────────────────────── }
- Procedure ExitToSelect( acty : integer );
- VAR
- SelDir : STRING128;
- ExitMsg : STRING128;
- FullDir : STRING128;
- begin
- GetSelectedDir( acty, SelDir ); { build a pascal string of the selected dir }
-
- if ( SelDir[0] > #0) then
- begin
-
- if ( GlobalDrvStr[0] = #0 ) then { no drive was specified }
- begin
- chdir( SelDir );
- end
- else { a cmd line drive was specified. use it! }
- begin
- FullDir:=GlobalDrvStr;
- FullDir:=FullDir + SelDir;
- chdir( FullDir );
- SelDir:=FullDir;
- end;
-
- ExitMsg:='Changed to Subdirectory: ' + SelDir;
- ExitToDos( CHANGEDEXIT, ExitMsg );
- end;
- end; { end proc }
- { ─────────────────────────────────────────────────────────────────────────── }
-
- { ------------------------- Begin Main (ie: main loop proc) ------------------ }
- begin
- Init_Globals; { initialize global variables }
- Video_Setup; { set screen mode }
-
- left:=Set_Filename(iname); { initialize the filename variable (iname) }
-
- if (left > 0) then { if there was a cmd line parameter, assume it was a filename, the load it }
- begin
- DrawScreen; { draw the main screen }
- max:=Read_File(iname); { read the file from disk into buffer[] }
- SysMode:=FILEMODE; { running as a text file browser }
- end
- else
- begin
- SysMode:=TREEDIRMODE;
- TreeDirScreen; { draw box on the screen }
- max:=TreeDir; { call the Tree Directory Code. put report in the buffer }
- left:=0; { reset left ctr to zero }
- DrawScreen; { draw the main screen }
- end;
-
- Write_Data(0, 0, -1); { write data to the CRT }
- PutAttr(0, 1, BARCOLOR, 80);
-
- { ------------------------------ Main Loop --------------------------------- }
- while (key <> _ESC) AND (key <> _X) do { loop till the Esc key is pressed }
- begin
- raw:=getscode; { get current key codes }
- key:=hi(raw); { extract the scan key code }
- asc:=byte(raw); { extract the ascii key code }
-
- { -------------------------- Case Block ---------------------------- }
- case (key) of { begin case }
- _PGUP: { PageUp key }
- begin
- star:=star - PAGESIZE;
- acty:=acty - PAGESIZE;
-
- if (star < 0) then
- begin
- star:=0;
- acty:=0;
- cury:=1;
- AdjustCursor;
- end;
-
- refresh:=TRUE;
- ShowColRow;
- end;
- _PGDN: { PageDown key }
- begin
- star:=star + PAGESIZE;
- acty:=acty + PAGESIZE;
-
- if ( (star + PAGESIZE) > max) then
- begin
- star:=max - PAGESIZE;
- acty:=max;
- cury:=22;
- AdjustCursor;
- end;
-
- refresh:=TRUE;
- ShowColRow;
- end;
- _UPAR: { UpArrow key }
- begin
-
- if (cury > 1) then
- begin
- PutAttr(0, cury, color, 80);
- dec(cury);
- AdjustCursor;
- PutAttr(0, cury, BARCOLOR, 80);
- end
- else if (cury = 1) then
- begin
-
- if (star > 0) then
- begin
- dec(star);
- refresh:=TRUE;
- end;
-
- end;
-
- if (acty > 0) then
- begin
- dec(acty);
- ShowColRow;
- end;
-
- end;
- _DNAR: { Down Arrow key }
- begin
-
- if (cury < 22) then
- begin
- PutAttr(0, cury, color, 80);
- inc(cury);
- AdjustCursor;
- PutAttr(0, cury, BARCOLOR, 80);
- end
- else if (cury = 22) then
- begin
-
- if ( (star + PAGESIZE) < max) then
- begin
- inc(star);
- refresh:=TRUE;
- end;
-
- end;
-
- if (acty < max) then
- begin
- inc(acty);
- ShowColRow;
- end;
-
- end;
- _RIAR: { right arrow key }
- begin
-
- if (curx < 79) then
- begin
- inc(curx);
- end
- else
- begin
- inc(left);
- refresh:=TRUE;
-
- if (left > LEFTMAX) then
- begin
- left:=0;
- curx:=0;
- actx:=0;
- end;
-
- end;
-
- AdjustCursor;
- inc(actx);
- ShowColRow;
- end;
- _LEAR: { left arrow key }
- begin
-
- if (curx = 0) and (left > 0) then
- begin
- dec(left);
- refresh:=TRUE;
- end
- else if (curx < 80) then
- begin
-
- if (curx > 0) then
- begin
- dec(curx);
- AdjustCursor;
- end;
-
- end;
-
- dec(actx);
- if (actx < 1) then actx:=1;
- ShowColRow;
- end;
- _END: { End Key }
- begin
- actx:=length(buffer[acty]^) + 1;
-
- if (actx < 81) then
- begin
- left:=0;
- curx:=actx - 1;
- end
- else
- begin
- left:=actx - 80;
- curx:=79;
- end;
-
- ShowColRow;
- AdjustCursor;
- refresh:=TRUE;
- end;
- _HOME: { Home key }
- begin
- curx:=0;
- actx:=1;
- left:=0;
- ShowColRow;
- AdjustCursor;
- refresh:=TRUE;
- end;
- _CTRL_PGUP: { Ctrl PageUp key }
- begin
-
- ASM { save 28 bytes by doing assignments in ASM }
- xor ax,ax
- mov word ptr star,ax
- mov word ptr acty,ax
- mov word ptr left,ax
- mov word ptr curx,ax
- mov al,01h
- mov word ptr cury,ax
- mov word ptr actx,ax
- mov byte ptr refresh,al
- end;
-
- ShowColRow;
- AdjustCursor;
- end;
- _CTRL_PGDN : { Ctrl PageDown key }
- begin
-
- if (max >= PAGESIZE) then
- begin
- star:=max - PAGESIZE;
- end
- else
- begin
- star:=0;
- end;
-
- refresh:=TRUE;
- acty:=max;
- ShowColRow;
- cury:=22;
- AdjustCursor;
- end;
- _F9,_F8 : { string search keys }
- begin
- find:=String_Search(key, refresh, star); { Ascii String Search }
- end;
- _F1: { 'h' key HELP Screen }
- begin
- help; { show help screen }
- end;
- _F2: { save file key }
- begin
- if (SysMode = TREEDIRMODE) then Write_File('treedir.tmp');
- end;
- _F3: { print file key }
- begin
- Write_File('LPT1');
- end;
- _F4: { call CO.COM to work on the selected DIR }
- begin
- if (SysMode = TREEDIRMODE) then ExecFileManager( acty );
- end;
- _RET: { Exit into the selected DIR }
- begin
- if (SysMode = TREEDIRMODE) then ExitToSelect( acty );
- end;
-
- end; { end case }
- { -------------------------- Case Block ---------------------------- }
-
- if (refresh) then { if time to update CRT data }
- begin
- refresh:=FALSE; { toggle to avoid doing too much CRT stuff }
- Write_Data(star, left, find); { write data to the CRT }
- PutAttr(0, cury, BARCOLOR, 80);
- end;
-
- end; { end while loop }
- { ------------------------------ Main Loop --------------------------------- }
-
- ExitToDos(NORMALEXIT,NORMAL);
- end.
- { ------------------------- End Main --------------------------------------- }
-
-