PROGRAM ADBLister;

{Cameron Birse, Macintosh Technical Support}

uses Memtypes,QuickDraw,OSIntf,ToolIntf;
TYPE
    SysEnvRec	  =	   RECORD
				environsVersion:	INTEGER;
				machineType:		   INTEGER;
				systemVersion:		 INTEGER;
				processor:		    	INTEGER;
				hasFPU:				      BOOLEAN;
				hasColorQD:	   		BOOLEAN;
				keyBoardType:  		INTEGER;
				atDrvrVersNum: 		INTEGER;
				sysVRefNum:		   	INTEGER;
				END;
    
    fourBytes = packed array [0..3] of byte;
    
CONST
    CurrentA5 = $904;

VAR
		  err			: Integer;
		  NumDevs		: integer;
		  DevBlock	: ADBDataBlock;
		  Addrs		: ADBAddress;
		  CmdNum		: integer;
		  ADBData : str255;
    GotLEDs, CompTrue, gotADB		: boolean;
		  Count, opCount, timer : integer;
		  finalTicks : longint;
		  TimeOut : integer;
    TheWorld : SysEnvRec;
    a : char;
    MyA5,R3Data : longint;
    ParseData : fourBytes;
	
	{------------------------------------------------------------------------------------}
	
PROCEDURE Debugger; INLINE $A9FF;
 
FUNCTION SysEnvirons(versionRequested: INTEGER; VAR theWorld: SysEnvRec): OSErr;
    INLINE $205f,$301f, $A090, $3e80;
  
PROCEDURE ShutDwnStart;
    INLINE $3F3C,$0002,$A895;

PROCEDURE PushA5;
    INLINE  $2F0D;   {move.l a5,-(a7)  ;push current A5 onto stack}
    
PROCEDURE PopA5;
    INLINE  $2A5F;   {move.l (a7)+,a5  ;pop stack into A5}
    
PROCEDURE   GetMyA5;
    INLINE  $2A52;   {movea.l (a2),a5  ;move apps a5 (pointed to by a2) into a5}
    
FUNCTION    GetCurA5:longint;
    INLINE  $2E8D;

FUNCTION   GetADBData:longint;
    INLINE  $2E90;   {move.l (a0),(a7) ;move ADB Data onto stack}

	{------------------------------------------------------------------------------------}

PROCEDURE ADBComplete;
			
BEGIN
		
    PushA5;
    GetMyA5;
			 R3Data := GetADBData;
    Count := Count + 1;
			 CompTrue := True;
			 PopA5;
			
END;

	{------------------------------------------------------------------------------------}
                                                
BEGIN 							 {main PROGRAM}
    
    gotADB := false; {assume no ADB, and just exit if none}
    err:= SysEnvirons (1,TheWorld);
    if err = noerr then
    begin
        case theworld.machineType of
         0,1,2 : begin
                    gotADB := false;
                    Writeln ('Yes, we have no ADB today.');
                    Writeln ('Press the mouse button to exit.');
                    repeat until button;
            end;
         Otherwise gotADB := True;
        end; {case}
    end
    else
    begin
        writeln ('SysEnvirons error = ',err);
        writeln ('Please press the mouse button to exit');
        repeat until button;
    end;
    If gotADB then
    BEGIN
        MyA5 := GetCurA5;
		      NumDevs := countADBs;
		      writeln ('there are ',NumDevs,' ADB devices on this machine');
		      writeln ('');
		
 		     repeat
        writeln ('press mouse to continue');
        writeln ('');
        repeat until button;
        comptrue := false;
			     Addrs := GetIndADB (DevBlock, NumDevs);
			     Case DevBlock.origADBAddr of
			      3 : Writeln ('Mouse');
			      2 : Begin
						          Case DevBlock.devType of 
						          1 : Begin
									               Writeln ('Apple Standard KeyBoard');
									               GotLEDs := false;
								            end;
						          2 : Begin
									               Writeln ('Apple Extended KeyBoard');
									               GotLEDs := true;
								            end;
						          end; {case}
					       end;
			     end; {case}
				 	  CmdNum := ((Addrs*16)+$0F);  {Device Address X, Talk command, Register 3}
						  ADBData[0] := Char($00);
						  ADBData[1] := Char($00);
						  ADBData[2] := Char($00);
						  err := ADBOp (@MyA5, @ADBComplete,@ADBData, CmdNum);
        if err = noerr then
        begin
            count := 0;
            repeat
                count := count + 1;         {timeout check}
                if count = 10000 then
                begin
                    err := 500;
                    comptrue := true;
                end
            until comptrue;
            ParseData := fourBytes(R3Data);
        end;
        if err <> noerr then Writeln ('ADBOp error = ',err);

			     Writeln ('Device = ',numdevs,' ; Device type = ',DevBlock.devType);
			     Writeln ('ADB Address = ',Addrs,' ; Original Address = ',DevBlock.origADBAddr);
        Writeln ('Routine Pointer = ',longint (DevBlock.dbServiceRtPtr),
                    ' ;Data Area Address = ',longint (DevBlock.dbDataAreaAddr));
        Writeln ('Handler ID = ',integer(ParseData[2]));
			     writeln ('');
			     NumDevs := NumDevs - 1;
		      until NumDevs = 0;
			     Writeln ('Press Mouse to quit');
        repeat until button;
    END;
		END.