【メモ帳】gif lzw エンコード 7bit 固定テスト

途中経過ｗ

7bit 固定 1byte 区切り
clear code = 128
end code = 129

lzw エンコードサブルーチン部のみを作って、昨日作った無圧縮 gif 出力ルーチンに、手でその出力を書き込んでチェックする。

ソースプログラム

    module m_mod
      implicit none
      integer :: nbit = 7
      integer :: kbit, kp, dict(4096) 
    contains
      subroutine clear_dict()
        integer :: i
        kbit = nbit
        kp = 2**kbit + 1
        dict = 0
        forall (i = 1:kp) dict(i) = i ! dict(nbit) clear code, dict(nbit+1) end code 
      end subroutine clear_dict
    
      subroutine enc(ienc, m1, m00)
        integer, intent(out) :: ienc
        integer, intent(in ) :: m1
        integer, intent(in ), optional :: m00
        integer, save :: m0 
        integer :: k, ip
        if (present(m00)) m0 = m00
      if (m1 == 2**kbit + 1) then ! end code
        ienc = m0       
        
      else      
        k = ishft(m0, 16) + m1
        ip = findloc(dict, k, dim = 1)
    !   print *, 'k, kp, ip', k, kp, ip
        if (ip == 0) then ! not found in dictionary
          kp = kp + 1
          dict(kp) = k
          ienc = m0
          m0 = m1
        else ! found 
          ienc = -1
          m0 = ip
        end if  
 !       print *, 'm0 m1', m0, m1
      end if  
      end subroutine enc
    end module m_mod
    
    program lzw0
      use m_mod
      implicit none
      integer :: i, k
      integer, parameter :: dat(*) = [1, 1, 1, 2, 2, 2, 3, 3, 3, 1, 1, 1, 129]
      call clear_dict()
      call enc(k, dat(2), dat(1))
      print *, k
      do i = 3, size(dat)
        call enc(k, dat(i))  
        if (k /= -1) print *, k 
        if (dat(i) == 2**kbit + 1) then 
          print *, 00, 'end code'
        end if  
      end do  
     ! print *, dict(1:260)
    end program lzw0

出力結果

色データ
RRRGGGBBBRRR

           1
         130
           2
         132
           3
         134
         130
           1
           0 end code
続行するには何かキーを押してください . . .

上記の結果

[1, 130, 2, 132, 3, 134, 30, 1] を 100 回繰り返したデータを gif ファイルにする。

出力結果

想定通りの結果になったので、とりあえず最低限度は理解出来たっぽい。

ソースプログラム

    program gif
      use, intrinsic :: iso_fortran_env 
      implicit none
      integer :: iw
      integer(int16) :: m
      integer(int16), parameter :: nx = 12, ny = 100
      type :: t_gif_header
        sequence  
        character(3) :: signature = 'GIF'
        character(3) :: version   = '89a' ! '87a'
        integer(int16) :: width  = nx
        integer(int16) :: height = ny
        integer(int8)  :: pck   = int(B'10001001', int8) 
        integer(int8)  :: background_color_index = 0
        integer(int8)  :: pixel_aspect_ratio     = 0
      end type  
      integer(int8), allocatable :: global_color_table(:)
      type (t_gif_header) :: head
      
      type :: t_image_block
        sequence
        integer(int8) :: image_separator = Z'2C'
        integer(int16) :: image_left_position = 00
        integer(int16) :: image_top_position  = 00
        integer(int16) :: image_width  = nx 
        integer(int16) :: image_height = ny
        integer(int8) :: pck = int(B'00000000', int8)
        ! local color table
        !integer(int8) :: LZW_minimum_code_size 
        !integer(int8) :: block_size  
        !integer(int8) :: image_data
        !integer(int8) :: block_terminator = Z'00'  
      end type t_image_block
      
      type :: t_graphic_control_extension
        sequence  
        integer(int8) :: extention_introducer  = Z'21'
        integer(int8) :: graphic_control_label = Z'F9'
        integer(int8) :: lock_size = Z'04'
        integer(int8) :: pck = Z'00'
        integer(int16) :: delay_time = 50 ! msec?
        integer(int8) :: transparent_color_index = 0
        integer(int8) :: block_terminator = Z'00'
      end type t_graphic_control_extension
      
      type :: t_application_extension ! for animation gif
        sequence  
        integer(int8) :: extension_intrducer = Z'21'
        integer(int8) :: extension_label = Z'FF'
        integer(int8) :: block_size_01 = Z'0B'
        character(len = 8) :: application_identifier = 'NETSCAPE'
        character(len = 3) :: application_authentication_code = '2.0'
        integer(int8) :: block_size_02 = Z'03' ! 0:block terminator
        integer(int8) :: n = Z'01' !application_data
        integer(int16) :: nloop = 0 ! 0:unlimited 
        integer(int8) :: block_terminator = Z'00'
      end type t_application_extension   
      
      type (t_image_block) :: img   
      type (t_graphic_control_extension) :: ext
      type (t_application_extension) :: anime
      integer :: i, nbits = 7
      integer, allocatable :: ipattern(:)
!
      open(newunit = iw, file = 'test.gif', access = 'stream')
!      
      allocate(global_color_table(3 * 2**nbits)) ! 
      global_color_table = 0
      global_color_table = int([0,0,0,255, 0, 0, 0,255,0, 0,0,255], int8) ! RGB
      write(iw) head      
      write(iw) global_color_table
!
!      write(iw) anime
! Frame 1
!      ipattern = [1, 1, 1, 2, 2, 2, 3, 3, 3, 1, 1, 1, 128]
      ipattern = [1, 130, 2, 132, 3, 134, 130, 1, 128]
      write(iw) ext 
      write(iw) img     
      write(iw) achar(nbits)
      do i = 1, 100
        write(iw) achar(size(ipattern)) ! data bytes  
        write(iw) achar(ipattern)       ! data // clear code = 128 = Z'80'
      end do  
      write(iw) achar(1)   ! 1byte         
      write(iw) achar(129) ! end code
      write(iw) achar(00) ! block_terminator
!
      write(iw) achar(int(Z'3B'))    
    end program gif

圧縮の効く例

150*200 dots

出力

ソースプログラム

    program gif
      use, intrinsic :: iso_fortran_env 
      implicit none
      integer :: iw
      integer(int16) :: m
      integer(int16), parameter :: nx = 150, ny = 200
      type :: t_gif_header
        sequence  
        character(3) :: signature = 'GIF'
        character(3) :: version   = '89a' ! '87a'
        integer(int16) :: width  = nx
        integer(int16) :: height = ny
        integer(int8)  :: pck   = int(B'10001001', int8) 
        integer(int8)  :: background_color_index = 0
        integer(int8)  :: pixel_aspect_ratio     = 0
      end type  
      integer(int8), allocatable :: global_color_table(:)
      type (t_gif_header) :: head
      
      type :: t_image_block
        sequence
        integer(int8) :: image_separator = Z'2C'
        integer(int16) :: image_left_position = 00
        integer(int16) :: image_top_position  = 00
        integer(int16) :: image_width  = nx 
        integer(int16) :: image_height = ny
        integer(int8) :: pck = int(B'00000000', int8)
        ! local color table
        !integer(int8) :: LZW_minimum_code_size 
        !integer(int8) :: block_size  
        !integer(int8) :: image_data
        !integer(int8) :: block_terminator = Z'00'  
      end type t_image_block
      
      type :: t_graphic_control_extension
        sequence  
        integer(int8) :: extention_introducer  = Z'21'
        integer(int8) :: graphic_control_label = Z'F9'
        integer(int8) :: lock_size = Z'04'
        integer(int8) :: pck = Z'00'
        integer(int16) :: delay_time = 50 ! msec?
        integer(int8) :: transparent_color_index = 0
        integer(int8) :: block_terminator = Z'00'
      end type t_graphic_control_extension
      
      type (t_image_block) :: img   
      type (t_graphic_control_extension) :: ext
      integer :: i, nbits = 7
      integer, allocatable :: ipattern(:)
!
      open(newunit = iw, file = 'test.gif', access = 'stream')
!      
      allocate(global_color_table(3 * 2**nbits)) ! 
      global_color_table = 0
      global_color_table = int([0,0,0,255, 0, 0, 0,255,0, 0,0,255], int8) ! RGB
      write(iw) head      
      write(iw) global_color_table
! Frame 1
!      ipattern = [spread([1], 1, 50), spread([2], 1, 50), spread([3], 1, 50), 128]
      ipattern = [1, 130, 131, 132, 133, 134, 135, 136, 137, 133, &
                  2, 140, 141, 142, 143, 144, 145, 146, 147, 143, &
                  3, 150, 151, 152, 153, 154, 155, 156, 157, 153, 128]
      write(iw) ext 
      write(iw) img     
      write(iw) achar(nbits)
      do i = 1, 200
        write(iw) achar(size(ipattern)) ! data bytes  
        write(iw) achar(ipattern)       ! data // clear code = 128 = Z'80'
      end do  
      write(iw) achar(1)   ! 1byte         
      write(iw) achar(129) ! end code
      write(iw) achar(00) ! block_terminator
!
      write(iw) achar(int(Z'3B'))    
    end program gif