World of Shareware - Software Farm 2/wosw_2.zip/wosw_2/PROG/NAPAPI10.ZIP/DEMO.PAS

Pascal/Delphi Source File | 1993-07-13 | 5.2 KB | 192 lines

{$I NAPFLAGS.INC}

program demo;

uses crt, dos, driver1, naplps, graph, timer;

var
   count   : byte;
   start,
   stop    : longint;

function exist (filename : string) : boolean;
   var
      inf : searchrec;
   begin
      findfirst (filename, anyfile, inf);
      exist := (doserror = 0);
   end;

function numtostr(number : longint) : string;
   var
      temp : string;
   begin
      str(number,temp);
      numtostr := temp;
   end;

procedure show_file(fn : string);
   var
      f       : file;
      numread : word;
      str     : string;
      buf     : array[0..199] of char; {200 char buffer}
   begin
      if not exist(fn) then exit;
      reset_naplps;
      assign(f,fn);
      reset(f,1);
      repeat
         blockread(f,buf,sizeof(buf),numread);
         move(buf,str[1],numread);
         str[0] := char(numread);
         interpret_naplps(str);
      until numread = 0;
      close(f);
   end;

procedure fadein(var pal : paltype; d : word);
   var
      c       : byte;
      done    : boolean;
      incpal  : paltype;
   begin
      done := false;
      fillchar(incpal,sizeof(incpal),#0);
      while not done do
         begin
            done := true;
            for c := 0 to 15 do
               begin
                  if (incpal[c].cr <> palette[c].cr) or
                     (incpal[c].cg <> palette[c].cg) or
                     (incpal[c].cb <> palette[c].cb) then
                     begin
                        if incpal[c].cr < palette[c].cr then
                           begin
                              inc(incpal[c].cr);
                              done := false;
                           end;
                        if incpal[c].cg < palette[c].cg then
                           begin
                              inc(incpal[c].cg);
                              done := false;
                           end;
                        if incpal[c].cb < palette[c].cb then
                           begin
                              inc(incpal[c].cb);
                              done := false;
                           end;
                        setrgbpalette_fast(c,incpal[c].cr,incpal[c].cg,incpal[c].cb);
                     end;
               end;
            delay(d);
         end;
   end;

procedure fadeout(decpal : paltype; d : word);
   var
      c       : byte;
      done    : boolean;
   begin
      done := false;
      while not done do
         begin
            done := true;
            for c := 0 to 15 do
               begin
                  if (decpal[c].cr <> 0) or
                     (decpal[c].cg <> 0) or
                     (decpal[c].cb <> 0) then
                     begin
                        if decpal[c].cr > 0 then
                           begin
                              dec(decpal[c].cr);
                              done := false;
                           end;
                        if decpal[c].cg > 0 then
                           begin
                              dec(decpal[c].cg);
                              done := false;
                           end;
                        if decpal[c].cb > 0 then
                           begin
                              dec(decpal[c].cb);
                              done := false;
                           end;
                        setrgbpalette_fast(c,decpal[c].cr,decpal[c].cg,decpal[c].cb);
                     end;
               end;
            delay(d);
         end;
   end;

begin
   register_drivers;
   graphmode   := detect;
   initgraph(graphdriver,graphmode,'');
   nap_init;

   setpal := false;
   for count := 0 to 15 do
      setrgbpalette_fast(count,0,0,0);

   show_file('frame1.nap');
   fadein (palette,1);
   start := readtimer;
   repeat
      stop := readtimer;
   until keypressed or (elapsedtime(start,stop,0) > 5);
   if keypressed then readkey;
   fadeout(palette,1);

   show_file('frame2.nap');
   fadein (palette,1);
   start := readtimer;
   repeat
      stop := readtimer;
   until keypressed or (elapsedtime(start,stop,0) > 120);
   if keypressed then readkey;
   fadeout(palette,1);

   show_file('frame3.nap');
   fadein (palette,1);
   start := readtimer;
   repeat
      stop := readtimer;
   until keypressed or (elapsedtime(start,stop,0) > 120);
   if keypressed then readkey;
   fadeout(palette,1);

   show_file('frame4.nap');
   fadein (palette,1);
   start := readtimer;
   repeat
      stop := readtimer;
   until keypressed or (elapsedtime(start,stop,0) > 30);
   if keypressed then readkey;
   fadeout(palette,1);

   show_file('frame5.nap');
   fadein (palette,0);
   start := readtimer;
   repeat
      stop := readtimer;
   until keypressed or (elapsedtime(start,stop,1) > 2);
   if keypressed then readkey;
   fadeout(palette,0);

   setpal := true;
   for count := 6 to 38 do
      begin
         show_file('frame'+numtostr(count)+'.nap');
         start := readtimer;
         repeat
            stop := readtimer;
            updateblinks;
         until keypressed or (elapsedtime(start,stop,0) > 30);
         if keypressed then readkey;
      end;
   nap_done;
   closegraph;
end.