maclab@reed.UUCP (Mac Development Lab) (09/19/85)
Below is the source for RasNIX, a desk accessory posted to Net.Sources.Mac.
See also, RasNIX.doc, another Net.Sources.Mac posting, which contains
documentation for the accessory.
Scott Gillespie
Reed College
...!tektronix!reed!maclab
----------------------------
program RasNIX;
(* V.85.09.18.spg *)
(*
RasNIX.
by Scott Gillespie
Reed College
Portland, OR 97202
UUCP: { decvax, ihnp4, ucbvax, ... }!tektronix!reed!maclab
This source is hereby in the public domain. Modification and
distribution are ENcouraged.
Written with
The Rascal Development System (from Reed College).
Distributor:
Metaresearch, Inc.
1100 SE WoodWard
Portland, OR 97202
(503) 232-1712
NOTE:
This program was created using an experimental version of the Rascal
Development system. Users of the current development system will note
many features that are not yet available: all of the features used
here (and more!) will of course be available in the next official Rascal
release. RasNIX source (including any modifications made between now
and then) will be included with the next release.
*** This source will not compile with the current (A+) release of Rascal.
RasNIX is a tiny, very-pseudo-UNIX emulator. See accompanying file
'RasNIX.doc' for details of operation. Or, look at procedure 'help().'
Once the Rascal Compiler and Linker are through with this program,
an object file (RasNIX.obj) will have been created. Due to
Rascal's structure, several options are available to the
programmer at this point:
1) RasNIX.obj may be executed, immediately, WITHIN the
development enviroment.
2) A Rascal utility program (MakeAppl) can take RasNIX.obj
as input, and create a stand-alone, double-clickable
application.
3) Another Rascal utility program (DeskMaker) can take
RasNIX.obj as input, and create a RasNIX Desk Accessory.
Not all Rascal .obj files may be made into desk accessories,
but if care is taken at the source level, a given
Rascal program will be desk-accessory-able.
*)
Uses
(*$U+*) (* Pull in type definitions from these libraries *)
uOSIntf, (* Operating system type definitions *)
uPackIntf, (* Package Manager type definitions *)
uToolIntf,
(*$U-*) (* Just pull in proc/func definitions *)
__QuickTraps, (* QuickDraw Procedure/Function Traps *)
__ToolTraps, (* Toolbox Procedure/Function Traps *)
__Memory, (* Memory Manager Procedure/Function Calls *)
__PBFile ; (* File Manager Param Block calls *)
LINK (* This is the Link directive -- no job-control file is needed
This is also a smart link, so all unneeded routines will
be thrown out. Smart-Linking is optional (a dumb-link
is a bit faster, plus it uses less memory) *)
__NoSysCall, (* Rascal provides a number of run-time
system calls. In order to make
RasNIX desk-accesory compatible, we
Link a library which contains ToolBox-
only versions of these Routines *)
__Memory,
__PBFile,
__Extras :; (* The ':;' (colon semi-colon) tells the Linker
to give the output file the default name
(RasNIX.obj) *)
Type
Operand = Byte[82];
(* For sorting file names *)
IndexList = Integer[5000];
IndexHand = ^^IndexList;
LongList = Longint[5000];
LongHand = ^^LongList;
var
cstr: Str255; (* Command String *)
comm,oper1,oper2,oper3: Operand;
width: integer; (* Screen width *)
wd: integer; (* Working directory -- 0 -> Home *)
sepchar: integer; (* character that separates command
and operand *)
numfiles: integer;
strlist: LongHand;
indlist: IndexHand;
myrect: Rect;
param: ParamBlockRec;
bfname: Operand; (* Place to stick filenames *)
(* --------Number Writing Call-------------*)
(* Had to rewrite this library call so as not to use Rascal Syscalls *)
PROCEDURE writelong(long: longint);
var str: block[18];
i,j: byte;
{
numtostring(long,str);
i:= 11-str[0];
loop(i>0,j:=1,,++j>i) DrawChar(' ');
DrawString(str);
};
(* ---------All of my file calls------------*)
Function ejectable(vref:integer): Boolean;
(* Bogus check for drivenum -- if 1 or 2 or 0, then o.k. to eject *)
Const
VCBHeader = $356;
var
VCBp : ^VCB;
{
ejectable := false;
loop(vref<0,VCBp:=ptrl(VCBHeader+2),
VCBp:=VCBp^.qlink,(VCBp=0) or (VCBp^.vcbvrefnum=vref));
if (vref>=0) or !VCBp
Then { Sysbeep(1); return };
vref := VCBp^.VCBDrvNum;
if vref<3 Then
ejectable := True
else
sysbeep(1);
};
PROCEDURE unmount(vref: integer; err: ^OSErr);
{
Param.IONamePtr := Nil;
Param.IOVRefNum := vref;
err^ := PBUnmountVol(Param)
};
PROCEDURE ejectv(vref: integer; err: ^OSErr);
{
Param.IONamePtr := Nil;
Param.IOVRefNum := vref;
err^ := PBEject(Param)
};
procedure delete(name: StringPtr; vref: integer; err: ^OSErr);
{
Param.IONamePtr := name;
Param.IOVRefNum := vref;
Param.IOVersNum := 0;
err^ := PBDelete(Param);
};
PROCEDURE getvinfo(ind,vol: integer; pname: ptrL; err: ^OSErr);
{
Param.IONamePtr := @bfname;
Param.IOVRefNum := vol;
Param.IOVolIndex := ind;
err^ := PBGetVInfo(Param);
pname^:= bfname;
};
PROCEDURE getfinfo(ind,vref: integer; name: StringPtr; err: ^OSErr);
{
Param.IONamePtr := name;
Param.IOVRefNum := vref;
Param.IOFDirIndex := ind;
Param.IOVersNum := 0;
err^ := PBGetFInfo(Param);
};
PROCEDURE flushvol(v: integer; name: StringPtr; err: ^OSErr);
{
Param.IONamePtr := name;
Param.IOVRefNum := v ;
err^ := PBFlushVol(Param);
};
PROCEDURE getindname(ind,vref: integer; pname: ^StringPtr; err: ^OSErr);
{
getfinfo(ind,vref,bfname,err);
pname^ := bfname;
};
PROCEDURE getfsize(file:ptrb; vref: integer; size:ptrL; err: ^OSErr);
{
getfinfo(0,vref,file,err);
size^ := Param.IOFlLgLen + Param.IOFlRLgLen;
};
PROCEDURE getnumfiles(vol: integer; num: ^Integer);
var
err: OSErr;
{
getvinfo(0,vol,Nil,@err);
num^ := Param.IOVNmFls;
};
Function getvsize(vol: integer): Longint;
var
err: OSErr;
{
getvinfo(0,vol,Nil,@err);
getvsize := (Param.IOVNmAlBlks - Param.IOVFrBlk) * Param.IOVAlBlkSiz;
};
(* ----------Screen Handling Calls-----------*)
procedure Erase();
var p: Point;
{
getpen(@p);
SetRect(myrect,p.h,p.v-9,p.h+6,p.v+3);
EraseRect(myrect);
};
procedure curs();
{ penmode(PatXor); Move(-1,2); Line(8,0); Move(-7,-2); penmode(PatCopy) };
procedure home();
{
cstr[0]:=0;
moveto(18,15);
SetRect(myrect,18,0,700,33);
EraseRect(myrect);
SetRect(myrect,0,17,700,35);
EraseRect(myrect);
curs()
};
procedure clearsc();
{ moveto(6,55); setrect(myrect,0,37,700,700); EraseRect(myrect)};
Function pipewrite(line: StringPtr; ind: integer): Boolean;
(* This routine handles writes to the screen -- up to 19 lines
can be displayed on a single RasNIX screen *)
var c,mods: integer;
{
c := 0;
if (ind%19 = 0) then {
writeln();
writeln();
textface(Bold+Italic);
drawstring("More?");
textface(Plain);
readchar(@c,@mods);
if ((c<>'n')and(c<>'N')and(c<>3)) then clearsc();
};
if ((c='n')or(c='N')or(c=3)) then
pipewrite := True
else {
writeln();
drawstring(line);
pipewrite := False;
};
};
(* ----------Parsing Calls -- Very Ugly...-----------*)
procedure leading(l:byte;pi:ptrb;sep:integer);
var i,j: byte;
{
i := pi^;
loop(cstr[i]=sep,,++i,(cstr[i]<>sep)or(i>l));
pi^ := i;
};
procedure getoper(l:byte;pi,dest:ptrb;sep:integer);
var i,j: byte;
{
loop(,i:=pi^,,) {
loop(cstr[i]=sep,,++i,(cstr[i]<>sep)or(i>l)); if (i>l) then break;
loop(,j:=1,++j;++i,(cstr[i]=sep)or(i>l)or(j>80)) dest[j]:=cstr[i];
dest[0]:=j-1; if (i>l) then break;
loop((j>80)and(cstr[i]<>sep),,++i,(cstr[i]=sep)or(i>l));
break;
};
pi^:=i;
};
Function checkdot(str: ptrb): integer;
{
if (oper1[0]=1) and (oper1[1]='.') then
checkdot := 1
else
checkdot := 0;
};
Procedure convertdot(str: ptrb);
(* Convert '.' to working directory name *)
var namep : StringPtr;
err: OSErr;
{
if (oper1[0]=1) and (oper1[1]='.') then {
getvinfo(-1,wd,@namep,@err);
if err=0 then
copystr(namep,oper1)
else
copystr("",oper1);
};
};
procedure parse(); (* Originally Written to handle multiple operands,
this procedure now only divides the command line
into two words *)
var l,i,j: byte;
{
i:=1;l:=cstr[0];
comm[0]:=0;oper1[0]:=0;oper2[0]:=0;oper3[0]:=0;
if l<0 then return;
leading(l,@i,' '); if (i>l) then return;
getoper(l,@i,comm,sepchar); if (i>l) then return;
leading(l,@i,sepchar); if (i>l) then return;
getoper(l,@i,oper1,256); if (i>l) then return;
getoper(l,@i,oper2,sepchar); if (i>l) then return;
getoper(l,@i,oper3,sepchar);
};
(* ----------Sorting Calls, for alphabetical listings-----------*)
(* The first four characters of each string are converted to a
longint, and the file's index is saved in a separate list: after
all filenames have been converted, a simple sorting procedure
rearranges the indexes according to the longint values. I did
this to avoid reading all of the filenames into memory. This
sorting method can be extended to do complete comparisons of
the filenames -- when sorting, all ties' indexes should be
made negative in the list: be repeating the process for the
next four characters of each tied string, until all negatives
have been cleared out of the list (thanks go to Richard Crandall
for help with this scheme). *)
procedure findi(ind: integer; pos: ^Integer);
var i,what: integer;
{
pos^:=1;
loop(,i:=1,,++i>numfiles) {
what:= indlist^^[i];
if (what=ind) then { pos^:= i; break };
};
};
Function cmp(i,j: integer): Boolean;
var il,jl: longint;
{
cmp := False;
i:= indlist^^[i];
j:= indlist^^[j];
il:= strlist^^[i];
jl:= strlist^^[j];
if (il<jl) then cmp := True;
};
procedure insert(i,j: integer);
var k,m: integer;
{
m:= indlist^^[i];
loop(,k:=i,,--k=j) indlist^^[k]:= indlist^^[k-1];
indlist^^[j]:=m;
};
procedure initlist(howmany: integer);
{
numfiles := howmany;
strlist := NewHandle((numfiles+1)*4);
indlist := NewHandle((numfiles+1)*2);
};
procedure haltlist();
{
disposhandle(indlist);
disposhandle(strlist);
};
procedure addlist(name: StringPtr; i: integer);
Type
ByteArr = byte[4][5000]; (* Rascal arrays indices are the opposite of
Pascal's. 'ByteArr' is 5000 arrays of
4 bytes each *)
ByteArrH = ^^ByteArr;
Var j: integer;
{
UprString(name);
loop(,j:=1,,++j>4) {
if name^[0]>=j then
ByteArrH(strlist)^^[j-1][i] := name^[j]%128
else
ByteArrH(strlist)^^[j-1][i] := 0;
};
indlist^^[i]:=i;
};
procedure sortlist();
var i,j,k: integer;
{
loop(numfiles>1,i:=numfiles,,--i=1) {
findi(i,@k);
loop(k>1,j:=1,,++j=k)
if cmp(k,j) then
{ insert(k,j); break };
};
};
Function getlist(i: integer): Integer;
{ getlist:= indlist^^[i]; };
(* ----------Two utilities for the Commands-----------*)
procedure makevol(vname: ptrb); (* volume name must be prefixed w/':' *)
{
vname[vname[0]+1]:=':';
vname[0]:=vname[0]+1;
};
Function vnametoref(name: ptrb; err: ^OSErr): integer;
var fname: StringPtr;
{
fname := @bfname;
copystr(name,fname);
makevol(fname);
getvinfo(-1,-99,@fname,err);
vnametoref:= Param.IOVrefNum;
};
(* ----------Here are the Command Calls-----------*)
procedure ls(); (* List directory *)
var ind,num,wc,i: integer;
namep: StringPtr;
err: OSErr;
size: longint;
{
cmpstr(oper1,"-l",@wc);
if (wd=0) then ind := 20 else getnumfiles(wd,@ind);
initlist(ind);
loop(,ind:=1,,++ind>numfiles) {
if (wd=0) then {
getvinfo(ind,0,@namep,@err);
if (err) then { numfiles := ind-1; break };
}
else
getindname(ind,wd,@namep, @err);
addlist(namep,ind);
};
sortlist();
loop(,ind:=1,,++ind>numfiles) {
num := getlist(ind);
if (wd=0) then {
getvinfo(num,0,@namep,@err);
size := (Param.IOVNmAlBlks - Param.IOVFrBlk) * Param.IOVAlBlkSiz;
}
else {
getindname(num,wd,@namep,@err);
getfsize(namep,wd,@size,@err)
};
if pipewrite(namep,ind) then break;
if (wc) then {
Drawchar(' ');
loop(namep^[0]<30,i:=namep^[0],,++i>30) Drawchar('.');
writelong(size);
};
};
haltlist();
};
procedure cd(); (* Change Directory
Also allows the format: cd :[-]n
:-n { -n is the vref }
:n { n is -vref }
*)
var err: Boolean;
tv : integer;
{
if (oper1[0]=0) then wd:=0 else {
if oper1[1]=':' then {
err := False;
if oper1[0]=2 then tv := oper1[2]-48 else
if oper1[0]=3 then tv := -(oper1[3]-48)
else
err := True;
}
else
tv := vnametoref(oper1,@err);
if !err then wd:=tv;
};
};
procedure eject(); (* eject the disk *)
var err: OSErr;
tv: integer;
{
if (oper1[0]) then {
tv := vnametoref(oper1,@err);
if !err then
if ejectable(tv) Then {
ejectv(tv,@err);
if !err then
if (wd=tv) then
wd := 0;
};
};
};
procedure forget(); (* Eject, if appropriate , and unmount *)
Const
BootDrive = $0210;
var err: OSErr;
tv,boot: integer;
{
if (oper1[0]) then {
boot := Ptrw(BootDrive)^; (* Boot drive refnum *)
tv := vnametoref(oper1,@err);
if (tv<>boot) then (* Don't 'forget' the boot drive *)
if !err then
if ejectable(tv) Then {
ejectv(tv,@err);
if !err Then unmount(tv,@err);
if (!err) and (tv=wd) then
wd:=0;
};
};
};
procedure pwd(); (* Print current directory *)
var name: StringPtr;
err: OSErr;
{
if (wd) then {
getvinfo(0,wd,@name,@err);
if pipewrite(name,1) then ;
}
else if pipewrite("..Home..",1) then ;
};
procedure rm(); (* Remove File *)
var err: OSErr;
{
if ((wd) and (oper1[0])) then {
delete(oper1,wd,@err);
if (err) then sysbeep(3) else {
drawstring("Removed: ");
drawstring(oper1);
flushvol(wd,Nil,@err);
};
};
};
procedure wc(); (* Print size of file or volume *)
var vref: integer;
size: longint;
numstr: block[20];
err: OSErr;
{
err :=0 ;
if (wd) then {
If checkdot(oper1) then copystr("",oper1);
If oper1[0] then
getfsize(oper1,wd,@size,@err)
else
size := getvsize(wd);
}
else {
vref := vnametoref(oper1,@err);
if (err=0) then
size := getvsize(wd);
};
if (err=0) then {
numtostring(size,numstr);
drawstring(oper1);drawstring(": ");drawstring(numstr);
drawstring(" bytes.");
};
};
procedure date();
{ iudatestring(cstr); if (pipewrite(cstr,1)) then ; };
procedure time();
{ iutimestring(cstr); if (pipewrite(cstr,1)) then ; };
procedure help();
var i: integer;
{
i:=1;
textface(Bold);
if (pipewrite("RasNIX Commands.......(Options)",i)) then;++i;
textface(Plain);
if (pipewrite("",i)) then;++i;
if (pipewrite("ls.........................( -l )",i)) then;++i;
if (pipewrite("cd.........................( :n )",i)) then;++i;
if (pipewrite("rm",i)) then;++i;
if (pipewrite("pwd",i)) then;++i;
if (pipewrite("date",i)) then;++i;
if (pipewrite("time",i)) then;++i;
if (pipewrite("help",i)) then;++i;
if (pipewrite("wc.........................( . )",i)) then;++i;
if (pipewrite("separ[ator]................( any char )",i)) then;++i;
if (pipewrite("eject",i)) then;++i;
if (pipewrite("forget",i)) then;++i;
if (pipewrite("info",i)) then;++i;
if (pipewrite("logout",i)) then;++i;
if (pipewrite("",i)) then;++i;
if (pipewrite("-- Use <Enter> to Cancel --",i)) then;++i;
};
procedure separ(); (* Make the command/operand separator this character *)
{
if (oper1[0]=0) then
sepchar := 32
else
sepchar := oper1[1];
};
procedure info(); (* NoSyscall doesn't handle backslash string
escapes, so must use a bunch of drawstrings *)
{
writeln();
TextFace(Bold);
Drawstring("RasNIX");Writeln();
TextFace(Plain);
Writeln();
DrawString("Written with");Writeln();
DrawString(" The Rascal Development System");Writeln();
Writeln();
Drawstring("by Scott Gillespie");Writeln();
Drawstring(" Reed College");Writeln();
Drawstring(" Portland, OR 97202");Writeln();
Drawstring(" UUCP: { decvax, ihnp4, ucbvax, ... }");Writeln();
Drawstring(" !tektronix!reed!maclab");Writeln();
Writeln();
TextFace(Bold);
Drawstring(" ... Type 'help' for help ... ");Writeln();
Writeln();
Writeln();
TextFace(Italic);
DrawString("Feel free to copy and distribute!");
TextFace(Plain);
};
procedure logout(); { ReqHalt() }; (* Call ReqHalt to halt execution *)
(* ----------These two procedures channel calls to the command-----------*)
Function IsCom(word: ptrb): Boolean;
var good: integer;
{
cmpstr(comm,word,@good);
if (good) then { clearsc(); IsCom:=True }
else IsCom := False;
};
procedure command();
{
parse();
if IsCom("ls") then ls() else
if IsCom("cd") then cd() else
if IsCom("pwd") then pwd() else
if IsCom("date") then date() else
if IsCom("time") then time() else
if IsCom("rm") then rm() else
if IsCom("help") then help() else
if IsCom("?") then help() else
if IsCom("wc") then wc() else
if IsCom("separ") then separ() else
if IsCom("eject") then eject() else
if IsCom("forget") then forget() else
if IsCom("info") then info() else
if IsCom("logout") then logout();
home()
};
(* ---------- Add a character to the command line -----------*)
procedure addchar(c,mods: integer);
var i: byte;
{
i := cstr[0];
if (c=8) then {
if (i>0) then {
if (i<>width) then
move(-6,0)
else
move((6*width+6)/1,-11);
erase();
--i;
};
}
else if (i<255) then {
Drawchar(c);
++i;
cstr[i] := c;
if (i=width) then writeln();
};
cstr[0] := i;
curs();
};
(* ---------- These are some of Rascal's built-in entry points -----------*)
(* The 'Supervisor' calls into these entry points at appropriate
times. For a desk accessory, a tiny version of the Supervisor
is joined to Rascal .obj file (by the Deskmaker utility) *)
procedure _KEY(c,mods: integer); (* called when a key is pressed *)
{
obscurecursor();
curs();
if (c=13) then command() else
if (c=3) then home() else
addchar(c,mods);
};
procedure _UPDATE(); (* called when the window needs to be updated *)
var P: Point;
{
curs();getpen(@P);moveto(0,35);line(700,0);moveto(6,15);
Drawchar('$');Drawchar(' ');moveto(P.h,P.v);
};
procedure _INIT(); (* called when the program is first started up *)
var xport: grafptr;
{
sepchar := ' ';
getport(@xport);
ValidRect(xport^.portrect);
wd := 0; (* working directory is ..home.. *)
pensize(1,2);
moveto(-20,-20); (* don't want to draw the cursor yet *)
_UPDATE();
width := (xport^.portrect.right - xport^.portrect.left)/6 - 5;
clearsc();
info();
home();
};