386DX-40 - morfizm

Разбирая старые файлы, наткнулся на custom-made заставку, которую я когда-то ставил себе на загрузку.
Думаю, оригинал написан на Паскале, но сохранился только hello.exe. Запустил его через DOSBox:



Update: нашёл исходник.

program Hello;

uses graph,crt;

const
  delay0 = 15;
  wait = 300; { tiks }

{$L egavga.obj}
{$L trip.obj}
var
  timer : longint absolute $40:$6c;

procedure setcreg(regnum : word; r,g,b : byte); assembler;
asm
  mov bx,regnum
  mov ch,g
  mov cl,b
  mov dh,r
  mov ah,10h
  mov al,10h
  int 10h
end;

procedure getcreg(regnum : word; var r,g,b : byte);
var
  r0,g0,b0 : byte;
begin
  asm
    mov bx,regnum
    mov ah,10
    mov al,15
    int 10h
    mov g0,ch
    mov b0,cl
    mov r0,dh
    end;
  r:=r0;
  g:=g0;
  b:=b0;
end;

procedure egavgadriverproc; external;
procedure triplexfontproc; external;

function since(i : longint): longint;
var
  j : longint;
begin
  j:=timer;
  while j<i do
        inc(j,1573040);
  since:=j-i;
end;

procedure init;
const
  maxtext = 7;
  text : array [1..maxtext] of string[50] = (
  'Welcome on IBM PC/AT 386DX-40!',
  'MS-DOS 6.22 is glad to see you now!',
  'Hard disk WDC AC21600H is ready for hard work',
  'SVGA monochrome "Sunny" is ready to output',
  'everything whatever you would dream about',
  '* * *',
  'Start working, please!');
var
  r,g,b : byte;
  procedure rgb(k : byte);
  begin
    setcreg(63,k,k,k);
  end;
  procedure rgb01;
  var
    i : integer;
  begin
    for i:=0 to 63 do begin
        delay(delay0);
        setcreg(63,i,i,i);
        end;
  end;
  procedure rgb10;
  var
    i : integer;
  begin
    for i:=63 downto 0 do begin
        delay(delay0);
        setcreg(63,i,i,i);
        end;
  end;
var
  grdriver,grmode,errorcode : integer;
  i,j,k : integer;
  p : longint;
  s,t : string;
begin
  grdriver:=detect;
  registerbgidriver(@egavgadriverproc);
  registerbgifont(@triplexfontproc);
  initgraph(grdriver,grmode,'');
  errorcode:=graphresult;
  if errorcode=grok then begin
     rgb(0);
     setcolor(white);
     ellipse((getmaxx div 2),(getmaxy div 2),0,360,
             (getmaxx div 2),(getmaxy div 2));
     ellipse((getmaxx div 2),(getmaxy div 2),0,360,
             (getmaxx div 2)-2,(getmaxy div 2)-2);
     settextstyle(triplexfont,horizdir,3);
     k:=122;
     for i:=1 to maxtext do begin
         j:=textwidth(text[i]);
         outtextxy((getmaxx-j) div 2,k,text[i]);
         k:=k+textheight(text[i])+10;
         end;
     rgb01;
     p:=timer;
     s:='';
     settextstyle(defaultfont,horizdir,0);
     repeat
       t:=s;
       str(round((wait-since(p))/18.2),s);
       s:=s+' seconds';
       if t<>s then begin
          setcolor(black);
          outtextxy(0,getmaxy-textheight(t)-5,t);
          setcolor(white);
          outtextxy(0,getmaxy-textheight(s)-5,s);
          end;
       if keypressed then
          break;
     until since(p)>wait;
     setcolor(black);
     outtextxy(0,getmaxy-textheight(s)-5,s);
     while keypressed do
           readkey;
     rgb10;
     cleardevice;
     rgb(63);
     closegraph;
     end;
end;

begin
  init;
end.