home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / CAVE.ZIP / PCX.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-14  |  4KB  |  191 lines
  1. UNIT  pcx;
  2.  
  3. INTERFACE
  4.  
  5. uses crt,graph,dos;
  6.  
  7. TYPE pcximage=^BYTE;
  8.  
  9. VAR old_key_isr:pointer;
  10.   PROCEDURE viewpcxfile(filename:string);
  11.   PROCEDURE loadpcxfile(filename:string; VAR pcxm:pcximage);
  12.   PROCEDURE init256graph;
  13.   PROCEDURE errors(code:byte);
  14.   Procedure check_file(name:string);
  15.   Procedure check_mem(VAR names:pcximage; amount:longint);
  16.  
  17. IMPLEMENTATION
  18.  
  19. VAR pcxim:pcximage;
  20.  thof,thseg,seger,offer:word;
  21.  pcxfile:file;
  22.  
  23. (*-------------- Procedure Errors -------------------------------------*)
  24.  
  25.  
  26.  
  27. PROCEDURE errors(code:byte);
  28. BEGIN
  29.   textmode(3);
  30.   clrscr;
  31.   setintvec($09, Old_Key_Isr);
  32.   writeln('!!! A Runtime Error Has Occured !!!');
  33.   Case code OF
  34.   1:writeln('Error Code 1: Not Enough Memory, Try Using A Boot Disk !!!!');
  35.   2:writeln('Error Code 2: File Not Found, Try Re-installing Game !!!!');
  36.   END;
  37.   writeln('Press Any Key To End.');
  38.   REPEAT UNTIL keypressed;
  39.   Halt(0);
  40. END;
  41.  
  42. (*---------------------- Procedure check_file --------------------------*)
  43.  
  44. Procedure check_file(name:string);
  45.  
  46. VAR test:file;
  47.  
  48. BEGIN
  49.   {$I-}
  50.   assign(test,name);
  51.   reset(test);
  52.   IF ioresult<>0 THEN
  53.   BEGIN
  54.     {$I+}
  55.     errors(2);
  56.   END
  57.   ELSE close(test);
  58.   {$I+}
  59. END;
  60.  
  61. (*----------------- Procedure Check_Mem -------------------------------*)
  62.  
  63.  
  64. Procedure check_mem(VAR names:pcximage; amount:longint);
  65. BEGIN
  66.   IF memavail<amount THEN errors(1);
  67.   getmem(names,amount);
  68. END;
  69.  
  70.  
  71. PROCEDURE init256graph;
  72.  
  73. BEGIN
  74.  ASM
  75.     push bp
  76.     mov bp,sp
  77.     mov al,13h
  78.     mov ah,0
  79.     int 10h
  80.     pop bp
  81.   END
  82. END;
  83.  
  84. PROCEDURE set256palette(filename:string);
  85.  
  86. VAR count:INTEGER;
  87.     red,green,blue:BYTE;
  88.     pcxer:file of byte;
  89.  
  90. BEGIN
  91.   assign(pcxer,filename);
  92.   reset(pcxer);
  93.   seek(pcxer,filesize(pcxer)-(256*3));
  94.   FOR count:=0 to 255 DO
  95.   BEGIN
  96.     read(pcxer,red,green,blue);
  97.     port[$3c7]:=count-1;
  98.     port[$3c9]:=(red SHR 2);
  99.     port[$3c9]:=(green SHR 2);
  100.     port[$3c9]:=(blue SHR 2);
  101.   END;
  102.  close(pcxer);
  103. END;
  104.  
  105. PROCEDURE decode_line(line:INTEGER);
  106.  
  107. VAR runcount,data:BYTE;
  108.     count,bytecount:INTEGER;
  109.  
  110. BEGIN
  111.   bytecount:=0;
  112.   WHILE bytecount<320 DO
  113.   BEGIN
  114.   data:=mem[thseg:thof];
  115.   thof:=thof+1;
  116.     IF data>192 THEN
  117.     BEGIN
  118.       runcount:=data AND $3f;
  119.        data:=mem[thseg:thof];
  120.       thof:=thof+1;
  121.       FOR count:=1 to runcount DO
  122.       BEGIN
  123.         mem[seger:offer+(line*320)+bytecount]:=data;
  124.         bytecount:=bytecount+1
  125.       END;
  126.     END
  127.     ELSE
  128.       BEGIN
  129.           mem[seger:offer+(line*320)+bytecount]:=data;
  130.         bytecount:=bytecount+1
  131.       END;
  132.   END;
  133. END;
  134.  
  135.  
  136. PROCEDURE show_file;
  137.  
  138. VAR count2:INTEGER;
  139.     joe:byte;
  140.  
  141. BEGIN
  142.   FOR count2:=0 to 199 DO
  143.   bEGIN
  144.   decode_line(count2);
  145.   END;
  146. END;
  147.  
  148.  
  149. PROCEDURE viewpcxfile(filename:string);
  150.  
  151. VAR count_me:WORD;
  152.  
  153. BEGIN
  154.   check_file(filename);
  155.   assign(pcxfile,filename);
  156.   reset(pcxfile);
  157.   check_mem(pcxim,filesize(pcxfile));
  158.   thseg:=seg(pcxim^);
  159.   thof:=ofs(pcxim^)+128;
  160.   seger:=$a000;
  161.   offer:=$0000;
  162.   blockread(pcxfile,pcxim^,filesize(pcxfile));
  163.   set256palette(filename);
  164.   show_file;
  165.   freemem(pcxim,filesize(pcxfile));
  166.   close(pcxfile);
  167. END;
  168.  
  169.  
  170. PROCEDURE loadpcxfile(filename:string; VAR pcxm:pcximage);
  171.  
  172. VAR count_me:WORD;
  173.  
  174. BEGIN
  175.   check_file(filename);
  176.   assign(pcxfile,filename);
  177.   reset(pcxfile);
  178.   check_mem(pcxim,filesize(pcxfile));
  179.   seger:=seg(pcxm^);
  180.   offer:=ofs(pcxm^);
  181.   thseg:=seg(pcxim^);
  182.   thof:=ofs(pcxim^)+128;
  183.   blockread(pcxfile,pcxim^,filesize(pcxfile));
  184.   set256palette(filename);
  185.   show_file;
  186.   close(pcxfile);
  187. END;
  188.  
  189. BEGIN
  190. getintvec($09,old_key_isr);
  191. END.