home *** CD-ROM | disk | FTP | other *** search
/ CD-X 1 / cdx_01.iso / demodisc / tyrant / pxcview / pcxview.pas
Encoding:
Pascal/Delphi Source File  |  1993-04-05  |  8.4 KB  |  344 lines
  1. (****************************************************************************)
  2. (*************  PCX File Viewer For  VGA, SVGA display **********************)
  3. (********************* by (c) Barba 1992-93 *********************************)
  4. (****************************************************************************)
  5.  
  6. {$F-,D-,L-,A-,B-,N-,E-,X+,G+,V-}
  7.  
  8. TYPE
  9.      header_type = RECORD
  10.           gyarto      : Byte;
  11.           verzio      : Byte;
  12.           tipus       : Byte;
  13.           bit_pix     : Byte;
  14.           x_min       : Integer;
  15.           y_min       : Integer;
  16.           x_max       : Integer;
  17.           y_max       : Integer;
  18.           felb_h      : Integer;
  19.           felb_v      : Integer;
  20.           szinskala   : ARRAY[ 1..48 ] OF Byte;
  21.           reserved    : Byte;
  22.           szinfokozat : Byte;
  23.           byte_sor    : Integer;
  24.           szin_szurke : Integer;
  25.           dummy       : ARRAY[ 1..58 ] OF Byte;
  26.            END;
  27.  
  28.           puffer_type = ARRAY[ 1..63000 ] OF Byte;
  29.  
  30. VAR
  31.  IsVga              : Boolean;
  32.  error,x,y,x1, y1,
  33.  z, k               : Integer;
  34.  x_size, y_size     : Word;
  35.  tomb               : ARRAY[ 0..767 ] OF Byte;
  36.  puffer             : puffer_type;
  37.  f            : FILE;
  38.  rek            : Byte;
  39.  r,g,b, mode        : Byte;
  40.  pp, i              : Word;
  41.  fnev               : String;
  42.  header             : header_type;
  43.  black_white        : Boolean;
  44.  param              : String;
  45.  
  46. CONST
  47.       video_segmens : Word = $A000;
  48.       cur_page      : Byte = 255;
  49.  
  50.  
  51. PROCEDURE lapoz;ASSEMBLER;
  52. ASM
  53.     mov ah, dl
  54.     mov dx, 03C4h
  55.     mov al, 0Eh
  56.     out dx, al
  57.     inc dx
  58.     in  al, dx
  59.     and ax, 0FF0h
  60.     xor ah, 2
  61.     or  al, ah
  62.     out dx, al
  63. END;
  64.  
  65. PROCEDURE DrawPixel( c: Byte; x, y : Word );ASSEMBLER;
  66. ASM
  67.      pusha
  68.      mov al, c
  69.      mov cl, al              (* szin elmentése                             *)
  70.      mov ax, y
  71.      mul x_size
  72.      add ax, x               (* az oszlop pozicio hozzáadása               *)
  73.      adc dx, 0               (* [dx:ax] a relativ fizikai cím              *)
  74.      mov bx, ax
  75.      cmp cur_page, dl        (*ugyanaz a lap, mint az elôzô rajzolásnál ?  *)
  76.      je @nem_lapoz           (* ha igen , akkor nem kell lapozni           *)
  77.      mov cur_page, dl
  78.      call lapoz              (* lapozo eljárás                             *)
  79. @nem_lapoz:
  80.      mov es, video_segmens
  81.      mov es:[bx], cl         (* képpont beírása                            *)
  82.      popa
  83. END;
  84.  
  85. FUNCTION Vga_Present: Boolean;
  86. VAR
  87.      l,h : Byte;
  88.  
  89. BEGIN
  90.  IsVga := FALSE;
  91.  ASM
  92.     mov ah, 1Ah     { funkcio kód   }
  93.     mov al, 00h;
  94.     int 10h
  95.     mov l, al        { Aktiv display kod   }
  96.     mov h, bl
  97.  END;
  98.  IF ( l = $1A ) THEN               { kérés támogatva }
  99.    IF  ( h= 7 ) OR ( h=8 ) THEN    { VGA mono   vagy  VGA color }
  100.      IsVGA := TRUE;
  101.  Vga_Present := IsVGA;
  102. END;
  103. {--------------------------------------------------------------------------}
  104.  
  105. {----------------- A fôprogram --------------------------------------------}
  106. BEGIN
  107.   i := PARAMCOUNT;
  108.   IF ( NOT Vga_Present ) THEN i := 0;
  109.   IF ( i = 0 ) THEN
  110.   BEGIN
  111.        WRITELN('PCX file megjelentô csak TRIDENT VGA-n   Version 1.3     1992-93 (c) Barba');
  112.        WRITELN;
  113.        WRITELN('Használat: PCXVIEW  név[.PCX ] [grafikus mód] [X,Y]  [B]');
  114.        WRITELN;
  115.        WRITELN('grafikus mód: ');
  116.        WRITELN;
  117.        WRITELN(' 0 -»  320 x 200    Video RAM 256 tól 1024 Kbyte -ig ');
  118.        WRITELN(' 1 -»  640 x 400    Video RAM >=  512  Kbyte');
  119.        WRITELN(' 2 -»  640 x 480    Video RAM >=  512  Kbyte');
  120.        WRITELN(' 3 -»  800 x 600    Video RAM >= 1024  Kbyte');
  121.        WRITELN(' 4 -» 1024 x 786    Video RAM >= 1024  Kbyte');
  122.        WRITELN;
  123.        WRITELN(' X,Y :   kezdôkoordináta ');
  124.        WRITELN(' B   :   fekete-fehér megjelenítés  ');
  125.        HALT;
  126.   END;
  127.  
  128.   fnev := PARAMSTR(1);
  129.   IF ( POS( '.', fnev ) = 0 ) THEN
  130.     fnev := fnev + '.PCX';
  131.  
  132.   ASSIGN(f,fnev);
  133.   {$I-}
  134.   RESET(f,1);
  135.   error := IoResult;
  136.   IF ( error <> 0 ) THEN BEGIN
  137.                 WRITELN('File nem található !');
  138.                 EXIT;
  139.              END;
  140.   BlockRead(f, header, SIZEOF( header ),pp);
  141.   CLOSE( f );
  142.   {$I+}
  143.  
  144.   X1 := 0;
  145.   Y1 := 0;
  146.  
  147.   CASE (header.y_max + 1) OF
  148.     0..200   : mode := 0;
  149.    201..400  : mode := 1;
  150.    401..480  : mode := 2;
  151.    481..600  : mode := 3;
  152.    601..1024 : mode := 4;
  153.   END;
  154.  
  155.   black_white := FALSE;
  156.  
  157.   param := PARAMSTR(i);
  158.   IF ( UpCASE( param[1] ) = 'B' ) THEN black_white := TRUE;
  159.   CASE i OF
  160.        2 : BEGIN
  161.             IF NOT black_white THEN VAL( PARAMSTR(2), mode, error );
  162.            END; { case 2 }
  163.        3 : BEGIN
  164.             IF NOT black_white THEN    { x és y koordináta }
  165.             BEGIN
  166.                VAL( PARAMSTR(2), x1, error );
  167.                IF error = 0 THEN
  168.             VAL( PARAMSTR(3), y1, error );
  169.             END
  170.             ELSE  VAL( PARAMSTR(2), mode, error );
  171.            END;  { case 3 }
  172.        4 : BEGIN
  173.           IF NOT black_white THEN   { mod + x + y }
  174.           BEGIN
  175.              VAL( PARAMSTR(2), mode, error );
  176.              IF error = 0 THEN
  177.               VAL( PARAMSTR(3), x1, error );
  178.               IF error = 0 THEN
  179.                VAL( PARAMSTR(4), y1, error );
  180.           END
  181.           ELSE BEGIN      { x, y, fekete, fehér }
  182.               VAL( PARAMSTR(2), x1, error );
  183.               IF error = 0 THEN
  184.                VAL( PARAMSTR(3), y1, error );
  185.                END;
  186.            END;  { case 4 }
  187.        5 : BEGIN       { összes paraméter }
  188.             VAL( PARAMSTR(2), mode, error );
  189.             IF error = 0 THEN
  190.             VAL( PARAMSTR(3), x1, error );
  191.              IF error = 0 THEN
  192.              VAL( PARAMSTR(4), y1, error );
  193.            END;  { case 5 }
  194.   END;  { case i }
  195.  
  196.   IF ( error = 0 ) AND (mode IN[0..4]) THEN
  197.   CASE mode OF
  198.      0 : BEGIN
  199.        mode := 19;
  200.        x_size := 320;
  201.        y_size := 200;
  202.      END;
  203.      1 : BEGIN
  204.        mode := 92;
  205.        x_size := 640;
  206.        y_size := 400;
  207.      END;
  208.      2 : BEGIN
  209.        mode := 93;
  210.        x_size := 640;
  211.        y_size := 480;
  212.      END;
  213.      3 : BEGIN
  214.        mode := 94;
  215.        x_size := 800;
  216.        y_size := 600;
  217.      END;
  218.      4 : BEGIN
  219.        mode := 98;
  220.        x_size := 1024;
  221.        y_size := 768;
  222.      END;
  223.   END   { case  mode }
  224.   ELSE BEGIN
  225.       WRITELN('Rossz sorrend, vagy helytelen paraméter !');
  226.       EXIT;
  227.        END;
  228.  
  229. {------------------- középre igazítás számítása -----------------------------}
  230.  IF ( x1 = 0 ) AND (y1 = 0 ) THEN
  231.  BEGIN
  232.   X1 := ( x_size - (header.x_max+1)) DIV 2 ;
  233.   IF x1 <0 THEN x1 := 0;
  234.   Y1 := ( y_size - (header.y_max+1)) DIV 2 ;
  235.   IF y1 <0 THEN y1:= 0;
  236.  END;
  237. {----------------------------------------------------------------------------}
  238.  
  239. {------------------------ file vizsgálat-------------------------------------}
  240.  IF (header.tipus <> 1 ) THEN { nem pcx }
  241.  BEGIN
  242.      WRITELN( 'Nem PCX file !');
  243.      HALT;
  244.  END;
  245. {----------------------------------------------------------------------------}
  246.   ASM
  247.       mov ah, 0
  248.       mov al, mode
  249.       int 10h       { VGA init }
  250.   END;
  251.  
  252.   IF (header.verzio = 5 ) THEN  { ha 3.0 -ás PCX  }
  253.   BEGIN
  254.    ASSIGN( f,fnev );
  255.    {$I-}
  256.    RESET( f,1 );
  257.    SEEK(f,FileSize(f)-3*256); { pixelek végén VGA szinskála 768 Byte }
  258.    BlockRead(f,tomb,3*256,pp);
  259.    CLOSE(f);
  260.    {$I+}
  261.  
  262.    FOR x := 0 TO 255 DO
  263.    BEGIN
  264.     tomb[ 3*x ] := tomb[ 3*x ] DIV 4;
  265.     tomb[3*x+1] := tomb[3*x+1] DIV 4;
  266.     tomb[3*x+2] := tomb[3*x+2] DIV 4;
  267.    END;
  268.  
  269.    ASM
  270.       mov dx, seg( tomb )
  271.       mov es, dx
  272.       mov dx, offset( tomb )
  273.       mov ah, 10h
  274.       mov al, 12h
  275.       mov bx, 0
  276.       mov cx, 256
  277.       int 10h                     { paletta init }
  278.    END;
  279.   END; { if }
  280.  
  281.   IF black_white THEN        { fekete, fehér   }
  282.   BEGIN
  283.    ASM
  284.       mov ax, 101Bh
  285.       mov bx, 0
  286.       mov cx, 256
  287.       int 10h
  288.    END;
  289.   END;
  290.  
  291.   ASSIGN( f,fnev);
  292.   {$I-}
  293.   RESET(f, 1 );
  294.   BLOCKREAD( f, header, SIZEOF( header), pp);
  295.   x := 0;
  296.   y := 0;
  297.   z := 0;
  298.   i := 0;
  299.  
  300.   BLOCKREAD( f, puffer, SIZEOF( puffer_type ), pp );
  301.   WHILE ( y < ( header.y_max - header.y_min +1 )) DO
  302.   BEGIN
  303.    IF ( i >= pp ) THEN BEGIN
  304.               BLOCKREAD( f, puffer, SIZEOF( puffer_type ), pp );
  305.               i := 0;
  306.                END;
  307.    INC( i );
  308.    rek := puffer[i];
  309.    z := 1;
  310.    IF ( rek > 192 ) THEN  {be van kapcsolva a két felsô BIT ? }
  311.    BEGIN
  312.       z := rek - 192;
  313.       IF ( i >= pp ) THEN BEGIN
  314.                  BLOCKREAD( f, puffer, SIZEOF( puffer_type ), pp );
  315.                  i := 0;
  316.               END;
  317.       INC( i );
  318.       rek := puffer[ i ];
  319.    END;
  320.    WHILE ( z <> 0 ) DO
  321.    BEGIN
  322.     INC( x );
  323.     DrawPixel( rek, x+X1, y+Y1 );
  324.     z := z - 1;
  325.    END;
  326.    IF ( x > header.x_max  ) THEN
  327.    BEGIN
  328.     x := 0;
  329.     INC( y );
  330.    END;
  331.   END;
  332.   CLOSE( f );
  333.   {$i+}
  334.   ASM
  335.       mov ah, 0
  336.       int 16h       { várokozás    }
  337.  
  338.       mov ah, 0
  339.       mov al, 3
  340.       int 10h       { TEXT mode 80*25 }
  341.   END;
  342.  
  343. END.
  344.