PROGRAM tny_boot ;

  TYPE
    str255 = string[ 255 ];
    fn_range = 1..14 ;
    fname = PACKED ARRAY [ fn_range ] OF char ;
    frec = PACKED RECORD
             reserved : PACKED ARRAY [ 0..19 ] OF byte ;
             resvd2 : byte ;
             attrib : byte ;
             time_stamp : integer ;
             date_stamp : integer ;
             size : long_integer ;
             name : fname ;
           END ;
    path_name = PACKED ARRAY [ 1..80 ] OF char ;
    file_array = array[ 1..250 ] of str255;
    InbufType = packed array[1..32044] of byte;
    Pallete = packed array[0..15] of integer;
    Screen = packed array[1..32000] of byte;
    Ptr_screen = ^screen;                     { pointer to the screen array }


    var rec_num,i,the_rez : integer;
	pics : file_array;
        tiny_path_str : str255;
        tny_path : path_name;
        inbuf : InbufType;
        Pal : Pallete;
        TinyPic : Screen;
	l : long_integer;
	show_title : boolean;

CONST
    Read_Only = 0;
    null_char = #0;

{SCREEN ROUTINES}

PROCEDURE GotoXY( x, y : Short_Integer );
	EXTERNAL;

FUNCTION Physbase : Ptr_screen;
   XBIOS( 2 );

FUNCTION Get_rez : Integer;
   XBIOS( 4 );

PROCEDURE Set_screen(Logical_Screen,Physical_Screen:Long_integer; Rez:integer);
   XBIOS( 5 );

PROCEDURE Setpallete(VAR Pal:Pallete );
   XBIOS( 6 );

FUNCTION Setcolor(ColorNumber,Tint:integer):integer;
   XBIOS( 7 );

PROCEDURE vsync;
   XBIOS( 37 );


{------------ FILE ROUTINES ---------------}

FUNCTION f_open(VAR name :Path_Name; mode :Integer ) :Integer;
    GemDos($3d);

FUNCTION f_close(handle :Integer) :Integer;
    GemDos($3e);

FUNCTION f_read(handle :Integer; count :Long_Integer;
                VAR buffer :InBufType) :Long_Integer;
    GemDos($3f);


function inkey : char;

	var char_val : integer;
	    val_return : long_integer;
	    key : char;

	function bconstat( device : integer ) : boolean;
		bios( 1 );

	function bconin( device : integer ) : long_integer;
		bios( 2 );

begin
	if bconstat( 2 ) then  { keypressed }
		val_return := bconin( 2 )
	  else
		val_return := 0;

	 char_val := int( val_return );
         key := chr( char_val );
	 inkey := key;

end;  { inkey }


procedure make_path( path_string : str255; var ipath : path_name );

var i : integer;
begin
    FOR i := 1 TO length( path_string ) DO
      ipath[i] := path_string[i] ;
    ipath[ length(path_string)+1 ] := chr(0) ;

end;  { make_path }


function good_pic( pic : str255 ) : boolean;

	var pic_name : path_name;
	    name : str255;
	    res, f : integer;
begin
    name := copy( tiny_path_str, 1, length( tiny_path_str) - 5 );
    name := concat( name, pic );
    make_path( name, pic_name );
    F := f_open(Pic_Name,Read_Only);
    L := f_read(f, 32044, inbuf);
    f := f_close(f);
    res := inbuf[ 1 ];
    if res > 2 then
	res := res - 3;

    if  ( ( the_rez = 2 ) and ( res < 2 ) ) or 
        ( (the_rez < 2 ) and ( res = 2 ) )  then
	good_pic := false
    else
	good_pic := true;

end;  { good_pic }


{$P-} { turn pointer checking off.. }

Procedure Show_Tiny_Screen( picname : str255 );

CONST
    Read_Only = 0;

VAR
    i,j,
    res,                    {Screen Resolution}
    DelayTime,              {Number of seconds to display pic on screen}
    RotStart,               {Start color number to rotate}
    RotEnd,                 {End color number to rotate}
    RotSpeed,               {Speed and direction to rotate}
    RotRevolutions,         {Number of revolutions to make}
    RotationsMade,          
    TimeToKill,
    f :Integer;
    S_ptr : Ptr_screen;         { a pointer to a packed array of bytes... }
    RotInfo:Boolean;            {Is there rotation info for the pic?}

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

PROCEDURE DecodePic;
VAR
    i, j :INTEGER;
    curplane, curln, curcol :Integer;
    ctrlptr, dataptr :Integer;
    ctrlcnt, datacnt :Integer;

{..........................................}
PROCEDURE PutWord;

VAR pos :Integer;

BEGIN {PUT WORD}
   pos := ShL(curplane,1) + curln * 160 + ShL(curcol,3);
   TinyPic[pos+1] := inbuf[dataptr];
   TinyPic[pos+2] := inbuf[dataptr+1];
   curln := curln+1;
   IF curln >= 200 then
   Begin
      curln := 0;
      curcol := curcol + 1;
      If curcol >= 20 then
      Begin
         curcol := 0;
         curplane := curplane + 1;
      End
   End
End; {PUT WORD}
{..........................................}

BEGIN {DECODE PIC}

    res := inbuf[1];
    rotInfo := True;
    IF res > 2 THEN res := res-3 ELSE rotInfo := False;

    ctrlptr := 2;
    IF rotInfo THEN
    Begin
       ctrlptr := ctrlptr + 4;
       RotEnd := (inbuf[2] & 15);
       RotStart := ShR(inbuf[2],4);
       RotSpeed := inbuf[3];
       RotRevolutions := (inbuf[4] * 256) + inbuf[5];
    End;

    FOR i:=1 TO 16 DO
      Pal[i-1] := (inbuf[((i-1)*2)+ctrlptr]*256) + inbuf[((i-1)*2)+ctrlptr+1];
    ctrlptr:=ctrlptr+32;

    ctrlcnt:=ShL(inbuf[ctrlptr],8)+inbuf[ctrlptr+1];
    datacnt:=ShL(inbuf[ctrlptr+2],8)+inbuf[ctrlptr+3];
    ctrlptr:=ctrlptr+4;
    dataptr:=ctrlptr+ctrlcnt;
    curplane:=0; curln:=0; curcol:=0;

    REPEAT
        IF inbuf[ctrlptr]>=128 THEN BEGIN
            FOR j:=1 TO (256-inbuf[ctrlptr]) DO BEGIN
                PutWord;
                dataptr:=dataptr+2;
                END;
            ctrlptr:=ctrlptr+1;
            END
   else IF inbuf[ctrlptr]=0 THEN BEGIN
            FOR j:=1 TO (inbuf[ctrlptr+1]*256+inbuf[ctrlptr+2]) DO
                PutWord;
            ctrlptr:=ctrlptr+3;
            dataptr:=dataptr+2;
            END
   else IF inbuf[ctrlptr]=1 THEN BEGIN
            FOR j:=1 TO (inbuf[ctrlptr+1]*256+inbuf[ctrlptr+2]) DO BEGIN
                PutWord;
                dataptr:=dataptr+2;
                END;
            ctrlptr:=ctrlptr+3;
            END
   else BEGIN
            FOR j:=1 TO inbuf[ctrlptr] DO    {inbuf[ctrlptr]>1}
                PutWord;
            ctrlptr:=ctrlptr+1;
            dataptr:=dataptr+2;
            END;
        UNTIL (curplane>=4);

END; {DECODE_PIC}

procedure title;

	var i, x1,x2, long, y : integer;
begin
    if show_title then
     begin
        if res = 0 then
          begin
		x1 := 1;
		x2 := 40;
	  end
	else
	  begin
		x1 := 2;
		x2 := 79;
	  end;;
	long := length( picname ) - 4;
	y := ( 25 - long ) div 2;
	
	for i := 1 to long do
	   begin
		gotoxy( i + y - 1, x1 );
		write( picname[ i ] );
	   end;
	picname := 'Tiny Boot by dwb';
	long := 16;
	y := 5;
	for i := 1 to long do
	   begin
		gotoxy( i + y -1, x2 );
		write( picname[ i ] );
	   end;
   end;

end; { title }	

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

Begin {SHOW_WELCOME}

        DecodePic;
        for i := 0 to 15 do f := Setcolor(i,Pal[i]); {Set Pallete colors}
        Set_Screen(-1,-1,res);    { set correct resolution }
        S_ptr := Physbase;        { grab location of screen... }
        S_ptr^ := TinyPic;        { stuff picture into screen }
	title;

End; {Show_Welcome}

{$P=}  {Turn pointer checking back on}

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

Function Random( Low, Hi : Integer ) : Integer;

	Function XB_Rnd : Long_Integer; 
	   Xbios( 17 );

	Function Rnd : Real;

	   Begin
	      Rnd := XB_Rnd / 16777216.0;
	   End;

Begin
      Random := Low + Trunc( Rnd * ( Hi - Low +1 ) );

End;   { RANDOM.PAS }


FUNCTION IO_Result : Short_Integer ;
	EXTERNAL ;


PROCEDURE IO_Check( YesNo : Boolean ) ;
	EXTERNAL ;



FUNCTION get_current_drive : integer ;
	GEMDOS( 25 );


procedure directory( path : path_name ; 
		     var fs : file_array; var total : integer);

  VAR
    r : frec ;
    i : fn_range ;
    kar : char;

	PROCEDURE set_dta( VAR buf : frec ) ;
	    GEMDOS( $1a ) ;

	FUNCTION get_first( VAR path : path_name ; 
				search_attrib :integer ):integer ;
	    GEMDOS( $4e ) ;

 	FUNCTION get_next : integer ;
	    GEMDOS( $4f ) ;

	PROCEDURE store_file( VAR r : frec ) ;

      	var     i : fn_range ;
      		temp : str255;

    	BEGIN
      		temp := '';
      		WITH r DO
        	BEGIN
          		i := 1 ;
          		WHILE (i <= 14) AND (name[i] <> chr(0)) DO
            		BEGIN
              			temp := concat( temp, name[ i ] );
		                i := i + 1
		        END ;
	     		total := total + 1;
	                fs[ total ] := temp
         	END ;

    	END ;  { store_file }

BEGIN
    set_dta( r ) ;
    IF get_first( path, 0 ) >= 0 THEN
      REPEAT
        store_file( r ) ;
	kar := inkey;
	if kar <> null_char then
	     if ( kar = 'Q' ) or ( kar = 'q' ) then
	        halt;
      UNTIL get_next < 0 ;

end; { directory }


function exist( name : str255 ) : boolean;

	var error : integer;
	    which : file of text;
begin
        io_check( false );
	reset( which, name );
        error := io_result;
	if error = 0 then
		exist := true
	else
		exist := false;
	close( which );
	io_check( true );

end;  { exist }


procedure check_alt_path( var tiny_pth : str255 );

	var which : file of text;
            title_show, file_name : str255;
begin
	
	file_name := concat( tiny_pth, 'TNY_BOOT.INF' );
	if exist( file_name ) then
	  begin
		reset( which, file_name );
		readln( which, tiny_pth );
		readln( which, title_show );
		if tiny_pth[ length( tiny_pth) ] <> '\' then
			tiny_pth := concat( tiny_pth, '\' );

		if ( title_show[ 1 ] = 'n' ) or
		   ( title_show[ 1 ] = 'N' ) then
			show_title := false;
           end;

end;  { check_alt_path }


procedure get_pic_names;

	var drnum : integer;
	    drive : char;
BEGIN
	rec_num := 0;
	drnum := get_current_drive;
        drive := chr( drnum + 65 );
	tiny_path_str := concat( drive, ':\AUTO\');
	check_alt_path( tiny_path_str );
	tiny_path_str := concat( tiny_path_str, '*.TNY' );
	make_path( tiny_path_str, tny_path );
	directory( tny_path, pics, rec_num );

END;  { get_pic_names }


procedure select_pic( pic : file_array; total : integer;
	  VAR select : integer ) ;

	var rot : integer;
	    ok : boolean;
begin
   rot := 0;
   repeat
	select := random( 1, total );
   	ok := good_pic( pic[ select ] );
        rot := rot + 1;
   until ( ok ) or ( rot > 50 );
   if not ok then
	select := 0;

end; { select_pic }
	

begin  { ------------- main routine ----------- }

	show_title := true;
        the_rez := get_rez;
	get_pic_names;
	select_pic( pics, rec_num, i);
	if i > 0 then
		show_tiny_screen( pics[ i ] );
end.