home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / XLIB_TP5.ZIP / DEMO / ANI_DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-24  |  5KB  |  135 lines
  1. (* This is a little demo to see how to use Xlib and Bitmaps for animations.
  2.  
  3.    This demo need the files
  4.       see in names : Array of String  the bitmaps
  5.       u.inc                           the font (while compiling)
  6.  
  7.    - You can 'move' the Bitmaps in one masterfile Ani_Demo.dat  .
  8.      So you can handle this demo with 2 files only ...
  9.  
  10.    - Draw with BEX own bitmaps and change the filename in names.
  11.  
  12.      I had scaned the bitmaps from a comic, converted and zoomed in
  13.      80x50 - pcx-pictures and read/colored with BEX.
  14.  
  15. *)
  16.  
  17.  
  18.  
  19. (* All these Compiler-directives make the EXE smaller ;-)
  20.    Put this line in {  }  and your errors will be deteteced.             *)
  21.  
  22. {$D-,K+,O-,Q-,R-,S-,T-,V-,Y-}
  23.  
  24. uses x_const,  (* Variables like GetMaxX,GetMaxY  or  X_Mode_360x240 and *)
  25.                (* function WaitVsyncStart                                *)
  26.      x_main,   (* x_set_mode,x_text_mode,x_set_clip_rect,x_circle        *)
  27.      x_bitmap, (* x_load_pbm,x_put_pbm_clipx,x_get_pbm_siyeXY            *)
  28.      x_FileIO, (* F_Size,Init_MasterFile,Close_MasterFile                *)
  29.      x_keys,   (* keyspressed                                            *)
  30.      x_Pal,    (* x_set_rgb_pal                                          *)
  31.      x_text,   (* x_text_init,x_register_userfont,x_set_font,E_Write     *)
  32.      x_rect;   (* box                                                    *)
  33.  
  34. const Bitmaps  = 2;
  35.       names : Array[0..Bitmaps] of String =
  36.               ('ani_pic1.pbm','ani_pic2.pbm','ani_pic3.pbm');
  37.       Frames   = 3;
  38.       Run  : Array[0..Frames] of Byte = (0,1,2,1);
  39.  
  40. (* Created with FEX   [FNT -> INC] *)
  41. {$I u.inc}
  42.  
  43. var P:Array[0..Bitmaps] of Pointer;
  44.     Help:Pointer;
  45.     i,i1,j,x:Word;
  46.     s:String;
  47.     Pic_X,Pic_Y:Word;
  48.     dummy:Boolean;
  49.     F:File;
  50. begin;
  51.   if not Init_MasterFile('Ani_Demo.dat') then WriteLn('ANI_DEMO.DAT not found - looking for single Bitmaps.');
  52.  
  53.   WriteLn('Loading Bitmaps ...');
  54.   (* Search PBM and Load -
  55.      if no PBM found, search PCX, if found load and convert in PBM  *)
  56.   for j:=0 to Bitmaps do
  57.   begin;
  58.     if F_Size(names[j])>0 then
  59.     begin;
  60.       GetMEM(P[j],F_Size(names[j]));
  61.       x_load_pbm(names[j],P[j]^);
  62.     end                   else
  63.     begin;                (* PCX load and convert *)
  64.       i:=F_Size(Only_one_Ext(names[j],'PCX'));
  65.       if i<>0 then i:=x_get_PCX_Size(Only_one_Ext(names[j],'PCX'))
  66.               else begin;WriteLn(names[j]+' not found.');exit;end;
  67.  
  68.       GetMEM(Help,i);
  69.       fillchar(Help^,i,0);
  70.       if not x_load_pcx_as_lbm(Only_one_Ext(names[j],'PCX'),Help^)
  71.            then begin;WriteLn(names[j]+'-File format error');exit;end;
  72.       if not x_lbm_to_pbm(Help^,P[j]^)
  73.            then begin;WriteLn(names[j]+' converting error');exit;end;
  74.       FreeMEM(Help,i);
  75.     end;
  76.   end;
  77.  
  78.   (* Get X,Y-resolution for calculating bitmapmove. *)
  79.   x_get_pbm_sizeXY(Pic_X,Pic_Y,P[0]^);
  80.  
  81.   (* Set mode X , RGB-palette (default in BEX),  ClipX-Window *)
  82.   x_set_mode(X_Mode_360x240,400);
  83.   x_set_rgb_pal;
  84.   x_set_clip_rect(Pic_X+2,0,GetMaxX-Pic_X,400);
  85.  
  86.   (* Init the userfont. *)
  87.   x_text_init;
  88.   x_register_userfont(font_U);
  89.   x_set_font(2);
  90.  
  91.   (* Write the title of this little demo . *)
  92.   E_Write(10,10,Gray5,Gray3,center(340,'Der Alte Sack und das kleine Arschloch.'));
  93.   x_write(10,14+x_font_height,Gray2,center(340,'The old slump and the little asshole (german comic).'));
  94.  
  95.   (* Draw the cinema box. *)
  96.   box(Pic_X,90,GetMaxX-Pic_X+4,110+Pic_Y,Gray5);
  97.   for i:=0 to 19 do
  98.   begin;
  99.     box(Pic_X+4+i*10,92,Pic_X+8+i*10,96,Gray0);
  100.     box(Pic_X+4+i*10,104+Pic_Y,Pic_X+8+i*10,108+Pic_Y,Gray0);
  101.   end;
  102.  
  103.   x :=GetMaxX-Pic_X;
  104.   j:=0;
  105.  
  106.   x:=200;
  107.  
  108.   (* Animate the bitmaps. *)
  109.   while (not keyspressed) do
  110.   begin;
  111.     (* Calcutale X and frameindex .  *)
  112.     Dec(x,2);    if x<2 then x:=GetMaxX-Pic_X;
  113.     Inc(j);
  114.     j:=j mod (frames+1);
  115.  
  116.     for i:=0 to 5 do WaitVsyncStart;  (* This delay is on every PC the same. *)
  117.  
  118.     (* Put Bitmap with X-clipping on screen. *)
  119.     x_put_pbm_clipx(x,100,P[Run[j]]^);
  120.  
  121.   end;
  122.  
  123.   x_text_mode;
  124.  
  125.   Close_MasterFile;
  126.   WriteLn('Thanx for watching. (Source in XLib_TP , the mode x units for Turbo Pascal).');
  127.   WriteLn;
  128.   WriteLn('Wer jetzt mehr vom kleinen Arschloch sehen will, sollte sich sofort');
  129.   WriteLn('"Der alte Sack, ein kleines Arschloch und andere Höhepunkte des Kapitalismus",');
  130.   WriteLn('erschienen im Eichborn Verlag, zulegen.');
  131.   WriteLn;
  132.   WriteLn('Also avaible as "little asshole", "Petit Emmerdeur", "Piccolo Stronzo".');
  133.  
  134. end.
  135.