bammi@cwruecmp.UUCP (Jwahar R. Bammi) (10/10/86)
#!/bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #!/bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # arcshell.mod # arcshell.h # This archive created: Fri Oct 10 14:13:58 1986 # By: Jwahar R. Bammi () export PATH; PATH=/bin:$PATH echo shar: extracting "'arcshell.mod'" '(18776 characters)' if test -f 'arcshell.mod' then echo shar: over-writing existing file "'arcshell.mod'" fi sed 's/^X//' << \SHAR_EOF > 'arcshell.mod' X(*$A+*) (*$F-*) XMODULE ArcShell; X XFROM SYSTEM IMPORT ADDRESS, ADR, CODE; XFROM Storage IMPORT CreateHeap; X XFROM GEMDOS IMPORT GetDrv, Open, Close, GetPath, Term, X loadExecute, Exec; XFROM BIOS IMPORT SetException, GetException; X XFROM GEMAESbase IMPORT MouseOff, MouseOn; XFROM AESGraphics IMPORT GrafMouse; XFROM AESForms IMPORT FileSelectorInput; X XFROM SYSCIO IMPORT GoToXY, X Read, X Write, WriteString, WriteCard, WriteInt, WriteLn; X XIMPORT GEMVDIbase, VDIControls, VDIAttribs, X GEMAESbase, AESGraphics, AESForms, AESObjects, X AESResources, AESApplications ; X XCONST OFF = FALSE; X ON = TRUE; X XTYPE Object = RECORD X next : CARDINAL; X head : CARDINAL; X tail : CARDINAL; X type : CARDINAL; X flags : CARDINAL; X state : CARDINAL; X spec : ADDRESS; X obx : CARDINAL; X oby : CARDINAL; X width : CARDINAL; X depth : CARDINAL; X END; X X ObjectStates = (Selected, Crossed, Checked, Disabled, Outlined, Shadowed); X X Tree = POINTER TO ARRAY [0..200] OF Object; X XCONST MOPTIONS = 0 ; X ADDBUTON = 2 ; X EXTRACTB = 3 ; X MOVEBUTN = 4 ; X UPDATEBU = 5 ; X FRESHENB = 6 ; X DELETEBU = 7 ; X VERBOSEB = 8 ; X LISTBUTN = 9 ; X COPYBUTN = 10 ; X RUNBUTON = 11 ; X TESTARCI = 12 ; X CNVTONPM = 13 ; X KEEPBACK = 17 ; X SUPPCOMP = 18 ; X SUPPWARN = 19 ; X SUPPNOTE = 20 ; X HOLDBUTN = 21 ; X CRYPTBUT = 22 ; X CANBUTON = 23 ; X OKBUTTON = 24 ; X X ABOUTBOX = 1 ; X ABOUTOKB = 4 ; X ABOUTCAN = 5 ; X XVAR VDIHandle : INTEGER ; X workIn : GEMVDIbase.VDIWorkInType ; X workOut : GEMVDIbase.VDIWorkOutType ; X WidthChar, X HeightChar, X WidthFont, X HeightFont : INTEGER ; X X (* Window data *) X X Window : INTEGER ; (* window handle *) X WindX, X WindY, X WindWidth, X WindHeight : INTEGER ; (* Total window *) X X Appl : INTEGER; X MainMenuTree : ADDRESS; X MoptMenuTree : ADDRESS; X SendMenuTree : ADDRESS; X RecvMenuTree : ADDRESS; X X Colour : BOOLEAN ; (* Running on Colour ST system *) X X (* Work area available to graphics modules *) X WorkX, X WorkY, X WorkWidth, X WorkHeight : INTEGER ; X XCONST CancelButton= 0; X OKButton= 1; X XTYPE NameString= ARRAY[0..64] OF CHAR; X XVAR CurrentDrive: CARDINAL; X CurrentPath: NameString; X X Path: NameString; X Name: NameString; X X ArcProgramName: NameString; X X DataPathName: NameString; X DataFileName: NameString; X DataName: NameString; X X ArcPathName: NameString; X ArcFileName: NameString; X ArcName: NameString; X X FileName: NameString; X ExButton: INTEGER; X Reply: CHAR; X AskForStdOutput: BOOLEAN; X MouseState: BOOLEAN; X X MainOption: ARRAY[0.. 0] OF CHAR; X SecondaryOption: ARRAY[0..10] OF CHAR; X X CommandLine: ARRAY[0..127] OF CHAR; X ProgramName: ARRAY[0..127] OF CHAR; X ProgramCommand: ARRAY[0..127] OF CHAR; X EnvironmentString: ARRAY[0..127] OF CHAR; X ExitCode: INTEGER; X X(*$P- Turn normal entry and exit code generation off *) XPROCEDURE DivideByZero; X XBEGIN (* DivideByZero *) X X CODE(4E73H); (* rte *) X XEND DivideByZero; X(*$P= Turn normal entry and exit code generation on*) X XPROCEDURE SetMouseState(SetMouse : BOOLEAN); X XBEGIN (* SetMouseState *) X X CASE SetMouse OF X ON : CASE MouseState OF X ON : ; X | OFF : GrafMouse(MouseOn, NIL); X END; X | OFF : CASE MouseState OF X ON : GrafMouse(MouseOff, NIL); X | OFF : ; X END; X END; X X MouseState := SetMouse; X XEND SetMouseState; X XPROCEDURE ClearScreen; X XBEGIN (* ClearScreen *) X X Write(CHR(27)); Write('E'); X XEND ClearScreen; X XPROCEDURE CenterMessage(VAR Message : ARRAY OF CHAR); X XVAR c, cmax: CARDINAL; X XBEGIN (* CenterMessage *) X X IF Message[0] = 0C X THEN RETURN; X END; X X c := 0; X cmax := HIGH(Message); X X WHILE (c <= cmax) AND X (Message[c] # 0C) DO X INC(c); X END; X X IF (c > cmax) OR X (Message[c] = 0C) X THEN DEC(c); X END; X X GoToXY((80 - c) DIV 2, 02); X X WriteString(Message); X XEND CenterMessage; X XPROCEDURE Exit(ExitCode : INTEGER); X XBEGIN (* Exit *) X X IF NOT Term(ExitCode) X THEN HALT; X END; X XEND Exit; X XPROCEDURE MoveStr(VAR To, From : ARRAY OF CHAR); X XVAR c, cmax, X c1, c1max: CARDINAL; X XBEGIN (* MoveStr *) X X c := 0; X cmax := HIGH(To); X c1 := 0; X c1max := HIGH(From); X X WHILE (c <= cmax) AND X (c1 <= c1max) AND X (From[c1] # 0C) DO X To[c] := From[c1]; X INC(c); X INC(c1); X END; X X IF c <= cmax X THEN To[c] := 0C; X END; X XEND MoveStr; X XPROCEDURE Append(VAR To: ARRAY OF CHAR; X VAR Data: ARRAY OF CHAR); X XVAR c, cmax, X c1, c1max: CARDINAL; X XBEGIN (* Append *) X X c := 0; X cmax := HIGH(To); X X WHILE (c <= cmax) AND X (To[c] # 0C) DO X INC(c); X END; X X c1 := 0; X c1max := HIGH(Data); X X WHILE (c <= cmax) AND X (c1 <= c1max) AND X (Data[c1] # 0C) DO X To[c] := Data[c1]; X INC(c); X INC(c1); X END; X X IF c <= cmax X THEN To[c] := 0C; X END; X XEND Append; X XPROCEDURE ConvertString(VAR To, From : ARRAY OF CHAR); X XVAR c, cmax, X c1, c1max: CARDINAL; X XBEGIN (* ConvertString *) X X c := 1; X cmax := HIGH(To); X X c1 := 0; X c1max := HIGH(From); X X WHILE (c <= cmax ) AND X (c1 <= c1max) AND X (From[c1] # 0C) DO X To[c] := From[c1]; X INC(c); X INC(c1); X END; X X IF c <= cmax X THEN To[c] := 0C; X END; X X To[0] := CHR(c-1); X XEND ConvertString; X X(* ------------------------------------------------------------------- *) X(* Dialog Stuff lives here *) X(* ------------------------------------------------------------------- *) X XPROCEDURE ObjectAddress(tree : INTEGER; obindex : INTEGER) : ADDRESS; X XVAR res : INTEGER; X treeadr : Tree; X ob : POINTER TO ADDRESS; X XBEGIN X X AESResources.ResourceGetAddr(0,tree,treeadr); X X RETURN ADR(treeadr^[obindex]); X XEND ObjectAddress; X XPROCEDURE GetObjectState(tree : INTEGER; obindex : INTEGER) : BITSET; X XVAR res : INTEGER; X treeadr : Tree; X XBEGIN X X AESResources.ResourceGetAddr(0,tree,treeadr); X X RETURN BITSET(treeadr^[obindex].state); X XEND GetObjectState; X XPROCEDURE TestObjectState(Tree : INTEGER; X ObIndex : INTEGER; X Mask : ObjectStates) : BOOLEAN; X XTYPE States = SET OF ObjectStates; X XVAR Value : BITSET; X XBEGIN X X Value := GetObjectState(Tree,ObIndex); X X RETURN (Mask IN States(Value)); X XEND TestObjectState; X XPROCEDURE SetObjectState(tree : INTEGER; obindex : INTEGER; state : BITSET); X XVAR res : INTEGER; X treeadr : Tree; X XBEGIN X X AESResources.ResourceGetAddr(0,tree,treeadr); X X treeadr^[obindex].state := INTEGER(state); X XEND SetObjectState; X XPROCEDURE SelectObject(tree : INTEGER; obindex : INTEGER); X XCONST Selected = 0 ; X XVAR b: BITSET; X XBEGIN X X b := GetObjectState(tree,obindex); X X INCL(b, Selected); X X SetObjectState(tree,obindex,b); X XEND SelectObject; X XPROCEDURE DeselectObject(tree : INTEGER; obindex : INTEGER); X XCONST Selected = 0 ; X XVAR b: BITSET; X XBEGIN X X b := GetObjectState(tree,obindex); X X EXCL(b, Selected); X X SetObjectState(tree,obindex,b); X XEND DeselectObject; X XPROCEDURE DoDialog(DialogIndex : INTEGER) : INTEGER ; X XVAR dTree : ADDRESS ; X x,y,w,h : INTEGER ; X result : INTEGER ; X XBEGIN X X AESResources.ResourceGetAddr(GEMAESbase.RTree,DialogIndex,dTree) ; X X AESForms.FormCenter(dTree,x,y,w,h) ; X X AESForms.FormDialogue(GEMAESbase.FormStart,0,0,0,0,x,y,w,h) ; X AESForms.FormDialogue(GEMAESbase.FormGrow,0,0,0,0,x,y,w,h) ; X X AESObjects.ObjectDraw(dTree,0,10,x,y,w,h) ; X X SetMouseState(ON); X result := AESForms.FormDo(dTree,0) ; X SetMouseState(OFF); X X AESForms.FormDialogue(GEMAESbase.FormShrink,0,0,0,0,x,y,w,h) ; X AESForms.FormDialogue(GEMAESbase.FormFinish,0,0,0,0,x,y,w,h) ; X X ClearScreen; X X RETURN result; X XEND DoDialog ; X XPROCEDURE FormatFileName(VAR FileName, X Path, X Name : NameString); X XVAR c: CARDINAL; X XBEGIN (* FormatFileName *) X X IF (Path[0] = 0C) AND X (Name[0] = 0C) X THEN FileName := '\*.*'; X RETURN; X ELSIF Path[0] = 0C X THEN FileName := Name; X RETURN; X ELSIF Name[0] = 0C X THEN FileName := Path; X RETURN; X END; X X FileName := Path; X X c := 0; X X WHILE (c <= HIGH(FileName)) AND X (FileName[c] # 0C) DO X INC(c); X END; X X WHILE (c # 0) AND X (FileName[c] # '\') DO X DEC(c); X END; X X IF c = 0 X THEN FileName := Name; X RETURN; X END; X X FileName[c+1] := 0C; X X Append(FileName, Name); X XEND FormatFileName; X XPROCEDURE DoMainOptions; X XCONST RS = 1EH; X GS = 1DH; X FS = 1CH; X XBEGIN (* DoMainOptions *) X X IF TestObjectState(MOPTIONS, ADDBUTON, Selected) X THEN MainOption := 'A'; X ELSIF TestObjectState(MOPTIONS, EXTRACTB, Selected) X THEN MainOption := 'X'; X ELSIF TestObjectState(MOPTIONS, MOVEBUTN, Selected) X THEN MainOption := 'M'; X ELSIF TestObjectState(MOPTIONS, FRESHENB, Selected) X THEN MainOption := 'F'; X ELSIF TestObjectState(MOPTIONS, UPDATEBU, Selected) X THEN MainOption := 'U'; X ELSIF TestObjectState(MOPTIONS, DELETEBU, Selected) X THEN MainOption := 'D'; X ELSIF TestObjectState(MOPTIONS, VERBOSEB, Selected) X THEN MainOption := 'V'; X ELSIF TestObjectState(MOPTIONS, COPYBUTN, Selected) X THEN MainOption := 'P'; X ELSIF TestObjectState(MOPTIONS, LISTBUTN, Selected) X THEN MainOption := 'L'; X ELSIF TestObjectState(MOPTIONS, RUNBUTON, Selected) X THEN MainOption := 'R'; X ELSIF TestObjectState(MOPTIONS, TESTARCI, Selected) X THEN MainOption := 'T'; X ELSIF TestObjectState(MOPTIONS, CNVTONPM, Selected) X THEN MainOption := 'C'; X END; X XEND DoMainOptions; X XPROCEDURE DoSecondaryOptions; X XCONST ESC= 1BH; X XVAR CryptData: ARRAY[0..3] OF CHAR; X XBEGIN (* DoSecondaryOptions *) X X SecondaryOption := ''; X X IF TestObjectState(MOPTIONS, SUPPCOMP, Selected) X THEN Append(SecondaryOption, 'S'); X END; X X IF TestObjectState(MOPTIONS, KEEPBACK, Selected) X THEN Append(SecondaryOption, 'B'); X END; X X IF TestObjectState(MOPTIONS, SUPPWARN, Selected) X THEN Append(SecondaryOption, 'W'); X END; X X IF TestObjectState(MOPTIONS, SUPPNOTE, Selected) X THEN Append(SecondaryOption, 'N'); X END; X X IF TestObjectState(MOPTIONS, HOLDBUTN, Selected) X THEN Append(SecondaryOption, 'H'); X AskForStdOutput := FALSE; X ELSE AskForStdOutput := TRUE; X END; X X IF TestObjectState(MOPTIONS, CRYPTBUT, Selected) X THEN Append(SecondaryOption, 'G'); X END; X XEND DoSecondaryOptions; X XPROCEDURE DoArc; X XVAR EncryptionKey: ARRAY[0..3] OF CHAR; X c: CARDINAL; X CReply: CHAR; X X OldDivideByZero: PROC; X XBEGIN (* DoArc *) X X IF ArcPathName[0] # 0C X THEN Path := ArcPathName; X Name := ArcFileName; X ELSE Path := CurrentPath; X Append(Path, '\*.ARC'); X Name := ''; X END; X X ExButton := 0; X X CenterMessage('We are asking for the Archive File Name here'); X SetMouseState(ON); X FileSelectorInput(ADR(Path), ADR(Name), ExButton); X SetMouseState(OFF); X X ClearScreen; X X IF ExButton = CancelButton X THEN Exit(-1); X END; X X IF Name[0] = 0C X THEN Exit(-2); X END; X X ArcPathName := Path; X ArcFileName := Name; X X FormatFileName(FileName, Path, Name); X X ArcName := FileName; X X IF (MainOption[0] = 'A') OR X (MainOption[0] = 'M') OR X (MainOption[0] = 'U') OR X (MainOption[0] = 'F') OR X (MainOption[0] = 'D') OR X (MainOption[0] = 'X') OR X (MainOption[0] = 'R') OR X (MainOption[0] = 'P') X THEN IF DataPathName[0] # 0C X THEN Path := DataPathName; X ELSE Path := CurrentPath; X Append(Path, '\*.*'); X END; X Name := ''; X ExButton := 0; X CenterMessage('We are asking for the Data File Name(s) here'); X SetMouseState(ON); X FileSelectorInput(ADR(Path), ADR(Name), ExButton); X SetMouseState(OFF); X ClearScreen; X IF ExButton = CancelButton X THEN Exit(-1); X END; X DataPathName := Path; X IF MainOption[0] = 'R' THEN FileName := Name; X ELSIF MainOption[0] = 'D' THEN IF Name[0] = 0C X THEN FileName := Path; X ELSE FileName := Name; X END; X ELSE FormatFileName(FileName, Path, Name); X END; X ELSE FileName := ''; X END; X X DataName := FileName; X X CommandLine[0] := MainOption[0]; X CommandLine[1] := 0C; X X Append(CommandLine, SecondaryOption); X X ClearScreen; X X IF TestObjectState(MOPTIONS, CRYPTBUT, Selected) X THEN WriteString('Enter the Encryption key '); X c := 0; X EncryptionKey := ' '; X LOOP Read(CReply); X IF CReply = CHR(0DH) X THEN EXIT; X END; X Write(CReply); X EncryptionKey[c] := CReply; X INC(c); X IF c = 4 X THEN EXIT; X END; X END; X Append(CommandLine, EncryptionKey); X END; X X Append(CommandLine, ' '); X Append(CommandLine, ArcName); X X IF DataName[0] # 0C X THEN Append(CommandLine, ' '); X Append(CommandLine, DataName); X END; X X IF AskForStdOutput X THEN Name := ''; X ExButton := 0; X CenterMessage('We are asking for the Standard Output File Name here'); X SetMouseState(ON); X FileSelectorInput(ADR(Path), ADR(Name), ExButton); X SetMouseState(OFF); X ClearScreen; X IF ExButton = CancelButton X THEN Exit(-1); X END; X IF Name[0] # 0C X THEN FormatFileName(FileName, Path, Name); X IF FileName[0] # 0C X THEN Append(CommandLine, ' >'); X Append(CommandLine, FileName); X END; X END; X END; X X MoveStr(ProgramName, ArcProgramName); X X ConvertString(ProgramCommand, CommandLine); X EnvironmentString := ''; X X WriteString(ProgramName); Write(' '); X WriteString(CommandLine); Write(' '); X WriteString(EnvironmentString); WriteLn; X X OldDivideByZero := PROC(GetException(5)); X SetException(5, DivideByZero); (* It would seem that zero length files induce X a divide by zero wich Modula-2 picks up so X let's intercept with a dummy *) X X Exec(loadExecute, X ProgramName, ProgramCommand, EnvironmentString, ExitCode); X X SetException(5, OldDivideByZero); X X CommandLine[0] := 0C; X X IF ExitCode # 0 X THEN WriteLn; X WriteString('Arc ExitCode is'); X WriteInt(ExitCode,6); X Read(CReply); X END; X X ClearScreen; X XEND DoArc; X XPROCEDURE DoProcess; X X PROCEDURE InitializeObjects; X X BEGIN (* InitializeObjects *) X X SelectObject(MOPTIONS, UPDATEBU); X(* X SelectObject(MOPTIONS, SUPPWARN); X SelectObject(MOPTIONS, SUPPNOTE); X*) X SelectObject(MOPTIONS, HOLDBUTN); X X END InitializeObjects; X XBEGIN (* DoProcess *) X X InitializeObjects; X X LOOP DeselectObject(MOPTIONS, OKBUTTON); X DeselectObject(MOPTIONS, CANBUTON); X X CASE DoDialog(MOPTIONS) OF X OKBUTTON : DoMainOptions; X DoSecondaryOptions; X DoArc; X | CANBUTON : EXIT; X | ELSE ; X END; X END; X XEND DoProcess; X X(* ------------------------------------------------------------------- *) X XPROCEDURE InitResource() : BOOLEAN ; X XCONST ResourceFileName = 'ARCSHELL.RSC'; X Alert = "[3][ ArcShell.rsc not found ][OK]" ; X XVAR str : ARRAY [0..99] OF CHAR ; X result : INTEGER ; X i : CARDINAL ; X XBEGIN X X Appl := AESApplications.ApplInitialise() ; X X str := ResourceFileName ; X X AESResources.ResourceLoad(str) ; X X IF ( GEMAESbase.AESCallResult = 0 ) X THEN str := Alert ; X result := AESForms.FormAlert(1,str) ; X RETURN FALSE ; X END ; X X(* Get AES VDI handle *) X X VDIHandle := AESGraphics.GrafHandle(WidthChar,HeightChar, X WidthFont,HeightFont); X X(* Open VDI Virtual workstation *) X X FOR i := 0 TO 9 DO X workIn[i] := 1 ; X END ; X X workIn[10] := 2 ; (* Set RC *) X X VDIControls.OpenVirtualWorkstation(workIn,VDIHandle,workOut) ; X X Colour := workOut[39] (* number of colours *) > 2 ; X X AESGraphics.GrafMouse(GEMAESbase.Arrow,NIL) ; (* put pointing mouse *) X X MouseState := ON; X X SetMouseState(OFF); X X DeselectObject(ABOUTBOX, ABOUTOKB); X DeselectObject(ABOUTBOX, ABOUTCAN); X X IF DoDialog(ABOUTBOX) = ABOUTCAN X THEN RETURN FALSE; X END; X X ClearScreen; X X GetDrv(CurrentDrive); X GetPath(CurrentPath, 0); X X Path[0] := CHR(ORD(CurrentDrive) + ORD('A')); X Path[1] := ':'; X Path[2] := 0C; X X Append(Path, CurrentPath); X X CurrentPath := Path; X X ArcProgramName := CurrentPath; X Append(ArcProgramName, 'ARC.TTP'); X X Open(ArcProgramName, 0, result); X X IF result > 0 X THEN IF NOT Close(result) X THEN Exit(-1); X END; X ELSE ExButton := 0; X Path := CurrentPath; X Append(Path, '\*.*'); X Name := ''; X CenterMessage('We are asking for the Archive Program Name here'); X SetMouseState(ON); X FileSelectorInput(ADR(Path), ADR(Name), ExButton); X SetMouseState(OFF); X ClearScreen; X IF ExButton = CancelButton X THEN Exit(-1); X END; X IF Name[0] = 0C X THEN Exit(-2); X END; X FormatFileName(ArcProgramName, Path, Name); X END; X X ArcPathName := ''; X DataPathName := ''; X X RETURN TRUE ; X XEND InitResource ; X X(* ------------------------------------------------------------------- *) X XPROCEDURE Terminate ; X XBEGIN X X AESResources.ResourceFree() ; X X VDIControls.CloseVirtualWorkstation(VDIHandle) ; X X AESApplications.ApplExit ; X XEND Terminate ; X XBEGIN (* ArcShell *) X X IF CreateHeap(32 * 1024, TRUE) X THEN IF InitResource() X THEN DoProcess; X END; X Terminate; X END; X XEND ArcShell. SHAR_EOF if test 18776 -ne "`wc -c 'arcshell.mod'`" then echo shar: error transmitting "'arcshell.mod'" '(should have been 18776 characters)' fi echo shar: extracting "'arcshell.h'" '(426 characters)' if test -f 'arcshell.h' then echo shar: over-writing existing file "'arcshell.h'" fi sed 's/^X//' << \SHAR_EOF > 'arcshell.h' XCONST X MOPTIONS = 0 ; X ADDBUTON = 2 ; X EXTRACTB = 3 ; X MOVEBUTN = 4 ; X FRESHENB = 6 ; X UPDATEBU = 5 ; X DELETEBU = 7 ; X VERBOSEB = 8 ; X COPYBUTN = 10 ; X LISTBUTN = 9 ; X RUNBUTON = 11 ; X TESTARCI = 12 ; X CNVTONPM = 13 ; X SUPPCOMP = 18 ; X KEEPBACK = 17 ; X SUPPWARN = 19 ; X SUPPNOTE = 20 ; X CRYPTBUT = 22 ; X HOLDBUTN = 21 ; X CANBUTON = 23 ; X OKBUTTON = 24 ; X ABOUTBOX = 1 ; X ABOUTOKB = 4 ; X ABOUTCAN = 5 ; SHAR_EOF if test 426 -ne "`wc -c 'arcshell.h'`" then echo shar: error transmitting "'arcshell.h'" '(should have been 426 characters)' fi # End of shell archive exit 0 -- usenet: .....!decvax!cwruecmp!bammi jwahar r. bammi csnet: bammi@case arpa: bammi%case@csnet-relay compuServe: 71515,155