【メモ帳】gif (3+1) bit

Fortran wiki に gif ルーチンがあったｗ

read_gif in Fortran Wiki
writegif in Fortran Wiki

しかし、気にせず進む。

4bit 可変長

昨日までは二重にバグって正しく動いていたｗｗ

カラーテーブルに数値を代入するところで、　global_color_table(:) の (:) をつけなかったせいで、F2003 の配列の自動再割り付けによって、サイズが４に再割り付けされていた。(:) をつけておけば、データ数が少なくても再割り付けされずに先頭から代入される。

  global_color_table(:) = int([0,0,0,255, 0, 0, 0,255,0, 0,0,255, 255, 255, 0], int8) 

(3+1)bit=4bit 長から始めて、途中で辞書サイズ 2^4 に達してデータ長が 5bit に伸びる。

実行結果

ソースプログラム

    program gif
      use, intrinsic :: iso_fortran_env 
      implicit none
      integer :: iw
      integer(int16) :: m
      integer(int16), parameter :: nx = 130, 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'10001010', 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 = 3
      integer, allocatable :: ipattern(:)
!
      open(newunit = iw, file = 'test.gif', access = 'stream')
!      
      allocate(global_color_table(3 * 2**3)) ! 
      global_color_table = 0
      global_color_table(:) = int([0,0,0,255, 0, 0, 0,255,0, 0,0,255, 255, 255, 0], int8) ! RGB
      write(iw) head      
      write(iw) global_color_table
! Frame 1
!     RRRGGGGBBBBGG
! 01 : 01  4bit                         1 
! 10 : 0A  4bit  1byte                  A   A1
! 02 : 02  4bit                         2
! 12 : 0C  4bit  2bytes                 C   C2  
! 02 : 02  4bit                         2
! 03 : 03  4bit  3bytes                 3   32 
! 15 : 0F  4bit                         F  
! 03 : 03  5bit  4bytes + 1bit          3   3F
! 02 : 02  5bit  4bytes + 6bits         4   
! 02 : 02  5bit  5bytes + 3bits         8   84
! 08 : 08  5bit  5bytes + 8bits = 6byte 4 0 40
      ipattern = [ Z'A1', Z'C2', Z'32', Z'3F', Z'84', Z'40' ]
      write(iw) ext 
      write(iw) img     
      write(iw) achar(nbits)
      do i = 1, 200 * 10
        write(iw) achar(size(ipattern)) ! data bytes  
        write(iw) achar(ipattern)       ! data // clear code = 8 = Z'08'
      end do  
      write(iw) achar(1)   ! 1byte         
      write(iw) achar(Z'09') ! end code
      write(iw) achar(00) ! block_terminator
!
      write(iw) achar(int(Z'3B'))    
    end program gif