【メモ帳】アニメ gif

animated gif テスト

先人の馴らしてくれた道を進んで、実行例を作ることができました。
GIFフォーマットの詳細

次は LZW 部分に進みたいと思います。

実行結果

ソース・プログラム

    program gif
      use, intrinsic :: iso_fortran_env 
      implicit none
      integer :: iw
      integer(int16) :: m
      integer(int16), parameter :: nx = 160, ny = 160
      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 = 3
      integer, allocatable :: ipattern(:)
!
      open(newunit = iw, file = 'test.gif', access = 'stream')
!      
      allocate(global_color_table(3 * 2**4)) ! 
      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 = [Z'11', Z'21', Z'22', Z'38', Z'33', Z'82']
      write(iw) ext 
      write(iw) img     
      write(iw) achar(nbits)
      do i = 1, 64
        write(iw) achar(240)            
        write(iw) achar(spread(ipattern, 2, 40))
      end do  
      write(iw) achar(1)            
      write(iw) achar(09)
      write(iw) achar(00) ! block_terminator
! Frame 2
      ipattern = [Z'22', Z'32', Z'33', Z'18', Z'11', Z'83']
      write(iw) ext 
      write(iw) img     
      write(iw) achar(nbits)
      do i = 1, 64
        write(iw) achar(240)            
        write(iw) achar(spread(ipattern, 2, 40))
      end do  
      write(iw) achar(1)            
      write(iw) achar(09)
      write(iw) achar(00) ! block_terminator
! Frame 3
      ipattern = [Z'33', Z'13', Z'11', Z'28', Z'22', Z'81']
      write(iw) ext 
      write(iw) img     
      write(iw) achar(nbits)
      do i = 1, 64
        write(iw) achar(240)            
        write(iw) achar(spread(ipattern, 2, 40))
      end do  
      write(iw) achar(1)            
      write(iw) achar(09)
      write(iw) achar(00) ! block_terminator
!
      write(iw) achar(int(Z'3B'))    
    end program gif

（H30.4.22 微修正)