package assembly pc_sound is

if memory_model = 0 then
  pragma memory_model(0);
else
  pragma memory_model(1);
end if;

CSEG
        jmp     main                    -- jump to initialization

DSEG
prevwhistle db ?
a_sample_duration dw ?
on_off_bytes db 256 dup(?)

CSEG
on_off_pattern equ  $
 dw 2#00000000_11111111#       -- 0    nibbles are in sign+magnitude form
 dw 2#00000001_11111111#       -- 1
 dw 2#00000011_11111111#       -- 2
 dw 2#00000111_11111111#       -- 3
 dw 2#00001111_11111111#       -- 4
 dw 2#00011111_11111111#       -- 5
 dw 2#00111111_11111111#       -- 6
 dw 2#01111111_11111111#       -- 7
 dw 2#00000000_11111110#       -- -1
 dw 2#00000000_01111110#       -- -2
 dw 2#00000000_00111110#       -- -3
 dw 2#00000000_00011110#       -- -4
 dw 2#00000000_00001110#       -- -5
 dw 2#00000000_00000110#       -- -6
 dw 2#00000000_00000010#       -- -7
 dw 2#00000000_00000000#       -- -8

get_ticks:             -- return current tick count in ax
       xor al,al
       pushf           --  save int enable status
       cli             --  lock out interrupts
       out 43h,al      --  read counter 0
       jmp short gtl   --    (don't go too fast)
gtl:
       in al,40h       --  get lsb of timer
       xchg ah,al      --
       jmp short gth   --    (don't go too fast)
gth:
       in al,40h       --  get msb of timer
       xchg ah,al      --
       popf            --  restore int enable status
       ret

play_ax_till_dx:       -- destroys ax,bx
                       -- high nibble of al contains amplitude
                       -- dx contains timeout value
       mov bx,on_off_bytes
       add bx,ax
       xchg si,bx
       even
pbd_loop:              -- output 16 speaker on/off bytes, then,
       push dx         -- if we haven't timed out, do it again
       mov dx,61h
       lodsw
       out dx,al
       mov al,ah
       out dx,al
       lodsw
       out dx,al
       mov al,ah
       out dx,al
       lodsw
       out dx,al
       mov al,ah
       out dx,al
       lodsw
       out dx,al
       mov al,ah
       out dx,al
       lodsw
       out dx,al
       mov al,ah
       out dx,al
       lodsw
       out dx,al
       mov al,ah
       out dx,al
       lodsw
       out dx,al
       mov al,ah
       out dx,al
       lodsw
       out dx,al
       xor al,al
       pushf           --  save int enable status
       cli             --  lock out interrupts
       out 43h,al      --  read counter 0
       mov al,ah
       out dx,al
       in al,40h       --  get lsb of timer
       xchg ah,al      --
       sub si,16
       in al,40h       --  get msb of timer
       xchg ah,al      --
       popf            --  restore int enable status
       pop dx
       cmp ax,dx
       jns pbd_loop
       xchg si,bx
       ret

play_it_out:
                       -- ds:si => sound block
                       -- cx    => N of bytes in sound block
                       -- destroys ax,bx,dx and si,cx
       call get_ticks
       mov dx,ax
       cld
play_it_out_loop:
       mov al,es:[si]
       and ax,16#00F0#;
       sub dx,[a_sample_duration]
       call play_ax_till_dx
       mov al,es:[si]
       inc si
       and ax,16#000F#
       shl al,1
       shl al,1
       shl al,1
       shl al,1
       sub dx,[a_sample_duration]
       call play_ax_till_dx
       loop play_it_out_loop
       mov al,[prevwhistle]
       out 61h,al
       ret

procedure set_sample_rate(samples_per_second:in sample_rates) is
       pop ax          -- save ret address
       if memory_model = 1 then
         pop dx
       end if;
       pop cx          -- cx:=sound_length
       if memory_model = 1 then  -- restore ret address
         push dx
       end if;
       push ax
       mov ax,13532    -- dx:ax := 1193180
       mov dx,18
       div cx
       mov [a_sample_duration],ax
       if memory_model = 0 then
         ret
       else
         ret far
       end if;
end set_sample_rate;

procedure playback(sound:in system.address;sound_length:in natural) is
                       -- clobbers ax,bx,cx,dx,si
       pop ax          -- save ret address
       if memory_model = 1 then
         pop dx
       end if;
       pop cx          -- cx:=sound_length
       pop si          -- si:=sound(sound'first)'address
       mov bx,es
       les si,lword ptr[si]
       if memory_model = 1 then  -- restore ret address
         push dx
       end if;
       push ax
       push bx
       call play_it_out
       pop  es
       if memory_model = 0 then
         ret
       else
         ret far
       end if;
end playback;

main:
       mov ax,149      -- default sample rate:=8K
       mov [a_sample_duration],ax
       in al,61h
       mov [prevwhistle],al
       and al,16#FD#
       mov bl,al               -- fill on_off_bytes with 16 lists of 16
       mov di,on_off_bytes     -- speaker control bytes, on and off matching
       mov cx,16               -- the bits in on_off_pattern
       cld
       mov si,on_off_pattern
amplitude_loop:
       push cx
       seg cs
       lodsw
       mov cx,16
bit_loop:
       mov bh,2        --      bh:=non_speaker_bits | one bit from ax
       and bh,al
       or  bh,bl
       mov [di],bh
       inc di
       ror ax,1
       loop bit_loop
       pop cx
       loop amplitude_loop
end pc_sound;