program ft8one
  implicit none
  integer, parameter :: sr = 12000, bits_per_sample = 16
  integer, parameter :: channels = 1, num_samples = 151680
  integer(4) :: i, byte_rate, block_align, data_chunk_size, file_size
  real(4) :: t, freq, amplitude
  integer(2) :: sample
  real(4), parameter :: pi = 3.1415927
  character(len=*), parameter :: fname = 'ft8_W1YK_KC1IKY.wav'

  open(unit=10, file=fname, access='stream', form='unformatted', status='replace', convert='little_endian')

  block_align = channels * bits_per_sample / 8
  byte_rate = sr * block_align
  data_chunk_size = num_samples * block_align
  file_size = 36 + data_chunk_size

  ! --- RIFF header ---
  call write_chars('RIFF')
  call write_u4(file_size)
  call write_chars('WAVE')

  ! --- fmt chunk ---
  call write_chars('fmt ')
  call write_u4(16)                                ! PCM header length
  call write_u2(1)                                  ! Format code: PCM
  call write_u2(channels)
  call write_u4(sr)
  call write_u4(byte_rate)
  call write_u2(block_align)
  call write_u2(bits_per_sample)

  ! --- data chunk ---
  call write_chars('data')
  call write_u4(data_chunk_size)

  ! --- waveform: 1500 Hz tone ---
  amplitude = 3000.0
  freq = 1500.0

  do i = 0, num_samples - 1
    t = real(i) / sr
    sample = int(amplitude * sin(2.0 * pi * freq * t))
    call write_i16(sample)
  end do

  close(10)
  print *, '✅ Wrote ', fname, ' with ', num_samples, ' samples.'

contains

  subroutine write_chars(s)
    character(len=*), intent(in) :: s
    integer :: i
    do i = 1, len_trim(s)
      write(10) achar(iachar(s(i:i)))
    end do
  end subroutine

  subroutine write_u2(n)
    integer(2), intent(in) :: n
    integer(1) :: b(2)
    b(1) = transfer(iand(n, z'00FF'), b(1))
    b(2) = transfer(ishft(n, -8), b(1))
    write(10) b
  end subroutine

  subroutine write_u4(n)
    integer(4), intent(in) :: n
    integer(1) :: b(4)
    b(1) = transfer(iand(n, z'000000FF'), b(1))
    b(2) = transfer(iand(ishft(n, -8), z'000000FF'), b(1))
    b(3) = transfer(iand(ishft(n, -16), z'000000FF'), b(1))
    b(4) = transfer(iand(ishft(n, -24), z'000000FF'), b(1))
    write(10) b
  end subroutine

  subroutine write_i16(n)
    integer(2), intent(in) :: n
    call write_u2(transfer(n, n))  ! Write signed 16-bit sample
  end subroutine

end program ft8one