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(); };