singer@endor.harvard.edu (Andrew Singer) (10/13/87)
[Lightspeed Pascal version of Describe (source)]
[Moderator's Notes: The description below states that this program runs
on "all systems", but it bombed on my System 3.2 disk and ran correctly
on my System 4.1 disk. I've posted the PackIt file mentioned in the
"Describe_Info" file to comp.binaries.mac.]
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# Describe_Info
# Describe.p
sed 's/^X//' << 'SHAR_EOF' > Describe_Info
XContained in this PackIt file you should find the following files:
X
X Describe Project
X Describe.p
X Describe.Rsrc
X
X "Describe Project" is the Lightspeed Pascal project file for
X the Describe program.
X
X "Describe.p" is the Lightspeed Pascal source for Describe.
X
X "Describe.Rsrc" contains the "STR#" resources used by the program.
X
X
XThis Describe program is very much like the Describe program uploaded
Xby Robert Scott Comer some time ago. The differences are that this
XDescribe runs properly on all systems, and this Describe provides
Xa little extra information (which is provided by the new SysEnvirons
Xtrap).
X
XThere are no copyrights attached to this code; I acknowledge that it
Xwas originally written in another language by someone else; the only
Xcredit I claim is for expanding its functionality and for making
Xit compatible with all hardware and software configurations.
X
X --Rich
X
X**Note: The opinions (if any) contained herein do not represent in any way
Xthe policies of my employer (THINK Technologies, Inc.)
X
XRichard Siegel
XCustomer Support Representative
XTHINK Technologies, Inc.
X
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > Describe.p
XPROGRAM Describe; {Based on "Describe.c", written by Robert Scott Comer in 1985.}
X{Richard M. Siegel, September 10, 1987}
X
X USES
X EnvironsIntf;
X
X CONST
X MenuBarHeight = $BAA;
X BufPtr = $010C;
X SysVersion = $015A;
X FSFCBLen = $03F6;
X
X VAR
X r : Rect;
X
X FUNCTION GetIntAddr (addr : LongInt) : Integer;
X VAR
X p : ^Integer;
X BEGIN
X p := Pointer(Addr);
X GetIntAddr := p^;
X END;
X
X FUNCTION GetLongAddr (addr : LongInt) : LongInt;
X VAR
X p : ^LongInt;
X BEGIN
X p := Pointer(Addr);
X GetLongAddr := p^;
X END;
X
X PROCEDURE GetSysEnvirons;
X VAR
X Environment : SysEnvRec;
X err : OSErr;
X
X s1, s2, s3 : Str255;
X
X BEGIN
X err := SysEnvirons(1, Environment);
X
X WITH Environment DO
X BEGIN
X GetIndString(s1, 15441, machineType + 1);
X GetIndString(s2, 13215, processor + 1);
X GetIndString(s3, 20622, keyBoardType + 1);
X
X WriteLn('Machine type: ', s1);
X WriteLn('Processor Type: ', s2);
X WriteLn('Keyboard Type: ', s3);
X
X IF hasFPU THEN
X WriteLn('Math coprocessor is installed.');
X
X IF hasColorQD THEN
X WriteLn('Color QuickDraw is installed.');
X IF keyBoardType = envMacAndPad THEN
X WriteLn('Macintosh Numeric Keypad is installed.');
X END;
X WriteLn;
X END;
X
X PROCEDURE GetSystemSoftware;
X VAR
X rom, machine, hfs : Integer;
X s : StringHandle;
X
X BEGIN
X Environs(rom, machine);
X WriteLn('ROM Version: ', rom : 1);
X
X s := GetString(0);
X WriteLn('System file signature: ', s^^);
X
X rom := GetIntAddr(SysVersion);
X WriteLn('Installed ROM Patches are version ', rom : 1);
X
X hfs := GetIntAddr(FSFCBLen);
X IF hfs > 0 THEN
X WriteLn('HFS is installed.')
X ELSE
X WriteLn('HFS is not installed.');
X WriteLn;
X END;
X
X PROCEDURE GetScreen;
X VAR
X h, v : Integer;
X
X BEGIN
X WITH screenBits.bounds DO
X WriteLn('Screen measures ', right : 1, ' horizontal by ', bottom : 1, ' vertical.');
X ScreenRes(h, v);
X WriteLn('Resolution: ', h : 1, ' dpi horizontal, ', v : 1, ' dpi vertical.');
X WriteLn;
X END;
X
X PROCEDURE GetMemory;
X VAR
X mem : LongInt;
X bufSize : LongInt;
X
X BEGIN
X mem := Ord4(TopMem);
X WriteLn('Top of memory is ', mem DIV 1024 : 1, ' Kbytes.');
X WriteLn('System Heap space is: ', Ord4(ApplicZone) DIV 1024 : 1, ' Kbytes.');
X WriteLn('Application Heap space is: ', (GetLongAddr(BufPtr) - Ord4(ApplicZone)) DIV 1024 : 1, ' Kbytes.');
X WriteLn('Buffer space is: ', (mem - GetLongAddr(BufPtr)) DIV 1024 : 1, ' Kbytes.');
X WriteLn;
X END;
X
X PROCEDURE Init;
X BEGIN
X r := screenBits.Bounds;
X WITH r DO
X BEGIN
X top := top + GetIntAddr(MenuBarHeight) + 20;
X right := right - 4;
X left := left + 4;
X bottom := bottom - 4;
X END;
X
X SetTextRect(r);
X ShowText;
X InitCursor;
X END;
X
X PROCEDURE GetDisks;
X VAR
X DrvQHdr : QHdrPtr;
X ThisDrive : ^DrvQEl;
X DriveStat : DrvSts;
X
X err : OSErr;
X
X BEGIN
X DrvQHdr := GetDrvQHdr;
X ThisDrive := Pointer(Ord4(DrvQHdr^.qHead));
X WriteLn('Installed Disk Drives:');
X WHILE ThisDrive <> NIL DO
X BEGIN
X err := DriveStatus(ThisDrive^.dqDrive, DriveStat);
X CASE ThisDrive^.dqDrive OF
X 1 :
X Write(' Internal floppy: ');
X 2 :
X Write(' External Floppy: ');
X OTHERWISE
X Write(' Unknown type (Drive #', ThisDrive^.dqDrive : 1, '): ');
X END;
X
X Write('File System ID: ', ThisDrive^.dqFSID : 1, ', Driver Reference: ', ThisDrive^.dqRefNum : 1);
X ThisDrive := Pointer(Ord4(ThisDrive^.qLink));
X WriteLn;
X END;
X WriteLn;
X END;
X
X PROCEDURE Click2Exit;
X BEGIN
X WriteLn;
X WriteLn('Click the mouse button to exit.');
X WHILE NOT button DO
X ;
X END;
X
XBEGIN
X Init;
X GetSysEnvirons;
X GetSystemSoftware;
X GetScreen;
X GetMemory;
X GetDisks;
X Click2Exit;
XEND.
SHAR_EOF
exit